Télécharger projc2.eso

Retour à la liste

Numérotation des lignes :

  1. C PROJC2 SOURCE GOUNAND 16/12/01 21:15:14 9218
  2. SUBROUTINE PROJC2(IMBOIT,IOEIL,CGRAV,XBMIN,XBMAX,YBMIN
  3. $ ,YBMAX,ZBMIN,ZBMAX)
  4. C***********************************************************************
  5. C NOM : PROJC2
  6. C DESCRIPTION : Calcul des coordonnées de la fenêtre de tracé
  7. C centrée sur le maillage IMBOIT
  8. C
  9. C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  10. C
  11. C ATTENTION : il faut que ce calcul, repris de prtrac.eso
  12. C et projec.eso a la creation reste consistant
  13. C avec ce qui est fait par ailleurs
  14. C dans prtrac.eso et projec.eso
  15. C
  16. C
  17. C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  18. C
  19. C
  20. C
  21. C LANGAGE : ESOPE
  22. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  23. C mél : gounand@semt2.smts.cea.fr
  24. C***********************************************************************
  25. C VERSION : v1, 29/11/2016, version initiale
  26. C HISTORIQUE : v1, 29/11/2016, création
  27. C HISTORIQUE :
  28. C HISTORIQUE :
  29. C***********************************************************************
  30. IMPLICIT INTEGER(I-N)
  31. REAL*8 XO,XG,XP,XN,SN,XV,SV,UI,UJ
  32. DIMENSION XO(3),XP(3),XN(3),XG(3),XV(3),UI(3),UJ(3),CGRAV(*)
  33. -INC CCOPTIO
  34. -INC CCREEL
  35. -INC SMCOORD
  36. -INC SMELEME
  37. POINTEUR IMBOIT.MELEME
  38. SEGMENT XPBOIT(3,NNODE)
  39. SEGACT MCOORD
  40. *
  41. segact imboit
  42. nnode=imboit.num(/2)
  43. *
  44. segini xpboit
  45. IF (IDIM.NE.2) GOTO 5500
  46. DO 5501 inode=1,nnode
  47. nuno=imboit.num(1,inode)
  48. XPBOIT(1,inode)=XCOOR(nuno*3-2)
  49. XPBOIT(2,inode)=XCOOR(nuno*3-1)
  50. 5501 CONTINUE
  51. GOTO 5502
  52. 5500 CONTINUE
  53. IREF=(IOEIL-1)*4
  54. XO(1)=XCOOR(IREF+1)
  55. XO(2)=XCOOR(IREF+2)
  56. XO(3)=XCOOR(IREF+3)
  57. DO J=1,3
  58. XG(J)=CGRAV(J)
  59. XN(J)=XO(J)-XG(J)
  60. ENDDO
  61.  
  62. C NORMALE AU PLAN
  63. SN=SQRT(XN(1)**2+XN(2)**2+XN(3)**2)
  64. IF (SN.EQ.0.) CALL ERREUR(21)
  65. IF (IERR.NE.0) RETURN
  66. DO 5 J=1,3
  67. XN(J)=XN(J)/SN
  68. 5 CONTINUE
  69. C REPERE LOCAL SUR LE PLAN
  70. UJ(1)=0.D0
  71. UJ(2)=0.D0
  72. UJ(3)=1.D0
  73. 21 CONTINUE
  74. SV=UJ(1)*XN(1)+UJ(2)*XN(2)+UJ(3)*XN(3)
  75. DO 20 J=1,3
  76. UJ(J)=UJ(J)-SV*XN(J)
  77. 20 CONTINUE
  78. SV=UJ(1)**2+UJ(2)**2+UJ(3)**2
  79. IF (ABS(SV).LT.0.01) THEN
  80. UJ(1)=0.D0
  81. UJ(2)=1.D0
  82. UJ(3)=1.D0
  83. GOTO 21
  84. ENDIF
  85. SV=SQRT(SV)
  86. UJ(1)=UJ(1)/SV
  87. UJ(2)=UJ(2)/SV
  88. UJ(3)=UJ(3)/SV
  89. UI(1)=UJ(2)*XN(3)-UJ(3)*XN(2)
  90. UI(2)=UJ(3)*XN(1)-UJ(1)*XN(3)
  91. UI(3)=UJ(1)*XN(2)-UJ(2)*XN(1)
  92. C PROJECTION CONIQUE SUR LE PLAN
  93. DO 12 inode=1,nnode
  94. i=imboit.num(1,inode)
  95. DO 13 J=1,3
  96. XP(J)=XCOOR(I*4-4+J)
  97. XV(J)=XP(J)-XO(J)
  98. 13 CONTINUE
  99. * XPBOIT(3,ICPR(I))=SQRT(XV(1)**2+XV(2)**2+XV(3)**2)
  100. SV=XV(1)*XN(1)+XV(2)*XN(2)+XV(3)*XN(3)
  101. SN=(XP(1)-XG(1))*XN(1)+(XP(2)-XG(2))*XN(2)+(XP(3)-XG(3))*XN(3)
  102. XPBOIT(3,inode)=-SN
  103. DO 14 J=1,3
  104. XP(J)=XP(J)-(SN/SV)*XV(J)-XG(J)
  105. 14 CONTINUE
  106. XPBOIT(1,inode)=XP(1)*UI(1)+XP(2)*UI(2)+XP(3)*UI(3)
  107. XPBOIT(2,inode)=XP(1)*UJ(1)+XP(2)*UJ(2)+XP(3)*UJ(3)
  108. 12 CONTINUE
  109. 5502 CONTINUE
  110. * calcul des mins et max
  111. XBMIN=1E30
  112. XBMAX=-XBMIN
  113. YBMIN=XBMIN
  114. YBMAX=XBMAX
  115. ZBMIN=XBMIN
  116. ZBMAX=XBMAX
  117. DO inode=1,nnode
  118. XBMIN=MIN(XBMIN,XPBOIT(1,inode))
  119. XBMAX=MAX(XBMAX,XPBOIT(1,inode))
  120. YBMIN=MIN(YBMIN,XPBOIT(2,inode))
  121. YBMAX=MAX(YBMAX,XPBOIT(2,inode))
  122. ZBMIN=MIN(ZBMIN,XPBOIT(3,inode))
  123. ZBMAX=MAX(ZBMAX,XPBOIT(3,inode))
  124. ENDDO
  125. *goo WRITE(IOIMP,*) 'PROJC2 : XBMIN,YBMIN,XBMAX,YBMAX,ZBMIN,ZBMAX=',
  126. *goo $ XBMIN,YBMIN,XBMAX,YBMAX,ZBMIN,ZBMAX
  127.  
  128. C
  129. XBDEC=XBMAX-XBMIN
  130. YBDEC=YBMAX-YBMIN
  131. ZBDEC=ZBMAX-ZBMIN
  132. *goo WRITE(IOIMP,*) 'PROJC2 : XBDEC,YBDEC,ZBDEC=',XBDEC,YBDEC,ZBDEC
  133. * Modif des marges
  134. * Nouveau :
  135. DDEC=MAX(XBDEC,YBDEC,ZBDEC)*0.1
  136. * MODIF JCARDO 28/02/2012 : DDEC vaut maintenant XSZPRE au minimum
  137. * (evite des erreurs de cancellation)
  138. DDEC=MAX(DDEC,xszpre)
  139. * DDEC=MAX(DDEC,xspeti)
  140. XBMAX=XBMAX+DDEC
  141. XBMIN=XBMIN-DDEC
  142. YBMIN=YBMIN-DDEC
  143. YBMAX=YBMAX+DDEC
  144. ZBMIN=ZBMIN-DDEC
  145. ZBMAX=ZBMAX+DDEC
  146. SEGSUP XPBOIT
  147. RETURN
  148. END
  149.  
  150.  
  151.  
  152.  

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