Télécharger la plaquette Cast3M


fr en

Télécharger clrep.eso

Retour à la liste

Numérotation des lignes : 

clrep

  1. C CLREP     SOURCE    CHAT      05/01/12    22:08:51     5004
  2.       SUBROUTINE CLREP(VECX,VECY,VECZ,ANGLE,IANGLE)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5.  
  6. -INC PPARAM
  7. -INC CCOPTIO
  8. C
  9. C----------------------------------------------------------------------
  10. C  CETTE ROUTINE A PLUSIEURS FONCTION :
  11. C
  12. C  1- :
  13. C
  14. C      POUR IANGLE = 0
  15. C    ==================
  16. C     ON CALCULE VECX ET VECY POUR UN VECZ DONNE
  17. C
  18. C----------------------------------------------------------------------
  19. C  2- :
  20. C
  21. C     POUR IANGLE = 1
  22. C    =================
  23. C     ON CALCULE L ANGLE ( EN DEGRE )
  24. C        POUR UN REPERE ( VF1 , VF2 ET VECZ ) DONNE
  25. C        PAR RAPPORT A ( VECX , VECY ET VECZ )
  26. C
  27. C     POUR IANGLE = 2
  28. C    =================
  29. C     ON CALCULE L ANGLE ( EN RADIAN )
  30. C        POUR UN REPERE ( VF1 , VF2 ET VECZ ) DONNE
  31. C        PAR RAPPORT A ( VECX , VECY ET VECZ )
  32. C
  33. C----------------------------------------------------------------------
  34. C
  35. C  3- :
  36. C
  37. C     POUR IANGLE = 3
  38. C    =================
  39. C     ON CALCULE VF1 ET VF2 POUR UN VECZ DONNE
  40. C        PLUS UN ANGLE ( EN RADIAN ) DONNE
  41. C        PAR RAPPORT A VECX
  42. C
  43. C----------------------------------------------------------------------
  44. C
  45.       DIMENSION VECX(*),VECY(*),VECZ(*)
  46.       DIMENSION VECX0(3)
  47. C
  48.       RAD=57.29577951308232D0
  49. C
  50.       USR3=1.D0/SQRT(VECZ(1)*VECZ(1)+VECZ(2)*VECZ(2)+VECZ(3)*VECZ(3))
  51. C
  52.       VECZ(1)=VECZ(1)*USR3
  53.       VECZ(2)=VECZ(2)*USR3
  54.       VECZ(3)=VECZ(3)*USR3
  55. C
  56.       IF (IANGLE.EQ.3) THEN
  57. C
  58.         CO=COS(ANGLE)
  59.         SI=SIN(ANGLE)
  60. C
  61.         VECX(1)=VECX(1)*CO+VECY(1)*SI
  62.         VECX(2)=VECX(2)*CO+VECY(2)*SI
  63.         VECX(3)=VECX(3)*CO+VECY(3)*SI
  64. C
  65.         USR1=1.D0/SQRT(VECX(1)*VECX(1)+VECX(2)*VECX(2)+VECX(3)*VECX(3))
  66.         VECX(1)=VECX(1)*USR1
  67.         VECX(2)=VECX(2)*USR1
  68.         VECX(3)=VECX(3)*USR1
  69. C
  70.         VECY(1)=VECZ(2)*VECX(3)-VECZ(3)*VECX(2)
  71.         VECY(2)=VECZ(3)*VECX(1)-VECZ(1)*VECX(3)
  72.         VECY(3)=VECZ(1)*VECX(2)-VECZ(2)*VECX(1)
  73. C
  74.         USR2=1.D0/SQRT(VECY(1)*VECY(1)+VECY(2)*VECY(2)+VECY(3)*VECY(3))
  75. C
  76.         VECY(1)=VECY(1)*USR2
  77.         VECY(2)=VECY(2)*USR2
  78.         VECY(3)=VECY(3)*USR2
  79. C
  80.         RETURN
  81.       ENDIF
  82. C
  83.       IF(IANGLE.EQ.0) GO TO 100
  84. C
  85.       VECX0(1)=VECX(1)
  86.       VECX0(2)=VECX(2)
  87.       VECX0(3)=VECX(3)
  88.       USR1=1.D0/SQRT(VECX(1)*VECX(1)+VECX(2)*VECX(2)+VECX(3)*VECX(3))
  89. C
  90.       VECX0(1)=VECX0(1)*USR1
  91.       VECX0(2)=VECX0(2)*USR1
  92.       VECX0(3)=VECX0(3)*USR1
  93. C
  94.   100 VECX(1)=-VECZ(2)
  95.       VECX(2)=VECZ(1)
  96.       VECX(3)=0.D0
  97. C
  98.       IF(VECX(1).EQ.0.AND.VECX(2).EQ.0.) VECX(1)=1.D0
  99. C
  100.       USR1=1.D0/SQRT(VECX(1)*VECX(1)+VECX(2)*VECX(2))
  101. C
  102.       VECX(1)=VECX(1)*USR1
  103.       VECX(2)=VECX(2)*USR1
  104. C
  105.       VECY(1)=VECZ(2)*VECX(3)-VECZ(3)*VECX(2)
  106.       VECY(2)=VECZ(3)*VECX(1)-VECZ(1)*VECX(3)
  107.       VECY(3)=VECZ(1)*VECX(2)-VECZ(2)*VECX(1)
  108. C
  109.       USR2=1.D0/SQRT(VECY(1)*VECY(1)+VECY(2)*VECY(2)+VECY(3)*VECY(3))
  110. C
  111.       VECY(1)=VECY(1)*USR2
  112.       VECY(2)=VECY(2)*USR2
  113.       VECY(3)=VECY(3)*USR2
  114. C
  115.       IF(IANGLE.EQ.0) RETURN
  116. C
  117.       CSN=VECX(1)*VECX0(1)+VECX(2)*VECX0(2)+VECX(3)*VECX0(3)
  118.       SSN=VECY(1)*VECX0(1)+VECY(2)*VECX0(2)+VECY(3)*VECX0(3)
  119.       ANGLE=ATAN2(SSN,CSN)
  120.       IF(IANGLE.EQ.1) ANGLE=ANGLE*RAD
  121. C
  122.       RETURN
  123.       END
  124.  
  125.  

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