Télécharger somme1.eso

Retour à la liste

Numérotation des lignes :

  1. C SOMME1 SOURCE CHAT 05/01/13 03:22:02 5004
  2. SUBROUTINE SOMME1 (KFONCT,X0,X8,DX, KSOMME)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * S O M M E 1
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * CREATION, A PARTIR DE FONCTIONS "F", LES FONCTIONS "G" TELLES:
  14. *
  15. * X
  16. * /
  17. * G(X) = / F(T).DT
  18. * /
  19. * X-DX
  20. *
  21. * CES FONCTIONS ETANT TOUTES DEFINIES PAR DES SUITES DE COUPLES DE
  22. * VALEURS (X,F(X)), ORDONNES STRICTEMENT SELON LES "X" CROISSANTS.
  23. *
  24. * MODULES UTILISES:
  25. * -----------------
  26. *
  27. -INC SMEVOLL
  28. -INC SMLREEL
  29. *
  30. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  31. * -----------
  32. *
  33. * KFONCT (E) OBJET "EVOLUTION" REPRESENTANT LES FONCTIONS A
  34. * INTEGRER.
  35. * X0, X8 (E) INTERVALLE TOTAL SUR LEQUEL LES FONCTIONS SERONT
  36. * INTEGREES.
  37. * DX (E) LONGUEUR DES INTERVALLES D'INTEGRATION.
  38. * LES FONCTIONS INTEGRALES PRENDRONT DONC LEUR 1ERE
  39. * VALEUR EN X0+DX ET LEUR DERNIERE VALEUR AUTOUR DE
  40. * X8 (SELON DX).
  41. * KSOMME (S) OBJET "EVOLUTION" REPRESENTANT LES FONCTIONS
  42. * INTEGRALES.
  43. *
  44. REAL*8 X0,X8,DX
  45. *
  46. * VARIABLES:
  47. * ----------
  48. *
  49. * 5 = INDICE SIGNIFIANT "BORNE INFERIEURE" POUR UN INTERVALLE
  50. * D'INTEGRATION DONNE.
  51. * 6 = INDICE SIGNIFIANT "BORNE SUPERIEURE" POUR UN INTERVALLE
  52. * D'INTEGRATION DONNE.
  53. * F5F6 = SUITE D'ORDONNEES POUR UN INTERVALLE D'INTEGRATION DONNE.
  54. * F0 = 1ERE VALEUR DE "F" SUR L'INTERVALLE OU ELLE EST DEFINIE.
  55. * F8 = DERNIERE VALEUR DE "F".
  56. * L56MAX = LONGUEUR MAXI DES TABLES DE TRAVAIL "X5X6" ET "F5F6".
  57. * NBFONC = NOMBRE DE PAS DE DISCRETISATION POUR LES FONCTIONS "F".
  58. * NBSOMM = NOMBRE DE PAS DE DISCRETISATION POUR LES FONCTIONS
  59. * INTEGRALES "G".
  60. * NEAR5S = X5 TRES VOISIN DE L'ABSCISSE SUIVANTE DANS LA LISTE.
  61. * NEAR6P = X6 TRES VOISIN DE L'ABSCISSE PRECEDENTE DANS LA LISTE.
  62. * NEAR6S = X6 TRES VOISIN DE L'ABSCISSE SUIVANTE DANS LA LISTE.
  63. * X5X6 = SUITE D'ABSCISSES POUR UN INTERVALLE D'INTEGRATION DONNE.
  64. *
  65. POINTEUR X5X6.MLREEL,F5F6.MLREEL
  66. LOGICAL NEAR5S,NEAR6P,NEAR6S
  67. COMMON /CSOMM1/ F0,F8,F6,A6,M6,NBFONC,NEAR6P,NEAR6S
  68. *
  69. * FONCTIONS:
  70. * ----------
  71. *
  72. LOGICAL EGALDP
  73. REAL*8 SOMME2,SOMME4
  74. *
  75. * MODE DE FONCTIONNEMENT:
  76. * -----------------------
  77. *
  78. * LES FONCTIONS D'ENTREES SONT SUPPOSEES CONSTANTES SUR LES
  79. * INTERVALLES OU ELLES NE SONT PAS DEFINIES, ET EGALES AUX VALEURS
  80. * AUX BORNES OU ELLES SONT DEFINIES.
  81. *
  82. * L'INTERVALLE "DX" EST SUPPOSE TRES PETIT DEVANT L'INTERVALLE DE
  83. * DEFINITION DES FONCTIONS ET "X0" EST SUPPOSE PROCHE DE LA 1ERE
  84. * ABSCISSE OU SONT DEFINIES LES FONCTIONS. CE QUI FAIT QUE LA
  85. * LOCALISATION DE "X0" ET DES INTERVALLES (X-DX,X) DANS L'INTERVALLE
  86. * DE DEFINITION DES FONCTIONS SE FONT PAR TESTS SUCCESSIFS DANS UN
  87. * ORDRE MONOTONE DANS LE SENS DES ABSCISSES CROISSANTES.
  88. *
  89. * REMARQUES:
  90. * ----------
  91. *
  92. * ON GARDE LES TYPES ET TITRES DES FONCTIONS POUR LES INTEGRALES
  93. * ASSOCIEES.
  94. *
  95. * AUTEUR, DATE DE CREATION:
  96. * -------------------------
  97. *
  98. * PASCAL MANIGOT 29 MARS 1988
  99. *
  100. * LANGAGE:
  101. * --------
  102. *
  103. * ESOPE + FORTRAN77
  104. *
  105. ************************************************************************
  106. *
  107. NBSOMM = NINT( (X8-X0)/DX )
  108. JG = NBSOMM
  109. *
  110. MEVOL1 = KFONCT
  111. SEGINI,MEVOLL=MEVOL1
  112. KSOMME = MEVOLL
  113. NEVOLL = IEVOLL(/1)
  114. SEGACT,MEVOL1
  115. *
  116. *
  117. DO 100 IB=1,NEVOLL
  118. *
  119. KEVOL1 = IEVOLL(IB)
  120. SEGINI,KEVOLL=KEVOL1
  121. IEVOLL(IB) = KEVOLL
  122. *
  123. IF (IB .EQ. 1) THEN
  124. SEGINI,MLREEL
  125. X = X0
  126. DO 120 IB2=1,NBSOMM
  127. X = X + DX
  128. PROG(IB2) = X
  129. 120 CONTINUE
  130. * END DO
  131. END IF
  132. SEGINI,MLREE1
  133. IPROGX = MLREEL
  134. IPROGY = MLREE1
  135. *
  136. 100 CONTINUE
  137. * END DO
  138. *
  139. * A CE NIVEAU,
  140. * "MLREEL" EST TOUJOURS ACTIF ET REPRESENTE LA LISTE DES ABSCISSES
  141. * POUR CHAQUE FONCTION INTEGRALE.
  142. * LES "IPROGY" SONT TOUS ACTIFS.
  143. *
  144. L56MAX = 100
  145. JG = L56MAX
  146. SEGINI,X5X6,F5F6
  147. *
  148. *
  149. DO 200 IB=1,NEVOLL
  150. *
  151. KEVOLL = IEVOLL(IB)
  152. MLREE1 = IPROGY
  153. KEVOL1 = MEVOL1.IEVOLL(IB)
  154. SEGACT,KEVOL1
  155. MLREE2 = KEVOL1.IPROGX
  156. MLREE3 = KEVOL1.IPROGY
  157. SEGACT,MLREE2,MLREE3
  158. NBFONC = MLREE2.PROG(/1)
  159. *
  160. F0 = MLREE3.PROG(1)
  161. S0 = F0 * DX
  162. F8 = MLREE3.PROG(NBFONC)
  163. S8 = F8 * DX
  164. *
  165. X6 = X0
  166. CALL PLACE3 (MLREE2.PROG,1,NBFONC,X6, M6,A6)
  167. CALL SOMME3 (MLREE3.PROG)
  168. *
  169. DO 300 ISOMME=1,NBSOMM
  170. *
  171. IF (M6 .GE. NBFONC) THEN
  172. *
  173. S6 = S8
  174. *
  175. ELSE
  176. *
  177. X5 = X6
  178. F5 = F6
  179. M5 = M6
  180. A5 = A6
  181. X6 = X5 + DX
  182. *
  183. INF = MAX (1,M5)
  184. CALL PLACE3 (MLREE2.PROG,INF,NBFONC,X6, M6,A6)
  185. *
  186. IF (M6 .LT. INF) THEN
  187. *
  188. S6 = S0
  189. * PREPARATION POUR LES "ISOMME" SUIVANTS:
  190. CALL SOMME3 (MLREE3.PROG)
  191. *
  192. ELSE
  193. *
  194. NEAR5S = NEAR6S
  195. CALL SOMME3 (MLREE3.PROG)
  196. *
  197. JG = M6 - M5 + 2
  198. IF (NEAR5S) THEN
  199. JG = JG - 1
  200. END IF
  201. IF (NEAR6P) THEN
  202. JG = JG - 1
  203. END IF
  204. IF (JG .LT. 2) THEN
  205. * X5 ET X6 SONT TROP VOISINS PAR RAPPORT A LA
  206. * DISCRETISATION LOCALE DE LA FONCTION.
  207. CALL ERREUR (419)
  208. RETURN
  209. END IF
  210. IF (JG .GT. L56MAX) THEN
  211. SEGADJ,X5X6
  212. SEGADJ,F5F6
  213. L56MAX = JG
  214. END IF
  215. *
  216. X5X6.PROG(1) = X5
  217. F5F6.PROG(1) = F5
  218. IF (NEAR5S) THEN
  219. I0 = M5
  220. ELSE
  221. I0 = M5 - 1
  222. END IF
  223. DO 320 IB3=2,(JG-1)
  224. X5X6.PROG(IB3) = MLREE2.PROG(I0+IB3)
  225. F5F6.PROG(IB3) = MLREE3.PROG(I0+IB3)
  226. 320 CONTINUE
  227. * END DO
  228. X5X6.PROG(JG) = X6
  229. F5F6.PROG(JG) = F6
  230. *
  231. S6 = SOMME2 (X5X6.PROG,F5F6.PROG,JG)
  232. *
  233. END IF
  234. *
  235. END IF
  236. *
  237. MLREE1.PROG(ISOMME) = S6
  238. *
  239. 300 CONTINUE
  240. * END DO
  241. *
  242. SEGDES,KEVOLL,MLREE1
  243. SEGDES,KEVOL1,MLREE2,MLREE3
  244. *
  245. 200 CONTINUE
  246. * END DO
  247. *
  248. SEGDES,MEVOLL,MLREEL
  249. SEGDES,MEVOL1
  250. SEGSUP,X5X6,F5F6
  251. *
  252. END
  253.  
  254.  

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