************************************************************************
SUBROUTINE OUT0
************************************************************************
IMPLICIT REAL*8(A-H,O-Z),INTEGER*4(I-N)
PARAMETER (NSPEC=4)
COMMON /QCONST/PAI,RAD,DEG,RE,CVLCTY
COMMON /QPARAM/RREF,RBTM,RREFP,
& PF0(NSPEC),GF0(NSPEC),
& XN0,THERM,ETA(NSPEC),SHINV(NSPEC),SHINVP,
& RRLI,HWLI,
& XLPP,HWPP,ERPP,DRR1,DTH1,DPH1,DRR2,DTH2,DPH2,
& RRMIN,RRMAX,ERRR,ERRA,HMIN,DISOUT,
& NPATH,NLPMAX,INDOUT,INDMSH,IEOF,
& IYEAR,IMNTH,IDATE
COMMON /QINIT /R0,T0,P0,E0,D0,F0
COMMON /QOUT /XX,YY,ZZ,OO,PP
COMMON /QTHPH0/COST0,SINT0,COSP0,SINP0
XX = R0*dSIN(T0*RAD)*dCOS(P0*RAD)
YY = R0*dSIN(T0*RAD)*dSIN(P0*RAD)
ZZ = R0*dCOS(T0*RAD)
OO = 0.0D0
PP = 0.0D0
RETURN
END
************************************************************************
SUBROUTINE OUT1(Y)
************************************************************************
IMPLICIT REAL*8(A-H,O-Z),INTEGER*4(I-N)
PARAMETER (NSPEC=4)
DIMENSION Y(8)
COMMON /QCONST/PAI,RAD,DEG,RE,CVLCTY
COMMON /QPARAM/RREF,RBTM,RREFP,
& PF0(NSPEC),GF0(NSPEC),
& XN0,THERM,ETA(NSPEC),SHINV(NSPEC),SHINVP,
& RRLI,HWLI,
& XLPP,HWPP,ERPP,DRR1,DTH1,DPH1,DRR2,DTH2,DPH2,
& RRMIN,RRMAX,ERRR,ERRA,HMIN,DISOUT,
& NPATH,NLPMAX,INDOUT,INDMSH,IEOF,
& IYEAR,IMNTH,IDATE
COMMON /QPATH /FKC,DEL,EPS,GMU,ALF,RAY
COMMON /QCOND /L,LL,NN,NLOOP,A
COMMON /QOUT /XX,YY,ZZ,OO,PP
COMMON /QTHPH0/COST0,SINT0,COSP0,SINP0
COMMON /QREF /PMU,PMUS,PMU0,
& PSI ,
& COPSI ,SIPSI ,
& COPSIS,SIPSIS,
& PX(NSPEC),PY(NSPEC),PZ(NSPEC),
& PA1,PA2,PA3,
& PK1,PK2,PK4,PK5,
& PA ,PB ,PC ,PD
COMMON /QDENS /XNS (NSPEC),
& DNSDRR(NSPEC),
& DNSDTH(NSPEC),
& DNSDPH(NSPEC)
real*8 RR,TH,PH,DL
RR = Y(1)
TH = Y(2)
PH = Y(3)
DL = DEL
XXX = RR*dSIN(TH*RAD)*dCOS(PH*RAD)
YYY = RR*dSIN(TH*RAD)*dSIN(PH*RAD)
ZZZ = RR*dCOS(TH*RAD)
DDD = dSQRT((XXX-XX)**2+(YYY-YY)**2+(ZZZ-ZZ)**2)
OO = OO+DDD
XX = XXX
YY = YYY
ZZ = ZZZ
IF(L.NE.0 .OR. LL.NE.0) GOTO 1020
IF(OO.GE.PP) THEN
write(21,1015)
& REAL(90.-TH),
& REAL(RR-6370.),
& REAL(PH),
& REAL(DL),
& PSI,
& 8.98*dsqrt(XNS(1)),
& REAL(PMU),
& REAL(Y(7))
c & Above time(ms)is the propagation delay
c & ((dcos((90.0-TH)*RAD)**2+0.5)/1.5)*
c & (XNS(1)+XNS(2)+XNS(3)+XNS(4))
1015 FORMAT(F8.2,F9.2,F9.5,F7.1,F10.1,F12.3,F11.2,F12.4)
PP=PP+DISOUT
A=A+1
END IF
1020 CONTINUE
RETURN
END