1 : C OPERPU SOURCE BP208322 12/05/24 21:15:00 7378 2 : SUBROUTINE OPERPU 3 : *_______________________________________________________________________ 4 : * 5 : * ELEVE UN NOMBRE A UNE PUISSANCE 6 : * 7 : * 8 : * PASCAL MANIGOT (12/03/85) : 9 : * REPRISE DE LA PROGRAMMATION POUR PERMETTRE LE CALCUL DE 10 : * "REEL ** ENTIER" (NOTAMMENT QUAND "REEL" EST NEGATIF). 11 : * 12 : * EBERSOLT (2 MAI 85) : REPRISE POUR PERMETTRE LE CALCUL DE 13 : * CHPO ** I2 OU DE CHEL ** I2 14 : * CHPO ** X2 OU DE CHEL ** X2 15 : * rem : DANS LE CAS OU UNE DES COMPOSANTES DU CHAMP EST 16 : * EST NEGATIVE ET SI L EXPOSANT EST REEL 17 : * ON MET LE RESULTAT A ZERO (au lieu de NAN ou erreur) 18 : * 19 : * BEAUFILS (20 MAI 87) : REPRISE POUR PERMETTRE LE CALCUL DE 20 : * LISTREEL ** I2 OU LISTREEL ** X2 21 : * 22 : * JM CAMPENON (12/90) : PASSAGE AUX NOUVEAUX CHAMELEM 23 : * 24 : * S PASCAL (06/2006) : 25 : * -Puissance d'un MCHAML de composante de type EVOLUTIOn 26 : * -Puissance d'un objet EVOLUTIOn 27 : * 28 : * BP (12/2010) concernant les LISTREELs et les EVOLUTIOns : 29 : * -reprise pour permettre la puissance entiere des evolutions 30 : * -moins de mise a zero intempestives et + de valeurs "justes" 31 : * -avertissement si présence d'INF 32 : * 33 : *_______________________________________________________________________ 34 : * 35 : IMPLICIT INTEGER(I-N) 36 : IMPLICIT REAL*8 (A-H,O-Z) 37 : -INC CCOPTIO 38 : *_______________________________________________________________________ 39 : * 40 : * ENTIER**ENTIER 41 : *_______________________________________________________________________ 42 : * 42 : CALL LIRENT(I1,0,IRETOU) 43 : IF (IRETOU.EQ.0) GOTO 2 43 : CALL LIRENT(I2,0,IRETOU) 44 : IF (IRETOU.EQ.0) THEN 44 : CALL REFUS 45 : GOTO 2 46 : ENDIF 46 : CALL ECRENT(I1**I2) 47 : RETURN 48 : * 49 : 2 CONTINUE 50 : *_______________________________________________________________________ 51 : * 52 : * FLOTTANT**ENTIER 53 : *_______________________________________________________________________ 54 : * 54 : CALL LIRREE(FLO1,0,IRETOU) 55 : IF (IRETOU.EQ.0) GOTO 3 55 : CALL LIRENT(I2,0,IRETOU) 56 : IF (IRETOU.EQ.0) THEN 56 : CALL REFUS 57 : GOTO 3 58 : ENDIF 58 : CALL ECRREE(FLO1**I2) 59 : RETURN 60 : * 61 : 3 CONTINUE 62 : *_______________________________________________________________________ 63 : * 64 : * FLOTTANT**FLOTTANT 65 : *_______________________________________________________________________ 66 : * 66 : CALL LIRREE(FLO1,0,IRETOU) 67 : IF (IRETOU.EQ.0) GOTO 4 67 : CALL LIRREE(FLO2,0,IRETOU) 68 : IF (IRETOU.EQ.0) THEN 68 : CALL REFUS 69 : GOTO 4 70 : ENDIF 70 : CALL ECRREE(FLO1**FLO2) 71 : RETURN 72 : * 73 : 4 CONTINUE 74 : *_______________________________________________________________________ 75 : * 76 : * MCHAML ** ENTIER 77 : *_______________________________________________________________________ 78 : * 78 : CALL LIRENT(I1,0,IRETOU) 79 : IF (IRETOU.EQ.0) GOTO 5 79 : CALL LIROBJ('MCHAML',IPCHE1,0,IRETOU) 80 : IF (IRETOU.EQ.0) THEN 80 : CALL REFUS 81 : GOTO 5 82 : ENDIF 82 : CALL PUCHEL(IPCHE1,I1,IPCHPU,IRET) 82 : IF (IRET.NE.0) CALL ECROBJ('MCHAML',IPCHPU) 83 : RETURN 84 : 85 : 5 CONTINUE 86 : *_______________________________________________________________________ 87 : * 88 : * CHPOINT**ENTIER 89 : *_______________________________________________________________________ 90 : * 90 : CALL LIRENT(I1,0,IRETOU) 91 : IF (IRETOU.EQ.0) GOTO 6 91 : CALL LIROBJ('CHPOINT',ICH,0,IRETOU) 92 : IF (IRETOU.EQ.0) THEN 92 : CALL REFUS 93 : GOTO 6 94 : ENDIF 94 : CALL PUCHPO(ICH,I1,ICHR,IRET) 94 : IF(IRET.NE.0) CALL ECROBJ('CHPOINT',ICHR) 95 : RETURN 96 : * 97 : 6 CONTINUE 98 : *_______________________________________________________________________ 99 : * 100 : * MCHAML ** FLOTTANT 101 : *_______________________________________________________________________ 102 : * 102 : CALL LIRREE(FLO,0,IRETOU) 103 : IF (IRETOU.EQ.0) GOTO 7 103 : CALL LIROBJ('MCHAML',IPCHE1,0,IRETOU) 104 : IF (IRETOU.EQ.0) THEN 104 : CALL REFUS 105 : GOTO 7 106 : ENDIF 106 : CALL PUCHER(IPCHE1,FLO,IPCHPU,IRET) 107 : IF ( IPCHPU.EQ.0 ) RETURN 107 : IF ( IRET.EQ.0 ) CALL ERREUR(220) 107 : CALL ECROBJ('MCHAML',IPCHPU) 108 : RETURN 109 : * 110 : 7 CONTINUE 111 : *_______________________________________________________________________ 112 : * 113 : * CHPOINT**FLOTTANT 114 : *_______________________________________________________________________ 115 : * 115 : CALL LIRREE(FLO,0,IRETOU) 116 : IF (IRETOU.EQ.0) GOTO 8 116 : CALL LIROBJ('CHPOINT',ICH,0,IRETOU) 117 : IF (IRETOU.EQ.0) THEN 117 : CALL REFUS 118 : GOTO 8 119 : ENDIF 119 : CALL PUCHPR(ICH,FLO,ICHR,IRET) 119 : IF( IRET.EQ.0 ) CALL ERREUR(220) 119 : IF(IRET.NE.0) CALL ECROBJ('CHPOINT',ICHR) 120 : RETURN 121 : * 122 : 8 CONTINUE 123 : *_______________________________________________________________________ 124 : * 125 : * LISTREEL**ENTIER 126 : *_______________________________________________________________________ 127 : * 127 : CALL LIRENT(I1,0,IRETOU) 128 : IF (IRETOU.EQ.0) GOTO 9 128 : CALL LIROBJ('LISTREEL',ILIST,0,IRETOU) 129 : IF (IRETOU.EQ.0) THEN 129 : CALL REFUS 130 : GOTO 9 131 : ENDIF 132 : FLO=I1 133 : IRET=1 133 : CALL PULIRF(ILIST,FLO,I1,IRES,IRET) 133 : CALL ECROBJ('LISTREEL',IRES) 134 : RETURN 135 : * 136 : 9 CONTINUE 137 : *_______________________________________________________________________ 138 : * 139 : * LISTREEL**FLOTTANT 140 : *_______________________________________________________________________ 141 : * 141 : CALL LIRREE(FLO,0,IRETOU) 142 : IF (IRETOU.EQ.0) GOTO 10 142 : CALL LIROBJ('LISTREEL',ILIST,0,IRETOU) 143 : IF (IRETOU.EQ.0) THEN 143 : CALL REFUS 144 : GOTO 10 145 : ENDIF 146 : I1=nint(FLO) 147 : IRET=2 147 : CALL PULIRF(ILIST,FLO,I1,IRES,IRET) 147 : CALL ECROBJ('LISTREEL',IRES) 148 : RETURN 149 : * 150 : 10 CONTINUE 151 : *_______________________________________________________________________ 152 : * 153 : * EVOLUTIOn**ENTIER 154 : *_______________________________________________________________________ 155 : * 155 : CALL LIRENT(I1,0,IRETOU) 156 : IF (IRETOU.EQ.0) GOTO 11 156 : CALL LIROBJ('EVOLUTIO',IEVOL1,0,IRETOU) 157 : IF (IRETOU.EQ.0) THEN 157 : CALL REFUS 158 : GOTO 11 159 : ENDIF 160 : FLO=REAL(I1) 161 : IRET=1 161 : CALL PUEVOL(IEVOL1,FLO,I1,IEVOPU,IRET) 162 : IF ( IRET.EQ.0) THEN 162 : CALL ERREUR(220) 163 : ENDIF 163 : CALL ECROBJ('EVOLUTIO',IEVOPU) 164 : RETURN 165 : * 166 : 11 CONTINUE 167 : *_______________________________________________________________________ 168 : * 169 : * EVOLUTIOn*FLOTTANT 170 : *_______________________________________________________________________ 171 : * 171 : CALL LIRREE(FLO,0,IRETOU) 172 : IF (IRETOU.EQ.0) GOTO 12 172 : CALL LIROBJ('EVOLUTIO',IEVOL1,0,IRETOU) 173 : IF (IRETOU.EQ.0) THEN 173 : CALL REFUS 174 : GOTO 12 175 : ENDIF 176 : IRET=2 176 : CALL PUEVOL(IEVOL1,FLO,I1,IEVOPU,IRET) 177 : IF (IRET.EQ.0) THEN 177 : CALL ERREUR(220) 178 : ENDIF 178 : CALL ECROBJ('EVOLUTIO',IEVOPU) 179 : RETURN 180 : * 181 : 12 CONTINUE 182 : *_______________________________________________________________________ 183 : C 184 : C ON A DONC RIEN TROUVE POUR FAIRE L OPERATION 185 : C 185 : CALL QUETYP(MOTERR(1:8),0,IRETOU) 186 : IF(IRETOU.NE.0) THEN 186 : CALL LIROBJ(MOTERR(1:8),IRET,1,IRETOU) 186 : CALL QUETYP(MOTERR(9:16),0,IRETOU) 187 : IF (IRETOU.EQ.0) MOTERR(9:16) = ' ???? ' 187 : CALL ERREUR(532) 188 : ELSE 188 : CALL ERREUR(533) 189 : ENDIF 190 : RETURN 191 : END 192 : 193 : 194 : 195 : 196 :
© Cast3M 2003 - All rights reserved.
Disclaimer