Télécharger la plaquette Cast3M


fr en

Télécharger angsol.eso

Retour à la liste

Numérotation des lignes : 

angsol

  1. C ANGSOL    SOURCE    CB215821  18/06/19    21:15:04     9862           
  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.       EPS  =ZERO
  26.  
  27.       DO 5 I=1,3
  28.          A    =XO(I)
  29.          XU(I)=XA(I)-A
  30.          XV(I)=XB(I)-A
  31.          XW(I)=XC(I)-A
  32.  5    CONTINUE
  33.  
  34. C   CALCUL DES NORMES DES VECTEURS
  35.       U=ZERO
  36.       V=ZERO
  37.       W=ZERO
  38.       DO 6 I=1,3
  39.          U=U+XU(I)**2
  40.          V=V+XV(I)**2
  41.          W=W+XW(I)**2
  42.  6    CONTINUE
  43.  
  44.       IF(IFLAG.EQ.1) THEN
  45.         IF (U.LT.XPETIT) GOTO 11
  46.         IF (V.LT.XPETIT) GOTO 11
  47.         IF (W.LT.XPETIT) GOTO 11
  48.       ELSE
  49.         IF (U.LT.XPETIT) RETURN
  50.         IF (V.LT.XPETIT) RETURN
  51.         IF (W.LT.XPETIT) RETURN
  52.       ENDIF
  53.  
  54.       U=SQRT(U)
  55.       V=SQRT(V)
  56.       W=SQRT(W)
  57.  
  58. C   CALCUL DU PRODUIT MIXTE DES TROIS VECTEURS
  59.       VOL=XU(1)*(XV(2)*XW(3)-XV(3)*XW(2))+
  60.      #    XU(2)*(XV(3)*XW(1)-XV(1)*XW(3))+
  61.      #    XU(3)*(XV(1)*XW(2)-XV(2)*XW(1))
  62.       IF(IFLAG.EQ.1) THEN
  63.         IF (ABS(VOL).LT.REAL(1.D-4)) CALL COPLAN(XO,XA,XB,XC,IFLIG)
  64.         IF (IFLIG.EQ.1) GOTO 12
  65.       ENDIF
  66.  
  67. C CALCUL DES ANGLES
  68.       A1=(XV(1)*XW(1) + XV(2)*XW(2) + XV(3)*XW(3))/(V*W)
  69.       B1=(XW(1)*XU(1) + XW(2)*XU(2) + XW(3)*XU(3))/(W*U)
  70.       C1=(XU(1)*XV(1) + XU(2)*XV(2) + XU(3)*XV(3))/(U*V)
  71.  
  72.       A= ACOS(MAX(MIN(A1,UN),UNM))
  73.       B= ACOS(MAX(MIN(B1,UN),UNM))
  74.       C= ACOS(MAX(MIN(C1,UN),UNM))
  75.  
  76. C    CALCUL DES NUMERATEURS ET DENOMINATEURS DANS LE
  77. C    SECOND MEMBRE DE LA FORMULE DE L'HUILIER
  78.       P1=(A+B+C)/REAL(4.D0)
  79.       P2=(B+C)  /DEUX
  80.       P3=(A+C)  /DEUX
  81.       P4=(A+B)  /DEUX
  82.  
  83.       DNUM= SIN(P1)* SIN(P2)* SIN(P3)* SIN(P4)
  84.       IF (DNUM.LT.ZERO) THEN
  85.         DNUM=ZERO
  86.         BNUM=.TRUE.
  87.       ELSE
  88.         DNUM= SQRT(DNUM)
  89.       ENDIF
  90.  
  91.       DDEN= COS(P1)* COS(P2)* COS(P3)* COS(P4)
  92.       IF (DDEN.LT.ZERO) THEN
  93.         DDEN=ZERO
  94.         BDEN=.TRUE.
  95.       ELSE
  96.         DDEN= SQRT(DDEN)
  97.       ENDIF
  98.  
  99.       IF (BNUM .AND. BDEN) THEN
  100.         CALL ERREUR(21)
  101.         RETURN
  102.       ENDIF
  103.  
  104. C   CALCUL DE L'ANGLE SOLIDE
  105.       EPS=SIGN(UN,VOL)*REAL(4.D0)*ATAN2(DNUM,DDEN)
  106.       RETURN
  107.  
  108. C                        UN DES VECTEURS EST NUL
  109.  11   IFLIG=1
  110.  12   RETURN
  111.       END
  112.  
  113.  

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