Sources Esope | Cast3M

venv
C VENV      SOURCE    PV        08/05/13    21:15:05     6100
 
      SUBROUTINE VENV
 
      IMPLICIT INTEGER (I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
 
C     LOCHAI dans CCNOYAU.INC
      CHARACTER*(LOCHAI) CVARENV
      EQUIVALENCE (CVARENV,IVARENV)
 
      CHARACTER CHARUNI
      CHARACTER*63 CHARREF
 
      DATA CHARREF( 1:26) / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /
      DATA CHARREF(27:52) / 'abcdefghijklmnopqrstuvwxyz' /
      DATA CHARREF(53:63) / '_0123456789'/
 
C= Initialisations
      CVARENV=' '
      LVARENV=0
 
C= Lecture de l'unique argument (nom de la variable d'environnement)
      CALL LIRCHA(CVARENV,1,LVARENV)
      IF (IERR.NE.0) RETURN
 
C= Enlevement des espaces du nom de la variable
      j=0
      DO i=1,LVARENV
        CHARUNI=CVARENV(i:i)
        IF (CHARUNI.NE.' ') THEN
          j=j+1
          CVARENV(j:j)=CHARUNI
        ENDIF
      ENDDO
      LVARENV=j
      IF (LVARENV.EQ.0) THEN
        CALL ERREUR(1008)
        RETURN
      ENDIF
 
C= Verification de la validite du nom de la variable (caracteres utilises)
C= Le premier caractere doit etre une lettre ou le symbole "_".
      CHARUNI=CVARENV(1:1)
      DO j=1,53
        IF (CHARUNI.EQ.CHARREF(j:j)) GOTO 10
      ENDDO
      CALL ERREUR(1008)
      RETURN
C= Les caracteres suivants sont des lettres, chiffres ou "_".
 10   CONTINUE
      DO i=2,LVARENV
        CHARUNI=CVARENV(i:i)
        DO j=1,63
          IF (CHARUNI.EQ.CHARREF(j:j)) GOTO 20
        ENDDO
        CALL ERREUR(1008)
        RETURN
 20     CONTINUE
      ENDDO
 
C= Appel au sousprogramme Esope pour obtenir le contenu de la variable
      CVARENV=CVARENV(1:LVARENV)//CHAR(0)
      lvarenv=500
      CALL OOOZEN(IVARENV,LVARENV)
 
C= Ecriture du contenu de la variable
C= Si elle n'est pas definie, on renvoie un mot/chaine d'un seul espace.
      IF (LVARENV.EQ.0) THEN
        CALL ECRCHA(' ')
      ELSE
        CALL ECRCHA(CVARENV(1:LVARENV))
      ENDIF
 
      RETURN
      END