Télécharger actipo.eso

Retour à la liste

Numérotation des lignes :

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

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