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

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