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