Télécharger intgev.eso

Retour à la liste

Numérotation des lignes :

  1. C INTGEV SOURCE CB215821 17/04/19 21:15:01 9403
  2. C
  3. C=======================================================================
  4. C
  5. C INTEGRATION DE L'ORDONNEE SUR LES ABSCISSES D'UN OBJET DE TYPE
  6. C EVOLUTION
  7. C
  8. C APPELEE PAR INTGRA
  9. C
  10. C L'INTEGRATION EST EFFECTUEE PAR LA METHODE DES TRAPEZES,
  11. C LE PAS D'INTEGRATION EST CALCULE A CHAQUE INSTANT
  12. C LE RESULTAT EST UN LISTREEL CONTENANT
  13. C - LES INTEGRALES DE CHAQUE COURBE DE L'OBJET EVOLUTION D'ENTREE
  14. C - OU LES INTEGRALES DE LA PREMIERE EVOLUTION D'ENTREE CALCULEE
  15. C POUR CHACUNE DES BORNES SI CELLES-CI SONT MULTIPLES (CAS DES
  16. C BORNES LISTREEL OU LISTENTI)
  17. C
  18. C SI IABSO=1, ON INTEGRE LA VALEUR ABSOLUE DES ORDONNEES
  19. C
  20. C CREATION : BEAUFILS, 24/03/87 (SOMM.eso)
  21. c MODIFS : BP, 2016-05-04 : BRANCHE DANS INTGEV + AJOUT DES BORNES
  22. C
  23. C=======================================================================
  24. C
  25. SUBROUTINE INTGEV(IPEVO,IABSO,CHBOR,IA,IB,XA,XB,ILENTA,ILENTB,
  26. & XINT,IPINT)
  27. C
  28. IMPLICIT INTEGER(I-N)
  29. IMPLICIT REAL*8(A-H,O-Z)
  30. C
  31. -INC CCOPTIO
  32. -INC SMEVOLL
  33. -INC SMLREEL
  34. -INC SMLENTI
  35. C
  36. CHARACTER*8 CHBOR
  37. C
  38.  
  39. XINT =0.D0
  40. IPINT=0
  41.  
  42. C=======================================================================
  43. C AIGUILLAGE SELON TYPE DE BORNES EN ENTREE
  44. C=======================================================================
  45. C Traitement special si plusieurs intervalles en entree
  46. IF(ILENTA.NE.0) GOTO 100
  47.  
  48.  
  49. C=======================================================================
  50. C CALCUL DES INTEGRALES DE NEVOLL FONCTIONS
  51. C SUR LE DOMAINE ENTIER OU [A B] (intervalle unique)
  52. C=======================================================================
  53.  
  54. C OUVERTURE DE L'EVOLUTION EN ENTREE
  55. MEVOLL=IPEVO
  56. SEGACT MEVOLL
  57. NEVOLL=IEVOLL(/1)
  58. c on n'accepte pas les evolutions VIDES (c'est un choix discutable)
  59. IF(NEVOLL.EQ.0) THEN
  60. MOTERR(1:8)='EVOLUTIO'
  61. CALL ERREUR(555)
  62. SEGDES,MEVOLL
  63. RETURN
  64. ENDIF
  65.  
  66. C CREATION DU LISTREEL SOLUTION
  67. JG=NEVOLL
  68. SEGINI MLREEL
  69. JG = 0
  70.  
  71. C --- BOUCLE SUR LES COURBES KEVOLL ---
  72. DO 1 IK=1,NEVOLL
  73.  
  74. KEVOLL=IEVOLL(IK)
  75. SEGACT KEVOLL
  76.  
  77. C VERIF DU TYPE : SEUL LISTREEL ADMIS, SINON ON SAUTE
  78. IF(TYPX(1:8).NE.'LISTREEL' .OR. TYPY(1:8).NE.'LISTREEL') THEN
  79. SEGDES,KEVOLL
  80. GOTO 1
  81. ENDIF
  82.  
  83. c sous-evolution ok : on integre
  84. JG=JG+1
  85. MLREE1=IPROGX
  86. SEGACT MLREE1
  87. MLREE2=IPROGY
  88. SEGACT MLREE2
  89. L1=MLREE1.PROG(/1)
  90. IF(L1.EQ.0) THEN
  91. MOTERR(1:8)='LISTREEL'
  92. CALL ERREUR(555)
  93. SEGDES,MLREE2,MLREE1,KEVOLL,MLREEL,MEVOLL
  94. RETURN
  95. ENDIF
  96.  
  97. c Definition des bornes d'integration
  98. c Cas IA et IB non precise (=0)
  99. IF(IA.EQ.0 .AND. IB.EQ.0) THEN
  100. IA=1
  101. IB=L1
  102. ISTEP=1
  103. ELSEIF(IB .LT. IA) THEN
  104. ISTEP=-1
  105. ELSE
  106. ISTEP= 1
  107. ENDIF
  108.  
  109. c ERREUR si IA ou IB < 0 ou > L1
  110. IF(IA.LT.1 .OR. IA.GT.L1) THEN
  111. INTERR(1)=IA
  112. INTERR(2)=1
  113. INTERR(3)=L1
  114. c L'indice ENTIER %i1 n'est pas compris entre %i2 et %i3
  115. CALL ERREUR(1068)
  116. RETURN
  117. ENDIF
  118.  
  119. IF(IB.LT.1 .OR. IB.GT.L1) THEN
  120. INTERR(1)=IA
  121. INTERR(2)=1
  122. INTERR(3)=L1
  123. c L'indice ENTIER %i1 n'est pas compris entre %i2 et %i3
  124. CALL ERREUR(1068)
  125. RETURN
  126. ENDIF
  127.  
  128. C EFFECTUE LE CALCUL
  129. TRAV=0.D0
  130. C option 'ABS'
  131. IF(IABSO.EQ.1) THEN
  132. DO 2 I=IA,(IB-ISTEP),ISTEP
  133. Y2=ABS(MLREE2.PROG(I+ISTEP))
  134. Y1=ABS(MLREE2.PROG(I))
  135. FORC=(Y2+Y1)/2.D0
  136. VPAS=MLREE1.PROG(I+ISTEP)-MLREE1.PROG(I)
  137. TRAV=TRAV+FORC*VPAS
  138. 2 CONTINUE
  139. ELSE
  140. DO 3 I=IA,(IB-ISTEP),ISTEP
  141. Y2=MLREE2.PROG(I+ISTEP)
  142. Y1=MLREE2.PROG(I)
  143. FORC=(Y2+Y1)/2.D0
  144. VPAS=MLREE1.PROG(I+ISTEP)-MLREE1.PROG(I)
  145. TRAV=TRAV+FORC*VPAS
  146. 3 CONTINUE
  147. ENDIF
  148.  
  149. C stockage et desactivations
  150. PROG(JG)=TRAV
  151. SEGDES MLREE1,MLREE2,KEVOLL
  152. C
  153. 1 CONTINUE
  154. C --- FIN DE LA BOUCLE SUR LES COURBES KEVOLL ---
  155. C
  156. IF(JG .NE. NEVOLL) SEGADJ,MLREEL
  157. SEGDES,MLREEL,MEVOLL
  158. C
  159. IPINT=MLREEL
  160. RETURN
  161.  
  162.  
  163. C=======================================================================
  164. C CALCUL DES INTEGRALES D'1 UNIQUE FONCTION
  165. C SUR UNE LISTE D'INTERVALLES [A_j B_j]
  166. C=======================================================================
  167. 100 CONTINUE
  168.  
  169.  
  170. C OUVERTURE DE L'EVOLUTION EN ENTREE
  171. MEVOLL=IPEVO
  172. SEGACT MEVOLL
  173. NEVOLL=IEVOLL(/1)
  174. c on n'accepte que les evolutions composee d'1 seule courbe
  175. IF(NEVOLL.NE.1) THEN
  176. MOTERR(1:8)='EVOLUTIO'
  177. INTERR(1)=MEVOLL
  178. CALL ERREUR(110)
  179. SEGDES,MEVOLL
  180. RETURN
  181. ENDIF
  182. KEVOLL=IEVOLL(1)
  183. SEGACT KEVOLL
  184.  
  185. C VERIF DU TYPE : SEUL LISTREEL ADMIS, SINON ON FAIT UNE ERREUR
  186. IF(TYPX(1:8).NE.'LISTREEL'.AND.TYPY(1:8).NE.'LISTREEL') THEN
  187. MOTERR(1:8) ='EVOLUTIO'
  188. MOTERR(9:16)='LISTREEL'
  189. c Il faut specifier un objet de type %m1:8 et de sous type %m9:16
  190. CALL ERREUR(79)
  191. SEGDES,MEVOLL,KEVOLL
  192. RETURN
  193. ENDIF
  194. c OUVERTURE DES 2 LISTREELS (NON VIDES) COMPOSANT L EVOLUTION
  195. MLREE1=IPROGX
  196. SEGACT MLREE1
  197. MLREE2=IPROGY
  198. SEGACT MLREE2
  199. L1=MLREE1.PROG(/1)
  200. IF(L1.EQ.0) THEN
  201. MOTERR(1:8)='LISTREEL'
  202. CALL ERREUR(555)
  203. SEGDES,MEVOLL,KEVOLL,MLREE1,MLREE2
  204. RETURN
  205. ENDIF
  206.  
  207. C OUVERTURE DES LISTENTI EN ENTREE
  208. MLENT1=ILENTA
  209. MLENT2=ILENTB
  210. SEGACT,MLENT1,MLENT2
  211. NA=MLENT1.LECT(/1)
  212. NB=MLENT2.LECT(/1)
  213. IF(NA.NE.NB) THEN
  214. WRITE(IOIMP,*) 'Nombre de bornes d integration incoherent !'
  215. MOTERR(1:8) ='INTG'
  216. MOTERR(5:12) ='LISTENTI'
  217. c L'operation %m1:4 doit se faire sur des objets %m5:12 de meme dimension
  218. CALL ERREUR(125)
  219. SEGDES,MEVOLL,KEVOLL,MLREE1,MLREE2,MLENT1,MLENT2
  220. RETURN
  221. ENDIF
  222.  
  223. C CREATION DU LISTREEL SOLUTION
  224. JG=NA
  225. SEGINI MLREEL
  226.  
  227. C --- BOUCLE SUR LES INTERVALLES A INTEGRER ---
  228. DO 101 IG=1,JG
  229. c Definition des bornes d'integration
  230. IA=MLENT1.LECT(IG)
  231. IB=MLENT2.LECT(IG)
  232.  
  233. c ERREUR si IA ou IB < 0 ou > L1
  234. IF(IA.LE.0.OR.IA.GT.L1) THEN
  235. MOTERR(1:8)='BORNE A '
  236. REAERR(1)=REAL(IA)
  237. REAERR(2)=REAL(1)
  238. REAERR(3)=REAL(L1)
  239. c %m1:8 = %r1 non compris entre %r2 et %r3
  240. CALL ERREUR(42)
  241. RETURN
  242. ENDIF
  243. IF(IB.LE.0.OR.IB.GT.L1) THEN
  244. MOTERR(1:8)='BORNE B '
  245. REAERR(1)=REAL(IB)
  246. REAERR(2)=REAL(1)
  247. REAERR(3)=REAL(L1)
  248. c %m1:8 = %r1 non compris entre %r2 et %r3
  249. CALL ERREUR(42)
  250. RETURN
  251. ENDIF
  252.  
  253. IF(IB .LT. IA) THEN
  254. c Cas IB<IA (non nuls)
  255. ISTEP=-1
  256. ELSE
  257. c Cas IB>=IA (non nuls)
  258. ISTEP=1
  259. ENDIF
  260.  
  261. C EFFECTUE LE CALCUL
  262. TRAV=0.D0
  263. C option 'ABS'
  264. IF(IABSO.EQ.1) THEN
  265. DO 102 I=IA,(IB-1),ISTEP
  266. Y2=ABS(MLREE2.PROG(I+ISTEP))
  267. Y1=ABS(MLREE2.PROG(I))
  268. FORC=(Y2+Y1)/2.D0
  269. VPAS=MLREE1.PROG(I+ISTEP)-MLREE1.PROG(I)
  270. TRAV=TRAV+FORC*VPAS
  271. 102 CONTINUE
  272. ELSE
  273. DO 103 I=IA,(IB-1),ISTEP
  274. Y2=MLREE2.PROG(I+ISTEP)
  275. Y1=MLREE2.PROG(I)
  276. FORC=(Y2+Y1)/2.D0
  277. VPAS=MLREE1.PROG(I+ISTEP)-MLREE1.PROG(I)
  278. TRAV=TRAV+FORC*VPAS
  279. 103 CONTINUE
  280. ENDIF
  281.  
  282. C stockage et desactivations
  283. PROG(IG)=TRAV
  284. C
  285. 101 CONTINUE
  286. C --- FIN DE LA BOUCLE SUR LES INTERVALLES ---
  287. C
  288. SEGDES MLREE1,MLREE2
  289. SEGDES KEVOLL,MLENT1,MLENT2
  290. c SEGADJ,MLREEL
  291. SEGDES,MLREEL,MEVOLL
  292. C
  293. IPINT=MLREEL
  294. RETURN
  295. END
  296.  
  297.  

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