Télécharger crioto.eso

Retour à la liste

Numérotation des lignes :

  1. C CRIOTO SOURCE CB215821 16/04/21 21:16:10 8920
  2. C CRIOTO SOURCE INSL 24/10/96
  3. SUBROUTINE CRIOTO(S1,SEQ,FCRI,NSTRS,TU,AA,BB,DK1,DK2)
  4. C
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. DIMENSION S1(NSTRS)
  8. C
  9. PI=4.D0*ATAN(1.D0)
  10. CALL INVA(S1,DJ2,DI1,CO3T,DJ3,NSTRS)
  11. TT=DK2*CO3T
  12. IF(CO3T .GE. 0.D0) PP=ACOS(TT)/3.D0
  13. IF(CO3T .LT. 0.D0) PP=(PI-ACOS(-1.D0*TT))/3.D0
  14. C
  15. DLA=DK1*COS(PP)
  16. B2=DLA*SQRT(DJ2)+BB*DI1
  17. DELT=B2*B2+4.D0*AA*DJ2
  18. SEQ=(B2+SQRT(DELT))/2.D0
  19. IF(DJ2.LT.1.D-20) SEQ = BB*DI1
  20. IF(ABS(TU).GT.1.D-10) THEN
  21. FCRI = AA*DJ2/TU/TU+DLA*SQRT(DJ2)/TU+BB*DI1/TU-1.D0
  22. ELSE
  23. FCRI=1.D0
  24. ENDIF
  25. C---------------------------------------------------------------------
  26. IECR=0
  27. IF(IECR.EQ.5) THEN
  28. WRITE(*,100) DLA,BB,PP,AA,DK1,DK2,DELT,SEQ,FCRI
  29. 100 FORMAT('DLA=',E9.3,1X,'BB=',E9.3,1X,'PP=',E9.3,1X,'AA=',E9.3,1X
  30. *,'DK1=',E9.3,1X,'DK2=',E9.3,1X,'DELT=',E9.3,1X,'SEQ=',E10.4,1X,
  31. * 'FCRI=',E10.4,/)
  32. ENDIF
  33. C---------------------------------------------------------------------
  34. C
  35. RETURN
  36. END
  37.  
  38.  
  39.  
  40.  
  41.  

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