Télécharger cosi.eso

Retour à la liste

Numérotation des lignes :

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

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