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