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 :
© Cast3M 2003 - All rights reserved.
Disclaimer