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