1 : C ALPHA SOURCE PV 07/10/05 21:15:01 5890 2 : C | 3 : FUNCTION ALPHA(II,KK,JJ,LL) 4 : C | 5 : C CETTE FONCTION REELLE RENVOIE LA VALEUR DE L'ANGLE ENTRE | 6 : C LES 2 FACETTES (KK II JJ) ET (LL II JJ) | 7 : C POUR DES RAISONS DE COUT ON RENVOIE LA COTANGENTE CE QUI | 8 : C SUFFIT POUR LES TESTS QUE L'ON EN FERA | 9 : C | 10 : C---------------------------------------------------------------------| 11 : C 12 : IMPLICIT INTEGER(I-N) 13 : IMPLICIT REAL*8(A-H,O-Z) 14 : -INC TDEMAIT 15 : -INC CCOPTIO 16 : DIMENSION V1(3),V2(3),V3(3),VN1(3),VN2(3),VN3(3) 17 : C 18 : C 19 : DO 10 I=1,3 20 : V1(I)=XYZ(I,KK)-XYZ(I,II) 21 : V2(I)=XYZ(I,JJ)-XYZ(I,II) 22 : V3(I)=XYZ(I,LL)-XYZ(I,II) 23 : 10 CONTINUE 24 : C 25 : C 26 : C CALCUL DE LA NORME DU VECTEUR V2 27 : V2NORM=SQRT(V2(1)**2+V2(2)**2+V2(3)**2) 28 : IF (V2NORM.NE.0.d0) GOTO 15 29 : WRITE (6,1000) 30 : 1000 FORMAT(' UNE NORME EST EGALE A ZERO') 31 : WRITE (6,*) ' II,JJ,KK,LL ',II,JJ,KK,LL 32 : ALPHA=-1D6 33 : RETURN 34 : C 35 : C LE VECTEUR V2 EST NORME 36 : 15 DO 20 I=1,3 37 : V2(I)=V2(I)/V2NORM 38 : 20 CONTINUE 39 : C 40 : C VN3=V2^V1 41 : VN3(1)=V2(2)*V1(3)-V2(3)*V1(2) 42 : VN3(2)=V2(3)*V1(1)-V2(1)*V1(3) 43 : VN3(3)=V2(1)*V1(2)-V2(2)*V1(1) 44 : C 45 : C VN1=V2^V3 46 : VN1(1)=V2(2)*V3(3)-V2(3)*V3(2) 47 : VN1(2)=V2(3)*V3(1)-V2(1)*V3(3) 48 : VN1(3)=V2(1)*V3(2)-V2(2)*V3(1) 49 : C 50 : C SCALAIRE(VN3,VN1)-----> COS(V1,V3) 51 : SCAL=VN3(1)*VN1(1)+VN3(2)*VN1(2)+VN3(3)*VN1(3) 52 : C 53 : C PRODUIT MIXTE (VN3,VN1,V2)----> SIN(V1,V3) 54 : PV= (VN3(2)*VN1(3)-VN3(3)*VN1(2))*V2(1) 55 : # +(VN3(3)*VN1(1)-VN3(1)*VN1(3))*V2(2) 56 : # +(VN3(1)*VN1(2)-VN3(2)*VN1(1))*V2(3) 57 : C 58 : C 59 : IF (PV.EQ.0.d0) GOTO 100 60 : ALPHA=SCAL/PV 61 : IF(ABS(ALPHA).GT.1d4) GOTO 150 62 : IF (PV.LT.0.) ALPHA=-2d6+ALPHA 63 : RETURN 64 : 100 CONTINUE 65 : C A PRIORI VN2 EST NUL 66 : ALPHA=-1d6 67 : 150 CONTINUE 68 : IF (SCAL.GT.0..AND.PV.GT.0.) ALPHA=1E6 69 : IF (SCAL.GT.0..AND.PV.LE.0.) ALPHA=-3E6 70 : IF (SCAL.LE.0) ALPHA=-1d6 71 : * WRITE (6,1111) KK,II,LL 72 : *1111 FORMAT(' ALPHA POINTS ALIGNES ',3I8) 73 : * WRITE (6,1112) II,KK,JJ,LL 74 : *1112 FORMAT(' ALPHA APPELEE AVEC ',4I6) 75 : * WRITE (6,1113) (V1(I),I=1,3) 76 : *1113 FORMAT(' V1 ',3G12.5) 77 : * WRITE (6,1114) (V2(I),I=1,3) 78 : *1114 FORMAT(' V2 ',3G12.5) 79 : * WRITE (6,1115) (V3(I),I=1,3) 80 : *1115 FORMAT(' V3 ',3G12.5) 81 : RETURN 82 : C 83 : C FIN DE LA FONCTION ALPHA 84 : END 85 : 86 :
© Cast3M 2003 - All rights reserved.
Disclaimer