Télécharger gamt2.eso

Retour à la liste

Numérotation des lignes :

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

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