Télécharger gamdp.eso

Retour à la liste

Numérotation des lignes :

  1. C GAMDP SOURCE CHAT 05/01/13 00:15:26 5004
  2. FUNCTION GAMDP(S,DS,ALF,R,IC,PREC,RFSG,RFEP,RFPR)
  3. C
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. -INC CCOPTIO
  7. C
  8. DIMENSION S(*),DS(*)
  9. C
  10. IF(IIMPI.EQ.9) WRITE(IOIMP,20) (S(I),I=1,6)
  11. IF(IIMPI.EQ.9) WRITE(IOIMP,21) (DS(I),I=1,6)
  12. IF(IIMPI.EQ.9) WRITE(IOIMP,22) ALF,R
  13. DSIEQ2=AVM(DS,DS)
  14. DSIEQ=SQRT(DSIEQ2)
  15. TRDSIG=DS(1)+DS(2)+DS(3)
  16. YY=DSIEQ2-ALF*ALF*TRDSIG*TRDSIG
  17. AA=AVM(S,DS)
  18. SIEQ02=AVM(S,S)
  19. TRSIG0=S(1)+S(2)+S(3)
  20. A2B=ALF*ALF*TRSIG0*TRDSIG
  21. XX=AA-A2B+ALF*R*TRDSIG
  22. ZZ2=(R-ALF*TRSIG0)**2
  23. IF(YY.EQ.0.D0) GO TO 1
  24. DELTA=XX*XX+YY*(ZZ2-SIEQ02)
  25. IF(IIMPI.EQ.9)
  26. . WRITE(IOIMP,23) DSIEQ2,TRDSIG,YY,AA,SIEQ02,TRSIG0,A2B,
  27. . XX,ZZ2,DELTA
  28. VRF=MAX(ABS(XX),RFPR)
  29. RFRF=VRF*VRF*PREC*PREC
  30. IF(ABS(DELTA).LE.RFRF.AND.DELTA.LE.0.D0) DELTA=0.D0
  31. IF(DELTA.GE.0.D0) GO TO 2
  32. IF(IIMPI.EQ.9) WRITE(IOIMP,11)DELTA
  33. GAMDP=100.D0
  34. RETURN
  35. 2 RADEL=SQRT(DELTA)
  36. GAMDP=(-XX+RADEL)/YY
  37. IF(IC.EQ.1)GAMDP=(-XX-RADEL)/YY
  38. RETURN
  39. 1 CRITD=DSIEQ-ALF*TRDSIG
  40. IF(CRITD.EQ.0.D0) GO TO 3
  41. IF(XX.NE.0.D0) GO TO 4
  42. IF(R.EQ.0.D0) GO TO 5
  43. IF(IIMPI.EQ.9) WRITE(IOIMP,10)
  44. GAMDP=100.D0
  45. RETURN
  46. 4 GAMDP=(ZZ2-SIEQ02)/(2.D0*XX)
  47. RETURN
  48. 5 GAMDP=0.D0
  49. RETURN
  50. 3 GAMDP=100.D0
  51. C
  52. 10 FORMAT(1X,'DANS GAMDP DETERMINANT EST NUL')
  53. 11 FORMAT(1X,'DANS GAMDP DELTA EST NEGATIF DELTA =',1PD12.5)
  54. 20 FORMAT(1X,'SIGMA =',6(1X,1PD12.5))
  55. 21 FORMAT(1X,'DSIGMA=',6(1X,1PD12.5))
  56. 22 FORMAT(1X,'ALFA =',1PD12.5,1X,'R =',1PD12.5)
  57. 23 FORMAT(1X,'DSIEQ2=',1PD12.5,1X,'TRDSIG=',1PD12.5,
  58. . 1X,'YY =',1PD12.5,1X,'AA =',1PD12.5,/,
  59. . 1X,'SIEQ02=',1PD12.5,1X,'TRSIG0=',1PD12.5,
  60. . 1X,'A2B =',1PD12.5,1X,'XX =',1PD12.5,/,
  61. . 1X,'ZZ2 =',1PD12.5,1X,'DELTA =',1PD12.5)
  62. C
  63. RETURN
  64. END
  65.  
  66.  
  67.  

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