Download angqua.eso

Back to the list

   1 : C ANGQUA    SOURCE    PV        07/11/23    21:15:23     5978           
   2 :       SUBROUTINE ANGQUA (NOD1,NOD2,NOD3,NOD4,  ANG1,ANG2,ANG3,ANG4)
   3 :       implicit real*8(a-h,o-z)
   4 : ************************************************************************
   5 : *     
   6 : *                             A N G Q U A
   7 : *                             -----------
   8 : *     
   9 : * FONCTION:
  10 : * ---------
  11 : *     
  12 : *     CALCUL DES ANGLES AUX COINS D'UN QUADRANGLE.
  13 : *     
  14 : * MODULES UTILISES:
  15 : * -----------------
  16 : *     
  17 :       IMPLICIT INTEGER(I-N)
  18 : -INC CCREEL
  19 : -INC CCOPTIO
  20 : -INC SMCOORD
  21 : *     
  22 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
  23 : * -----------
  24 : *     
  25 : *    +XCOOR   (E)  VOIR LE COMMUN "COPTIO" ET LE SEGMENT "MCOORD".
  26 : *                  (SEGMENT SUPPOSE ACTIF)
  27 : *    +IDIM    (E)  VOIR LE COMMUN "COPTIO".
  28 : *     NOD?    (E)  NUMERO DU NOEUD "?", "?"=1,4.
  29 : *     ANG?    (S)  ANGLE AU NOEUD "?" ENTRE 0 ET 2*PI.
  30 : *     
  31 :       REAL *8 ANG1,ANG2,ANG3,ANG4
  32 : *     
  33 : * VARIABLES:
  34 : * ----------
  35 : *     
  36 :       INTEGER IND4(0:5)
  37 :       REAL*8 XE(3,4),V1(3),V2(3),ANG(4)
  38 : *     
  39 : * AUTEUR, DATE DE CREATION:
  40 : * -------------------------
  41 : *     
  42 : *     PASCAL MANIGOT     5 OCTOBRE 1990
  43 : *     
  44 : ************************************************************************
  45 : *     
  46 : *     INDICAGE CIRCULAIRE:
  47 :       DATA IND4/4,1,2,3,4,1/
  48 : *     
  49 :       IDIMP1 = IDIM + 1
  50 :       XE(1,1) = XCOOR((NOD1-1)*IDIMP1+1)
  51 :       XE(1,2) = XCOOR((NOD2-1)*IDIMP1+1)
  52 :       XE(1,3) = XCOOR((NOD3-1)*IDIMP1+1)
  53 :       XE(1,4) = XCOOR((NOD4-1)*IDIMP1+1)
  54 :       XE(2,1) = XCOOR((NOD1-1)*IDIMP1+2)
  55 :       XE(2,2) = XCOOR((NOD2-1)*IDIMP1+2)
  56 :       XE(2,3) = XCOOR((NOD3-1)*IDIMP1+2)
  57 :       XE(2,4) = XCOOR((NOD4-1)*IDIMP1+2)
  58 :       IF (IDIM.EQ.3) THEN
  59 :          XE(3,1) = XCOOR((NOD1-1)*IDIMP1+3)
  60 :          XE(3,2) = XCOOR((NOD2-1)*IDIMP1+3)
  61 :          XE(3,3) = XCOOR((NOD3-1)*IDIMP1+3)
  62 :          XE(3,4) = XCOOR((NOD4-1)*IDIMP1+3)
  63 :       ELSE
  64 :          XE(3,1) = 0.
  65 :          XE(3,2) = 0.
  66 :          XE(3,3) = 0.
  67 :          XE(3,4) = 0.
  68 :       END IF
  69 : *     
  70 : *     CALCUL DE LA NORMALE "EXTERIEURE" MOYENNE:
  71 : *     
  72 :       XN = (XE(2,3)-XE(2,1))*(XE(3,4)-XE(3,2))
  73 :      &     - (XE(3,3)-XE(3,1))*(XE(2,4)-XE(2,2))
  74 :       YN = (XE(3,3)-XE(3,1))*(XE(1,4)-XE(1,2))
  75 :      &     - (XE(1,3)-XE(1,1))*(XE(3,4)-XE(3,2))
  76 :       ZN = (XE(1,3)-XE(1,1))*(XE(2,4)-XE(2,2))
  77 :      &     - (XE(2,3)-XE(2,1))*(XE(1,4)-XE(1,2))
  78 :       XNORM1 = SQRT(XN**2 + YN**2 + ZN**2)
  79 :       XN = XN / XNORM1
  80 :       YN = YN / XNORM1
  81 :       ZN = ZN / XNORM1
  82 : *     
  83 : *     CALCUL DES ANGLES:
  84 : *     
  85 :       DO 100 K=1,4
  86 :          KP1 = IND4(K+1)
  87 :          KM1 = IND4(K-1)
  88 :          DO 110 J=1,3
  89 :             V1(J) = XE(J,KP1) - XE(J,K)
  90 :             V2(J) = XE(J,KM1) - XE(J,K)
  91 :  110     CONTINUE
  92 : *        END DO
  93 :          XNORM1 = SQRT(V1(1)**2 + V1(2)**2 + V1(3)**2)
  94 :      &        * SQRT(V2(1)**2 + V2(2)**2 + V2(3)**2)
  95 :          COSINU = (V1(1)*V2(1) + V1(2)*V2(2) + V1(3)*V2(3)) / XNORM1
  96 :          ANG(K) = ACOS(COSINU)
  97 :          XPVECT = V1(2)*V2(3) - V1(3)*V2(2)
  98 :          YPVECT = V1(3)*V2(1) - V1(1)*V2(3)
  99 :          ZPVECT = V1(1)*V2(2) - V1(2)*V2(1)
 100 :          S = XPVECT*XN + YPVECT*YN + ZPVECT*ZN
 101 :          IF (S .LT. 0.) THEN
 102 :             ANG(K) = (2. * REAL(XPI)) - ANG(K)
 103 :          END IF
 104 :  100  CONTINUE
 105 : *     END DO
 106 : *     
 107 :       ANG1 = ANG(1)
 108 :       ANG2 = ANG(2)
 109 :       ANG3 = ANG(3)
 110 :       ANG4 = ANG(4)
 111 : *     
 112 :       END
 113 : 
 114 : 
 115 : 
 116 : 
 117 :  
 118 :  
 119 :  
 120 :  

© Cast3M 2003 - All rights reserved.
Disclaimer