1C
2C This file is issued from the MODULEF library, but has been
3C subsequently modified
4C
5      SUBROUTINE FONOP2(NCODOP,IMODE,MOPN,MI,MR,ML,MC,MD,ICODE)
6C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
7C           S.P. FONOP2          (FONCTIONS INTERPRETEES)
8C           -----------
9C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
10C BUT :
11C     EFFECTUER UNE OPERATION BINAIRE
12C
13C PARAMETRES D ENTREE :
14C     NCODOP  : CODE OPERATION
15C     IMODE   : 1 OPERATION SUR LES TYPES SEULEMENT
16C             : 0 OPERATION SUR LES TYPES ET LES VALEURS
17C     MOPN    : PILE DES OPERANDES
18C     MI,MR,ML,MC,MD : TABLE DES CONSTANTES ENTIERES, REELLES, ...
19C
20C PARAMETRES DE SORTIE :
21C     ICODE   : CODE DE RETOUR (VOIR LE S.P. FONERR)
22C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
23C PROGRAMMEUR : PATRICK LAUG ; INRIA (3) 954 90 20 POSTE 508
24C ......................................................................
25      INTEGER          MOPN(*),MI(*)
26      REAL             MR(*)
27      LOGICAL          ML(*)
28      INTEGER          MC(*)
29      DOUBLE PRECISION MD(*)
30      COMMON /FONLC / LCI,LCR,LCL,LCC,LCD,LCOPN,LCOPT,LCSYM,LCEXP,LCIDN
31      COMMON /FONLM / LMI,LMR,LML,LMC,LMD,LMOPN,LMOPT,LMSYM,LMEXP,LMIDN
32C
33C REPERAGE DES OPERANDES
34      ICODE = 0
35      LCOPN = LCOPN - 1
36      IF (LCOPN.LE.0) GOTO 800
37      ITYPE1 = (MOPN(LCOPN)-30 000) / 1000
38      IF (ITYPE1.GT.2) GOTO 800
39      II = 30 000 + ITYPE1*1000
40      I1 = MOPN(LCOPN) - II
41      ITYPE2 = (MOPN(LCOPN+1)-30 000) / 1000
42      IF (ITYPE2.NE.ITYPE1) GOTO 800
43      I2 = MOPN(LCOPN+1) - II
44      I3 = (LMI - LMOPN) + LCOPN
45      MOPN(LCOPN) = II + I3
46      IF (IMODE.NE.0) RETURN
47C
48C BRANCHEMENT SELON NCODOP
49      GOTO (10,20,30,40,50,60,70,80,90,100,110,120,130,140),NCODOP
50      GOTO 800
51C
52C
53C  1: +
54   10 GOTO (11,12,13,800,15),ITYPE1
55   11 MI(I3) = MI(I1) + MI(I2)
56      GOTO 900
57   12 MR(I3) = MR(I1) + MR(I2)
58      GOTO 900
59   13 ML(I3) = ML(I1) .OR. ML(I2)
60      GOTO 900
61   15 MD(I3) = MD(I1) + MD(I2)
62      GOTO 900
63C
64C  2: -
65   20 GOTO (21,22,800,800,25),ITYPE1
66   21 MI(I3) = MI(I1) - MI(I2)
67      GOTO 900
68   22 MR(I3) = MR(I1) - MR(I2)
69      GOTO 900
70   25 MD(I3) = MD(I1) - MD(I2)
71      GOTO 900
72C
73C  3: *
74   30 GOTO (31,32,33,800,35),ITYPE1
75   31 MI(I3) = MI(I1) * MI(I2)
76      GOTO 900
77   32 MR(I3) = MR(I1) * MR(I2)
78      GOTO 900
79   33 ML(I3) = ML(I1) .AND. ML(I2)
80      GOTO 900
81   35 MD(I3) = MD(I1) * MD(I2)
82      GOTO 900
83C
84C  4: /
85   40 GOTO (41,42,800,800,45),ITYPE1
86   41 MI(I3) = MI(I1) / MI(I2)
87      GOTO 900
88   42 MR(I3) = MR(I1) / MR(I2)
89      GOTO 900
90   45 MD(I3) = MD(I1) / MD(I2)
91      GOTO 900
92C
93C  5: **
94   50 GOTO (51,52,800,800,55),ITYPE1
95   51 MI(I3) = MI(I1) ** MI(I2)
96      GOTO 900
97C --- ON UTILISE SI POSSIBLE UN EXPOSANT ENTIER
98   52 IEXP = NINT(MR(I2))
99      IF (REAL(IEXP).EQ.MR(I2)) THEN
100         MR(I3) = MR(I1) ** IEXP
101      ELSE
102         MR(I3) = MR(I1) ** MR(I2)
103      END IF
104      GOTO 900
105   55 IEXP = NINT(MD(I2))
106      IF (DBLE(IEXP).EQ.MD(I2)) THEN
107         MD(I3) = MD(I1) ** IEXP
108      ELSE
109         MD(I3) = MD(I1) ** MD(I2)
110      END IF
111      GOTO 900
112C
113C  6: .EQ.
114   60 GOTO (61,62,63,64,65),ITYPE1
115   61 ML(I3) = MI(I1) .EQ. MI(I2)
116      GOTO 900
117   62 ML(I3) = MR(I1) .EQ. MR(I2)
118      GOTO 900
119   63 ML(I3) = ML(I1) .EQV. ML(I2)
120      GOTO 900
121   64 ML(I3) = MC(I1) .EQ. MC(I2)
122      GOTO 900
123   65 ML(I3) = MD(I1) .EQ. MD(I2)
124      GOTO 900
125C
126C  7: .NE.
127   70 GOTO (71,72,73,74,75),ITYPE1
128   71 ML(I3) = MI(I1) .NE. MI(I2)
129      GOTO 900
130   72 ML(I3) = MR(I1) .NE. MR(I2)
131      GOTO 900
132   73 ML(I3) = ML(I1) .NEQV. ML(I2)
133      GOTO 900
134   74 ML(I3) = MC(I1) .NE. MC(I2)
135      GOTO 900
136   75 ML(I3) = MD(I1) .NE. MD(I2)
137      GOTO 900
138C
139C  8: .GT.
140   80 GOTO (81,82,800,800,85),ITYPE1
141   81 ML(I3) = MI(I1) .GT. MI(I2)
142      GOTO 900
143   82 ML(I3) = MR(I1) .GT. MR(I2)
144      GOTO 900
145   85 ML(I3) = MD(I1) .GT. MD(I2)
146      GOTO 900
147C
148C  9: .LT.
149   90 GOTO (91,92,800,800,95),ITYPE1
150   91 ML(I3) = MI(I1) .LT. MI(I2)
151      GOTO 900
152   92 ML(I3) = MR(I1) .LT. MR(I2)
153      GOTO 900
154   95 ML(I3) = MD(I1) .LT. MD(I2)
155      GOTO 900
156C
157C 10: .GE.
158  100 GOTO (101,102,800,800,105),ITYPE1
159  101 ML(I3) = MI(I1) .GE. MI(I2)
160      GOTO 900
161  102 ML(I3) = MR(I1) .GE. MR(I2)
162      GOTO 900
163  105 ML(I3) = MD(I1) .GE. MD(I2)
164      GOTO 900
165C
166C 11: .LE.
167  110 GOTO (111,112,800,800,115),ITYPE1
168  111 ML(I3) = MI(I1) .LE. MI(I2)
169      GOTO 900
170  112 ML(I3) = MR(I1) .LE. MR(I2)
171      GOTO 900
172  115 ML(I3) = MD(I1) .LE. MD(I2)
173      GOTO 900
174C
175C 12: MOD
176  120 GOTO (121,122,800,800,125),ITYPE1
177  121 MI(I3) = MOD(MI(I1), MI(I2))
178      GOTO 900
179  122 MR(I3) = MOD(MR(I1), MR(I2))
180      GOTO 900
181  125 MD(I3) = MOD(MD(I1), MD(I2))
182      GOTO 900
183C
184C 13: MIN
185  130 GOTO (131,132,800,800,135),ITYPE1
186  131 MI(I3) = MIN(MI(I1), MI(I2))
187      GOTO 900
188  132 MR(I3) = MIN(MR(I1), MR(I2))
189      GOTO 900
190  135 MD(I3) = MIN(MD(I1), MD(I2))
191      GOTO 900
192C
193C 14: MAX
194  140 GOTO (141,142,800,800,145),ITYPE1
195  141 MI(I3) = MAX(MI(I1), MI(I2))
196      GOTO 900
197  142 MR(I3) = MAX(MR(I1), MR(I2))
198      GOTO 900
199  145 MD(I3) = MAX(MD(I1), MD(I2))
200      GOTO 900
201C
202C RETOUR (AVEC OU SANS ERREUR)
203  800 ICODE = 18
204  900 RETURN
205      END
206