Télécharger adevo.eso

Retour à la liste

Numérotation des lignes :

  1. C ADEVO SOURCE BP208322 15/05/11 21:15:00 8528
  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'
  56. CALL ERREUR(302)
  57. RETURN
  58. 198 ICMP=2
  59. 199 CONTINUE
  60. C
  61. C BOUCLE SUR LES COURBES
  62. C
  63. NC1=MEVOL1.IEVOLL(/1)
  64. NC2=MEVOL2.IEVOLL(/1)
  65. IF(NC1.EQ.NC2) GOTO 200
  66. CALL ERREUR(111)
  67. RETURN
  68. C
  69. 200 CONTINUE
  70. N=NC1
  71. NC=NC1/ICMP
  72. SEGINI MEVOLL
  73. IRET=MEVOLL
  74. TI=TITREE
  75. IEVTEX=TI
  76. ITYEVO=MEVOL1.ITYEVO
  77. C
  78. C
  79. DO 201 IC=1,NC,ICMP
  80. KEVOL1=MEVOL1.IEVOLL(IC)
  81. KEVOL2=MEVOL2.IEVOLL(IC)
  82. SEGACT KEVOL1,KEVOL2
  83. ITYP1=KEVOL1.NUMEVY
  84. ITYP2=KEVOL2.NUMEVY
  85. MLREE1=KEVOL1.IPROGX
  86. MLREE2=KEVOL2.IPROGX
  87. SEGACT MLREE1,MLREE2
  88. L2=MLREE2.PROG(/1)
  89. L1=MLREE1.PROG(/1)
  90. C
  91. C LES LISTREEL ONT-ILS MEME LONGUEUR ?
  92. IF(L1.EQ.L2)GOTO 10
  93. CALL ERREUR(337)
  94. GOTO 100
  95. 10 CONTINUE
  96. C
  97. C LES LISTREEL DES ABSCISSES SONT ILS IDENTIQUES ?
  98. CALL VERIPR(MLREE1.PROG,MLREE2.PROG,L1,IRETOU,1.D-2)
  99. IF(IRETOU.EQ.0) THEN
  100. CALL ERREUR(394)
  101. RETURN
  102. ENDIF
  103. C
  104. SEGINI KEVOLL
  105. IEVOLL(IC)=KEVOLL
  106. c KEVTEX=TI
  107. KEVTEX=KEVOL1.KEVTEX
  108. NOMEVX=KEVOL1.NOMEVX
  109. NOMEVY=KEVOL1.NOMEVY
  110. NUMEVX=KEVOL1.NUMEVX
  111. NUMEVY=KEVOL1.NUMEVY
  112. TYPX=KEVOL1.TYPX
  113. TYPY=KEVOL1.TYPY
  114. JG=L1
  115. SEGINI MLREEL
  116. IPROGX=MLREEL
  117. DO 31 I=1,L1
  118. PROG(I)=MLREE1.PROG(I)
  119. 31 CONTINUE
  120. SEGDES MLREEL,KEVOLL,MLREE1,MLREE2
  121. C
  122. MLREE1=KEVOL1.IPROGY
  123. MLREE2=KEVOL2.IPROGY
  124. SEGACT MLREE1,MLREE2
  125. C
  126. NPT=L1
  127. SEGINI TEMPP
  128. IMOD1=0
  129. IMOD2=0
  130. IF (ITYP1.EQ.'MODU') THEN
  131. IMOD1=1
  132. DO 180 I=1,L1
  133. DM1(I)=MLREE1.PROG(I)
  134. 180 CONTINUE
  135. ELSE
  136. DO 181 I=1,L1
  137. DR1(I)=MLREE1.PROG(I)
  138. 181 CONTINUE
  139. ENDIF
  140. C
  141. IF (ITYP2.EQ.'MODU') THEN
  142. IMOD2=1
  143. DO 182 I=1,L1
  144. DM2(I)=MLREE2.PROG(I)
  145. 182 CONTINUE
  146. ELSE
  147. DO 183 I=1,L1
  148. DR2(I)=MLREE2.PROG(I)
  149. 183 CONTINUE
  150. ENDIF
  151. SEGDES MLREE1,MLREE2
  152. SEGDES KEVOL1,KEVOL2
  153. C
  154. IF (ICMP.EQ.1) GO TO 170
  155. C
  156. KEVOL1=MEVOL1.IEVOLL(IC+1)
  157. KEVOL2=MEVOL2.IEVOLL(IC+1)
  158. SEGACT KEVOL1,KEVOL2
  159. MLREE1=KEVOL1.IPROGX
  160. SEGACT MLREE1
  161. L1=MLREE1.PROG(/1)
  162. C
  163. SEGINI KEVOLL
  164. IEVOLL(IC+1)=KEVOLL
  165. KEVTEX=TI
  166. NOMEVX=KEVOL1.NOMEVX
  167. NOMEVY=KEVOL1.NOMEVY
  168. NUMEVX=KEVOL1.NUMEVX
  169. NUMEVY=KEVOL1.NUMEVY
  170. TYPX=KEVOL1.TYPX
  171. TYPY=KEVOL1.TYPY
  172. C
  173. JG=L1
  174. SEGINI MLREEL
  175. IPROGX=MLREEL
  176. DO 35 I=1,L1
  177. PROG(I)=MLREE1.PROG(I)
  178. 35 CONTINUE
  179. SEGDES MLREEL,KEVOLL,MLREE1
  180. C
  181. MLREE1=KEVOL1.IPROGY
  182. MLREE2=KEVOL2.IPROGY
  183. SEGACT MLREE1,MLREE2
  184. C
  185. IF (IMOD1.EQ.1) THEN
  186. DO 190 I=1,L1
  187. DP1(I)=MLREE1.PROG(I)
  188. 190 CONTINUE
  189. ELSE
  190. DO 191 I=1,L1
  191. DI1(I)=MLREE1.PROG(I)
  192. 191 CONTINUE
  193. ENDIF
  194. IF (IMOD2.EQ.1) THEN
  195. DO 192 I=1,L1
  196. DP2(I)=MLREE2.PROG(I)
  197. 192 CONTINUE
  198. ELSE
  199. DO 193 I=1,L1
  200. DI2(I)=MLREE2.PROG(I)
  201. 193 CONTINUE
  202. ENDIF
  203. SEGDES MLREE1,MLREE2
  204. SEGDES KEVOL1,KEVOL2
  205. C
  206. IF (IMOD1.EQ.1) THEN
  207. CALL CONVCP(DR1,DI1,DM1,DP1,L1,-1)
  208. ENDIF
  209. C
  210. IF (IMOD2.EQ.1) THEN
  211. CALL CONVCP(DR2,DI2,DM2,DP2,L2,-1)
  212. ENDIF
  213. C
  214. 17 IF(INV.EQ.1) THEN
  215. DO 20 I=1,L1
  216. DR1(I)=DR1(I)+DR2(I)
  217. DI1(I)=DI1(I)+DI2(I)
  218. 20 CONTINUE
  219. ELSE
  220. DO 21 I=1,L1
  221. DR1(I)=DR1(I)-DR2(I)
  222. DI1(I)=DI1(I)-DI2(I)
  223. 21 CONTINUE
  224. ENDIF
  225. C
  226. KEVOL1=IEVOLL(IC)
  227. KEVOL2=IEVOLL(IC+1)
  228. SEGACT KEVOL1*MOD,KEVOL2*MOD
  229. JG=L1
  230. SEGINI MLREE1,MLREE2
  231. KEVOL1.IPROGY=MLREE1
  232. KEVOL2.IPROGY=MLREE2
  233. C
  234. IF (IMOD1.EQ.1) THEN
  235. CALL CONVCP(DR1,DI1,DM1,DP1,L1,1)
  236. DO 22 I=1,L1
  237. MLREE1.PROG(I)=DM1(I)
  238. MLREE2.PROG(I)=DP1(I)
  239. 22 CONTINUE
  240. ELSE
  241. DO 23 I=1,L1
  242. MLREE1.PROG(I)=DR1(I)
  243. MLREE2.PROG(I)=DI1(I)
  244. 23 CONTINUE
  245. ENDIF
  246. C
  247. SEGDES MLREE1,MLREE2,KEVOL1,KEVOL2
  248. GO TO 196
  249. C
  250. 170 CONTINUE
  251. IF(INV.EQ.1) THEN
  252. DO 171 I=1,L1
  253. DR1(I)=DR1(I)+DR2(I)
  254. 171 CONTINUE
  255. ELSE
  256. DO 172 I=1,L1
  257. DR1(I)=DR1(I)-DR2(I)
  258. 172 CONTINUE
  259. ENDIF
  260. C
  261. KEVOL1=IEVOLL(IC)
  262. SEGACT KEVOL1
  263. JG=L1
  264. SEGINI MLREE1
  265. KEVOL1.IPROGY=MLREE1
  266. C
  267. IF (IMOD1.EQ.1) THEN
  268. CALL CONVCP(DR1,DI1,DM1,DP1,L1,1)
  269. DO 173 I=1,L1
  270. MLREE1.PROG(I)=DM1(I)
  271. 173 CONTINUE
  272. ELSE
  273. DO 174 I=1,L1
  274. MLREE1.PROG(I)=DR1(I)
  275. 174 CONTINUE
  276. ENDIF
  277. C
  278. SEGDES MLREE1,KEVOL1
  279. C
  280. 196 SEGSUP TEMPP
  281. 201 CONTINUE
  282. C
  283. SEGDES MEVOLL,MEVOL1,MEVOL2
  284. C
  285. 100 CONTINUE
  286. RETURN
  287. END
  288.  
  289.  
  290.  
  291.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales