Sources Esope | Cast3M

gamtr
C GAMTR     SOURCE    CB215821  16/04/21    21:16:59     8920
      SUBROUTINE GAMTR(S,DS,F1ST,F2ST,R1,R2,CC,SS,CS,ITR,IRZ,GAMMA,
     .                 PREC,RFSG,RFEP,RFPR,KERRE)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
C
      DIMENSION S(*),DS(*)
      DIMENSION CP(3)
C
      IT=ITR+1
      GO TO(100,200),IT
      WRITE(IOIMP,20) IT
      KERRE=640
      RETURN
C
  100 CP(1)=S(1)
      CP(2)=S(2)
      CP(3)=S(4)
      CALL DIAGOD(CP)
      X=DS(4)*DS(4)-DS(1)*DS(2)
      R=MIN(R1,R2)
      Y=(R-S(1))*DS(2)+(R-S(2))*DS(1)+2.D0*S(4)*DS(4)
      Z=S(4)*S(4)-S(1)*S(2)+R*(S(1)+S(2))-R*R
      IF(ABS(X).LT.RFSG*RFSG) X=0.D0
      IF(X.EQ.0.D0) GO TO 1
      DELTA=Y*Y-4.D0*X*Z
      VRF=MAX(ABS(Y),RFSG)
      RFRF=VRF*VRF*RFPR*RFPR
      IF(IIMPI.EQ.9) WRITE(IOIMP,1001) X,Y,Z,DELTA
      IF(ABS(DELTA).LE.RFRF.AND.DELTA.LE.0.D0) DELTA=0.D0
      IF(DELTA.GE.0.D0) GO TO 2
      WRITE(IOIMP,22)DELTA
      GAMMA=100.D0
      RETURN
    2 RADEL=SQRT(DELTA)
      GAMT1=(-Y+RADEL)/(2.D0*X)
      GAMT2=(-Y-RADEL)/(2.D0*X)
      IF(IIMPI.EQ.9) WRITE(IOIMP,1002) GAMT1,GAMT2
      IF(GAMT1.GT.1.D0) GAMT1=1.D0
      IF(GAMT2.GT.1.D0) GAMT2=1.D0
      IF(GAMT1.EQ.1.D0.AND.GAMT2.LT.0.D0) GAMT2=0.D0
      IF(GAMT2.EQ.1.D0.AND.GAMT1.LT.0.D0) GAMT1=0.D0
      IF(GAMT1.GE.0.D0.OR.GAMT2.GE.0.D0) GO TO 8
      GAMT1=0.D0
      GAMT2=0.D0
      GO TO 8
C
  200 IF(F1ST.GT.R1) GO TO 3
      GAMT1=100.D0
      GO TO 4
    3 F1DS=ROTA(DS,CC,SS,CS,1)
      IF(F1DS.NE.0.D0) GO TO 5
      GAMT1=100.D0
      GO TO 4
    5 F1S=ROTA(S,CC,SS,CS,1)
      GAMT1=(R1-F1S)/F1DS
      IF(F1ST.GT.R1.AND.GAMT1.LT.0.D0) GAMT1=0.D0
    4 IF(F2ST.GT.R2) GO TO 6
      GAMT2=100.D0
      GO TO 8
    6 F2DS=ROTA(DS,CC,SS,CS,2)
      IF(F2DS.NE.0.D0) GO TO 7
      GAMT2=100.D0
      GO TO 8
    7 F2S=ROTA(S,CC,SS,CS,2)
      GAMT2=(R2-F2S)/F2DS
      IF(F2ST.GT.R2.AND.GAMT2.LT.0.D0) GAMT2=0.D0
C
    8 GAGA=GAMT1*GAMT2
      IF(GAGA.LE.0.D0) GO TO 9
      GAMMA=MIN(GAMT1,GAMT2)
      IRZ=1
      IF(GAMMA.EQ.GAMT2) IRZ=2
      DENOR=MIN(GAMT1,GAMT2)
      DENOR=MAX(DENOR,RFPR)
      DIF=ABS(GAMT1-GAMT2)/DENOR
      IF(DIF.LE.PREC) IRZ=3
      RETURN
    9 IF(GAMT1.EQ.0.D0.AND.GAMT2.EQ.0.D0) GO TO 12
      IF(GAMT1.LT.0.D0)GO TO 10
      GAMMA=GAMT1
      IRZ=1
      RETURN
   10 GAMMA=GAMT2
      IRZ=2
      RETURN
   12 GAMMA=0.D0
      IRZ=3
      RETURN
    1 IF(Y.NE.0.D0) GO TO 11
      WRITE(IOIMP,21)
      GAMMA=100.D0
      RETURN
   11 GAMMA=-Z/Y
      IRZ=1
C
   20 FORMAT(1X,'ERREUR DANS GAMTR IL FAUT DETERMINER IT =',I4)
   21 FORMAT(1X,'ERREUR DANS GAMTR DETERMINANT EST NUL')
   22 FORMAT(1X,'ERREUR DANS GAMTR DELTA EST NEGATIF DELTA =',1PE12.5)
 1001 FORMAT(1X,'X     =',1PD12.5,1X,'Y     =',1PD12.5,
     .       1X,'Z     =',1PD12.5,1X,'DELTA =',1PD12.5)
 1002 FORMAT(1X,'GAMT1 =',1PD12.5,1X,'GAMT2 =',1PD12.5)
C
      RETURN
      END