Télécharger projec.eso

Retour à la liste

Numérotation des lignes :

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

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