Esope source files

   1 : C VENV      SOURCE    PV        08/05/13    21:15:05     6100           
   2 : 
   3 :       SUBROUTINE VENV
   4 : 
   5 :       IMPLICIT INTEGER (I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : 
   8 : -INC CCOPTIO
   9 : 
  10 :       CHARACTER*500 CVARENV
  11 :       EQUIVALENCE (CVARENV,IVARENV)
  12 : 
  13 :       CHARACTER CHARUNI
  14 :       CHARACTER*63 CHARREF
  15 : 
  16 :       DATA CHARREF( 1:26) / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /
  17 :       DATA CHARREF(27:52) / 'abcdefghijklmnopqrstuvwxyz' /
  18 :       DATA CHARREF(53:63) / '_0123456789'/
  19 : 
  20 : C= Initialisations
  21 :       CVARENV=' '
  22 :       LVARENV=0
  23 : 
  24 : C= Lecture de l'unique argument (nom de la variable d'environnement)
  24 :       CALL LIRCHA(CVARENV,1,LVARENV)
  25 :       IF (IERR.NE.0) RETURN
  26 : 
  27 : C= Enlevement des espaces du nom de la variable
  28 :       j=0
  29 :       DO i=1,LVARENV
  30 :         CHARUNI=CVARENV(i:i)
  31 :         IF (CHARUNI.NE.' ') THEN
  32 :           j=j+1
  33 :           CVARENV(j:j)=CHARUNI
  34 :         ENDIF
  35 :       ENDDO
  36 :       LVARENV=j
  37 :       IF (LVARENV.EQ.0) THEN
  37 :         CALL ERREUR(1008)
  38 :         RETURN
  39 :       ENDIF
  40 : 
  41 : C= Verification de la validite du nom de la variable (caracteres utilises)
  42 : C= Le premier caractere doit etre une lettre ou le symbole "_".
  43 :       CHARUNI=CVARENV(1:1)
  44 :       DO j=1,53
  45 :         IF (CHARUNI.EQ.CHARREF(j:j)) GOTO 10
  46 :       ENDDO
  46 :       CALL ERREUR(1008)
  47 :       RETURN
  48 : C= Les caracteres suivants sont des lettres, chiffres ou "_".
  49 :  10   CONTINUE
  50 :       DO i=2,LVARENV
  51 :         CHARUNI=CVARENV(i:i)
  52 :         DO j=1,63
  53 :           IF (CHARUNI.EQ.CHARREF(j:j)) GOTO 20
  54 :         ENDDO
  54 :         CALL ERREUR(1008)
  55 :         RETURN
  56 :  20     CONTINUE
  57 :       ENDDO
  58 : 
  59 : C= Appel au sousprogramme Esope pour obtenir le contenu de la variable
  60 :       CVARENV=CVARENV(1:LVARENV)//CHAR(0)
  61 :       lvarenv=500
  61 :       CALL OOOZEN(IVARENV,LVARENV)
  62 : 
  63 : C= Ecriture du contenu de la variable
  64 : C= Si elle n'est pas definie, on renvoie un mot/chaine d'un seul espace.
  65 :       IF (LVARENV.EQ.0) THEN
  65 :         CALL ECRCHA(' ')
  66 :       ELSE
  66 :         CALL ECRCHA(CVARENV(1:LVARENV))
  67 :       ENDIF
  68 : 
  69 :       RETURN
  70 :       END
  71 : 
  72 :  
  73 :