Télécharger cadrcl.eso

Retour à la liste

Numérotation des lignes :

  1. C CADRCL SOURCE GOUNAND 16/08/01 21:15:03 9043
  2. C TRACE DE DEFORMES
  3. C CALCUL DU CADRE GLOBAL
  4. C PROJECTION SUCCESSIVE DE CHAQUE DEFORME (SELON ICLE)
  5. C 1995 option DIRE P.PEGON JRC-ISPRA
  6. C
  7. C PP option DIRE
  8. SUBROUTINE CADRCL(KABCOR,LABCO2,IOEIL,XPROJ,
  9. # ICLE,XMINT,YMINT,XMAXT,YMAXT,zmint,zmaxt,cgrav,diloc,LDIRE,
  10. > axez)
  11. IMPLICIT INTEGER(I-N)
  12. REAL*8 XO,XG,XP,XN,SN,XV,SV,UI,UJ
  13. DIMENSION XO(3),XP(3),XN(3),XG(3),XV(3),UI(3),UJ(3),axez(3)
  14. dimension cgrav(*)
  15. C+PP option DIRE
  16. dimension diloc(*)
  17. C+PP
  18. COMMON /CCADRC/XN,XG,XO,UI,UJ
  19. C ATTENTION
  20. SEGMENT KABCOR(0)
  21. SEGMENT KABCO2(2,0)
  22. SEGMENT LABCO2(3,0)
  23. SEGMENT ICOR2(0)
  24. SEGMENT KXPRO2(NVEC)
  25. SEGMENT XCORD(IDIM,ITE)
  26. SEGMENT XCOR2(IDIM,ITE)
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC SMCOORD
  31. SEGMENT XPROJ(3,ITE)
  32. SEGMENT XPRO2(3,ITE)
  33. C+PP option DIRE
  34. REAL*8 SSN
  35. LOGICAL LDIRE
  36. *dbg write(6,*) 'coucou cadrcl'
  37. C+PP
  38. C ICLE = 0 RECHERCHE DES MIN MAX SUR TOUTES LES DEFORMES
  39. C CALCUL DE LA PROJECTION
  40. IF (ICLE.NE.0) GOTO 1000
  41. XMINT=1E30
  42. YMINT=XMINT
  43. ZMINT=XMINT
  44. XMAXT=-1E30
  45. YMAXT=XMAXT
  46. ZMAXT=XMAXT
  47. NCORD=KABCOR(/1)
  48. IF (IDIM.EQ.3) GOTO 50
  49. DO 10 ICORD=1,NCORD
  50. XCORD=KABCOR(ICORD)
  51. ITE=XCORD(/2)
  52. DO 19 J=1,ITE
  53. XMINT=MIN(XMINT,XCORD(1,J))
  54. XMAXT=MAX(XMAXT,XCORD(1,J))
  55. YMINT=MIN(YMINT,XCORD(2,J))
  56. YMAXT=MAX(YMAXT,XCORD(2,J))
  57. ZMINT=0
  58. ZMAXT=0
  59. 19 CONTINUE
  60. 10 CONTINUE
  61. IF (LABCO2.EQ.0) GOTO 60
  62. DO 61 ICORD=1,NCORD
  63. IF (LABCO2(3,ICORD).EQ.0) GOTO 61
  64. KABCO2=LABCO2(1,ICORD)
  65. XCORD=KABCOR(ICORD)
  66. ITE=XCORD(/2)
  67. NVEC=KABCO2(/2)
  68. IF (NVEC.EQ.0) GOTO 61
  69. DO 7 IVEC=1,NVEC
  70. XCOR2=KABCO2(1,IVEC)
  71. ICOR2=KABCO2(2,IVEC)
  72. ITE=XCOR2(/2)
  73. DO 18 J=1,ITE
  74. IF (ICOR2(J).EQ.0) GOTO 18
  75. UX=XCOR2(1,J)-XCORD(1,J)
  76. UY=XCOR2(2,J)-XCORD(2,J)
  77. U1=XCOR2(1,J)-UX/3-UY/5
  78. V1=XCOR2(2,J)-UY/3+UX/5
  79. XMINT=MIN(XMINT,U1)
  80. XMAXT=MAX(XMAXT,U1)
  81. YMINT=MIN(YMINT,V1)
  82. YMAXT=MAX(YMAXT,V1)
  83. U1=XCOR2(1,J)-UX/3+UY/5
  84. V1=XCOR2(2,J)-UY/3-UX/5
  85. XMINT=MIN(XMINT,U1)
  86. XMAXT=MAX(XMAXT,U1)
  87. YMINT=MIN(YMINT,V1)
  88. YMAXT=MAX(YMAXT,V1)
  89. XMINT=MIN(XMINT,XCOR2(1,J))
  90. XMAXT=MAX(XMAXT,XCOR2(1,J))
  91. YMINT=MIN(YMINT,XCOR2(2,J))
  92. YMAXT=MAX(YMAXT,XCOR2(2,J))
  93. 18 CONTINUE
  94. 7 CONTINUE
  95. 61 CONTINUE
  96. 60 CONTINUE
  97. RETURN
  98. 50 CONTINUE
  99. SEGACT MCOORD
  100. XMINT=1E30
  101. XMAXT=-XMINT
  102. YMINT=XMINT
  103. YMAXT=-YMINT
  104. ZMINT=XMINT
  105. ZMAXT=-YMINT
  106. IREF=(IOEIL-1)*4
  107. XO(1)=XCOOR(IREF+1)
  108. XO(2)=XCOOR(IREF+2)
  109. XO(3)=XCOOR(IREF+3)
  110. C POINT MOYEN
  111. DO 1 I=1,3
  112. XG(I)=0.D0
  113. 1 CONTINUE
  114. NPTOT=0
  115. DO 100 ICORD=1,NCORD
  116. XCORD=KABCOR(ICORD)
  117. ITE=XCORD(/2)
  118. NPTOT=NPTOT+ITE
  119. DO 2 I=1,ITE
  120. DO 3 J=1,3
  121. XG(J)=XG(J)+XCORD(J,I)
  122. 3 CONTINUE
  123. 2 CONTINUE
  124. 100 CONTINUE
  125. C+PP option DIRE
  126. IF (LDIRE)THEN
  127. DO J=1,3
  128. XG(J)=cgrav(J)
  129. XN(J)=XO(J)-XG(J)
  130. ENDDO
  131. ELSE
  132. C+PP
  133. DO 4 J=1,3
  134. XG(J)=XG(J)/NPTOT
  135. XN(J)=XO(J)-XG(J)
  136. cgrav(j)=xg(j)
  137. 4 CONTINUE
  138. C+PP option DIRE
  139. ENDIF
  140. C+PP
  141. C NORMALE AU PLAN
  142. SN=SQRT(XN(1)**2+XN(2)**2+XN(3)**2)
  143. IF (SN.EQ.0.) CALL ERREUR(21)
  144. IF (IERR.NE.0) RETURN
  145. C+PP option DIRE
  146. SSN=SN
  147. C+PP
  148. DO 5 J=1,3
  149. XN(J)=XN(J)/SN
  150. 5 CONTINUE
  151. C REPERE LOCAL SUR LE PLAN
  152. C+PP option DIRE
  153. IF (LDIRE)THEN
  154. DO J=1,3
  155. UJ(J)=diloc(J)
  156. ENDDO
  157. ELSE
  158. C+PP
  159. UJ(1)=0.D0
  160. UJ(2)=0.D0
  161. UJ(3)=1.D0
  162. C+PP option DIRE
  163. ENDIF
  164. C+PP
  165. 21 CONTINUE
  166. SV=UJ(1)*XN(1)+UJ(2)*XN(2)+UJ(3)*XN(3)
  167. DO 20 J=1,3
  168. UJ(J)=UJ(J)-SV*XN(J)
  169. 20 CONTINUE
  170. SV=UJ(1)**2+UJ(2)**2+UJ(3)**2
  171. IF (ABS(SV).LT.0.1) THEN
  172. UJ(1)=0.D0
  173. UJ(2)=1.D0
  174. UJ(3)=1.D0
  175. GOTO 21
  176. ENDIF
  177. SV=SQRT(SV)
  178. UJ(1)=UJ(1)/SV
  179. UJ(2)=UJ(2)/SV
  180. UJ(3)=UJ(3)/SV
  181. UI(1)=UJ(2)*XN(3)-UJ(3)*XN(2)
  182. UI(2)=UJ(3)*XN(1)-UJ(1)*XN(3)
  183. UI(3)=UJ(1)*XN(2)-UJ(2)*XN(1)
  184. C PROJECTION CONIQUE SUR LE PLAN
  185. DO 170 ICORD=1,NCORD
  186. XCORD=KABCOR(ICORD)
  187. ITE=XCORD(/2)
  188. DO 12 I=1,ITE
  189. DO 13 J=1,3
  190. XP(J)=XCORD(J,I)
  191. XV(J)=XP(J)-XO(J)
  192. 13 CONTINUE
  193. SV=XV(1)*XN(1)+XV(2)*XN(2)+XV(3)*XN(3)
  194. C+PP option DIRE
  195. IF ((LDIRE.AND.-SV.GE.SSN).OR.(.NOT.LDIRE))THEN
  196. C+PP
  197. SN=(XP(1)-XG(1))*XN(1)+(XP(2)-XG(2))*XN(2)+(XP(3)-XG(3))
  198. $ *XN(3)
  199. DO 14 J=1,3
  200. XP(J)=XP(J)-(SN/SV)*XV(J)-XG(J)
  201. 14 CONTINUE
  202. XPRO=XP(1)*UI(1)+XP(2)*UI(2)+XP(3)*UI(3)
  203. YPRO=XP(1)*UJ(1)+XP(2)*UJ(2)+XP(3)*UJ(3)
  204. ZPRO=-SN
  205. XMINT=MIN(XMINT,XPRO)
  206. XMAXT=MAX(XMAXT,XPRO)
  207. YMINT=MIN(YMINT,YPRO)
  208. YMAXT=MAX(YMAXT,YPRO)
  209. ZMINT=MIN(ZMINT,ZPRO)
  210. ZMAXT=MAX(ZMAXT,ZPRO)
  211. C+PP option DIRE
  212. ENDIF
  213. C+PP
  214. 12 CONTINUE
  215. 170 CONTINUE
  216. IF (LABCO2.EQ.0) GOTO 11
  217. DO 171 ICORD=1,NCORD
  218. IF (LABCO2(3,ICORD).EQ.0) GOTO 171
  219. KABCO2=LABCO2(1,ICORD)
  220. XCORD=KABCOR(ICORD)
  221. ITE=XCORD(/2)
  222. NVEC=KABCO2(/2)
  223. IF (NVEC.EQ.0) GOTO 171
  224. DO 6 IVEC=1,NVEC
  225. XCOR2=KABCO2(1,IVEC)
  226. ICOR2=KABCO2(2,IVEC)
  227. DO 17 I=1,ITE
  228. IF (ICOR2(I).EQ.0) GOTO 17
  229. C+PP a faire meme ss DIRE car sinon que signifie XPRO,YPRO?
  230. DO J=1,3
  231. XP(J)=XCORD(J,I)
  232. XV(J)=XP(J)-XO(J)
  233. ENDDO
  234. SV=XV(1)*XN(1)+XV(2)*XN(2)+XV(3)*XN(3)
  235. C+PP option DIRE
  236. IF (LDIRE.AND.-SV.LT.SSN) THEN
  237. ICOR2(I)=0
  238. GOTO 17
  239. ENDIF
  240. C+PP a faire meme ss DIRE car sinon que signifie XPRO,YPRO?
  241. SN=(XP(1)-XG(1))*XN(1)+(XP(2)-XG(2))*XN(2)+(XP(3)-XG(3))
  242. $ *XN(3)
  243. DO J=1,3
  244. XP(J)=XP(J)-(SN/SV)*XV(J)-XG(J)
  245. ENDDO
  246. XPRO=XP(1)*UI(1)+XP(2)*UI(2)+XP(3)*UI(3)
  247. YPRO=XP(1)*UJ(1)+XP(2)*UJ(2)+XP(3)*UJ(3)
  248. C+PP
  249. DO 15 J=1,3
  250. XP(J)=XCOR2(J,I)
  251. XV(J)=XP(J)-XO(J)
  252. 15 CONTINUE
  253. SV=XV(1)*XN(1)+XV(2)*XN(2)+XV(3)*XN(3)
  254. C+PP option DIRE
  255. IF (LDIRE.AND.-SV.LT.SSN) THEN
  256. ICOR2(I)=0
  257. GOTO 17
  258. ENDIF
  259. C+PP
  260. SN=(XP(1)-XG(1))*XN(1)+(XP(2)-XG(2))*XN(2)+(XP(3)-XG(3))
  261. $ *XN(3)
  262. DO 16 J=1,3
  263. XP(J)=XP(J)-(SN/SV)*XV(J)-XG(J)
  264. 16 CONTINUE
  265. XPROO=XP(1)*UI(1)+XP(2)*UI(2)+XP(3)*UI(3)
  266. YPROO=XP(1)*UJ(1)+XP(2)*UJ(2)+XP(3)*UJ(3)
  267. XMINT=MIN(XMINT,XPROO)
  268. XMAXT=MAX(XMAXT,XPROO)
  269. YMINT=MIN(YMINT,YPROO)
  270. YMAXT=MAX(YMAXT,YPROO)
  271. UX=XPROO-XPRO
  272. UY=YPROO-YPRO
  273. U1=XPROO-UX/3-UY/5
  274. V1=YPROO-UY/3+UX/5
  275. XMINT=MIN(XMINT,U1)
  276. XMAXT=MAX(XMAXT,V1)
  277. U1=XPROO-UX/3+UY/5
  278. V1=YPROO-UY/3-UX/5
  279. XMINT=MIN(XMINT,U1)
  280. XMAXT=MAX(XMAXT,V1)
  281. 17 CONTINUE
  282. 6 CONTINUE
  283. 171 CONTINUE
  284. 11 CONTINUE
  285. * axez pour tourner correctement avec opengl
  286. axez(1)=0
  287. axez(2)=uj(3)
  288. axez(3)=sqrt(1-uj(3)**2)
  289. if (xn(3).lt.0) axez(3)=-axez(3)
  290. * write (6,*) ' axez ',axez(1),axez(2),axez(3)
  291. RETURN
  292. 1000 CONTINUE
  293. C ON REMPLIT XPROJ POUR LA DEFORME CONCERNEE
  294. XCORD=KABCOR(ICLE)
  295. ITE=XCORD(/2)
  296. IF (IDIM.EQ.2) GOTO 1100
  297. C+PP option DIRE
  298. SSN=SQRT(XN(1)**2+XN(2)**2+XN(3)**2)
  299. SSN=0.95*SSN
  300. C+PP
  301. C PROJECTION CONIQUE SUR LE PLAN
  302. DO 612 I=1,ITE
  303. DO 613 J=1,3
  304. XP(J)=XCORD(J,I)
  305. XV(J)=XP(J)-XO(J)
  306. 613 CONTINUE
  307. SV=XV(1)*XN(1)+XV(2)*XN(2)+XV(3)*XN(3)
  308. SN=(XP(1)-XG(1))*XN(1)+(XP(2)-XG(2))*XN(2)+(XP(3)-XG(3))*XN(3)
  309. XPROJ(3,I)=-SN
  310. DO 614 J=1,3
  311. XP(J)=XP(J)-(SN/SV)*XV(J)-XG(J)
  312. 614 CONTINUE
  313. C+PP option DIRE
  314. IF ((LDIRE.AND.-SV.GE.SSN).OR.(.NOT.LDIRE))THEN
  315. C+PP
  316. XPROJ(1,I)=XP(1)*UI(1)+XP(2)*UI(2)+XP(3)*UI(3)
  317. XPROJ(2,I)=XP(1)*UJ(1)+XP(2)*UJ(2)+XP(3)*UJ(3)
  318. C+PP option DIRE
  319. ELSE
  320. XPROJ(1,I)=(XMINT+XMAXT)/2
  321. XPROJ(2,I)=(YMINT+YMAXT)/2
  322. ENDIF
  323. C+PP
  324. 612 CONTINUE
  325. IF (LABCO2.EQ.0) GOTO 618
  326. IF (LABCO2(3,ICLE).EQ.0) GOTO 618
  327. KABCO2=LABCO2(1,ICLE)
  328. NVEC=KABCO2(/2)
  329. SEGINI KXPRO2
  330. LABCO2(2,ICLE)=KXPRO2
  331. IF (NVEC.EQ.0) GOTO 618
  332. DO 8 IVEC=1,NVEC
  333. XCOR2=KABCO2(1,IVEC)
  334. ICOR2=KABCO2(2,IVEC)
  335. * ajout SG 2016/07/16 apparemment le ITE de XCOR2 n'est pas
  336. * forcement celui de XCORD en cas de coupe
  337. ITE=XCOR2(/2)
  338. SEGINI XPRO2
  339. KXPRO2(IVEC)=XPRO2
  340. DO 617 I=1,ITE
  341. IF (ICOR2(I).EQ.0) GOTO 617
  342. DO 615 J=1,3
  343. XP(J)=XCOR2(J,I)
  344. XV(J)=XP(J)-XO(J)
  345. 615 CONTINUE
  346. SV=XV(1)*XN(1)+XV(2)*XN(2)+XV(3)*XN(3)
  347. SN=(XP(1)-XG(1))*XN(1)+(XP(2)-XG(2))*XN(2)+(XP(3)-XG(3))
  348. $ *XN(3)
  349. XPRO2(3,I)=-SN
  350. DO 616 J=1,3
  351. XP(J)=XP(J)-(SN/SV)*XV(J)-XG(J)
  352. 616 CONTINUE
  353. XPRO2(1,I)=XP(1)*UI(1)+XP(2)*UI(2)+XP(3)*UI(3)
  354. XPRO2(2,I)=XP(1)*UJ(1)+XP(2)*UJ(2)+XP(3)*UJ(3)
  355. 617 CONTINUE
  356. SEGSUP XCOR2
  357. 8 CONTINUE
  358. 618 CONTINUE
  359. SEGSUP XCORD
  360. RETURN
  361. 1100 CONTINUE
  362. DO 1110 I=1,IDIM
  363. DO 1110 J=1,ITE
  364. XPROJ(I,J)=XCORD(I,J)
  365. 1110 CONTINUE
  366. IF (LABCO2.EQ.0) GOTO 1111
  367. IF (LABCO2(3,ICLE).EQ.0) GOTO 1111
  368. KABCO2=LABCO2(1,ICLE)
  369. NVEC=KABCO2(/2)
  370. SEGINI KXPRO2
  371. LABCO2(2,ICLE)=KXPRO2
  372. IF (NVEC.EQ.0) GOTO 1111
  373. DO 9 IVEC=1,NVEC
  374. XCOR2=KABCO2(1,IVEC)
  375. ICOR2=KABCO2(2,IVEC)
  376. SEGINI XPRO2
  377. KXPRO2(IVEC)=XPRO2
  378. DO 1113 J=1,ITE
  379. IF (ICOR2(J).EQ.0) GOTO 1113
  380. DO 1112 I=1,IDIM
  381. XPRO2(I,J)=XCOR2(I,J)
  382. 1112 CONTINUE
  383. 1113 CONTINUE
  384. SEGSUP XCOR2
  385. 9 CONTINUE
  386. 1111 CONTINUE
  387. SEGSUP XCORD
  388. * axez pour tourner correctement avec opengl
  389. axez(1)=0
  390. axez(2)=uj(3)
  391. axez(3)=sqrt(1-uj(3)**2)
  392. if (xn(3).lt.0) axez(3)=-axez(3)
  393. * write (6,*) ' axez ',axez(1),axez(2),axez(3)
  394.  
  395. RETURN
  396. END
  397.  
  398.  
  399.  
  400.  
  401.  
  402.  
  403.  

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