Télécharger cosi.eso

Retour à la liste

Numérotation des lignes :

cosi
  1. C COSI SOURCE CHAT 05/01/12 22:22:50 5004
  2. *$$$$ COSI
  3. C COSI SOURCE ISPRA 90/06/12
  4. SUBROUTINE COSI
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. C=======================================================================
  8. C OPERATEUR COSI
  9. C
  10. C A2*EVOLUTION = COSI A1*EVOLUTION (METH*MOT)
  11. C
  12. C=======================================================================
  13. C PROGRAMMEUR : P.P.
  14. C=======================================================================
  15. C
  16. CHARACTER *72 TI
  17. CHARACTER*12 MOTX,MOTY
  18. C
  19. PARAMETER (NMOCLE=2)
  20. CHARACTER*4 MOTCLE(NMOCLE)
  21. C
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMEVOLL
  26. -INC SMLREEL
  27. C
  28. POINTEUR IACCE1.MLREEL,ITEMP1.MLREEL,IACCE2.MLREEL,ITEMP2.MLREEL
  29. POINTEUR JACCE1.MEVOLL,JACCE2.MEVOLL
  30. POINTEUR KACCE1.KEVOLL,KACCE2.KEVOLL
  31. SEGMENT, MTRAV
  32. IMPLIED AI(NPT),BI(NPT),GI(NPT)
  33. ENDSEGMENT
  34. C
  35. DIMENSION A(3,3),B(3)
  36. C
  37. C 1) LECTURE DES DONNEES GIBIANE
  38. C
  39. C 1.1) LISTE DES MOTS CLEF
  40. C
  41. DATA MOTCLE/'SIMP','LINE'/
  42. C
  43. C
  44. C 1.2) DEFAUTS
  45. C
  46. IMETH=1
  47. C
  48. C 1.3) LECTURE DE L'OBJET EVOLUTIO CONTENANT L'ACCELERATION
  49. C
  50. CALL LIROBJ('EVOLUTIO',JACCE1,1,IRET)
  51. IF(IRET.EQ.0) GOTO 666
  52. C
  53. C 1.4) LECTURE DU MOT-CLEF
  54. C (OPTIONEL)
  55. C
  56. CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0)
  57. C
  58. IF(IVAL.NE.0)THEN
  59. IMETH=IVAL
  60. ENDIF
  61. C
  62. C
  63. C 2) VERIFICATION DES DONNEES
  64. C
  65. C 2.1) MEME ABSCISSE
  66. C
  67. SEGACT, JACCE1
  68. N=JACCE1.IEVOLL(/1)
  69. DO 10 IE1=1,N
  70. KACCE1=JACCE1.IEVOLL(IE1)
  71. SEGACT, KACCE1
  72. ITEMP=KACCE1.IPROGX
  73. SEGDES, KACCE1
  74. IF(IE1.EQ.1)THEN
  75. ITEMP1=ITEMP
  76. ELSE
  77. IF(ITEMP.NE.ITEMP1)THEN
  78. CALL ERREUR(567)
  79. SEGDES, JACCE1
  80. GOTO 666
  81. ENDIF
  82. ENDIF
  83. 10 CONTINUE
  84. C
  85. C 2.2) REPARTITION HOMOGENE DES DT
  86. C
  87. SEGACT, ITEMP1
  88. NPT=ITEMP1.PROG(/1)
  89. DT=(ITEMP1.PROG(NPT)-ITEMP1.PROG(1))/(NPT-1)
  90. DT1=ITEMP1.PROG(2)-ITEMP1.PROG(1)
  91. SEGDES, ITEMP1
  92. IF(ABS(DT1-DT)/DT.GT.1.D-5)THEN
  93. CALL ERREUR(568)
  94. SEGDES, JACCE1
  95. GOTO 666
  96. ENDIF
  97. C
  98. C 3) DUPLICATION DES TEMPS ET INITIALISATIONS DIVERSES
  99. C
  100. SEGINI, ITEMP2=ITEMP1
  101. SEGDES, ITEMP2
  102. C
  103. TI=JACCE1.IEVTEX
  104. SEGINI, JACCE2
  105. JACCE2.IEVTEX='Correction de:'//TI(1:58)
  106. C
  107. SEGINI, MTRAV
  108. C
  109. C
  110. C 4) LOOP DE CALCUL
  111. C
  112. DO 100 IE1=1,N
  113. C
  114. C 4.1) INITIALISATION ET DUPLICATION DES DONNEES
  115. C
  116. C
  117. KACCE1=JACCE1.IEVOLL(IE1)
  118. SEGINI, KACCE2=KACCE1
  119. C
  120. KACCE2.IPROGX=ITEMP2
  121. C
  122. IACCE1=KACCE2.IPROGY
  123. SEGINI, IACCE2=IACCE1
  124. KACCE2.IPROGY=IACCE2
  125. C
  126. SEGDES, KACCE2
  127. JACCE2.IEVOLL(IE1)=KACCE2
  128. C
  129. C
  130. C 4.2) CALCUL DE ALPHA(I), BETA(I) ET GAMMA(I)
  131. C
  132. C 4.2.1) METHODE SIMPLIFIEE
  133. C
  134. IF(IMETH.EQ.1)THEN
  135. AI(1)=DT/2
  136. BI(1)=(2*(NPT-2)+1)*DT*DT/4
  137. DO 20 IE2=2,NPT-1
  138. AI(IE2)=DT
  139. BI(IE2)=(NPT-IE2)*DT*DT
  140. 20 CONTINUE
  141. AI(NPT)=DT/2
  142. BI(NPT)=DT*DT/4
  143. C
  144. GI(1)=0.D0
  145. DO 21 IE2=2,NPT
  146. GI(1)=GI(1)+BI(IE2)*DT/2
  147. 21 CONTINUE
  148. DO 22 IE2=2,NPT-1
  149. GI(IE2)=BI(IE2)*DT/2
  150. DO 22 IE3=IE2+1,NPT
  151. GI(IE2)=GI(IE2)+BI(IE3)*DT
  152. 22 CONTINUE
  153. GI(NPT)=BI(NPT)*DT/2
  154. ENDIF
  155. C
  156. C 4.2.2) METHODE LINEAIRE
  157. C
  158. IF(IMETH.EQ.2)THEN
  159. AI(1)=DT/2
  160. BI(1)=(3*(NPT-2)+2)*DT*DT/6
  161. DO 25 IE2=2,NPT-1
  162. AI(IE2)=DT
  163. BI(IE2)=(NPT-IE2)*DT*DT
  164. 25 CONTINUE
  165. AI(NPT)=DT/2
  166. BI(NPT)=DT*DT/6
  167. C
  168. GI(1)=(2*(NPT-2)+1)*DT*DT*DT/24
  169. DO 26 IE2=2,NPT
  170. GI(1)=GI(1)+BI(IE2)*DT/2
  171. 26 CONTINUE
  172. DO 27 IE2=2,NPT-1
  173. GI(IE2)=BI(IE2)*DT/2-DT*DT*DT/12
  174. DO 27 IE3=IE2+1,NPT
  175. GI(IE2)=GI(IE2)+BI(IE3)*DT
  176. 27 CONTINUE
  177. GI(NPT)=BI(NPT)*DT/4
  178. ENDIF
  179. C
  180. C 4.3) CALCUL DE A ET B
  181. C
  182. DO 30 IE2=1,3
  183. B(IE2)=0.D0
  184. DO 30 IE3=1,3
  185. A(IE3,IE2)=0.D0
  186. 30 CONTINUE
  187. DO 31 IE2=1,NPT
  188. A(1,1)=A(1,1)+AI(IE2)**2
  189. A(1,2)=A(1,2)+AI(IE2)*BI(IE2)
  190. A(1,3)=A(1,3)+AI(IE2)*GI(IE2)
  191. A(2,2)=A(2,2)+BI(IE2)**2
  192. A(2,3)=A(2,3)+BI(IE2)*GI(IE2)
  193. A(3,3)=A(3,3)+GI(IE2)**2
  194. B(1)=B(1)+AI(IE2)*IACCE2.PROG(IE2)
  195. B(2)=B(2)+BI(IE2)*IACCE2.PROG(IE2)
  196. B(3)=B(3)+GI(IE2)*IACCE2.PROG(IE2)
  197. 31 CONTINUE
  198. A(2,1)=A(1,2)
  199. A(3,1)=A(1,3)
  200. A(3,2)=A(2,3)
  201. C
  202. C 4.4) RESOLUTION DE A*X=B
  203. C
  204. DET=A(1,1)*(A(2,2)*A(3,3)-A(3,2)*A(2,3))
  205. > -A(2,1)*(A(1,2)*A(3,3)-A(3,2)*A(1,3))
  206. > +A(3,1)*(A(1,2)*A(2,3)-A(2,2)*A(1,3))
  207. XAM1= B(1)*(A(2,2)*A(3,3)-A(3,2)*A(2,3))
  208. > -B(2)*(A(1,2)*A(3,3)-A(3,2)*A(1,3))
  209. > +B(3)*(A(1,2)*A(2,3)-A(2,2)*A(1,3))
  210. XAM2=-B(1)*(A(2,1)*A(3,3)-A(3,1)*A(2,3))
  211. > +B(2)*(A(1,1)*A(3,3)-A(3,1)*A(1,3))
  212. > -B(3)*(A(1,1)*A(2,3)-A(2,1)*A(1,3))
  213. XAM3= B(1)*(A(2,1)*A(3,2)-A(3,1)*A(2,2))
  214. > -B(2)*(A(1,1)*A(3,2)-A(3,1)*A(1,2))
  215. > +B(3)*(A(1,1)*A(2,2)-A(2,1)*A(1,2))
  216. XAM1=XAM1/DET
  217. XAM2=XAM2/DET
  218. XAM3=XAM3/DET
  219. C
  220. C 4.5) CORRECTION DE L'ACCELERATION
  221. C
  222. DO 40 IE2=1,NPT
  223. IACCE2.PROG(IE2)=IACCE2.PROG(IE2)
  224. > -XAM1*AI(IE2)-XAM2*BI(IE2)-XAM3*GI(IE2)
  225. 40 CONTINUE
  226. C
  227. C 4.6) FIN ACTIVATION
  228. C
  229. SEGDES, IACCE2
  230. C
  231. 100 CONTINUE
  232. C
  233. C
  234. C
  235. SEGSUP, MTRAV
  236. SEGDES, JACCE1
  237. SEGDES, JACCE2
  238. C
  239. C 5) RETOUR A GIBIANE
  240. C
  241. CALL ECROBJ('EVOLUTIO',JACCE2)
  242. C
  243. C
  244. 666 CONTINUE
  245. RETURN
  246. END
  247.  
  248.  
  249.  
  250.  
  251.  

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