Download crioto.eso

Back to the list

   1 : C CRIOTO    SOURCE    CHAT      05/01/12    22:30:34     5004           
   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*DATAN(1.D0)
   9 :       CALL INVA(S1,DJ2,DI1,CO3T,DJ3,NSTRS)
  10 :       TT=DK2*CO3T
  11 :       IF(CO3T .GE. 0.D0) PP=DACOS(TT)/3.D0
  12 :       IF(CO3T .LT. 0.D0) PP=(PI-DACOS(-1.D0*TT))/3.D0
  13 : C
  14 :       DLA=DK1*DCOS(PP)
  15 :       B2=DLA*DSQRT(DJ2)+BB*DI1
  16 :       DELT=B2*B2+4.D0*AA*DJ2
  17 :       SEQ=(B2+DSQRT(DELT))/2.D0
  18 :       IF(DJ2.LT.1.D-20) SEQ = BB*DI1
  19 :       IF(DABS(TU).GT.1.D-10) THEN
  20 :         FCRI = AA*DJ2/TU/TU+DLA*DSQRT(DJ2)/TU+BB*DI1/TU-1.D0
  21 :       ELSE
  22 :         FCRI=1.D0
  23 :       ENDIF
  24 : C---------------------------------------------------------------------
  25 :       IECR=0
  26 :       IF(IECR.EQ.5) THEN
  27 :       WRITE(*,100) DLA,BB,PP,AA,DK1,DK2,DELT,SEQ,FCRI
  28 :   100 FORMAT('DLA=',E9.3,1X,'BB=',E9.3,1X,'PP=',E9.3,1X,'AA=',E9.3,1X
  29 :      *,'DK1=',E9.3,1X,'DK2=',E9.3,1X,'DELT=',E9.3,1X,'SEQ=',E10.4,1X,
  30 :      * 'FCRI=',E10.4,/)
  31 :       ENDIF
  32 : C---------------------------------------------------------------------
  33 : C
  34 :       RETURN
  35 :       END
  36 :  
  37 :  

© Cast3M 2003 - All rights reserved.
Disclaimer