Télécharger evolin.eso

Retour à la liste

Numérotation des lignes :

  1. C EVOLIN SOURCE CB215821 20/01/28 22:06:20 10508
  2. SUBROUTINE EVOLIN (IEV1,XX1,IEV2,XX2,IEV3)
  3. *____________________________________________________________________
  4. *
  5. * Interpolation d'une courbe (type EVOLUTION)
  6. * en fouction de deux autres courbes (type EVOLUTION)
  7. *
  8. * ENTREES :
  9. * ---------
  10. *
  11. * IEV1 Pointeur sur un objet de type EVOLUTION
  12. * IEV2 Pointeur sur le deuxieme objet de type EVOLUTION
  13. * XX1 Flottant donnant le rapport entre la courbe
  14. * a calculer et la courbe designee par IEV2
  15. * XX2 Flottant donnant le rapport entre la courbe
  16. * a calculer et la courbe designee par IEV1.
  17. * Il existe la relation (XX1 + XX2)=1
  18. *
  19. *
  20. * SORTIE :
  21. * --------
  22. *
  23. * IEV3 Pointeur sur l'objet EVOLUTION resultat
  24. * =0 si operation impossible
  25. *
  26. *____________________________________________________________________
  27. *
  28. IMPLICIT INTEGER(I-N)
  29. IMPLICIT REAL*8(A-H,O-Z)
  30.  
  31. -INC CCOPTIO
  32. -INC CCREEL
  33. -INC CCASSIS
  34. -INC SMEVOLL
  35. -INC SMLREEL
  36. -INC SMLENTI
  37.  
  38. LOGICAL LOG0, LOG2
  39. REAL*8 XNAN
  40. C XNAN : Ne pas l'initialiser, c'est fait expres
  41.  
  42. POINTEUR MREX.MLREEL,MREY.MLREEL,MREY2.MLREEL
  43.  
  44. MEVOL1=IEV1
  45. MEVOL2=IEV2
  46. IF(MEVOL1.EQ.0 .OR. MEVOL2.EQ.0) THEN
  47. MOTERR(1:8)='EVOLUTIO'
  48. CALL ERREUR(37)
  49. IEV3=0
  50. RETURN
  51. ENDIF
  52.  
  53. N1=MEVOL1.IEVOLL(/1)
  54. N2=MEVOL2.IEVOLL(/1)
  55.  
  56. C QUELQUES TESTS SUR LES EVOLUTIONS
  57. IF(N1.NE.1) THEN
  58. MOTERR(1:8)='EVOLUTIO'
  59. INTERR(1)=MEVOL1
  60. CALL ERREUR(110)
  61. IEV3=0
  62. RETURN
  63. ENDIF
  64.  
  65. IF(N2.NE.1) THEN
  66. MOTERR(1:8)='EVOLUTIO'
  67. INTERR(1)=MEVOL2
  68. CALL ERREUR(110)
  69. IEV3=0
  70. RETURN
  71. ENDIF
  72.  
  73. IF(MEVOL1.ITYEVO.NE.'REEL '.OR.
  74. $ MEVOL2.ITYEVO.NE.'REEL ') THEN
  75. MOTERR(1:8)='EVOLUTIO'
  76. MOTERR(9:16)='REEL '
  77. CALL ERREUR(79)
  78. IEV3=0
  79. RETURN
  80. ENDIF
  81.  
  82. KEVOL1=MEVOL1.IEVOLL(1)
  83. KEVOL2=MEVOL2.IEVOLL(1)
  84. IF(KEVOL1.TYPX.NE.'LISTREEL'.OR.KEVOL1.TYPY.NE.'LISTREEL')THEN
  85. MOTERR(1:8)='EVOLUTIO'
  86. MOTERR(9:16)='LISTREEL'
  87. INTERR(1)=MEVOL1
  88. CALL ERREUR(630)
  89. IEV3=0
  90. RETURN
  91. ENDIF
  92. IF(KEVOL2.TYPX.NE.'LISTREEL'.OR.KEVOL2.TYPY.NE.'LISTREEL')THEN
  93. MOTERR(1:8)='EVOLUTIO'
  94. MOTERR(9:16)='LISTREEL'
  95. INTERR(1)=MEVOL2
  96. CALL ERREUR(630)
  97. IEV3=0
  98. RETURN
  99. ENDIF
  100. IF(KEVOL1.NOMEVX.NE.KEVOL2.NOMEVX) THEN
  101. MOTERR(1:9)='abscisses'
  102. MOTERR(10:17)='EVOLUTIO'
  103. INTERR(1)=MEVOL1
  104. INTERR(2)=MEVOL2
  105. CALL ERREUR(631)
  106. IEV3=0
  107. RETURN
  108. ENDIF
  109. IF(KEVOL1.NOMEVY.NE.KEVOL2.NOMEVY) THEN
  110. MOTERR(1:9)='ordonnees'
  111. MOTERR(10:17)='EVOLUTIO'
  112. INTERR(1)=MEVOL1
  113. INTERR(2)=MEVOL2
  114. CALL ERREUR(631)
  115. IEV3=0
  116. RETURN
  117. ENDIF
  118.  
  119. MLREEL=KEVOL1.IPROGX
  120. MLREE1=KEVOL1.IPROGY
  121. MLREE2=KEVOL2.IPROGX
  122. MLREE3=KEVOL2.IPROGY
  123.  
  124. C Recherche de la precision pour fusionner des ABSCISSES
  125. JG0=MLREEL.PROG(/1)
  126. JG2=MLREE2.PROG(/1)
  127. XPRECR=XZPREC * 100.D0
  128. XMIN= 1.D0/XPETIT
  129. XMAX=-XMIN
  130. DO III=1,JG0
  131. XV0 =MLREEL.PROG(III)
  132. XMIN=MIN(XMIN,XV0)
  133. XMAX=MAX(XMAX,XV0)
  134. ENDDO
  135. DO III=1,JG2
  136. XV2 =MLREE2.PROG(III)
  137. XMIN=MIN(XMIN,XV2)
  138. XMAX=MAX(XMAX,XV2)
  139. ENDDO
  140. XPREC=MAX(XPRECR*(XMAX-XMIN),XPETIT)
  141.  
  142. C DECOMPTE pour trouver la taille des LISTREELS sans faire de SEGADJ
  143. JGMAX=JG0+JG2
  144. JG =0
  145. IJ0 =1
  146. IJ2 =1
  147. DO III=1,JGMAX
  148. IF(IJ0.EQ.1)THEN
  149. XV0 = MLREEL.PROG(1)
  150. IF(IJ2.LE.JG2)THEN
  151. XV2 = MLREE2.PROG(IJ2)
  152. IF (XV0 .GT. XV2+XPREC)THEN
  153. LOG0=.FALSE.
  154. XV0 = XNAN
  155. ELSE
  156. LOG0=.TRUE.
  157. ENDIF
  158. ELSE
  159. LOG0=.TRUE.
  160. ENDIF
  161. ELSEIF(IJ0 .LE. JG0)THEN
  162. XV0 = MLREEL.PROG(IJ0)
  163. LOG0=.TRUE.
  164. ELSE
  165. XV0 = XNAN
  166. LOG0=.FALSE.
  167. ENDIF
  168.  
  169. IF(IJ2.EQ.1)THEN
  170. XV2 = MLREE2.PROG(1)
  171. IF(IJ0.LE.JG0)THEN
  172. IF(LOG0)THEN
  173. XV0 = MLREEL.PROG(IJ0)
  174. IF (XV2 .GT. XV0+XPREC)THEN
  175. LOG2=.FALSE.
  176. XV2 = XNAN
  177. ELSE
  178. LOG2=.TRUE.
  179. ENDIF
  180. ELSE
  181. LOG2=.TRUE.
  182. ENDIF
  183. ELSE
  184. LOG2=.TRUE.
  185. ENDIF
  186. ELSEIF(IJ2 .LE. JG2)THEN
  187. XV2 = MLREE2.PROG(IJ2)
  188. LOG2=.TRUE.
  189. ELSE
  190. XV2 = XNAN
  191. LOG2=.FALSE.
  192. ENDIF
  193.  
  194. IF (.NOT. LOG0 .AND. .NOT. LOG2)THEN
  195. C Plus aucun points : on quitte
  196. GOTO 101
  197. ELSEIF( LOG0 .AND. .NOT. LOG2)THEN
  198. C Ajout du pt de la 1ere courbe
  199. JG = JG +1
  200. IJ0 = IJ0+1
  201. ELSEIF(.NOT. LOG0 .AND. LOG2)THEN
  202. C Ajout du pt de la 2eme courbe
  203. JG = JG +1
  204. IJ2 = IJ2+1
  205. ELSE
  206. IF (ABS(XV2-XV0) .LT. XPREC)THEN
  207. C Pts confondus
  208. JG = JG +1
  209. IJ0 = IJ0+1
  210. IJ2 = IJ2+1
  211. ELSEIF(XV0 .LT. XV2)THEN
  212. C Ajout du pt de la 1ere courbe
  213. JG = JG +1
  214. IJ0 = IJ0+1
  215. ELSE
  216. C Ajout du pt de la 2eme courbe
  217. JG = JG +1
  218. IJ2 = IJ2+1
  219. ENDIF
  220. ENDIF
  221.  
  222. ENDDO
  223. 101 CONTINUE
  224.  
  225. C Creation du resultat
  226. N=1
  227. IF(nbesc.NE.0)CALL oooprl(1)
  228. SEGINI,MEVOLL,KEVOLL,MREX,MREY
  229. IF(nbesc.NE.0)CALL oooprl(0)
  230.  
  231. C Remplissage du resultat
  232. MEVOLL.ITYEVO =MEVOL1.ITYEVO
  233. MEVOLL.IEVTEX =MEVOL1.IEVTEX
  234. MEVOLL.IEVOLL(1)=KEVOLL
  235. KEVOLL.IPROGX =MREX
  236. KEVOLL.IPROGY =MREY
  237. KEVOLL.NUMEVX =KEVOL1.NUMEVX
  238. KEVOLL.NUMEVY =KEVOL1.NUMEVY
  239. KEVOLL.TYPX =KEVOL1.TYPX
  240. KEVOLL.TYPY =KEVOL1.TYPY
  241. KEVOLL.NOMEVX =KEVOL1.NOMEVX
  242. KEVOLL.NOMEVY =KEVOL1.NOMEVY
  243. KEVOLL.KEVTEX =KEVOL1.KEVTEX
  244. IEV3=MEVOLL
  245.  
  246. JGMAX=JG
  247. JG =0
  248. IJ0 =1
  249. IJ2 =1
  250. DO III=1,JGMAX
  251. IF(IJ0.EQ.1)THEN
  252. XV0 = MLREEL.PROG(1)
  253. YV0 = MLREE1.PROG(1)
  254. IF(IJ2.LE.JG2)THEN
  255. XV2 = MLREE2.PROG(IJ2)
  256. IF (XV0 .GT. XV2+XPREC)THEN
  257. LOG0=.FALSE.
  258. XV0 = XNAN
  259. ELSE
  260. LOG0=.TRUE.
  261. ENDIF
  262. ELSE
  263. LOG0=.TRUE.
  264. ENDIF
  265. ELSEIF(IJ0 .LE. JG0)THEN
  266. XV0 = MLREEL.PROG(IJ0)
  267. YV0 = MLREE1.PROG(IJ0)
  268. LOG0=.TRUE.
  269. ELSE
  270. XV0 = XNAN
  271. YV0 = MLREE1.PROG(JG0)
  272. LOG0=.FALSE.
  273. ENDIF
  274.  
  275. IF(IJ2.EQ.1)THEN
  276. XV2 = MLREE2.PROG(1)
  277. YV2 = MLREE3.PROG(1)
  278. IF(IJ0.LE.JG0)THEN
  279. IF(LOG0)THEN
  280. XV0 = MLREEL.PROG(IJ0)
  281. IF (XV2 .GT. XV0+XPREC)THEN
  282. LOG2=.FALSE.
  283. XV2 = XNAN
  284. ELSE
  285. LOG2=.TRUE.
  286. ENDIF
  287. ELSE
  288. LOG2=.TRUE.
  289. ENDIF
  290. ELSE
  291. LOG2=.TRUE.
  292. ENDIF
  293. ELSEIF(IJ2 .LE. JG2)THEN
  294. XV2 = MLREE2.PROG(IJ2)
  295. YV2 = MLREE3.PROG(IJ2)
  296. LOG2=.TRUE.
  297. ELSE
  298. XV2 = XNAN
  299. YV2 = MLREE3.PROG(JG2)
  300. LOG2=.FALSE.
  301. ENDIF
  302.  
  303. IF (.NOT. LOG0 .AND. .NOT. LOG2)THEN
  304. C Plus aucun points : on a mal compte ??
  305. CALL ERREUR(5)
  306. ELSEIF( LOG0 .AND. .NOT. LOG2)THEN
  307. C Ajout du pt de la 1ere courbe
  308. JG = JG +1
  309. MREX.PROG(JG)=XV0
  310. MREY.PROG(JG)=XX1*YV0+XX2*YV2
  311. IJ0 = IJ0+1
  312. ELSEIF(.NOT. LOG0 .AND. LOG2)THEN
  313. C Ajout du pt de la 2eme courbe
  314. JG = JG +1
  315. MREX.PROG(JG)=XV2
  316. MREY.PROG(JG)=XX1*YV0+XX2*YV2
  317. IJ2 = IJ2+1
  318. ELSE
  319. IF (ABS(XV2-XV0) .LT. XPREC)THEN
  320. C Pts confondus
  321. JG = JG +1
  322. MREX.PROG(JG)=0.5D0*(XV0+XV2)
  323. MREY.PROG(JG)=XX1*YV0+XX2*YV2
  324. IJ0 = IJ0+1
  325. IJ2 = IJ2+1
  326. ELSEIF(XV0 .LT. XV2)THEN
  327. C Ajout du pt de la 1ere courbe
  328. JG = JG +1
  329. MREX.PROG(JG)=XV0
  330. Xd =MLREE2.PROG(IJ2-1)
  331. Yd =MLREE3.PROG(IJ2-1)
  332. YIPOL=Yd+(YV2-Yd)*((XV0-Xd)/(XV2-Xd))
  333. MREY.PROG(JG)=XX1*YV0+XX2*YIPOL
  334. IJ0 = IJ0+1
  335. ELSE
  336. C Ajout du pt de la 2eme courbe
  337. JG = JG +1
  338. MREX.PROG(JG)=XV2
  339. Xd =MLREEL.PROG(IJ0-1)
  340. Yd =MLREE1.PROG(IJ0-1)
  341. YIPOL=Yd+(YV0-Yd)*((XV2-Xd)/(XV0-Xd))
  342. MREY.PROG(JG)=XX1*YV0+XX2*YIPOL
  343. MREY.PROG(JG)=XX2*YV2 + XX1*YIPOL
  344. IJ2 = IJ2+1
  345. ENDIF
  346. ENDIF
  347. ENDDO
  348. END
  349.  
  350.  
  351.  

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