Télécharger oooprm.eso

Retour à la liste

oooprm
C OOOPRM    SOURCE    PV090527  26/04/24    08:23:19     12524          
      SUBROUTINE OOOPRM (LRET,HKEY,HVAL,LVAL,IVAL)
C----------------------------------------------------------------------
C
C    RECHERCHE D'UN PARAMETRE A L'AIDE D'UN MOT CLE DANS UNE CHAINE
C
C   ->LRET  1  HKEY ABSENT  OU SYNTAXE ERRONNEE (IVAL=-1)
C           2  HKEY PRESENT ET PAS DE VALEUR    :     ,KEY,
C           3  HKEY PRESENT ET VALEUR NUMERIQUE :     ,KEY=17,CLE(17)
C           4  HKEY PRESENT ET VALEUR ALPHANUM  :     ,KEY=MOT,CLE(MOT)
C
C     HKEY     CONTIENT LE MOT CLE A RECHERCHER
C
C   ->HVAL     RECOIT LA VALEUR ALPHA QUI SUIT LE MOT-CLE  HKEY
C   ->LVAL     NOMBRE DE CARACTERES DE CETTE VALEUR ALPHA
C
C   ->IVAL     RECOIT LA VALEUR NUMERIQUE ENTIERE QUI SUIT HKEY
C
C PROGRAMMEUR : MOUGIN
C       MODIF : 01/02/89    ACCEPTER UN NOMBRE NEGATIF : PARAM=-7
C
C-----------------------------------------------------------------------
C
      CHARACTER *(*) HKEY,HVAL
      CHARACTER *1   H1
C
      CHARACTER *256 HPARM
      CHARACTER *  1 HPAR1(256)
      CHARACTER *26 VALMIN,VALMAX
 
      EQUIVALENCE   (HPAR1(1),HPARM)
      DATA VALMIN /'abcdefghijklmnopqrstuvwxyz'/
      DATA VALMAX /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
C
      SAVE INIT , HPARM ,LPARM
      DATA INIT  /0/
C
      LRET=2
      IVAL=0
      LVAL=0
      LKEY=LEN(HKEY)
C
C         CHERCHER LE PARM.GO ET LE CHARGER DS HPARM SI BESOIN
C
      IF (INIT.EQ.0)                                   THEN
        INIT=1
        CALL OOOZZ7 (LPARM,HPARM)
          DO I=1,LEN(HPARM)
            IRANG=INDEX(VALMIN,HPARM(I:I))
            IF (IRANG.GE.1.AND.IRANG.LE.26)
     *            HPARM(I:I)=VALMAX(IRANG:IRANG)
          ENDDO
        HPAR1(LPARM+1)=','
      ENDIF
      IF (LPARM.EQ.0)                                  GO TO 950
C
C-----------------------------------------------------------------------
C
C             CHERCHER LE MOT CLE  HKEY  DANS LA CHAINE HPARM
C
C   ->I1   INDICE DE LA VIRGULE PRECEDANT UN MOT-CLE
C   ->I2   INDICE DU CARACTERE  PRECEDANT LA VIRGULE SUIVANTE
C
      I2=0
 10   I1=I2
 11   IF (HPAR1(I2+1).NE.',')                          THEN
         I2=I2+1
                                                       GO TO 11
      ENDIF
 
 15   IF (HPARM(I1+1:I1+LKEY).EQ.HKEY)                 GO TO 50
C           CE N'EST PAS LE BON PARM-->2 EME PARTIE DU PARM SI PARM=?
C           RECHERCHE 2 EME PARTIE DU PARM SI PARM = OU (
 25      I1=I1+1
         H1=HPAR1(I1)
         IF (H1.EQ.'=' .OR. H1.EQ.'(')                 GO TO 15
         IF (I1.LT.I2)                                 GO TO 25
C            ARRET SI FIN DU CHAMP PARM
 30      I2=I2+1
         IF (I2.NE.LPARM+1)                            GO TO 10
                                                       GO TO 950
 
C-----------------------------------------------------------------------
C
C                    LE MOT-CLE  HKEY  EST TROUVE
C
C   ->I1   INDICE DU CARACTERE QUI SUIT LE MOT-CLE RECONNU
C   ->H1   VALEUR DE CE CARACTERE
C
 50   I1=I1+LKEY+1
      H1=HPAR1(I1)
      IF   (H1.EQ.',')                                 RETURN
      IF   (H1.NE.'=')                                 THEN
        IF (H1.NE.'(')                                 GO TO 30
        I2=I2-1
      ENDIF
C
C                       VALEUR DU PARAMETRE
C
      LVAL=I2-I1
      IF (LVAL.EQ.0)                                   RETURN
      HVAL=HPARM(I1+1:I1+LVAL)
      H1  =HPAR1(I1+1)
      N1  =ICHAR(H1)-ICHAR('0')
      IF ((N1.GE.0 .AND. N1.LE.9) .OR. H1.EQ.'-')      THEN
        IF (H1.EQ.'-')                                 THEN
          ISIGNE = -1
          I1     = I1+1
        ELSE
          ISIGNE = +1
        ENDIF
        DO    K=I1+1,I2
          H1  =HPAR1(K)
          N1=ICHAR(H1)-ICHAR('0')
          IF (N1.GE.0 .AND. N1.LE.9)                   THEN
            IVAL=IVAL*10+N1
          ELSE
                                                       GO TO 901
          ENDIF
        ENDDO
        IVAL = ISIGNE*IVAL
        LRET = 3
      ELSE
        LRET = 4
      ENDIF
                                                       RETURN
C
C******    ANOMALIE
C
 901  IVAL = -1
 950  LRET = 1
 
      END
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales