Esope source files

   1 : C CHCASS    SOURCE    GOUNAND   14/01/31    21:15:05     7925           
   2 :       SUBROUTINE CHCASS(MENT,ICASS,MSOR)
   3 :       IMPLICIT REAL*8 (A-H,O-Z)
   4 :       IMPLICIT INTEGER (I-N)
   5 : C***********************************************************************
   6 : C NOM         : CHCASS
   7 : C DESCRIPTION : Change la casse d'un mot
   8 : C               icass = 0 passage en minuscule
   9 : C               icass = 1 passage en majuscule
  10 : C               MENT et MSOR peuvent être identiques.
  11 : C
  12 : C
  13 : C LANGAGE     : ESOPE
  14 : C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  15 : C               mél : gounand@semt2.smts.cea.fr
  16 : C***********************************************************************
  17 : C***********************************************************************
  18 : C HISTORIQUE : 24/01/2014 : création
  19 : C HISTORIQUE :
  20 : C HISTORIQUE :
  21 : C***********************************************************************
  22 :       EXTERNAL LONG
  23 :       CHARACTER*(*) MENT,MSOR
  24 :       CHARACTER*26 MINUSC,MAJUSC
  25 :       DATA MINUSC/'abcdefghijklmnopqrstuvwxyz'/
  26 :       DATA MAJUSC/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
  27 : *
  28 : * Executable statements
  29 : *
  30 :       LENT=LONG(MENT)
  31 :       LSOR=LONG(MSOR)
  32 :       LN=MIN(LENT,LSOR)
  33 :       IF(ICASS.EQ.1) THEN
  34 :          DO IN=1,LN
  35 :             ICAR=INDEX(MINUSC,MENT(IN:IN))
  36 :             IF (ICAR.NE.0) THEN
  37 :                MSOR(IN:IN)=MAJUSC(ICAR:ICAR)
  38 :             ELSE
  39 :                MSOR(IN:IN)=MENT(IN:IN)
  40 :             ENDIF
  41 :          ENDDO
  42 :       ELSE
  43 :          DO IN=1,LN
  44 :             ICAR=INDEX(MAJUSC,MENT(IN:IN))
  45 :             IF (ICAR.NE.0) THEN
  46 :                MSOR(IN:IN)=MINUSC(ICAR:ICAR)
  47 :             ELSE
  48 :                MSOR(IN:IN)=MENT(IN:IN)
  49 :             ENDIF
  50 :          ENDDO
  51 :       ENDIF
  52 :       RETURN
  53 : *
  54 : * End of subroutine CHCASS
  55 : *
  56 :       END
  57 : 
  58 : 
  59 : 
  60 :