Télécharger la plaquette Cast3M


fr en

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