C
C This file is issued from the MODULEF library, but has been 
C subsequently modified
C
      SUBROUTINE FONOP1(NCODOP,IMODE,MOPN,MI,MR,ML,MC,MD,ICODE)
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C           S.P. FONOP1          (FONCTIONS INTERPRETEES)
C           -----------
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C BUT :
C     EFFECTUER UNE OPERATION UNAIRE
C
C PARAMETRES D ENTREE :
C     NCODOP  : CODE OPERATION
C     IMODE   : 1 OPERATION SUR LES TYPES SEULEMENT
C             : 0 OPERATION SUR LES TYPES ET LES VALEURS
C     MOPN    : PILE DES OPERANDES
C     MI,MR,ML,MC,MD : TABLE DES CONSTANTES ENTIERES, REELLES, ...
C
C PARAMETRES DE SORTIE :
C     ICODE   : CODE DE RETOUR (VOIR LE S.P. FONERR)
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C PROGRAMMEUR : PATRICK LAUG ; INRIA (3) 954 90 20 POSTE 508
C ......................................................................
      INTEGER          MOPN(*),MI(*)
      REAL             MR(*)
      LOGICAL          ML(*)
      INTEGER          MC(*)
      DOUBLE PRECISION MD(*)
      COMMON /FONLC / LCI,LCR,LCL,LCC,LCD,LCOPN,LCOPT,LCSYM,LCEXP,LCIDN
      COMMON /FONLM / LMI,LMR,LML,LMC,LMD,LMOPN,LMOPT,LMSYM,LMEXP,LMIDN
C
C REPERAGE DES OPERANDES
      ICODE = 0
      IF (NCODOP .EQ. 1) RETURN
      ITYPE1 = (MOPN(LCOPN)-30 000) / 1000
      IF (ITYPE1.GT.2) GOTO 800
      I1 = MOPN(LCOPN) - (30 000 + ITYPE1*1000)
      ITYPE2 = ITYPE1
      IF (NCODOP .EQ. 3) ITYPE2 = 1
      IF (NCODOP .EQ. 4) ITYPE2 = 2
      IF (NCODOP .EQ. 5) ITYPE2 = 5
      I2 = (LMI - LMOPN) + LCOPN
      MOPN(LCOPN) = (30 000 + ITYPE2*1000) + I2
      IF (IMODE.NE.0) RETURN
C
C BRANCHEMENT SELON NCODOP
      GOTO (20,30,40,50,60,70,80,90,
     +  100,110,120,130,140,150,160,170,180,190),NCODOP-1
      GOTO 800
C
C  2 : - UNAIRE
   20 GOTO (21,22,23,800,25),ITYPE1
   21 MI(I2) = -MI(I1)
      GOTO 900
   22 MR(I2) = -MR(I1)
      GOTO 900
   23 ML(I2) = .NOT. ML(I1)
      GOTO 900
   25 MD((I2+1)/2) = -MD((I1+1)/2)
      GOTO 900
C
C  3 : INT
   30 GOTO (31,32,800,800,35),ITYPE1
   31 MI(I2) = INT(MI(I1))
      GOTO 900
   32 MI(I2) = INT(MR(I1))
      GOTO 900
   35 MI(I2) = INT(MD(I1))
      GOTO 900
C
C  4 : REAL
   40 GOTO (41,42,800,800,45),ITYPE1
   41 MR(I2) = REAL(MI(I1))
      GOTO 900
   42 MR(I2) = REAL(MR(I1))
      GOTO 900
   45 MR(I2) = REAL(MD(I1))
      GOTO 900
C
C  5 : DBLE
   50 GOTO (51,52,800,800,55),ITYPE1
   51 MD(I2) = DBLE(MI(I1))
      GOTO 900
   52 MD(I2) = DBLE(MR(I1))
      GOTO 900
   55 MD(I2) = DBLE(MD(I1))
      GOTO 900
C
C  6 : ABS
   60 GOTO (61,62,800,800,65),ITYPE1
   61 MI(I2) = ABS(MI(I1))
      GOTO 900
   62 MR(I2) = ABS(MR(I1))
      GOTO 900
   65 MD(I2) = ABS(MD(I1))
      GOTO 900
