Télécharger angsol.eso

Retour à la liste

Numérotation des lignes :

  1. C ANGSOL SOURCE CB215821 16/11/30 21:15:01 9227
  2. C CALCUL DE L'ANGLE SOLIDE D'UN TRIEDRE
  3. C
  4. C PIERRE VERPEAUX MAI 1979
  5. C
  6. C
  7. C VERSION EN SIMPLE PRECISION FORTRAN PUR
  8. C
  9. SUBROUTINE ANGSOL(XO,XA,XB,XC,EPS,IFLAG,IFLIG)
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8 (A-H,O-Z)
  12.  
  13. LOGICAL BNUM,BDEN
  14. -INC CCREEL
  15. DIMENSION XO(3),XA(3),XB(3),XC(3),XU(3),XV(3),XW(3)
  16. C CALCUL DES TROIS VECTEURS COMPOSANT LE TRIEDRE
  17. IFLIG=0
  18. ZERO =REAL(XZERO)
  19. UNM =REAL(-1.D0)
  20. UN =REAL(1.D0 )
  21. DEUX =REAL(2.D0 )
  22. BNUM =.FALSE.
  23. BDEN =.FALSE.
  24.  
  25.  
  26. DO 5 I=1,3
  27. A =XO(I)
  28. XU(I)=XA(I)-A
  29. XV(I)=XB(I)-A
  30. XW(I)=XC(I)-A
  31. 5 CONTINUE
  32.  
  33. C CALCUL DES NORMES DES VECTEURS
  34. U=ZERO
  35. V=ZERO
  36. W=ZERO
  37. DO 6 I=1,3
  38. U=U+XU(I)**2
  39. V=V+XV(I)**2
  40. W=W+XW(I)**2
  41. 6 CONTINUE
  42.  
  43. IF(IFLAG.EQ.1) THEN
  44. IF (U.LT.XPETIT) GOTO 11
  45. IF (V.LT.XPETIT) GOTO 11
  46. IF (W.LT.XPETIT) GOTO 11
  47. ELSE
  48. IF (U.LT.XPETIT) GOTO 10
  49. IF (V.LT.XPETIT) GOTO 10
  50. IF (W.LT.XPETIT) GOTO 10
  51. ENDIF
  52.  
  53. U=SQRT(U)
  54. V=SQRT(V)
  55. W=SQRT(W)
  56.  
  57. C CALCUL DU PRODUIT MIXTE DES TROIS VECTEURS
  58. VOL=XU(1)*(XV(2)*XW(3)-XV(3)*XW(2))+
  59. # XU(2)*(XV(3)*XW(1)-XV(1)*XW(3))+
  60. # XU(3)*(XV(1)*XW(2)-XV(2)*XW(1))
  61. IF(IFLAG.EQ.1) THEN
  62. IF (ABS(VOL).LT.REAL(1.D-4)) CALL COPLAN(XO,XA,XB,XC,IFLIG)
  63. IF (IFLIG.EQ.1) GOTO 12
  64. ENDIF
  65.  
  66. C CALCUL DES ANGLES
  67. A1=(XV(1)*XW(1) + XV(2)*XW(2) + XV(3)*XW(3))/(V*W)
  68. B1=(XW(1)*XU(1) + XW(2)*XU(2) + XW(3)*XU(3))/(W*U)
  69. C1=(XU(1)*XV(1) + XU(2)*XV(2) + XU(3)*XV(3))/(U*V)
  70.  
  71. A= ACOS(MAX(MIN(A1,UN),UNM))
  72. B= ACOS(MAX(MIN(B1,UN),UNM))
  73. C= ACOS(MAX(MIN(C1,UN),UNM))
  74.  
  75. C CALCUL DES NUMERATEURS ET DENOMINATEURS DANS LE
  76. C SECOND MEMBRE DE LA FORMULE DE L'HUILIER
  77. P1=(A+B+C)/REAL(4.D0)
  78. P2=(B+C) /DEUX
  79. P3=(A+C) /DEUX
  80. P4=(A+B) /DEUX
  81.  
  82. DNUM= SIN(P1)* SIN(P2)* SIN(P3)* SIN(P4)
  83. IF (DNUM.LT.ZERO) THEN
  84. DNUM=ZERO
  85. BNUM=.TRUE.
  86. ELSE
  87. DNUM= SQRT(DNUM)
  88. ENDIF
  89.  
  90. DDEN= COS(P1)* COS(P2)* COS(P3)* COS(P4)
  91. IF (DDEN.LT.ZERO) THEN
  92. DDEN=ZERO
  93. BDEN=.TRUE.
  94. ELSE
  95. DDEN= SQRT(DDEN)
  96. ENDIF
  97.  
  98. IF (BNUM .AND. BDEN) THEN
  99. CALL ERREUR(21)
  100. RETURN
  101. ENDIF
  102.  
  103. C CALCUL DE L'ANGLE SOLIDE
  104. IF (VOL.LE.ZERO) THEN
  105. EPS= REAL(-4.D0)*ATAN2(DNUM,DDEN)
  106. ELSE
  107. EPS= REAL( 4.D0)*ATAN2(DNUM,DDEN)
  108. ENDIF
  109. RETURN
  110.  
  111. 10 EPS=ZERO
  112. RETURN
  113. C UN DES VECTEURS EST NUL
  114. 11 IFLIG=1
  115. 12 RETURN
  116. END
  117.  
  118.  
  119.  

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