C CRIOTO SOURCE CHAT 05/01/12 22:30:34 5004 C CRIOTO SOURCE INSL 24/10/96 SUBROUTINE CRIOTO(S1,SEQ,FCRI,NSTRS,TU,AA,BB,DK1,DK2) C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) DIMENSION S1(NSTRS) C PI=4.D0*DATAN(1.D0) CALL INVA(S1,DJ2,DI1,CO3T,DJ3,NSTRS) TT=DK2*CO3T IF(CO3T .GE. 0.D0) PP=DACOS(TT)/3.D0 IF(CO3T .LT. 0.D0) PP=(PI-DACOS(-1.D0*TT))/3.D0 C DLA=DK1*DCOS(PP) B2=DLA*DSQRT(DJ2)+BB*DI1 DELT=B2*B2+4.D0*AA*DJ2 SEQ=(B2+DSQRT(DELT))/2.D0 IF(DJ2.LT.1.D-20) SEQ = BB*DI1 IF(DABS(TU).GT.1.D-10) THEN FCRI = AA*DJ2/TU/TU+DLA*DSQRT(DJ2)/TU+BB*DI1/TU-1.D0 ELSE FCRI=1.D0 ENDIF C--------------------------------------------------------------------- IECR=0 IF(IECR.EQ.5) THEN WRITE(*,100) DLA,BB,PP,AA,DK1,DK2,DELT,SEQ,FCRI 100 FORMAT('DLA=',E9.3,1X,'BB=',E9.3,1X,'PP=',E9.3,1X,'AA=',E9.3,1X *,'DK1=',E9.3,1X,'DK2=',E9.3,1X,'DELT=',E9.3,1X,'SEQ=',E10.4,1X, * 'FCRI=',E10.4,/) ENDIF C--------------------------------------------------------------------- C RETURN END