C
C  7 : SQRT
   70 GOTO (71,72,800,800,75),ITYPE1
   71 MI(I2) = SQRT(REAL(MI(I1)))
      GOTO 900
   72 MR(I2) = SQRT(MR(I1))
      GOTO 900
   75 MD(I2) = SQRT(MD(I1))
      GOTO 900
C
C  8 : EXP
   80 GOTO (81,82,800,800,85),ITYPE1
   81 MI(I2) = EXP(REAL(MI(I1)))
      GOTO 900
   82 MR(I2) = EXP(MR(I1))
      GOTO 900
   85 MD(I2) = EXP(MD(I1))
      GOTO 900
C
C  9 : LOG
   90 GOTO (91,92,800,800,95),ITYPE1
   91 MI(I2) = LOG(REAL(MI(I1)))
      GOTO 900
   92 MR(I2) = LOG(MR(I1))
      GOTO 900
   95 MD(I2) = LOG(MD(I1))
      GOTO 900
C
C 10 : LOG10
  100 GOTO (101,102,800,800,105),ITYPE1
  101 MI(I2) = LOG10(REAL(MI(I1)))
      GOTO 900
  102 MR(I2) = LOG10(MR(I1))
      GOTO 900
  105 MD(I2) = LOG10(MD(I1))
      GOTO 900
C
C 11 : SIN
  110 GOTO (111,112,800,800,115),ITYPE1
  111 MI(I2) = SIN(REAL(MI(I1)))
      GOTO 900
  112 MR(I2) = SIN(MR(I1))
      GOTO 900
  115 MD(I2) = SIN(MD(I1))
      GOTO 900
C
C 12 : COS
  120 GOTO (121,122,800,800,125),ITYPE1
  121 MI(I2) = COS(REAL(MI(I1)))
      GOTO 900
  122 MR(I2) = COS(MR(I1))
      GOTO 900
  125 MD(I2) = COS(MD(I1))
      GOTO 900
C
C 13 : TAN
  130 GOTO (131,132,800,800,135),ITYPE1
  131 MI(I2) = TAN(REAL(MI(I1)))
      GOTO 900
  132 MR(I2) = TAN(MR(I1))
      GOTO 900
  135 MD(I2) = TAN(MD(I1))
      GOTO 900
C
C 14 : ASIN
  140 GOTO (141,142,800,800,145),ITYPE1
  141 MI(I2) = ASIN(REAL(MI(I1)))
      GOTO 900
  142 MR(I2) = ASIN(MR(I1))
      GOTO 900
  145 MD(I2) = ASIN(MD(I1))
      GOTO 900
C
C 15 : ACOS
  150 GOTO (151,152,800,800,155),ITYPE1
  151 MI(I2) = ACOS(REAL(MI(I1)))
      GOTO 900
  152 MR(I2) = ACOS(MR(I1))
      GOTO 900
  155 MD(I2) = ACOS(MD(I1))
      GOTO 900
C
C 16 : ATAN
  160 GOTO (161,162,800,800,165),ITYPE1
  161 MI(I2) = ATAN(REAL(MI(I1)))
      GOTO 900
  162 MR(I2) = ATAN(MR(I1))
      GOTO 900
  165 MD(I2) = ATAN(MD(I1))
      GOTO 900
C
C 17 : SINH
  170 GOTO (171,172,800,800,175),ITYPE1
  171 MI(I2) = SINH(REAL(MI(I1)))
      GOTO 900
  172 MR(I2) = SINH(MR(I1))
      GOTO 900
  175 MD(I2) = SINH(MD(I1))
      GOTO 900
C
C 18 : COSH
  180 GOTO (181,182,800,800,185),ITYPE1
  181 MI(I2) = COSH(REAL(MI(I1)))
      GOTO 900
  182 MR(I2) = COSH(MR(I1))
      GOTO 900
  185 MD(I2) = COSH(MD(I1))
      GOTO 900
C
C 19 : TANH
  190 GOTO (191,192,800,800,195),ITYPE1
  191 MI(I2) = TANH(REAL(MI(I1)))
      GOTO 900
  192 MR(I2) = TANH(MR(I1))
      GOTO 900
  195 MD(I2) = TANH(MD(I1))
      GOTO 900
C
C RETOUR (AVEC OU SANS ERREUR)
  800 ICODE = 17
  900 RETURN
      END
