Télécharger actipo.eso

Retour à la liste

Numérotation des lignes :

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

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