[updated 30.May.2000]

Librairie redlib > Fichier redval.f

Qui appelle redval ?

line
      SUBROUTINE REDVAL (TEXTE,TEXTEC,NER,FLOT)  
line
  Auteur : D.Martin (Mai 1996)
  Derniere modification : D.Martin (20 Mai 1996)
   
  Valeur d'expression mathematique unaire sous forme de chaine ASCII 
 
 -- Argument d'entree --
  TEXTE  chaine de caractere "expression mathematique"
  TEXTEC tableau de caracteres "equivalent"
  NER    numero de l'erreur en sortie (0 si OK)
  FLOT   valeur numerique de l'expression
line
      CHARACTER       TEXTE*(*),TEXTEC(*)
      INTEGER         NER
      DOUBLEPRECISION FLOT
 
      LOGICAL         EXCLLU,LITERA
      INTEGER         NEXTCH,LASTCH,NDEB,IRE,NFIX,N1,N2
     &               ,NBFUNC,NCFUNC,IFUNCT
      PARAMETER      (NBFUNC=21,NCFUNC=6)
      CHARACTER*6     ELFUNC(NBFUNC),FFUNCT
      CHARACTER       FLFUNC(6*NBFUNC)
      EQUIVALENCE    (FLFUNC,ELFUNC)
      DATA ELFUNC   /'ACOS  ','ARCCOS','ARCSIN','ARCTG ','ASIN  '
     &              ,'ATAN  ','CH    ','COS   ','COSH  ','EXP   '
     &              ,'LN    ','LOG   ','LOG10 ','SH    ','SIN   '
     &              ,'SINH  ','SQRT  ','TAN   ','TANH  ','TG    '
     &              ,'TH    '/
line
      LITERA =.TRUE.
      NER    = 0
      FLOT   = 0.D0
      NEXTCH = 1
      LASTCH = LEN(TEXTE)
      IF (TEXTE(1:1).EQ.'-'.OR.TEXTE(1:1).EQ.'+') NEXTCH=2
 
      NDEB = INDEX (TEXTE,'(')
      N2   = INDEX (TEXTE,')')
      IF (NDEB*N2.LE.0) THEN
         Cas d'un nombre 
         N1=NEXTCH
         N2=LASTCH
         CALL REDNBR (TEXTEC,N1,N2,LITERA,EXCLLU,IRE,NFIX,FLOT)
         IF (IRE.NE.1.AND.IRE.NE.2) GOTO 99998
      ELSEIF (NDEB.GT.NEXTCH+1) THEN
         Cas d'une fonction elementaire Fortran
         FFUNCT=TEXTE(NEXTCH:NDEB-1)
         N1=NDEB+1
         N2=N2-1
         Valeur de l'argument de la fonction
         CALL REDNBR (TEXTEC,N1,N2,LITERA,EXCLLU,IRE,NFIX,FLOT)
         IF (IRE.NE.1.AND.IRE.NE.2) GOTO 99998
         CALL DICCHN (1,NBFUNC,NCFUNC,FLFUNC,FFUNCT,IFUNCT,NFIX)        !utilite
         IF (NFIX.GT.0) THEN
            IF (IFUNCT.LE.2) THEN
            IF (ABS(FLOT).GT.1.D0) GOTO 99997
               FLOT = ACOS (FLOT)
            ELSEIF (IFUNCT.EQ.3.OR.IFUNCT.EQ.5) THEN
               IF (ABS(FLOT).GT.1.D0) GOTO 99997
               FLOT = ASIN (FLOT)
            ELSEIF (IFUNCT.EQ.4.OR.IFUNCT.EQ.6) THEN
               FLOT = ATAN (FLOT)
            ELSEIF (IFUNCT.EQ.8) THEN
               FLOT = COS (FLOT)
            ELSEIF (IFUNCT.EQ.7.OR.IFUNCT.EQ.9) THEN
               FLOT = COSH (FLOT)
            ELSEIF (IFUNCT.EQ.10) THEN
               FLOT = EXP (FLOT)
            ELSEIF (IFUNCT.EQ.11.OR.IFUNCT.EQ.12) THEN
               IF (FLOT.LE.0.D0) GOTO 99997
               FLOT = LOG (FLOT)
            ELSEIF (IFUNCT.EQ.13) THEN
               IF (FLOT.LE.0.D0) GOTO 99997
               FLOT = LOG10 (FLOT)
            ELSEIF (IFUNCT.EQ.15) THEN
               FLOT = SIN (FLOT)
            ELSEIF (IFUNCT.EQ.14.OR.IFUNCT.EQ.16) THEN
               FLOT = SINH (FLOT)
            ELSEIF (IFUNCT.EQ.17) THEN
               IF (FLOT.LE.0.D0) GOTO 99997
               FLOT = SQRT (FLOT)
            ELSEIF (IFUNCT.EQ.18.OR.IFUNCT.EQ.20) THEN
               FLOT = TAN (FLOT)
            ELSEIF (IFUNCT.EQ.19.OR.IFUNCT.EQ.21) THEN
               FLOT = TANH (FLOT)
            ENDIF
         ELSE
            Fonction elementaire non reconnue
            GOTO 99999
         ENDIF
      ELSE
         Cas d'un nombre entre parentheses
         N1=NDEB+1
         N2=N2-1
         CALL REDNBR (TEXTEC,N1,N2,LITERA,EXCLLU,IRE,NFIX,FLOT)
         IF (IRE.NE.1.AND.IRE.NE.2) GOTO 99998
      ENDIF
      IF (TEXTE(1:1).EQ.'-') FLOT = -FLOT
      RETURN
line
99997 NER=5
      RETURN
99998 NER=1
      RETURN
99999 NER=2
                                                                    END !RedVal
line
top

redval est appelé dans

top