Télécharger alpha.eso

Retour à la liste

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. -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. IF (IVERB.EQ.1) WRITE (6,1000)
  30. 1000 FORMAT(' UNE NORME EST EGALE A ZERO')
  31. IF (IVERB.EQ.1) 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. IF(ABS(ALPHA).GT.1d4) GOTO 150
  61. IF (PV.LT.0.) ALPHA=-2d6+ALPHA
  62. RETURN
  63. 100 CONTINUE
  64. C A PRIORI VN2 EST NUL
  65. ALPHA=-1d6
  66. 150 CONTINUE
  67. IF (SCAL.GT.0..AND.PV.GT.0.) ALPHA=1E6
  68. IF (SCAL.GT.0..AND.PV.LE.0.) ALPHA=-3E6
  69. IF (SCAL.LE.0) ALPHA=-1d6
  70. * WRITE (6,1111) KK,II,LL
  71. *1111 FORMAT(' ALPHA POINTS ALIGNES ',3I8)
  72. * WRITE (6,1112) II,KK,JJ,LL
  73. *1112 FORMAT(' ALPHA APPELEE AVEC ',4I6)
  74. * WRITE (6,1113) (V1(I),I=1,3)
  75. *1113 FORMAT(' V1 ',3G12.5)
  76. * WRITE (6,1114) (V2(I),I=1,3)
  77. *1114 FORMAT(' V2 ',3G12.5)
  78. * WRITE (6,1115) (V3(I),I=1,3)
  79. *1115 FORMAT(' V3 ',3G12.5)
  80. RETURN
  81. C
  82. C FIN DE LA FONCTION ALPHA
  83. END
  84.  
  85.  
  86.  
  87.  

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