Télécharger gamt2.eso

Retour à la liste

Numérotation des lignes :

  1. C GAMT2 SOURCE CHAT 05/01/13 00:15:38 5004
  2. SUBROUTINE GAMT2 (S,DS,R,YUNG,GAMA)
  3. C
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. -INC CCOPTIO
  7. DIMENSION S(*),DS(*)
  8. C
  9. RF=YUNG*YUNG*1.D-16
  10. GAMRF=1.D-7
  11. C
  12. X=DS(4)*DS(4)-DS(1)*DS(2)
  13. Y=(R-S(1))*DS(2)+(R-S(2))*DS(1)+2.D0*S(4)*DS(4)
  14. Z=S(4)*S(4)-S(1)*S(2)+R*(S(1)+S(2))-R*R
  15. *
  16. IF(IIMPI.EQ.9) THEN
  17. WRITE(IOIMP,*) ' S1=',S(1),' DS1=',DS(1)
  18. WRITE(IOIMP,*) ' S2=',S(2),' DS2=',DS(2)
  19. WRITE(IOIMP,*) ' S4=',S(4),' DS4=',DS(4)
  20. WRITE(IOIMP,*) ' R =',R
  21. WRITE(IOIMP,*) ' X =',X
  22. WRITE(IOIMP,*) ' Y =',Y
  23. WRITE(IOIMP,*) ' Z =',Z
  24. ENDIF
  25. *
  26. IF(ABS(X).LT.RF) X=0.D0
  27. IF(ABS(Y).LT.RF) Y=0.D0
  28. IF(ABS(Z).LT.RF) Z=0.D0
  29. IF(IIMPI.EQ.9) THEN
  30. WRITE(IOIMP,*) ' XN=',X
  31. WRITE(IOIMP,*) ' YN=',Y
  32. WRITE(IOIMP,*) ' ZN=',Z
  33. ENDIF
  34. IF(X.EQ.0.D0) GO TO 1
  35. DELTA=Y*Y-4.D0*X*Z
  36. IF(IIMPI.EQ.9) WRITE(IOIMP,*) 'DELTA=',DELTA
  37. IF(ABS(DELTA).LT.RF.AND.DELTA.LT.0.D0) DELTA=0.D0
  38. IF(DELTA.GE.0.D0) GO TO 2
  39. GAMA=1.D0
  40. RETURN
  41. C
  42. 2 RADEL=SQRT(DELTA)
  43. GAMA1=(-Y+RADEL)/(2.D0*X)
  44. GAMA2=(-Y-RADEL)/(2.D0*X)
  45. IF(IIMPI.EQ.9) THEN
  46. WRITE(IOIMP,*) 'GAMA1=',GAMA1
  47. WRITE(IOIMP,*) 'GAMA2=',GAMA2
  48. ENDIF
  49. IF(ABS(GAMA1).LE.GAMRF) GAMA1=0.D0
  50. IF(ABS(GAMA2).LE.GAMRF) GAMA2=0.D0
  51. IF(GAMA1.GT.1.D0) GAMA1=1.D0
  52. IF(GAMA2.GT.1.D0) GAMA2=1.D0
  53. IF(GAMA1.EQ.1.D0.AND.GAMA2.LT.0.D0) GAMA2=0.D0
  54. IF(GAMA2.EQ.1.D0.AND.GAMA1.LT.0.D0) GAMA1=0.D0
  55. IF(GAMA1.GE.0.D0.OR.GAMA2.GE.0.D0) GO TO 3
  56. GAMA1=0.D0
  57. GAMA2=0.D0
  58. C
  59. 3 GAGA=GAMA1*GAMA2
  60. IF(IIMPI.EQ.9) WRITE(IOIMP,*) 'GAGA=',GAGA
  61. IF(GAGA.LE.0.D0) GO TO 4
  62. GAMA=MIN(GAMA1,GAMA2)
  63. IF(IIMPI.EQ.9) WRITE(IOIMP,*) 'GAMA 3=',GAMA
  64. RETURN
  65. C
  66. 4 IF(GAMA1.EQ.0.D0.AND.GAMA2.EQ.0.D0) GO TO 5
  67. IF(GAMA1.LT.0.)GO TO 6
  68. GAMA=GAMA1
  69. IF(IIMPI.EQ.9) WRITE(IOIMP,*) 'GAMA 4=',GAMA
  70. RETURN
  71. C
  72. 6 GAMA=GAMA2
  73. IF(IIMPI.EQ.9) WRITE(IOIMP,*) 'GAMA 6=',GAMA
  74. RETURN
  75. C
  76. 5 GAMA=0.D0
  77. IF(IIMPI.EQ.9) WRITE(IOIMP,*) 'GAMA 5=',GAMA
  78. RETURN
  79. C
  80. 1 IF(Y.EQ.0.D0) GO TO 7
  81. GAMA=-Z/Y
  82. IF(IIMPI.EQ.9) WRITE(IOIMP,*) 'GAMA 1=',GAMA
  83. RETURN
  84. C
  85. 7 IF(Z.EQ.0.D0) GO TO 8
  86. GAMA=1.D0
  87. IF(IIMPI.EQ.9) WRITE(IOIMP,*) 'GAMA 7=',GAMA
  88. RETURN
  89. C
  90. 8 GAMA=0.D0
  91. IF(IIMPI.EQ.9) WRITE(IOIMP,*) 'GAMA 8=',GAMA
  92. C
  93. RETURN
  94. END
  95.  
  96.  

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