1 : C ADEVO SOURCE CHAT 05/01/12 21:17:58 5004 2 : SUBROUTINE ADEVO(IPEV1,IPEV2,IRET,INV) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C 6 : C======================================================================= 7 : C = = 8 : C = APPELE PAR ADEVOL = 9 : C = = 10 : C = CONSTRUCTION D'UN OBJET DE TYPE EVOL CONTENANT LA SOMME OU LA = 11 : C = DIFFERENCE TERME A TERME DE DEUX OBJETS EVOLUTION = 12 : C = DE MEMES ABSCISSES = 13 : C = = 14 : C = SYNTAXE : PROD = EVOLF + EVOLV = 15 : C = = 16 : C = ON EXECUTE LA SOMME TERME A TERME DES ORDONNEES DES DEUX = 17 : C = OBJETS DE TYPE EVOLUTIO EVOLF ET EVOLV. LES ABSCISSES DE PROD, = 18 : C = L'OBJET AINSI CREE, RESTENT CELLES DE EVOLF ET EVOLV. = 19 : C = = 20 : C = = 21 : C = = 22 : C = MEVOL1 : POINTEUR SUR MEVOLF (OBJET EVOLUTION) = 23 : C = MEVOL2 : POINTEUR SUR MEVOLV " " = 24 : C = KEVOL1 : POINTEUR SUR KEVOLF = 25 : C = KEVOL2 : POINTEUR SUR KEVOLV = 26 : C = MLREE1 : POINTEUR SUR LA LISTREEL ORDONNEE DE EVOLF = 27 : C = MLREE2 : POINTEUR SUR LA LISTREEL ORDONNEE DE EVOLV = 28 : C = = 29 : C = CREATION : 4/12/87 = 30 : C = F.ROULLIER = 31 : C======================================================================= 32 : C 33 : -INC CCOPTIO 34 : -INC SMEVOLL 35 : -INC SMLREEL 36 : C 37 : SEGMENT TEMPP 38 : IMPLIED DR1(NPT),DI1(NPT),DM1(NPT),DP1(NPT) 39 : IMPLIED DR2(NPT),DI2(NPT),DM2(NPT),DP2(NPT) 40 : ENDSEGMENT 41 : CHARACTER *72 TI 42 : CHARACTER*4 ITYP1,ITYP2 43 : C 44 : C LES 2 OBJETS EVOLUTION DOIVENT ETRE DE MEME SOUS-TYPE 45 : C ET DE MEME LONGUEUR 46 : C 47 : MEVOL1=IPEV1 48 : MEVOL2=IPEV2 49 : SEGACT MEVOL1,MEVOL2 50 : ITYP1=MEVOL1.ITYEVO 51 : ITYP2=MEVOL2.ITYEVO 52 : ICMP=1 53 : IF (ITYP1.EQ.'COMP'.AND.ITYP2.EQ.'COMP') GO TO 198 54 : IF (ITYP1.EQ.'REEL'.AND.ITYP2.EQ.'REEL') GO TO 199 55 : 197 MOTERR(1:8)='EVOLUTIO' 55 : CALL ERREUR(302) 56 : RETURN 57 : 198 ICMP=2 58 : 199 CONTINUE 59 : C 60 : C BOUCLE SUR LES COURBES 61 : C 62 : NC1=MEVOL1.IEVOLL(/1) 63 : NC2=MEVOL2.IEVOLL(/1) 64 : IF(NC1.EQ.NC2) GOTO 200 64 : CALL ERREUR(111) 65 : RETURN 66 : C 67 : 200 CONTINUE 68 : N=NC1 69 : NC=NC1/ICMP 70 : SEGINI MEVOLL 71 : IRET=MEVOLL 72 : TI=TITREE 73 : IEVTEX=TI 74 : ITYEVO=MEVOL1.ITYEVO 75 : C 76 : C 77 : DO 201 IC=1,NC,ICMP 78 : KEVOL1=MEVOL1.IEVOLL(IC) 79 : KEVOL2=MEVOL2.IEVOLL(IC) 80 : SEGACT KEVOL1,KEVOL2 81 : ITYP1=KEVOL1.NUMEVY 82 : ITYP2=KEVOL2.NUMEVY 83 : MLREE1=KEVOL1.IPROGX 84 : MLREE2=KEVOL2.IPROGX 85 : SEGACT MLREE1,MLREE2 86 : L2=MLREE2.PROG(/1) 87 : L1=MLREE1.PROG(/1) 88 : C 89 : C LES LISTREEL ONT-ILS MEME LONGUEUR ? 90 : IF(L1.EQ.L2)GOTO 10 90 : CALL ERREUR(337) 91 : GOTO 100 92 : 10 CONTINUE 93 : C 94 : C LES LISTREEL DES ABSCISSES SONT ILS IDENTIQUES ? 94 : CALL VERIPR(MLREE1.PROG,MLREE2.PROG,L1,IRETOU,1.D-2) 95 : IF(IRETOU.EQ.0) THEN 95 : CALL ERREUR(394) 96 : RETURN 97 : ENDIF 98 : C 99 : SEGINI KEVOLL 100 : IEVOLL(IC)=KEVOLL 101 : KEVTEX=TI 102 : NOMEVX=KEVOL1.NOMEVX 103 : NOMEVY=KEVOL1.NOMEVY 104 : NUMEVX=KEVOL1.NUMEVX 105 : NUMEVY=KEVOL1.NUMEVY 106 : TYPX=KEVOL1.TYPX 107 : TYPY=KEVOL1.TYPY 108 : JG=L1 109 : SEGINI MLREEL 110 : IPROGX=MLREEL 111 : DO 31 I=1,L1 112 : PROG(I)=MLREE1.PROG(I) 113 : 31 CONTINUE 114 : SEGDES MLREEL,KEVOLL,MLREE1,MLREE2 115 : C 116 : MLREE1=KEVOL1.IPROGY 117 : MLREE2=KEVOL2.IPROGY 118 : SEGACT MLREE1,MLREE2 119 : C 120 : NPT=L1 121 : SEGINI TEMPP 122 : IMOD1=0 123 : IMOD2=0 124 : IF (ITYP1.EQ.'MODU') THEN 125 : IMOD1=1 126 : DO 180 I=1,L1 127 : DM1(I)=MLREE1.PROG(I) 128 : 180 CONTINUE 129 : ELSE 130 : DO 181 I=1,L1 131 : DR1(I)=MLREE1.PROG(I) 132 : 181 CONTINUE 133 : ENDIF 134 : C 135 : IF (ITYP2.EQ.'MODU') THEN 136 : IMOD2=1 137 : DO 182 I=1,L1 138 : DM2(I)=MLREE2.PROG(I) 139 : 182 CONTINUE 140 : ELSE 141 : DO 183 I=1,L1 142 : DR2(I)=MLREE2.PROG(I) 143 : 183 CONTINUE 144 : ENDIF 145 : SEGDES MLREE1,MLREE2 146 : SEGDES KEVOL1,KEVOL2 147 : C 148 : IF (ICMP.EQ.1) GO TO 170 149 : C 150 : KEVOL1=MEVOL1.IEVOLL(IC+1) 151 : KEVOL2=MEVOL2.IEVOLL(IC+1) 152 : SEGACT KEVOL1,KEVOL2 153 : MLREE1=KEVOL1.IPROGX 154 : SEGACT MLREE1 155 : L1=MLREE1.PROG(/1) 156 : C 157 : SEGINI KEVOLL 158 : IEVOLL(IC+1)=KEVOLL 159 : KEVTEX=TI 160 : NOMEVX=KEVOL1.NOMEVX 161 : NOMEVY=KEVOL1.NOMEVY 162 : NUMEVX=KEVOL1.NUMEVX 163 : NUMEVY=KEVOL1.NUMEVY 164 : TYPX=KEVOL1.TYPX 165 : TYPY=KEVOL1.TYPY 166 : C 167 : JG=L1 168 : SEGINI MLREEL 169 : IPROGX=MLREEL 170 : DO 35 I=1,L1 171 : PROG(I)=MLREE1.PROG(I) 172 : 35 CONTINUE 173 : SEGDES MLREEL,KEVOLL,MLREE1 174 : C 175 : MLREE1=KEVOL1.IPROGY 176 : MLREE2=KEVOL2.IPROGY 177 : SEGACT MLREE1,MLREE2 178 : C 179 : IF (IMOD1.EQ.1) THEN 180 : DO 190 I=1,L1 181 : DP1(I)=MLREE1.PROG(I) 182 : 190 CONTINUE 183 : ELSE 184 : DO 191 I=1,L1 185 : DI1(I)=MLREE1.PROG(I) 186 : 191 CONTINUE 187 : ENDIF 188 : IF (IMOD2.EQ.1) THEN 189 : DO 192 I=1,L1 190 : DP2(I)=MLREE2.PROG(I) 191 : 192 CONTINUE 192 : ELSE 193 : DO 193 I=1,L1 194 : DI2(I)=MLREE2.PROG(I) 195 : 193 CONTINUE 196 : ENDIF 197 : SEGDES MLREE1,MLREE2 198 : SEGDES KEVOL1,KEVOL2 199 : C 200 : IF (IMOD1.EQ.1) THEN 200 : CALL CONVCP(DR1,DI1,DM1,DP1,L1,-1) 201 : ENDIF 202 : C 203 : IF (IMOD2.EQ.1) THEN 203 : CALL CONVCP(DR2,DI2,DM2,DP2,L2,-1) 204 : ENDIF 205 : C 206 : 17 IF(INV.EQ.1) THEN 207 : DO 20 I=1,L1 208 : DR1(I)=DR1(I)+DR2(I) 209 : DI1(I)=DI1(I)+DI2(I) 210 : 20 CONTINUE 211 : ELSE 212 : DO 21 I=1,L1 213 : DR1(I)=DR1(I)-DR2(I) 214 : DI1(I)=DI1(I)-DI2(I) 215 : 21 CONTINUE 216 : ENDIF 217 : C 218 : KEVOL1=IEVOLL(IC) 219 : KEVOL2=IEVOLL(IC+1) 220 : SEGACT KEVOL1*MOD,KEVOL2*MOD 221 : JG=L1 222 : SEGINI MLREE1,MLREE2 223 : KEVOL1.IPROGY=MLREE1 224 : KEVOL2.IPROGY=MLREE2 225 : C 226 : IF (IMOD1.EQ.1) THEN 226 : CALL CONVCP(DR1,DI1,DM1,DP1,L1,1) 227 : DO 22 I=1,L1 228 : MLREE1.PROG(I)=DM1(I) 229 : MLREE2.PROG(I)=DP1(I) 230 : 22 CONTINUE 231 : ELSE 232 : DO 23 I=1,L1 233 : MLREE1.PROG(I)=DR1(I) 234 : MLREE2.PROG(I)=DI1(I) 235 : 23 CONTINUE 236 : ENDIF 237 : C 238 : SEGDES MLREE1,MLREE2,KEVOL1,KEVOL2 239 : GO TO 196 240 : C 241 : 170 CONTINUE 242 : IF(INV.EQ.1) THEN 243 : DO 171 I=1,L1 244 : DR1(I)=DR1(I)+DR2(I) 245 : 171 CONTINUE 246 : ELSE 247 : DO 172 I=1,L1 248 : DR1(I)=DR1(I)-DR2(I) 249 : 172 CONTINUE 250 : ENDIF 251 : C 252 : KEVOL1=IEVOLL(IC) 253 : SEGACT KEVOL1 254 : JG=L1 255 : SEGINI MLREE1 256 : KEVOL1.IPROGY=MLREE1 257 : C 258 : IF (IMOD1.EQ.1) THEN 258 : CALL CONVCP(DR1,DI1,DM1,DP1,L1,1) 259 : DO 173 I=1,L1 260 : MLREE1.PROG(I)=DM1(I) 261 : 173 CONTINUE 262 : ELSE 263 : DO 174 I=1,L1 264 : MLREE1.PROG(I)=DR1(I) 265 : 174 CONTINUE 266 : ENDIF 267 : C 268 : SEGDES MLREE1,KEVOL1 269 : C 270 : 196 SEGSUP TEMPP 271 : 201 CONTINUE 272 : C 273 : SEGDES MEVOLL,MEVOL1,MEVOL2 274 : C 275 : 100 CONTINUE 276 : RETURN 277 : END 278 : 279 :
© Cast3M 2003 - All rights reserved.
Disclaimer