Télécharger gamtr.eso

Retour à la liste

Numérotation des lignes :

  1. C GAMTR SOURCE CB215821 16/04/21 21:16:59 8920
  2. SUBROUTINE GAMTR(S,DS,F1ST,F2ST,R1,R2,CC,SS,CS,ITR,IRZ,GAMMA,
  3. . PREC,RFSG,RFEP,RFPR,KERRE)
  4. C
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7.  
  8. -INC PPARAM
  9. -INC CCOPTIO
  10. C
  11. DIMENSION S(*),DS(*)
  12. DIMENSION CP(3)
  13. C
  14. IT=ITR+1
  15. GO TO(100,200),IT
  16. WRITE(IOIMP,20) IT
  17. KERRE=640
  18. RETURN
  19. C
  20. 100 CP(1)=S(1)
  21. CP(2)=S(2)
  22. CP(3)=S(4)
  23. CALL DIAGOD(CP)
  24. X=DS(4)*DS(4)-DS(1)*DS(2)
  25. R=MIN(R1,R2)
  26. Y=(R-S(1))*DS(2)+(R-S(2))*DS(1)+2.D0*S(4)*DS(4)
  27. Z=S(4)*S(4)-S(1)*S(2)+R*(S(1)+S(2))-R*R
  28. IF(ABS(X).LT.RFSG*RFSG) X=0.D0
  29. IF(X.EQ.0.D0) GO TO 1
  30. DELTA=Y*Y-4.D0*X*Z
  31. VRF=MAX(ABS(Y),RFSG)
  32. RFRF=VRF*VRF*RFPR*RFPR
  33. IF(IIMPI.EQ.9) WRITE(IOIMP,1001) X,Y,Z,DELTA
  34. IF(ABS(DELTA).LE.RFRF.AND.DELTA.LE.0.D0) DELTA=0.D0
  35. IF(DELTA.GE.0.D0) GO TO 2
  36. WRITE(IOIMP,22)DELTA
  37. GAMMA=100.D0
  38. RETURN
  39. 2 RADEL=SQRT(DELTA)
  40. GAMT1=(-Y+RADEL)/(2.D0*X)
  41. GAMT2=(-Y-RADEL)/(2.D0*X)
  42. IF(IIMPI.EQ.9) WRITE(IOIMP,1002) GAMT1,GAMT2
  43. IF(GAMT1.GT.1.D0) GAMT1=1.D0
  44. IF(GAMT2.GT.1.D0) GAMT2=1.D0
  45. IF(GAMT1.EQ.1.D0.AND.GAMT2.LT.0.D0) GAMT2=0.D0
  46. IF(GAMT2.EQ.1.D0.AND.GAMT1.LT.0.D0) GAMT1=0.D0
  47. IF(GAMT1.GE.0.D0.OR.GAMT2.GE.0.D0) GO TO 8
  48. GAMT1=0.D0
  49. GAMT2=0.D0
  50. GO TO 8
  51. C
  52. 200 IF(F1ST.GT.R1) GO TO 3
  53. GAMT1=100.D0
  54. GO TO 4
  55. 3 F1DS=ROTA(DS,CC,SS,CS,1)
  56. IF(F1DS.NE.0.D0) GO TO 5
  57. GAMT1=100.D0
  58. GO TO 4
  59. 5 F1S=ROTA(S,CC,SS,CS,1)
  60. GAMT1=(R1-F1S)/F1DS
  61. IF(F1ST.GT.R1.AND.GAMT1.LT.0.D0) GAMT1=0.D0
  62. 4 IF(F2ST.GT.R2) GO TO 6
  63. GAMT2=100.D0
  64. GO TO 8
  65. 6 F2DS=ROTA(DS,CC,SS,CS,2)
  66. IF(F2DS.NE.0.D0) GO TO 7
  67. GAMT2=100.D0
  68. GO TO 8
  69. 7 F2S=ROTA(S,CC,SS,CS,2)
  70. GAMT2=(R2-F2S)/F2DS
  71. IF(F2ST.GT.R2.AND.GAMT2.LT.0.D0) GAMT2=0.D0
  72. C
  73. 8 GAGA=GAMT1*GAMT2
  74. IF(GAGA.LE.0.D0) GO TO 9
  75. GAMMA=MIN(GAMT1,GAMT2)
  76. IRZ=1
  77. IF(GAMMA.EQ.GAMT2) IRZ=2
  78. DENOR=MIN(GAMT1,GAMT2)
  79. DENOR=MAX(DENOR,RFPR)
  80. DIF=ABS(GAMT1-GAMT2)/DENOR
  81. IF(DIF.LE.PREC) IRZ=3
  82. RETURN
  83. 9 IF(GAMT1.EQ.0.D0.AND.GAMT2.EQ.0.D0) GO TO 12
  84. IF(GAMT1.LT.0.D0)GO TO 10
  85. GAMMA=GAMT1
  86. IRZ=1
  87. RETURN
  88. IRZ=2
  89. RETURN
  90. 12 GAMMA=0.D0
  91. IRZ=3
  92. RETURN
  93. 1 IF(Y.NE.0.D0) GO TO 11
  94. WRITE(IOIMP,21)
  95. GAMMA=100.D0
  96. RETURN
  97. 11 GAMMA=-Z/Y
  98. IRZ=1
  99. C
  100. 20 FORMAT(1X,'ERREUR DANS GAMTR IL FAUT DETERMINER IT =',I4)
  101. 21 FORMAT(1X,'ERREUR DANS GAMTR DETERMINANT EST NUL')
  102. 22 FORMAT(1X,'ERREUR DANS GAMTR DELTA EST NEGATIF DELTA =',1PE12.5)
  103. 1001 FORMAT(1X,'X =',1PD12.5,1X,'Y =',1PD12.5,
  104. . 1X,'Z =',1PD12.5,1X,'DELTA =',1PD12.5)
  105. 1002 FORMAT(1X,'GAMT1 =',1PD12.5,1X,'GAMT2 =',1PD12.5)
  106. C
  107. RETURN
  108. END
  109.  
  110.  
  111.  
  112.  

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