C CHCASS    SOURCE    GOUNAND   14/01/31    21:15:05     7925           
      SUBROUTINE CHCASS(MENT,ICASS,MSOR)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : CHCASS
C DESCRIPTION : Change la casse d'un mot
C               icass = 0 passage en minuscule
C               icass = 1 passage en majuscule
C               MENT et MSOR peuvent être identiques.
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C***********************************************************************
C HISTORIQUE : 24/01/2014 : création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
      EXTERNAL LONG
      CHARACTER*(*) MENT,MSOR
      CHARACTER*26 MINUSC,MAJUSC
      DATA MINUSC/'abcdefghijklmnopqrstuvwxyz'/
      DATA MAJUSC/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
*
* Executable statements
*
      LENT=LONG(MENT)
      LSOR=LONG(MSOR)
      LN=MIN(LENT,LSOR)
      IF(ICASS.EQ.1) THEN
         DO IN=1,LN
            ICAR=INDEX(MINUSC,MENT(IN:IN))
            IF (ICAR.NE.0) THEN
               MSOR(IN:IN)=MAJUSC(ICAR:ICAR)
            ELSE
               MSOR(IN:IN)=MENT(IN:IN)
            ENDIF
         ENDDO
      ELSE
         DO IN=1,LN
            ICAR=INDEX(MAJUSC,MENT(IN:IN))
            IF (ICAR.NE.0) THEN
               MSOR(IN:IN)=MINUSC(ICAR:ICAR)
            ELSE
               MSOR(IN:IN)=MENT(IN:IN)
            ENDIF
         ENDDO
      ENDIF
      RETURN
*
* End of subroutine CHCASS
*
      END