Télécharger projec.eso

Retour à la liste

Numérotation des lignes :

  1. C PROJEC SOURCE CB215821 17/09/18 21:15:04 9551
  2. SUBROUTINE PROJEC(ICPR,XPROJ,IOEIL,CGRAV,axez)
  3. IMPLICIT INTEGER(I-N)
  4. REAL*8 XO,XG,XP,XN,SN,XV,SV,UI,UJ
  5. DIMENSION XO(3),XP(3),XN(3),XG(3),XV(3),UI(3),UJ(3),CGRAV(*),
  6. > axez(*)
  7. -INC CCOPTIO
  8. -INC SMCOORD
  9. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  10. SEGMENT XPROJ(3,ITE)
  11. SEGACT MCOORD
  12.  
  13. IF (IDIM .NE. 2) GOTO 5500
  14. C REPERE LOCAL SUR LE PLAN
  15. XN(1)=0.D0
  16. XN(2)=0.D0
  17. XN(3)=1.D0
  18.  
  19. UJ(1)=0.D0
  20. UJ(2)=0.D0
  21. UJ(3)=1.D0
  22.  
  23. DO 5501 I=1,ICPR(/1)
  24. IF (ICPR(I).EQ.0) GOTO 5501
  25. XPROJ(1,ICPR(I))=XCOOR(I*3-2)
  26. XPROJ(2,ICPR(I))=XCOOR(I*3-1)
  27. 5501 CONTINUE
  28. GOTO 5502
  29.  
  30. C Seulement si IDIM .NE. 2
  31. 5500 CONTINUE
  32. IREF=(IOEIL-1)*4
  33. XO(1)=XCOOR(IREF+1)
  34. XO(2)=XCOOR(IREF+2)
  35. XO(3)=XCOOR(IREF+3)
  36. C POINT MOYEN
  37. DO 1 I=1,3
  38. XG(I)=0.D0
  39. 1 CONTINUE
  40. DO 2 I=1,ICPR(/1)
  41. IF (ICPR(I).EQ.0) GOTO 2
  42. DO 3 J=1,3
  43. XG(J)=XG(J)+XCOOR(I*4-4+J)
  44. 3 CONTINUE
  45. 2 CONTINUE
  46. NBPOIN=XPROJ(/2)
  47. DO 4 J=1,3
  48. XG(J)=XG(J)/NBPOIN
  49. XN(J)=XO(J)-XG(J)
  50. 4 CONTINUE
  51. C NORMALE AU PLAN
  52. SN=SQRT(XN(1)**2+XN(2)**2+XN(3)**2)
  53. IF (SN.EQ.0.D0) CALL ERREUR(21)
  54. IF (IERR.NE.0) RETURN
  55. DO 5 J=1,3
  56. XN(J)=XN(J)/SN
  57. 5 CONTINUE
  58. C REPERE LOCAL SUR LE PLAN
  59. UJ(1)=0.D0
  60. UJ(2)=0.D0
  61. UJ(3)=1.D0
  62. 21 CONTINUE
  63. SV=UJ(1)*XN(1)+UJ(2)*XN(2)+UJ(3)*XN(3)
  64. DO 20 J=1,3
  65. UJ(J)=UJ(J)-SV*XN(J)
  66. 20 CONTINUE
  67. SV=UJ(1)**2+UJ(2)**2+UJ(3)**2
  68. IF (ABS(SV).LT.1.D-2) THEN
  69. UJ(1)=0.D0
  70. UJ(2)=1.D0
  71. UJ(3)=1.D0
  72. GOTO 21
  73. ENDIF
  74. SV=SQRT(SV)
  75. UJ(1)=UJ(1)/SV
  76. UJ(2)=UJ(2)/SV
  77. UJ(3)=UJ(3)/SV
  78. UI(1)=UJ(2)*XN(3)-UJ(3)*XN(2)
  79. UI(2)=UJ(3)*XN(1)-UJ(1)*XN(3)
  80. UI(3)=UJ(1)*XN(2)-UJ(2)*XN(1)
  81. C PROJECTION CONIQUE SUR LE PLAN
  82. DO 12 I=1,ICPR(/1)
  83. IF (ICPR(I).EQ.0) GOTO 12
  84. DO 13 J=1,3
  85. XP(J)=XCOOR(I*4-4+J)
  86. XV(J)=XP(J)-XO(J)
  87. 13 CONTINUE
  88. * XPROJ(3,ICPR(I))=SQRT(XV(1)**2+XV(2)**2+XV(3)**2)
  89. SV=XV(1)*XN(1)+XV(2)*XN(2)+XV(3)*XN(3)
  90. SN=(XP(1)-XG(1))*XN(1)+(XP(2)-XG(2))*XN(2)+(XP(3)-XG(3))*XN(3)
  91. XPROJ(3,ICPR(I))=-SN
  92. DO 14 J=1,3
  93. XP(J)=XP(J)-(SN/SV)*XV(J)-XG(J)
  94. 14 CONTINUE
  95. XPROJ(1,ICPR(I))=XP(1)*UI(1)+XP(2)*UI(2)+XP(3)*UI(3)
  96. XPROJ(2,ICPR(I))=XP(1)*UJ(1)+XP(2)*UJ(2)+XP(3)*UJ(3)
  97. 12 CONTINUE
  98. * rendre le centre de gravite pour eventuelle rotation
  99. cgrav(1)=xg(1)
  100. cgrav(2)=xg(2)
  101. cgrav(3)=xg(3)
  102.  
  103. 5502 CONTINUE
  104. * axez pour tourner correctement avec opengl
  105. axez(1)=0
  106. axez(2)=uj(3)
  107. axez(3)=sqrt(ABS(1-uj(3)**2))
  108. if (xn(3).lt.0.D0) axez(3)=-axez(3)
  109. * write (6,*) ' axez ',axez(1),axez(2),axez(3)
  110. RETURN
  111. END
  112.  
  113.  

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