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 CCOPTIO CHARACTER*500 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