Télécharger actipo.eso

Retour à la liste

Numérotation des lignes :

  1. C ACTIPO SOURCE CB215821 19/07/31 21:15:14 10277
  2. SUBROUTINE ACTIPO(FLOT,IDET,MCHPO1,MCHPO2,MCHPO3,MCHPO4)
  3. C--------------------------------------------------------------------
  4. C ACCELERATION POUR DES CHAMPOINTS
  5. C--------------------------------------------------------------------
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8(A-H,O-Z)
  8. -INC CCOPTIO
  9. -INC SMCHPOI
  10. -INC SMELEME
  11. -INC SMCOORD
  12. -INC CCREEL
  13. CHARACTER*4 NAMEU(9),NAMEF(9)
  14. SEGMENT SNOMIN
  15. CHARACTER*4 NOMIN(0)
  16. ENDSEGMENT
  17. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  18. SEGMENT/MTRAV/(VA(NIN,KPOI)*D,VB(NIN,KPOI)*D,VC(NIN,KPOI)*D
  19. . ,VD(NIN,KPOI)*D,IBIN(NIN,KPOI),IPASS(NIN))
  20. SEGMENT/MTRBV/(VF(NIN,KPOI)*D)
  21. DATA NAMEU(1),NAMEU(2),NAMEU(3)/'UX ','UY ','UZ '/
  22. DATA NAMEU(4),NAMEU(5),NAMEU(6)/'RX ','RY ','RZ '/
  23. DATA NAMEU(7),NAMEU(8),NAMEU(9)/'UR ','UT ','RT '/
  24. DATA NAMEF(1),NAMEF(2),NAMEF(3)/'FX ','FY ','FZ '/
  25. DATA NAMEF(4),NAMEF(5),NAMEF(6)/'MX ','MY ','MZ '/
  26. DATA NAMEF(7),NAMEF(8),NAMEF(9)/'FR ','FT ','MT '/
  27. DATA BINF,BSUP/1.D-2,1.D2/
  28. xp100=xpetit * 100.
  29. C
  30. C ** ON FABRIQUE UN ICPR SUR LE 3 EME CHPOINT
  31. C
  32. SEGACT MCOORD
  33. SEGINI ICPR
  34. SEGINI SNOMIN
  35. MCHPOI=MCHPO3
  36. SEGACT MCHPOI
  37. KPOI=0
  38. DO 1 I = 1,IPCHP(/1)
  39. MSOUPO=IPCHP(I)
  40. SEGACT MSOUPO
  41. MELEME=IGEOC
  42. SEGACT MELEME
  43. DO 2 K=1,NUM(/2)
  44. IP=NUM(1,K)
  45. IF(ICPR(IP).NE.0) GO TO 2
  46. KPOI=KPOI+1
  47. ICPR(IP)=KPOI
  48. 2 CONTINUE
  49. C
  50. C ** RECHERCHE DE TOUTES LES INCONNUES DE CE CHPOINT
  51. C
  52. IF(I.NE.1) GO TO 3
  53. DO 4 K=1,NOCOMP(/2)
  54. NOMIN(**)=NOCOMP(K)
  55. 4 CONTINUE
  56. GO TO 7
  57. 3 CONTINUE
  58. NN=NOMIN(/2)
  59. DO 5 K=1,NOCOMP(/2)
  60. DO 6 KK=1,NN
  61. IF(NOMIN(KK).EQ.NOCOMP(K)) GO TO 5
  62. 6 CONTINUE
  63. NOMIN(**)=NOCOMP(K)
  64. 5 CONTINUE
  65. 7 CONTINUE
  66. 1 CONTINUE
  67. NIN=NOMIN(/2)
  68. SEGINI MTRAV
  69. C
  70. C ON RECUPERE LE 3-EME CHAMP MIS DANS VA
  71. C
  72. DO 10 I=1,IPCHP(/1)
  73. MSOUPO=IPCHP(I)
  74. SEGACT MSOUPO
  75. MELEME=IGEOC
  76. SEGACT MELEME
  77. MPOVAL=IPOVAL
  78. SEGACT MPOVAL
  79. DO 11 K=1,NOCOMP(/2)
  80. DO 12 KK=1,NIN
  81. IF(NOMIN(KK).EQ.NOCOMP(K)) GO TO 13
  82. 12 CONTINUE
  83. 13 CONTINUE
  84. IPASS(K)=KK
  85. 11 CONTINUE
  86. DO 14 K=1,NUM(/2)
  87. DO 14 KK=1,NOCOMP(/2)
  88. K1=IPASS(KK)
  89. K2= ICPR(NUM(1,K))
  90. IBIN(K1,K2)=1
  91. VA(K1,K2)=VPOCHA(K,KK)
  92. VD(K1,K2)=VPOCHA(K,KK)
  93. 14 CONTINUE
  94. 10 CONTINUE
  95. C
  96. C ON RECUPERE LE 2-EME CHAMP MIS DANS VB
  97. C
  98. MCHPOI=MCHPO2
  99. SEGACT MCHPOI
  100. DO 20 I=1,IPCHP(/1)
  101. MSOUPO=IPCHP(I)
  102. SEGACT MSOUPO
  103. MELEME=IGEOC
  104. SEGACT MELEME
  105. MPOVAL=IPOVAL
  106. SEGACT MPOVAL
  107. DO 29 K=1,NIN
  108. IPASS(K)=0
  109. 29 CONTINUE
  110. DO 21 K=1,NOCOMP(/2)
  111. DO 22 KK=1,NIN
  112. IF(NOMIN(KK).EQ.NOCOMP(K)) GO TO 23
  113. 22 CONTINUE
  114. GO TO 21
  115. 23 CONTINUE
  116. IPASS(K)=KK
  117. 21 CONTINUE
  118. DO 28 K=1,NUM(/2)
  119. K2= ICPR(NUM(1,K))
  120. IF(K2.EQ.0) GO TO 28
  121. DO 24 KK=1,NOCOMP(/2)
  122. K1=IPASS(KK)
  123. IF(K1.EQ.0) GO TO 24
  124. VB(K1,K2)=VPOCHA(K,KK)
  125. 24 CONTINUE
  126. 28 CONTINUE
  127. 20 CONTINUE
  128. C
  129. C ON RECUPERE LE 1-ER CHAMP MIS DANS VC
  130. C
  131. MCHPOI=MCHPO1
  132. SEGACT MCHPOI
  133. DO 30 I=1,IPCHP(/1)
  134. MSOUPO=IPCHP(I)
  135. SEGACT MSOUPO
  136. MELEME=IGEOC
  137. SEGACT MELEME
  138. MPOVAL=IPOVAL
  139. SEGACT MPOVAL
  140. DO 39 K=1,NIN
  141. IPASS(K)=0
  142. 39 CONTINUE
  143. DO 31 K=1,NOCOMP(/2)
  144. DO 32 KK=1,NIN
  145. IF(NOMIN(KK).EQ.NOCOMP(K)) GO TO 33
  146. 32 CONTINUE
  147. GO TO 31
  148. 33 CONTINUE
  149. IPASS(K)=KK
  150. 31 CONTINUE
  151. DO 38 K=1,NUM(/2)
  152. K2= ICPR(NUM(1,K))
  153. IF(K2.EQ.0) GO TO 38
  154. DO 34 KK=1,NOCOMP(/2)
  155. K1=IPASS(KK)
  156. IF(K1.EQ.0) GO TO 34
  157. VC(K1,K2)=VPOCHA(K,KK)
  158. 34 CONTINUE
  159. 38 CONTINUE
  160. 30 CONTINUE
  161. C
  162. GO TO (2001,2002),IDET
  163. C
  164. C ACCELERATION GEOMETRIQUE
  165. C
  166. 2001 CONTINUE
  167. DO 41 K=1,KPOI
  168. DO 42 I=1,NIN
  169. RR=VA(I,K)
  170. IF(IBIN(I,K).EQ.0) GO TO 42
  171. RD=VB(I,K)-VC(I,K)
  172. IF(abs(rd).lt.xp100) GO TO 43
  173. RAI=(VA(I,K)-VB(I,K))/RD
  174. IF(ABS(RAI).GT.FLOT) GO TO 43
  175. IF(abs(1.D0-RAI).LE.xp100) GO TO 43
  176. RR=VA(I,K)+(VA(I,K)-VB(I,K))*RAI/(1.D0-RAI)
  177. 43 CONTINUE
  178. VD(I,K)=RR
  179. 42 CONTINUE
  180. 41 CONTINUE
  181. GO TO 3000
  182. C
  183. C ACCELERATION SECANTE
  184. C
  185. 2002 CONTINUE
  186. C
  187. C ON RECUPERE LE DERNIER CHAMP DANS VF
  188. C
  189. SEGINI MTRBV
  190. MCHPOI=MCHPO4
  191. SEGACT MCHPOI
  192. DO 70 I=1,IPCHP(/1)
  193. MSOUPO=IPCHP(I)
  194. SEGACT MSOUPO
  195. MELEME=IGEOC
  196. SEGACT MELEME
  197. MPOVAL=IPOVAL
  198. SEGACT MPOVAL
  199. DO 79 K=1,NIN
  200. IPASS(K)=0
  201. 79 CONTINUE
  202. DO 71 K=1,NOCOMP(/2)
  203. DO 710 KN=1,9
  204. IF(NAMEF(KN).EQ.NOCOMP(K)) GO TO 720
  205. 710 CONTINUE
  206. GO TO 71
  207. 720 CONTINUE
  208. DO 72 KK=1,NIN
  209. IF(NOMIN(KK).EQ.NAMEU(KN)) GO TO 73
  210. 72 CONTINUE
  211. GO TO 71
  212. 73 CONTINUE
  213. IPASS(K)=KK
  214. 71 CONTINUE
  215. DO 78 K=1,NUM(/2)
  216. K2= ICPR(NUM(1,K))
  217. IF(K2.EQ.0) GO TO 78
  218. DO 74 KK=1,NOCOMP(/2)
  219. K1=IPASS(KK)
  220. IF(K1.EQ.0) GO TO 74
  221. VF(K1,K2)=VPOCHA(K,KK)
  222. 74 CONTINUE
  223. 78 CONTINUE
  224. 70 CONTINUE
  225. C
  226. ZNUM=0.D0
  227. ZDENOM=0.D0
  228. DO 761 K=1,KPOI
  229. DO 762 I=1,NIN
  230. IF(IBIN(I,K).EQ.0) GO TO 762
  231. ZNUM=ZNUM+VF(I,K)*VC(I,K)
  232. ZDENOM=ZDENOM+VF(I,K)*(VC(I,K)+VB(I,K)-VA(I,K))
  233. 762 CONTINUE
  234. 761 CONTINUE
  235. IF(ZDENOM.EQ.0.D0) XMU=1.D0
  236. IF(ZDENOM.NE.0.D0) XMU=ZNUM/ZDENOM
  237. IF(ABS(XMU).LT.BINF.OR.ABS(XMU).GT.BSUP) XMU=1.D0
  238. IF(XMU.EQ.0.D0) XMU=1.D0
  239. XMUN=1.D0-XMU
  240. DO 771 K=1,KPOI
  241. DO 772 I=1,NIN
  242. IF(IBIN(I,K).EQ.0) GO TO 772
  243. VD(I,K)=XMU*VA(I,K)+XMUN*VC(I,K)
  244. 772 CONTINUE
  245. 771 CONTINUE
  246. C
  247. 3000 CONTINUE
  248. SEGACT MCHPO3
  249. SEGINI,MCHPOI=MCHPO3
  250. DO 50 I=1,IPCHP(/1)
  251. MSOUP1=MCHPO3.IPCHP(I)
  252. SEGACT MSOUP1
  253. SEGINI,MSOUPO=MSOUP1
  254. IPCHP(I)=MSOUPO
  255. MPOVA1=MSOUP1.IPOVAL
  256. SEGINI,MPOVAL=MPOVA1
  257. IPOVAL=MPOVAL
  258. MELEME=IGEOC
  259. SEGACT MELEME
  260. DO 51 KK=1,NOCOMP(/2)
  261. DO 52 K=1,NOMIN(/2)
  262. IF(NOMIN(K).EQ.NOCOMP(KK)) GO TO 53
  263. 52 CONTINUE
  264. CALL ERREUR ( 5 )
  265. RETURN
  266. 53 CONTINUE
  267. KPA=K
  268. DO 54 K=1,NUM(/2)
  269. IP=ICPR(NUM(1,K))
  270. VPOCHA(K,KK)=VD(KPA,IP)
  271. 54 CONTINUE
  272. 51 CONTINUE
  273. 50 CONTINUE
  274. SEGSUP SNOMIN,ICPR,MTRAV
  275. IF(IDET.EQ.2) SEGSUP MTRBV
  276. CALL ACTOBJ('CHPOINT ',MCHPOI,1)
  277. CALL ECROBJ('CHPOINT ',MCHPOI)
  278. END
  279.  
  280.  
  281.  

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