Numérotation des lignes :

1. C ALPHA SOURCE JC220346 16/11/29 21:15:01 9221
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.
16. -INC PPARAM
17. -INC CCOPTIO
18. DIMENSION V1(3),V2(3),V3(3),VN1(3),VN2(3),VN3(3)
19. C
20. C
21. DO 10 I=1,3
22. V1(I)=XYZ(I,KK)-XYZ(I,II)
23. V2(I)=XYZ(I,JJ)-XYZ(I,II)
24. V3(I)=XYZ(I,LL)-XYZ(I,II)
25. 10 CONTINUE
26. C
27. C
28. C CALCUL DE LA NORME DU VECTEUR V2
29. V2NORM=SQRT(V2(1)**2+V2(2)**2+V2(3)**2)
30. IF (V2NORM.NE.0.d0) GOTO 15
31. IF (IVERB.EQ.1) WRITE (6,1000)
32. 1000 FORMAT(' UNE NORME EST EGALE A ZERO')
33. IF (IVERB.EQ.1) WRITE (6,*) ' II,JJ,KK,LL ',II,JJ,KK,LL
34. ALPHA=-1D6
35. RETURN
36. C
37. C LE VECTEUR V2 EST NORME
38. 15 DO 20 I=1,3
39. V2(I)=V2(I)/V2NORM
40. 20 CONTINUE
41. C
42. C VN3=V2^V1
43. VN3(1)=V2(2)*V1(3)-V2(3)*V1(2)
44. VN3(2)=V2(3)*V1(1)-V2(1)*V1(3)
45. VN3(3)=V2(1)*V1(2)-V2(2)*V1(1)
46. C
47. C VN1=V2^V3
48. VN1(1)=V2(2)*V3(3)-V2(3)*V3(2)
49. VN1(2)=V2(3)*V3(1)-V2(1)*V3(3)
50. VN1(3)=V2(1)*V3(2)-V2(2)*V3(1)
51. C
52. C SCALAIRE(VN3,VN1)-----> COS(V1,V3)
53. SCAL=VN3(1)*VN1(1)+VN3(2)*VN1(2)+VN3(3)*VN1(3)
54. C
55. C PRODUIT MIXTE (VN3,VN1,V2)----> SIN(V1,V3)
56. PV= (VN3(2)*VN1(3)-VN3(3)*VN1(2))*V2(1)
57. # +(VN3(3)*VN1(1)-VN3(1)*VN1(3))*V2(2)
58. # +(VN3(1)*VN1(2)-VN3(2)*VN1(1))*V2(3)
59. C
60. C
61. IF (PV.EQ.0.d0) GOTO 100
62. IF(ABS(ALPHA).GT.1d4) GOTO 150
63. IF (PV.LT.0.) ALPHA=-2d6+ALPHA
64. RETURN
65. 100 CONTINUE
66. C A PRIORI VN2 EST NUL
67. ALPHA=-1d6
68. 150 CONTINUE
69. IF (SCAL.GT.0..AND.PV.GT.0.) ALPHA=1E6
70. IF (SCAL.GT.0..AND.PV.LE.0.) ALPHA=-3E6
71. IF (SCAL.LE.0) ALPHA=-1d6
72. * WRITE (6,1111) KK,II,LL
73. *1111 FORMAT(' ALPHA POINTS ALIGNES ',3I8)
74. * WRITE (6,1112) II,KK,JJ,LL
75. *1112 FORMAT(' ALPHA APPELEE AVEC ',4I6)
76. * WRITE (6,1113) (V1(I),I=1,3)
77. *1113 FORMAT(' V1 ',3G12.5)
78. * WRITE (6,1114) (V2(I),I=1,3)
79. *1114 FORMAT(' V2 ',3G12.5)
80. * WRITE (6,1115) (V3(I),I=1,3)
81. *1115 FORMAT(' V3 ',3G12.5)
82. RETURN
83. C
84. C FIN DE LA FONCTION ALPHA
85. END
86.
87.
88.
89.

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