1 : C OPEVOL SOURCE BP208322 12/07/10 21:15:24 7432 2 : C 3 : SUBROUTINE OPEVOL(IPO1,ICALC, IPO2) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : ************************************************************************ 7 : * 8 : * O P E V O L 9 : * ----------- 10 : * 11 : * FONCTION: 12 : * --------- 13 : * 14 : * EFFECTUE DIVERSES OPERATIONS SUR UNE EVOLUTION 15 : * 16 : * MODULES UTILISES: 17 : * ----------------- 18 : * 19 : -INC CCOPTIO 20 : -INC CCREEL 21 : -INC SMEVOLL 22 : -INC SMLREEL 23 : * 24 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 25 : * ----------- 26 : * 27 : * IPO1 (E) POINTEUR SUR UNE EVOLUTION. 28 : * ICALC (E) NUMERO DU TYPE DE CALCUL: 29 : * = 1 COSINUS. 30 : * = 2 SINUS. 31 : * = 7 EXPONENTIELLE. 32 : * = 8 LOGARITHME. 33 : * = 9 VALEUR ABSOLUE. 34 : * =10 COSINUS HYPERBOLIQUE 35 : * =11 SINUS HYPERBOLIQUE 36 : * =12 TANGENTE HYPERBOLIQUE 37 : * =13 FONCTION D'ERREUR ERF 38 : * IPO2 (S) POINTEUR SUR L EVOLUTION RESULTAT. 39 : * = 0 , SI OPERATION IMPOSSIBLE. 40 : * 41 : * AUTEUR, DATE DE CREATION: 42 : * ------------------------- 43 : * 44 : * BP 06/07/2012 : adaptation de OPLREE.eso 45 : * 46 : * LANGAGE: 47 : * -------- 48 : * 49 : * ESOPE + FORTRAN77 50 : * 51 : ************************************************************************ 52 : 53 : * SEGMENT MEVOLL 54 : MEVOLL = IPO1 55 : segact,MEVOLL 56 : segini,MEVOL1=MEVOLL 57 : IPO2 = MEVOL1 58 : N=IEVOLL(/1) 59 : 60 : ***** Boucle sur les EVOLUTIONS ELEMENTAIRES ************************** 61 : DO 999 K=1,N 62 : 63 : * SEGMENT KEVOLL 64 : KEVOLL = IEVOLL(K) 65 : SEGACT,KEVOLL 66 : SEGINI,KEVOL1=KEVOLL 67 : MEVOL1.IEVOLL(K)=KEVOL1 68 : 69 : * LISTREEL 70 : MLREEL = KEVOLL.IPROGY 71 : SEGACT MLREEL 72 : LDIM = PROG(/1) 73 : JG = LDIM 74 : SEGINI MLREE1 75 : KEVOL1.IPROGY=MLREE1 76 : 77 : * recopie de OPLREE.eso 78 : IF (ICALC.EQ.1) THEN 79 : DO 10 I = 1,LDIM 80 : XX = MLREEL.PROG(I) 81 : MLREE1.PROG(I) = COS(XX * XPI / 180.D0) 82 : 10 CONTINUE 83 : ELSE IF (ICALC.EQ.2) THEN 84 : DO 20 I = 1,LDIM 85 : XX = MLREEL.PROG(I) 86 : MLREE1.PROG(I) = SIN(XX * XPI / 180.D0) 87 : 20 CONTINUE 88 : ELSE IF (ICALC.EQ.7) THEN 89 : DO 70 I = 1,LDIM 90 : XX = MLREEL.PROG(I) 91 : MLREE1.PROG(I) = EXP(XX) 92 : 70 CONTINUE 93 : ELSE IF (ICALC.EQ.8) THEN 94 : DO 80 I = 1,LDIM 95 : XX = MLREEL.PROG(I) 96 : IF (XX.GT.0.D0) THEN 97 : MLREE1.PROG(I) = LOG(XX) 98 : ELSE 98 : CALL ERREUR (36) 99 : *+* NUMERO D'ERREUR PAS FIGNOLE. 100 : IPO2 = 0 101 : RETURN 102 : END IF 103 : 80 CONTINUE 104 : ELSE IF (ICALC.EQ.9) THEN 105 : DO 90 I = 1,LDIM 106 : XX = MLREEL.PROG(I) 107 : MLREE1.PROG(I) = ABS(XX) 108 : 90 CONTINUE 109 : ELSE IF (ICALC.EQ.10) THEN 110 : DO 100 I = 1,LDIM 111 : XX = MLREEL.PROG(I) 112 : MLREE1.PROG(I) = COSH(XX) 113 : 100 CONTINUE 114 : ELSE IF (ICALC.EQ.11) THEN 115 : DO 110 I = 1,LDIM 116 : XX = MLREEL.PROG(I) 117 : MLREE1.PROG(I) = SINH(XX) 118 : 110 CONTINUE 119 : ELSE IF (ICALC.EQ.12) THEN 120 : DO 120 I = 1,LDIM 121 : XX = MLREEL.PROG(I) 122 : MLREE1.PROG(I) = TANH(XX) 123 : 120 CONTINUE 124 : ELSE IF (ICALC.EQ.13) THEN 125 : DO 130 I = 1,LDIM 126 : XX = MLREEL.PROG(I) 127 : YY = ERGAUS(XX) 128 : MLREE1.PROG(I) = YY 129 : 130 CONTINUE 130 : ELSE 131 : * EN FAIT, CE CAS NE PEUT PAS ARRIVER EN DEHORS DE LA PERIODE 132 : * DE TEST. 133 : IPO2 = 0 134 : ENDIF 135 : * 136 : SEGDES,MLREE1,MLREEL 137 : SEGDES,KEVOL1,KEVOLL 138 : 139 : 999 CONTINUE 140 : ***** fin de Boucle sur les EVOLUTIONS ELEMENTAIRES ******************** 141 : segdes,MEVOL1,MEVOLL 142 : * 143 : END 144 : 145 : 146 : 147 : 148 : 149 :
© Cast3M 2003 - All rights reserved.
Disclaimer