Télécharger gamt3.eso

Retour à la liste

Numérotation des lignes :

  1. C GAMT3 SOURCE CHAT 05/01/13 00:15:41 5004
  2. SUBROUTINE GAMT3(S,DS,R3,YUNG,GAMA,KERRE)
  3. C
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. -INC CCOPTIO
  7. C
  8. DIMENSION S(*),DS(*)
  9. RF=YUNG*YUNG*YUNG*1.D-24
  10. GAMRF=1.D-7
  11. C
  12. C***********************************************************************
  13. C*********** CALCUL DES COEFICIENTS DE L EQUATION DU 3: DEGRE **********
  14. C*********** AAA GAMA **3 + BBB GAMA **2 + CCC GAMA + DDD =0 ***********
  15. C***********************************************************************
  16. C
  17. AA1=DS(1)*DS(2)*DS(3)+2.D0*DS(4)*DS(5)*DS(6)
  18. AA2=DS(1)*DS(5)*DS(5)+DS(2)*DS(6)*DS(6)+DS(3)*DS(4)*DS(4)
  19. AAA=AA1-AA2
  20. C
  21. BB1=DS(1)*DS(2)*R3+DS(2)*DS(3)*R3+DS(3)*DS(1)*R3
  22. BB2=DS(4)*DS(4)*R3+DS(5)*DS(5)*R3+DS(6)*DS(6)*R3
  23. BB3=S(1)*DS(5)*DS(5)+S(2)*DS(6)*DS(6)+S(3)*DS(4)*DS(4)
  24. BB4=S(1)*DS(2)*DS(3)+S(2)*DS(3)*DS(1)+S(3)*DS(1)*DS(2)
  25. BB5=S(4)*DS(5)*DS(6)+S(5)*DS(6)*DS(4)+S(6)*DS(4)*DS(5)
  26. BB6=S(4)*DS(4)*DS(3)+S(5)*DS(5)*DS(1)+S(6)*DS(6)*DS(2)
  27. BBB=-BB1+BB2-BB3+BB4+2.D0*BB5-2.D0*BB6
  28. C
  29. CC1=DS(1)*R3*R3+DS(2)*R3*R3+DS(3)*R3*R3
  30. CC2=S(1)*DS(2)*R3+S(2)*DS(3)*R3+S(3)*DS(1)*R3
  31. CC3=S(1)*DS(3)*R3+S(2)*DS(1)*R3+S(3)*DS(2)*R3
  32. CC4=S(4)*DS(4)*R3+S(5)*DS(5)*R3+S(6)*DS(6)*R3
  33. CC5=S(1)*S(2)*DS(3)+S(2)*S(3)*DS(1)+S(3)*S(1)*DS(2)
  34. CC6=S(4)*S(4)*DS(3)+S(5)*S(5)*DS(1)+S(6)*S(6)*DS(2)
  35. CC7=S(4)*S(5)*DS(6)+S(5)*S(6)*DS(4)+S(6)*S(4)*DS(5)
  36. CC8=S(1)*S(5)*DS(5)+S(2)*S(6)*DS(6)+S(3)*S(4)*DS(4)
  37. CCC=CC1-CC2-CC3+2.D0*CC4+CC5-CC6+2.D0*CC7-2.D0*CC8
  38. C
  39. DD1=-R3*R3*R3+S(1)*R3*R3+S(2)*R3*R3+S(3)*R3*R3
  40. DD2=S(4)*S(4)*R3+S(5)*S(5)*R3+S(6)*S(6)*R3
  41. DD3=S(1)*S(2)*R3+S(2)*S(3)*R3+S(3)*S(1)*R3
  42. DD4=S(1)*S(5)*S(5)+S(2)*S(6)*S(6)+S(3)*S(4)*S(4)
  43. DD5=S(1)*S(2)*S(3)+2.D0*S(4)*S(5)*S(6)
  44. DDD=DD1+DD2-DD3-DD4+DD5
  45. C
  46. IF(IIMPI.EQ.9) THEN
  47. WRITE(6,*) 'AA1',AA1
  48. WRITE(6,*) 'AA2',AA2
  49. WRITE(6,*) 'AAA',AAA
  50. WRITE(6,*) '***********************************************'
  51. C
  52. WRITE(6,*) 'BB1',BB1
  53. WRITE(6,*) 'BB2',BB2
  54. WRITE(6,*) 'BB3',BB3
  55. WRITE(6,*) 'BB4',BB4
  56. WRITE(6,*) 'BB5',BB5
  57. WRITE(6,*) 'BB6',BB6
  58. WRITE(6,*) 'BBB',BBB
  59. WRITE(6,*) '***********************************************'
  60. C
  61. WRITE(6,*) 'CC1',CC1
  62. WRITE(6,*) 'CC2',CC2
  63. WRITE(6,*) 'CC3',CC3
  64. WRITE(6,*) 'CC4',CC4
  65. WRITE(6,*) 'CC5',CC5
  66. WRITE(6,*) 'CC6',CC6
  67. WRITE(6,*) 'CC7',CC7
  68. WRITE(6,*) 'CC8',CC8
  69. WRITE(6,*) 'CCC',CCC
  70. WRITE(6,*) '***********************************************'
  71. C
  72. WRITE(6,*) 'DD1',DD1
  73. WRITE(6,*) 'DD2',DD2
  74. WRITE(6,*) 'DD3',DD3
  75. WRITE(6,*) 'DD4',DD4
  76. WRITE(6,*) 'DD5',DD5
  77. WRITE(6,*) 'DDD',DDD
  78. WRITE(6,*) '***********************************************'
  79. C
  80. ENDIF
  81. C
  82. IF(ABS(AAA).LT.RF) AAA=0.D0
  83. IF(ABS(BBB).LT.RF) BBB=0.D0
  84. IF(ABS(CCC).LT.RF) CCC=0.D0
  85. IF(ABS(DDD).LT.RF) DDD=0.D0
  86. C
  87. C***********************************************************************
  88. C******* CALCUL DES RACINES REELLES DE L EQUATION DU 3: DEGRE **********
  89. C***********************************************************************
  90. C
  91. CALL RSEQ3D (AAA,BBB,CCC,DDD,YUNG,X1,X2,X3,KERRE)
  92. IF(KERRE.NE.0) RETURN
  93. C
  94. C***********************************************************************
  95. C************** LA PLUS PETITE VALEUR DE GAMMA POSITIVE ****************
  96. C***********************************************************************
  97. C
  98. IF(ABS(X1).LE.GAMRF) X1=0.D0
  99. IF(ABS(X2).LE.GAMRF) X2=0.D0
  100. IF(ABS(X3).LE.GAMRF) X3=0.D0
  101. IF(X1.LT.0.D0) X1=1.D0
  102. IF(X2.LT.0.D0) X2=1.D0
  103. IF(X3.LT.0.D0) X3=1.D0
  104. GAMA=MIN(X1,X2,X3)
  105. C
  106. RETURN
  107. END
  108.  
  109.  

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