Télécharger actipo.eso

Retour à la liste

Numérotation des lignes :

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

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