fs/ 40777 1750 1750 0 6613213026 10447 5 ustar klimes klimes fs/fs-opt2.for 100666 1750 1750 7647 6270300044 12560 0 ustar klimes klimes C C Filenames: CHARACTER*80 FILE2 C C Logical unit numbers: INTEGER LU2 PARAMETER (LU2=2) C C Array dimensions: INTEGER MLE,MH,MSPINE PARAMETER (MLE=400,MH=MLE**2+1,MSPINE=MLE*(MLE+1)/2) C INTEGER ISP1(MSPINE),ISP2(MSPINE),ISP3(MSPINE) INTEGER IS1(MSPINE),IS2(MSPINE),IS3(MSPINE) C C....................................................................... C NH=100 FILE2='net.fs' WRITE(*,'(A)') *'+Enter maximum f.s. size (100), and f.s. filename (''net.fs''): ' READ(*,*) NH,FILE2 NH=NH*NH+1 IF(NH.GT.MH) THEN STOP 'ERROR: TOO LARGE FORWARD STAR.' END IF OPEN(LU2,FILE=FILE2) C DH=1./SQRT(12.*FLOAT(NH)) DH=DH/2. NFS=1 NSPINE=0 DO 69 IH=1,NH DO 58 I1=INT(SQRT(FLOAT(IH)/3.)-DH+1.),INT(SQRT(FLOAT(IH))+DH) I=IH-I1*I1 DO 57 I2=INT(SQRT(FLOAT(I)/2.)-DH+1.), * MIN0(INT(SQRT(FLOAT(I))+DH),I1) I3I3=I-I2*I2 IF(I3I3.EQ.0) THEN I3=0 DO 10 J=2,I1 IF(MOD(I1,J).EQ.0.AND.MOD(I2,J).EQ.0) THEN GO TO 56 END IF 10 CONTINUE C C New spine NSPINE=NSPINE+1 IF(NSPINE.GT.MSPINE) THEN STOP 'ERROR: TOO MANY SPINES.' END IF ISP1(NSPINE)=I3 ISP2(NSPINE)=I2 ISP3(NSPINE)=I1 C 56 CONTINUE END IF 57 CONTINUE 58 CONTINUE C IF(IH.EQ.NFS*NFS+1) THEN DO 66 ISPINE=NSPINE,3,-1 C Looking for two closest spines II=ISP2(ISPINE)*ISP2(ISPINE)+ISP3(ISPINE)*ISP3(ISPINE) JL=2 JLL=2 AL=999999. JR=1 JRR=1 AR=999999. DO 64 JSPINE=1,NSPINE IF(ISP3(JSPINE).GT.0) THEN IF(JSPINE.NE.ISPINE) THEN IJ=ISP2(ISPINE)*ISP3(JSPINE)-ISP3(ISPINE)*ISP2(JSPINE) JJ=ISP2(JSPINE)*ISP2(JSPINE)+ISP3(JSPINE)*ISP3(JSPINE) A=FLOAT(IJ*IJ)/FLOAT(II*JJ) IF(IJ.LT.0) THEN IF(A.LT.AL) THEN JL=JSPINE AL=A JLR=ISP2(JL)*ISP3(JR)-ISP3(JL)*ISP2(JR) JLL=ISP2(JL)*ISP2(JL)+ISP3(JL)*ISP3(JL) R=FLOAT(JLR*JLR*IH)/FLOAT(JLL*JRR) IF(R.LT.0.999999) THEN ISP3(ISPINE)=-ISP3(ISPINE) GO TO 65 END IF END IF ELSE IF(A.LT.AR) THEN JR=JSPINE AR=A JLR=ISP2(JL)*ISP3(JR)-ISP3(JL)*ISP2(JR) JRR=ISP2(JR)*ISP2(JR)+ISP3(JR)*ISP3(JR) R=FLOAT(JLR*JLR*IH)/FLOAT(JLL*JRR) IF(R.LT.0.999999) THEN ISP3(ISPINE)=-ISP3(ISPINE) GO TO 65 END IF END IF END IF END IF END IF 64 CONTINUE 65 CONTINUE 66 CONTINUE NS=0 DO 67 ISPINE=1,NSPINE IF(ISP3(ISPINE).GT.0) THEN NS=NS+1 IS1(NS)=ISP1(ISPINE) IS2(NS)=ISP2(ISPINE) IS3(NS)=ISP3(ISPINE) END IF 67 CONTINUE WRITE(*,'(A,I7,2I8)') '+',NFS,NS WRITE(LU2,'(I3,I6,I7,E13.6)') NFS,NS WRITE(LU2,'(8(3I3,1X))') (IS1(I),IS2(I),IS3(I),I=1,NS) NFS=NFS+1 DO 68 ISPINE=1,NSPINE ISP3(ISPINE)=IABS(ISP3(ISPINE)) 68 CONTINUE END IF 69 CONTINUE WRITE(LU2,'(I3,I6,I7,E13.6)') 0,0 C STOP END C C======================================================================= C fs/fs-opt3.for 100666 1750 1750 50576 6270300054 12601 0 ustar klimes klimes C Program to determine optimized spherical 3-D forward stars C C Input from console: C (1) NH,'STARS','TABLE',/ C NH... Maximum forward star size. C 'STARS'... Name of the output file with 3-D forward stars. C Renamed to 'net.fs3', it may serve as the data file for C the NET program. C 'TABLE'... Table filename. Just informative output. C Default: NH=27, 'STARS'='net.fs', 'TABLE'='table.fs'. C C Output file 'STARS': C (1) For each forward star (1A) and (1B): C (1A) NLE, NEDGE C NLE... Level of a forward star. C NEDGE...Number of edges. C (1B) (I1(I),I2(I),I3(I),I=1,NEDGE) C List of edges. Just edges with 0.LE.I1.LE.I2.LE.I3 are listed. C (2) 0, 0 C C Output file 'TABLE': C For each forward star (1): C (1) INT(H*H), H, R*R/2, H*H*R*R C H... Radius of a forward star in grid intervals. C R... Radius of the largest angular circle containing no edge C of the forward star. C Just the forward stars with smaller R's than the preceding ones are C listed. C C Date: 1997, January 19 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Filenames: CHARACTER*80 FILE1,FILE2 C C Logical unit numbers: INTEGER LU1,LU2 PARAMETER (LU1=1) PARAMETER (LU2=2) C C Array dimensions: INTEGER MLE,MH,MEDGE,MCIRC PARAMETER (MLE=80,MH=MLE**2+2,MEDGE=(MLE+1)**3/13) PARAMETER (MCIRC=(MLE+1)**3/5) C Memory: more than 4.2*(MLE+1)**3 B. C Time 386/20MHZ: (NH/56)**3 s = (NH/219)**3 min =(NH/860)**3 h. C INTEGER NCIRC,ICIRC,KCIRC1(MCIRC),KCIRC2(MCIRC),KCIRC3(MCIRC) INTEGER K1,K2,K3,NH,IH,I1,I2,I3,I3I3,I,J,NEDGE INTEGER KS1(MEDGE) INTEGER KS2(MEDGE) INTEGER KS3(MEDGE),KEDGE(MEDGE),LEDGE(MH),IEDGE,NS REAL EDGE1(MEDGE),S10,S11,S12,S13,A101,A112,A123,A130,C1 REAL EDGE2(MEDGE),S20,S21,S22,S23,A201,A212,A223,A230,C2 REAL EDGE3(MEDGE),S30,S31,S32,S33,A301,A312,A323,A330,C3 REAL RCIRC(MCIRC),RADIUS(MH),DH,CS,C,RR,AUX REAL S1(MEDGE) REAL S2(MEDGE) REAL S3(MEDGE) EQUIVALENCE (KCIRC1,KS1),(KCIRC2,KS2),(KCIRC3,KS3) EQUIVALENCE (KCIRC1,S1),(KCIRC2,S2),(KCIRC3,S3),(RCIRC,KEDGE) C C NCIRC.. Number of circles stored. C ICIRC.. Index of a circle. C KCIRC1(ICIRC),KCIRC2(ICIRC),KCIRC3(ICIRC)... Edges at the C periphery of a circle. C KCIRC3(ICIRC)= 0: The circle does not exist. C KCIRC3(ICIRC)=-1: Circle centre at the side of the region, C between edges 2=(1,1,0) and 3=(1,1,1). C KCIRC3(ICIRC)=-2: Circle centre at the side of the region, C between edges 3=(1,1,1) and 2=(1,1,0). C KCIRC3(ICIRC)=-3: Circle centre at the side of the region, C between edges 1=(1,0,0) and 2=(1,1,0). C K1,K2,K3... Above indices of a current circle. C NH... Square of the maximum length of an edge. C IH... Square of the length of an edge. C I3I3... Limit for I3*I3. C I... Limit for I2*I2+I3*I3. C J... Loop variable. C I1,I2,I3... Components of an edge. C NEDGE...Number of edges stored. C KS1,KS2,KS3... Edges of the resulting forward star (vectors). C KEDGE...List of edges of the resulting forward star. C LEDGE(IH)... Index of the last edge of square length IH. C IEDGE...Index of a current edge when decimating a forward star. C NS... Number of edges in vicinity of the current edge, when C decimating a forward star. C S1,S2,S3... Unit vectors of edges in vicinity of the current edge, C when decimating a forward star. C EDGE1(IS),EDGE2(IS),EDGE3(IS)... Unit vector of the IS-th edge. C S10,S20,S30... Unit vector of the current edge. C S11,S21,S31, S12,S22,S32, S13,S23,S33... Unit vectors of the C edges at the periphery of the current circle. C AIJK... I-th conponent of the vector connecting points J and K of C the unit sphere. C C1,C2,C3... Axial vector of the current circle. C RCIRC(ICIRC)... Radius**2 of a ICIRC-th circle. C RADIUS(IH)... Radius**2 of the maximum circle. C DH... A small real to remove rounding errors. C CS,C... Cosines of angular radii of circles. C RR... Square of radius of the largest angular circle containing C no edge of the forward star. C AUX... Auxiliary starage location. C C....................................................................... C C Opening data files: NH=27 FILE2='net.fs' FILE1='table.fs' WRITE(*,'(A)') * '+Enter maximum f.s. size (27), f.s. filename (''net.fs'')', * ' and table filename (''table.fs''): ' READ(*,*) NH,FILE2,FILE1 NH=NH*NH+2 IF(NH.GT.MH) THEN STOP 'ERROR: TOO LARGE FORWARD STAR.' END IF OPEN(LU2,FILE=FILE2) OPEN(LU1,FILE=FILE1) C WRITE(*,'(A)') '+ H*H edges circles' WRITE(*,'(3I8,A)') NH,MEDGE,MCIRC,' maximum' WRITE(*,'(A)') C DH=1./SQRT(12.*FLOAT(NH)) DH=DH/2. NEDGE=0 DO 69 IH=1,NH DO 58 I1=INT(SQRT(FLOAT(IH)/3.)-DH+1.),INT(SQRT(FLOAT(IH))+DH) I=IH-I1*I1 DO 57 I2=INT(SQRT(FLOAT(I)/2.)-DH+1.), * MIN0(INT(SQRT(FLOAT(I))+DH),I1) I3I3=I-I2*I2 I3=INT(SQRT(FLOAT(I3I3))+0.500) IF(I3*I3.EQ.I3I3.AND.I3.LE.I2) THEN DO 10 J=2,I1 IF(MOD(I1,J).EQ.0.AND.MOD(I2,J).EQ.0.AND.MOD(I3,J).EQ.0) * THEN GO TO 56 END IF 10 CONTINUE C C New edge NEDGE=NEDGE+1 IF(NEDGE.GT.MEDGE) THEN STOP 'ERROR: TOO MANY EDGES.' END IF AUX=SQRT(FLOAT(IH)) S10=FLOAT(I1)/AUX S20=FLOAT(I2)/AUX S30=FLOAT(I3)/AUX EDGE1(NEDGE)=S10 EDGE2(NEDGE)=S20 EDGE3(NEDGE)=S30 C C Loop over circles DO 49 ICIRC=1,NCIRC K3=KCIRC3(ICIRC) IF(K3.NE.0) THEN K1=KCIRC1(ICIRC) K2=KCIRC2(ICIRC) S11=EDGE1(K1) S21=EDGE2(K1) S31=EDGE3(K1) S12=EDGE1(K2) S22=EDGE2(K2) S32=EDGE3(K2) A112=S11-S12 A212=S21-S22 A312=S31-S32 IF(K3.GT.0) THEN C Circle centre inside the region: S13=EDGE1(K3) S23=EDGE2(K3) S33=EDGE3(K3) A123=S12-S13 A223=S22-S23 A323=S32-S33 C1=A212*A323-A312*A223 C2=A312*A123-A112*A323 C3=A112*A223-A212*A123 ELSE C Circle centre at a side of the region: IF(K3.EQ.-1) THEN C1= A312 C2= A312 C3=-A112-A212 ELSE IF(K3.EQ.-2) THEN C1=-A212-A312 C2= A112 C3= A112 ELSE C1= A212 C2=-A112 C3= 0. END IF END IF CS=C1*S11+C2*S21+C3*S31 C =C1*S10+C2*S20+C3*S30 IF(ABS(C).GT.ABS(CS)) THEN C C Current edge inside the current circle. NEW=ICIRC C A101=S10-S11 A201=S20-S21 A301=S30-S31 IF(K3.GT.0) THEN C Circle centre inside the region: A130=S13-S10 A230=S23-S20 A330=S33-S30 C New circle 0-1-2: C1=A201*A312-A301*A212 C2=A301*A112-A101*A312 C3=A101*A212-A201*A112 CALL CIRCLE(NEW,NEDGE,K1,K2,S10,S20,S30, * C1,C2,C3,EDGE1,EDGE2,EDGE3, * MCIRC,NCIRC,KCIRC1,KCIRC2,KCIRC3,RCIRC) C New circle 2-3-0: C1=A223*A330-A323*A230 C2=A323*A130-A123*A330 C3=A123*A230-A223*A130 CALL CIRCLE(NEW,NEDGE,K2,K3,S10,S20,S30, * C1,C2,C3,EDGE1,EDGE2,EDGE3, * MCIRC,NCIRC,KCIRC1,KCIRC2,KCIRC3,RCIRC) C New circle 3-0-1: C1=A230*A301-A330*A201 C2=A330*A101-A130*A301 C3=A130*A201-A230*A101 CALL CIRCLE(NEW,NEDGE,K3,K1,S10,S20,S30, * C1,C2,C3,EDGE1,EDGE2,EDGE3, * MCIRC,NCIRC,KCIRC1,KCIRC2,KCIRC3,RCIRC) ELSE C Circle centre at a side of the region: A120=S12-S10 A220=S22-S20 A320=S32-S30 C New circle 2-0-1: C1=A220*A301-A320*A201 C2=A320*A101-A120*A301 C3=A120*A201-A220*A101 CALL CIRCLE(NEW,NEDGE,K1,K2,S10,S20,S30, * C1,C2,C3,EDGE1,EDGE2,EDGE3, * MCIRC,NCIRC,KCIRC1,KCIRC2,KCIRC3,RCIRC) C New circle 0-1: IF(K3.EQ.-1) THEN C1= A301 C2= A301 C3=-A101-A201 ELSE IF(K3.EQ.-2) THEN C1=-A201-A301 C2= A101 C3= A101 ELSE IF(K3.EQ.-3) THEN C1= A201 C2=-A101 C3= 0. END IF CALL CIRCLE(NEW,NEDGE,K1,K3,S10,S20,S30, * C1,C2,C3,EDGE1,EDGE2,EDGE3, * MCIRC,NCIRC,KCIRC1,KCIRC2,KCIRC3,RCIRC) C New circle 2-0: IF(K3.EQ.-1) THEN C1= A320 C2= A320 C3=-A120-A220 ELSE IF(K3.EQ.-2) THEN C1=-A220-A320 C2= A120 C3= A120 ELSE C1= A220 C2=-A120 C3= 0. END IF CALL CIRCLE(NEW,NEDGE,K2,K3,S10,S20,S30, * C1,C2,C3,EDGE1,EDGE2,EDGE3, * MCIRC,NCIRC,KCIRC1,KCIRC2,KCIRC3,RCIRC) END IF WRITE(*,'(A,I7,2I8)') '+',IH,NEDGE,NCIRC C END IF END IF 49 CONTINUE C WRITE(*,'(A,I7,2I8)') '+',IH,NEDGE,NCIRC 56 CONTINUE END IF 57 CONTINUE 58 CONTINUE IF(IH.EQ.3) THEN NCIRC=4 KCIRC1(1)=2 KCIRC2(1)=3 KCIRC3(1)=-1 RCIRC(1)=0.0917517 KCIRC1(2)=3 KCIRC2(2)=1 KCIRC3(2)=-2 RCIRC(2)=0.2113249 KCIRC1(3)=1 KCIRC2(3)=2 KCIRC3(3)=-3 RCIRC(3)=0.1464466 KCIRC1(4)=1 KCIRC2(4)=2 KCIRC3(4)=3 RCIRC(4)=0.2142030 RADIUS(1)=0.6666667 RADIUS(2)=0.3333333 END IF AUX=0. DO 68 ICIRC=1,NCIRC IF(KCIRC3(ICIRC).NE.0) THEN AUX=AMAX1(RCIRC(ICIRC),AUX) END IF 68 CONTINUE LEDGE(IH)=NEDGE RADIUS(IH)=AUX 69 CONTINUE C C....................................................................... C DO 71 IH=NH,2,-1 IF(RADIUS(IH).EQ.RADIUS(IH-1)) THEN RADIUS(IH)=0. END IF 71 CONTINUE C DO 72 IH=1,NH IF(RADIUS(IH).NE.0.) THEN AUX=SQRT(FLOAT(IH)) I3=INT(AUX+0.00001) I2=IH-I3*I3 RR=ASIN(SQRT(RADIUS(IH)))**2 WRITE(LU1,'(I4,A,I2,A,I2,A,I2,F12.6,E13.6,F9.6)') * IH,'=',I3,'*',I3,'+',I2,AUX,RR/2.,FLOAT(IH)*RR END IF 72 CONTINUE C C....................................................................... C WRITE(*,'(A,I7,2I8)') ' ',0,0 J=INT(SQRT(FLOAT(NH-2)+DH)) DO 99 J=1,J IH=J*J+2 DO 81 IEDGE=LEDGE(IH),1,-1 KEDGE(IEDGE)=1 81 CONTINUE DO 82 IEDGE=LEDGE(IH),4,-1 WRITE(*,'(A,I7)') '+',IEDGE CALL PICK(IEDGE,LEDGE(IH),KEDGE,EDGE1,EDGE2,EDGE3, * NS,S1,S2,S3,RADIUS(IH)) CALL SPOT(NS,S1,S2,S3,RADIUS(IH)) KEDGE(IEDGE)=NS 82 CONTINUE C NEDGE=0 DO 95 IEDGE=1,LEDGE(IH) IF(KEDGE(IEDGE).NE.0) THEN NEDGE=NEDGE+1 KEDGE(NEDGE)=IEDGE END IF 95 CONTINUE I3I3=1 DO 98 IEDGE=1,NEDGE I=KEDGE(IEDGE) 96 CONTINUE IF(LEDGE(I3I3).GE.I) GO TO 97 I3I3=I3I3+1 GO TO 96 97 CONTINUE AUX=SQRT(FLOAT(I3I3)) KS1(IEDGE)=INT(EDGE1(I)*AUX+0.5) KS2(IEDGE)=INT(EDGE2(I)*AUX+0.5) KS3(IEDGE)=INT(EDGE3(I)*AUX+0.5) 98 CONTINUE WRITE(*,'(A,I7,2I8)') '+',IH,NEDGE RR=ASIN(SQRT(RADIUS(IH)))**2 C-old WRITE(LU2,'(I3,I6,I7,E13.6)') J,NEDGE,IH,RR/2. C-old RR... SQUARE OF THE RADIUS OF THE LARGEST ANGULAR CIRCLE C-old CONTAINING NO EDGE OF THE FORWARD STAR. C-old IH... SQUARE OF THE RADIUS OF A FORWARD STAR IN GRID INTERVALS. WRITE(LU2,'(I3,I6,I7,E13.6)') J,NEDGE WRITE(LU2,'(8(3I3,1X))') (KS3(I),KS2(I),KS1(I),I=1,NEDGE) 99 CONTINUE C-old WRITE(LU2,'(I3,I6,I7,E13.6)') 0,0,0,0. WRITE(LU2,'(I3,I6,I7,E13.6)') 0,0 C STOP END C C======================================================================= C SUBROUTINE CIRCLE(NEW,K1,K2,K3,S1,S2,S3,C1,C2,C3, * EDGE1,EDGE2,EDGE3,MCIRC,NCIRC,KCIRC1,KCIRC2,KCIRC3,RCIRC) INTEGER NEW,K1,K2,K3,MCIRC,NCIRC,KCIRC1(*),KCIRC2(*),KCIRC3(*) REAL S1,S2,S3,C1,C2,C3 REAL EDGE1(*),EDGE2(*),EDGE3(*),RCIRC(*) C C NEW... If non-zero, free memory location for a circle. C K1,K2,K3... Edges of a new circle. C S1,S2,S3... Unit vector of an edge at the periphery of the new C circle. C C1,C2,C3... Axial vector of the new circle. C EDGE1(IS),EDGE2(IS),EDGE3(IS)... Unit vector of the IS-th C edge. C MCIRC.. Maximum number of circles. C NCIRC.. Number of circles stored. C KCIRC1(ICIRC),KCIRC2(ICIRC),KCIRC3(ICIRC)... Edges at the C periphery of a circle. C C----------------------------------------------------------------------- C INTEGER IS,I REAL CC,CS,SS,C C C IS... Index of an edge (loop variable). C I... Auxiliary starage location. C CS,C... Cosines of angular radii of circles. C CC,CS,SS... Scalar products C*C, C*S, S*S of the input vectors. C C....................................................................... C IF(NEW.GT.0) THEN KCIRC3(NEW)=0 END IF IF((C1+0.00001.GE.C2.AND.C2+0.00001.GE.C3.AND.C3+0.00001.GE.0.).OR * .(C1-0.00001.LE.C2.AND.C2-0.00001.LE.C3.AND.C3-0.00001.LE.0.)) * THEN CS=ABS(C1*S1+C2*S2+C3*S3) DO 21 IS=1,K1-1 IF(IS.NE.K2.AND.IS.NE.K3) THEN C=C1*EDGE1(IS)+C2*EDGE2(IS)+C3*EDGE3(IS) IF(ABS(C).GT.CS) THEN GO TO 22 END IF END IF 21 CONTINUE C New circle is to be stored: IF(NEW.GT.0) THEN I=NEW NEW=0 ELSE I=NCIRC+1 NCIRC=I IF(NCIRC.GT.MCIRC) THEN STOP 'ERROR: TOO MANY CIRCLES.' END IF END IF KCIRC1(I)=K1 KCIRC2(I)=K2 KCIRC3(I)=K3 C Given: periphery edge S and axial edge C. SS=S1*S1+S2*S2+S3*S3 CS=C1*S1+C2*S2+C3*S3 CC=C1*C1+C2*C2+C3*C3 RCIRC(I)=1.-CS*CS/(CC*SS) 22 CONTINUE END IF RETURN END C C======================================================================= C SUBROUTINE PICK(IEDGE,NEDGE,KEDGE,EDGE1,EDGE2,EDGE3, * NS,S1,S2,S3,R) INTEGER IEDGE,NEDGE,KEDGE(NEDGE),NS REAL EDGE1(NEDGE),EDGE2(NEDGE),EDGE3(NEDGE) REAL S1(NEDGE),S2(NEDGE),S3(NEDGE),R C C Subroutine designed to pick up edges within a circle of radius C 2*SQRT(R) around the given edge. C C IEDGE... Index of the given edge. C EDGE1(IS),EDGE2(IS),EDGE3(IS)... Unit vector of the IS-th C edge. C S1(IS),S2(IS),S3(IS)... Unit vector of the IS-th picked up edge. C C----------------------------------------------------------------------- C INTEGER IS REAL C1,C2,C3,C,CR C C IS1,IS2,IS3,IS... Indices of edges (loop variables). C C... Cosine of angular radus of a circle. C C....................................................................... C CR=SQRT(1.-4.*R)-0.00001 NS=1 S1(1)=EDGE1(IEDGE) S2(1)=EDGE2(IEDGE) S3(1)=EDGE3(IEDGE) C1=S1(1) C2=S2(1) C3=S3(1) C DO 10 IS=1,NEDGE IF(KEDGE(IS).NE.0) THEN IF(IS.NE.IEDGE) THEN C=C1*EDGE1(IS)+C2*EDGE2(IS)+C3*EDGE3(IS) IF(ABS(C).GE.CR) THEN NS=NS+1 S1(NS)=EDGE1(IS) S2(NS)=EDGE2(IS) S3(NS)=EDGE3(IS) END IF END IF END IF 10 CONTINUE RETURN END C C======================================================================= C SUBROUTINE SPOT(NS,S1,S2,S3,R) INTEGER NS REAL S1(NS),S2(NS),S3(NS),R C C Subroutine designed to look for a circle of radius .GT. SQRT(R), C containing the first given edge and no other. C C S1(IS),S2(IS),S3(IS)... Unit vector of the IS-th C edge. C C Output: C NS=0 if a circle has been found. C C----------------------------------------------------------------------- C INTEGER IS1,IS2,IS3,IS REAL S11,S12,S13,A112,A123,C1 REAL S21,S22,S23,A212,A223,C2 REAL S31,S32,S33,A312,A323,C3,CS,C,CR C C IS1,IS2,IS3,IS... Indices of edges (loop variables). C CS,C... Cosines of angular radii of circles. C C....................................................................... C CR=SQRT(1.-R)-0.00001 S10=S1(1) S20=S2(1) S30=S3(1) C DO 33 IS3=2,NS S13=S1(IS3) S23=S2(IS3) S33=S3(IS3) DO 32 IS2=2,IS3-1 S12=S1(IS2) S22=S2(IS2) S32=S3(IS2) A123=S12-S13 A223=S22-S23 A323=S32-S33 DO 31 IS1=-1,IS2-1 IF(IS1.GE.2) THEN S11=S1(IS1) S21=S2(IS1) S31=S3(IS1) A112=S11-S12 A212=S21-S22 A312=S31-S32 C Circle axis: C1=A212*A323-A312*A223 C2=A312*A123-A112*A323 C3=A112*A223-A212*A123 ELSE IF(IS1.EQ.1) THEN C1= A323 C2= A323 C3=-A123-A223 ELSE IF(IS1.EQ.0) THEN C1=-A223-A323 C2= A123 C3= A123 ELSE C1= A223 C2=-A123 C3= 0. END IF C =SQRT(C1*C1+C2*C2+C3*C3) C1=C1/C C2=C2/C C3=C3/C CS=ABS(C1*S13+C2*S23+C3*S33) IF(CS.LT.CR) THEN C =C1*S10+C2*S20+C3*S30 IF(ABS(C).GT.CS) THEN DO 21 IS=2,NS IF(IS.NE.IS1.AND.IS.NE.IS2.AND.IS.NE.IS3) THEN C=C1*S1(IS)+C2*S2(IS)+C3*S3(IS) IF(ABS(C).GT.CS) THEN GO TO 22 END IF END IF 21 CONTINUE C There is a large circle: RETURN 22 CONTINUE END IF END IF 31 CONTINUE 32 CONTINUE 33 CONTINUE C NS=0 RETURN END C C======================================================================= C fs/fs-mcir2.for 100666 1750 1750 3764 5526032642 12715 0 ustar klimes klimes C C FILENAMES: CHARACTER*80 FILE2 C C LOGICAL UNIT NUMBERS: INTEGER LU2 PARAMETER (LU2=2) C C ARRAY DIMENSIONS: INTEGER MLE,MH,MSPINE PARAMETER (MLE=600,MH=MLE**2+1,MSPINE=MLE*(MLE+1)/2) C INTEGER ISP1(MSPINE),ISP2(MSPINE),ISP3(MSPINE) C C....................................................................... C NH=100 FILE2='NET.FS' WRITE(*,'(A)') *'+ENTER MAXIMUM F.S. SIZE (100), AND F.S. FILENAME (''NET.FS''): ' READ(*,*) NH,FILE2 NH=NH*NH+1 IF(NH.GT.MH) THEN STOP 'ERROR: TOO LARGE FORWARD STAR.' END IF OPEN(LU2,FILE=FILE2) C DH=1./SQRT(12.*FLOAT(NH)) DH=DH/2. NFS=1 NSPINE=0 DO 69 IH=1,NH DO 58 I1=INT(SQRT(FLOAT(IH)/3.)-DH+1.),INT(SQRT(FLOAT(IH))+DH) I=IH-I1*I1 DO 57 I2=INT(SQRT(FLOAT(I)/2.)-DH+1.), * MIN0(INT(SQRT(FLOAT(I))+DH),I1) I3I3=I-I2*I2 I3=INT(SQRT(FLOAT(I3I3))+0.500) IF(I3*I3.EQ.I3I3.AND.I3.LE.I2) THEN IF(I3.EQ.0) THEN DO 10 J=2,I1 IF(MOD(I1,J).EQ.0.AND.MOD(I2,J).EQ.0) THEN GO TO 56 END IF 10 CONTINUE C C NEW SPINE NSPINE=NSPINE+1 IF(NSPINE.GT.MSPINE) THEN STOP 'ERROR: TOO MANY SPINES.' END IF ISP1(NSPINE)=I3 ISP2(NSPINE)=I2 ISP3(NSPINE)=I1 C 56 CONTINUE END IF END IF 57 CONTINUE 58 CONTINUE C IF(IH.EQ.NFS*NFS+1) THEN WRITE(*,'(A,I7,2I8)') '+',NFS,NSPINE WRITE(LU2,'(I3,I6,I7,E13.6)') NFS,NSPINE WRITE(LU2,'(8(3I3,1X))') (ISP1(I),ISP2(I),ISP3(I),I=1,NSPINE) NFS=NFS+1 END IF 69 CONTINUE WRITE(LU2,'(I3,I6,I7,E13.6)') 0,0 C STOP END C C======================================================================= C fs/fs-msph3.for 100666 1750 1750 3766 5526032654 12740 0 ustar klimes klimes C C FILENAMES: CHARACTER*80 FILE2 C C LOGICAL UNIT NUMBERS: INTEGER LU2 PARAMETER (LU2=2) C C ARRAY DIMENSIONS: INTEGER MLE,MH,MSPINE PARAMETER (MLE=600,MH=MLE**2+1,MSPINE=MLE*(MLE+1)/2) C INTEGER ISP1(MSPINE),ISP2(MSPINE),ISP3(MSPINE) C C....................................................................... C NH=27 FILE2='NET.FS' WRITE(*,'(A)') * '+ENTER MAXIMUM F.S. SIZE (27), AND F.S. FILENAME (''NET.FS''): ' READ(*,*) NH,FILE2 NH=NH*NH+2 IF(NH.GT.MH) THEN STOP 'ERROR: TOO LARGE FORWARD STAR.' END IF OPEN(LU2,FILE=FILE2) C DH=1./SQRT(12.*FLOAT(NH)) DH=DH/2. NFS=1 NSPINE=0 DO 69 IH=1,NH DO 58 I1=INT(SQRT(FLOAT(IH)/3.)-DH+1.),INT(SQRT(FLOAT(IH))+DH) I=IH-I1*I1 DO 57 I2=INT(SQRT(FLOAT(I)/2.)-DH+1.), * MIN0(INT(SQRT(FLOAT(I))+DH),I1) I3I3=I-I2*I2 I3=INT(SQRT(FLOAT(I3I3))+0.500) IF(I3*I3.EQ.I3I3.AND.I3.LE.I2) THEN DO 10 J=2,I1 IF(MOD(I1,J).EQ.0.AND.MOD(I2,J).EQ.0 * .AND.MOD(I3,J).EQ.0) THEN GO TO 56 END IF 10 CONTINUE C C NEW SPINE NSPINE=NSPINE+1 IF(NSPINE.GT.MSPINE) THEN STOP 'ERROR: TOO MANY SPINES.' END IF ISP1(NSPINE)=I3 ISP2(NSPINE)=I2 ISP3(NSPINE)=I1 C 56 CONTINUE END IF 57 CONTINUE 58 CONTINUE C IF(IH.EQ.NFS*NFS+2) THEN WRITE(*,'(A,I7,2I8)') '+',NFS,NSPINE WRITE(LU2,'(I3,I6,I7,E13.6)') NFS,NSPINE WRITE(LU2,'(8(3I3,1X))') (ISP1(I),ISP2(I),ISP3(I),I=1,NSPINE) NFS=NFS+1 END IF 69 CONTINUE WRITE(LU2,'(I3,I6,I7,E13.6)') 0,0 C STOP END C C======================================================================= C fs/fs-msqr2.for 100666 1750 1750 2762 5526032652 12743 0 ustar klimes klimes C C FILENAMES: CHARACTER*80 FILE2 C C LOGICAL UNIT NUMBERS: INTEGER LU2 PARAMETER (LU2=2) C C ARRAY DIMENSIONS: INTEGER MLE,MH,MSPINE PARAMETER (MLE=600,MH=MLE**2+1,MSPINE=MLE*(MLE+1)/2) C INTEGER ISP1(MSPINE),ISP2(MSPINE),ISP3(MSPINE) C C....................................................................... C NH=100 FILE2='NET.FS' WRITE(*,'(A)') *'+ENTER MAXIMUM F.S. SIZE (100), AND F.S. FILENAME (''NET.FS''): ' READ(*,*) NH,FILE2 IF(NH.GT.MH) THEN STOP 'ERROR: TOO LARGE FORWARD STAR.' END IF OPEN(LU2,FILE=FILE2) C NSPINE=0 DO 69 I1=1,NH DO 58 I2=0,I1 DO 57 I3=0,0 DO 10 J=2,I1 IF(MOD(I1,J).EQ.0.AND.MOD(I2,J).EQ.0 * .AND.MOD(I3,J).EQ.0) THEN GO TO 56 END IF 10 CONTINUE C C NEW SPINE NSPINE=NSPINE+1 IF(NSPINE.GT.MSPINE) THEN STOP 'ERROR: TOO MANY SPINES.' END IF ISP1(NSPINE)=I3 ISP2(NSPINE)=I2 ISP3(NSPINE)=I1 C 56 CONTINUE 57 CONTINUE 58 CONTINUE C WRITE(*,'(A,I7,2I8)') '+',I1,NSPINE WRITE(LU2,'(I3,I6,I7,E13.6)') I1,NSPINE WRITE(LU2,'(8(3I3,1X))') (ISP1(I),ISP2(I),ISP3(I),I=1,NSPINE) 69 CONTINUE WRITE(LU2,'(I3,I6,I7,E13.6)') 0,0 C STOP END C C======================================================================= C fs/fs-mcub3.for 100666 1750 1750 2762 5526032650 12706 0 ustar klimes klimes C C FILENAMES: CHARACTER*80 FILE2 C C LOGICAL UNIT NUMBERS: INTEGER LU2 PARAMETER (LU2=2) C C ARRAY DIMENSIONS: INTEGER MLE,MH,MSPINE PARAMETER (MLE=600,MH=MLE**2+1,MSPINE=MLE*(MLE+1)/2) C INTEGER ISP1(MSPINE),ISP2(MSPINE),ISP3(MSPINE) C C....................................................................... C NH=27 FILE2='NET.FS' WRITE(*,'(A)') * '+ENTER MAXIMUM F.S. SIZE (27), AND F.S. FILENAME (''NET.FS''): ' READ(*,*) NH,FILE2 IF(NH.GT.MH) THEN STOP 'ERROR: TOO LARGE FORWARD STAR.' END IF OPEN(LU2,FILE=FILE2) C NSPINE=0 DO 69 I1=1,NH DO 58 I2=0,I1 DO 57 I3=0,I2 DO 10 J=2,I1 IF(MOD(I1,J).EQ.0.AND.MOD(I2,J).EQ.0 * .AND.MOD(I3,J).EQ.0) THEN GO TO 56 END IF 10 CONTINUE C C NEW SPINE NSPINE=NSPINE+1 IF(NSPINE.GT.MSPINE) THEN STOP 'ERROR: TOO MANY SPINES.' END IF ISP1(NSPINE)=I3 ISP2(NSPINE)=I2 ISP3(NSPINE)=I1 C 56 CONTINUE 57 CONTINUE 58 CONTINUE C WRITE(*,'(A,I7,2I8)') '+',I1,NSPINE WRITE(LU2,'(I3,I6,I7,E13.6)') I1,NSPINE WRITE(LU2,'(8(3I3,1X))') (ISP1(I),ISP2(I),ISP3(I),I=1,NSPINE) 69 CONTINUE WRITE(LU2,'(I3,I6,I7,E13.6)') 0,0 C STOP END C C======================================================================= C fv/ 40777 1750 1750 0 6613213036 10453 5 ustar klimes klimes fv/netfv.htm 100666 1750 1750 21055 6602575624 12443 0 ustar klimes klimes
fv/netind.for 100666 1750 1750 75560 6622171036 12601 0 ustar klimes klimes CTwo-point network shortest-path ray tracing within Fresnel volumes. Description of the algorithm employing programs NET and NETIND.
Given: The model, the source point, and the receiver point. Algorithm: (1) Determination of the Fresnel volume: (1.1) Create source point file 'SRC' containing the coordinates of the source point, and receiver point file 'REC' containing the coordinates of the receiver point. The file format is described within the source code 'net.for'. Choose the rectangular grid for the network ray tracing: N1*N2*N3 big bricks, each containing one grid point. We assume here that this original grid is not indexed. (1.2) Generate the grid velocities (file 'VEL') and, possibly, indices of geological blocks (file 'ICB'). If using the model specification software package 'MODEL', this task is performed by the program 'grid.for'. (1.3) Calculate travel-time field 'TT1' from the source, and the two-point travel time with its error. This step is performed by the program 'net.for'. (1.4) Calculate travel-time field 'TT2' from the receiver. This step is performed by the program 'net.for'. (1.5) Run 'netind.for' program with the travel-time fields 'TT1' and 'TT2', and with the calculated two-point travel time plus its estimated error (as the maximum sum of travel times limiting the Fresnel volume). The Fresnel volume is determined and the corresponding index file 'IND' is created. (2) Two-point ray tracing within the Fresnel volume: (2.1) Edit the grid: Divide each of N1*N2*N3 big bricks into L1*L2*L3 small bricks, each small brick having the gridpoint at its centre. If big bricks cannot be divided (e.g. because being short of the computer memory), the algorithm has to be terminated here, without reaching the required accuracy. This step is usually completed together with step (1.5) or (2.5) by the 'netind.for' program. (2.2) Generate the grid velocities (file 'VEL') and, possibly, indices of geological blocks (file 'ICB'). The same as (1.2) except for the index file 'IND', describing the Fresnel volume, specified. The new files 'VEL' and 'ICB' correspond to the index file 'IND' and to the new subdivision of big bricks into small bricks. (2.3) Calculate new, indexed, travel-time field 'TT1' from the source, and the two-point travel time with its error. If the two-point travel time is sufficiently accurate, the procedure may be terminated here and the file 'TT1' is not required. This step is performed by the program 'net.for'. (2.4) Calculate new, indexed, travel-time field 'TT2' from the receiver. This step is performed by the program 'net.for'. (2.5) Run 'netind.for' program with the travel-time fields 'TT1' and 'TT2', and with the calculated two-point travel time plus its estimated error (as the maximum sum of travel times limiting the Fresnel volume). Then the new Fresnel volume is determined and the new index file 'OUT' is created. Whereas the old index file 'IND' corresponds to N1*N2*N3 big bricks, the new index file 'OUT' corresponds to (N1*L1)*(N2*L2)*(N3*L3) big bricks. In this way, the new index file upgrades the old small bricks to big bricks. (3) Changing to the new, finer Fresnel volume: (3.1) Edit the grid: Upgrade old small bricks to big bricks, i.e. write (N1*L1),(N2*L2),(N3*L3) in place of N1,N2,N3, while L1,L2,L3 become undefined. This step is usually completed together with step (2.5) by the 'netind.for' program. (3.2) Replace the old index file 'IND' by the new index file 'OUT'. (3.3) Proceed to (2.1). Strategy of array dimensioning for network ray tracing within Fresnel volumes: In 'net.for', neglecting the template forward stars, the most of the memory is used by the following 7 arrays: IND(N123)... Indexing of Fresnel volumes, P(L1234)... Slownesses (always used), TT(L1234)... First-arrival times (always used), IPOSQ(L1234)... Queue (always used), IPRED(L1234)... Predecessors (used in Fresnel volumes), NFS(L1234)... Optimum sizes of forward stars (often used), ICB(L1234)... Indices of geological blocks (often used). Here the dimensions denote the number of storage locations required. If the index array IND(N123) is used, the minimum dimension N123 is the number of big bricks in the whole model volume. The minimum dimension L1234 of the other 4 to 6 arrays is the number of small bricks in the Fresnel volume. Let us denote: NDIM=2,3 ... For 2-D or 3-D calculation, respectively, NARR=4,5,6 ... Number of arrays dimensioned by L1234, MRAM... Total memory available for the above 7 arrays. The error of arrival time is proportional to the grid step: error=constant*step. The grid step in the last but one iteration is dependent on the total number of small bricks in the model volume in that iteration, that is the number N123 of all big bricks in the last iteration: step=constant*N123**(-1/NDIM). The ratio of the Fresnel volume to the model volume depends on the error in the last but one iteration: ratio=constant*error**((NDIM-1)/2). Finally: ratio=constant*N123**(-(NDIM-1)/(2*NDIM)). Then the number of small bricks within the Fresnel volume is: L1234=L1*L2*L3*N123*ratio as an objective, we choose to maximize the total number Y of small bricks within the whole model volume during the last iteration: Y=L1*L2*L3*N123 =L1234/RATIO =constant*L1234*N123**((NDIM-1)/(2*NDIM)). The memory available for all the above arrays is: MRAM=N123+NARR*L1234. The objective function Y=(constant/NARR)*(MRAM-N123)*N123**((NDIM-1)/(2*NDIM)) is extremal for N123=MRAM*(NDIM-1)/(3*NDIM-1), i.e. In 2-D: N123=MRAM/5, L1234=MRAM*4/(5*NARR), In 3-D: N123=MRAM/4, L1234=MRAM*3/(4*NARR). There is no considerable difference between this optimum choice and the smaller value of N123=MRAM/NARR. For example, if NARR=6, the difference of the grid step is 1/4 per cent in 2-D, and 1 per cent in 3-D. That is why in most cases the following two-iteration strategy will be sufficient: 1-st iteration: N123=0, L1234=MRAM*(NDIM-1)/(3*NDIM-1) 2-nd iteration: N123=MRAM*(NDIM-1)/(3*NDIM-1), L1234=(MRAM-N123)/NARR Input data for 'net.for' (first iteration): N1*N2*N3=MRAM*(NDIM-1)/(3*NDIM-1) Input data for 'netind.for': L1MAX=0, L2MAX=0, L3MAX=0 (defaults) In 3-D, the big bricks may be expected to be divided into 2*2*2 to 6*6*6 small bricks, depending on the complexity of the model. A finer division is unlike in inhomogeneous 3-D models. Although the number of network nodes in the first iteration is slightly greater than in the second iteration, the first iteration should be several times (2 to 6 times in 3-D) faster than the second iteration because of smaller optimized forward stars. On the other hand, if desirable to save the computation time, the following three-iteration strategy 1-st iteration: N123=0, L1234=MRAM*(NDIM-1)/(3*NDIM-1)/(2**NDIM), 2-nd iteration: N123=MRAM*(NDIM-1)/(3*NDIM-1)/(2**NDIM), L1*L2*L3=2**NDIM, 3-rd iteration: N123=MRAM*(NDIM-1)/(3*NDIM-1), L1234=(MRAM-N123)/NARR Input data for 'net.for' (first iteration): N1*N2*N3=MRAM*(NDIM-1)/(3*NDIM-1)/(2**NDIM) Input data for 'netind.for': L1MAX=2, L2MAX=2, L3MAX=2 (first run) L1MAX=0, L2MAX=0, L3MAX=0 (second run) may be little bit faster since nearly 2**(1.5*NDIM-0.5) times reducing the computation time of the first iteration. Let us note that the above strategies were suggested especially for 3-D, where the shortage of computer memory limiting the accuracy is a dominant feature. If, in 2-D, the computer memory does not limit the accuracy required, other strategies decreasing the computation time should be applied.
C Program NETIND to generate the index file mapping gridpoints onto the C network nodes situated within the Fresnel volume. C C Version: 3.10 C Date: 1998, November 11 C C Coded by: Ludek Klimes C Department of Geophysics, Charles University Prague C Ke Karlovu 3, 121 16 Praha 2, Czech Republic C E-mail: klimes@seis.karlov.mff.cuni.cz C C....................................................................... C C C Data files: C C Main input data read from the * device: C The data are read in by the list directed input (free format). C The strings have to be enclosed in apostrophes. C (1) 'SEP','NET1','NET2','NET3',/ C 'SEP'...String in apostrophes containing the name C the input file with the data specifying grid C File SEP, specifying the grid dimensions, C will be updated by appending the dimensions of the grid C for the next network ray tracing. C If the same file SEP is used in all iterations, it C accumulates the history of the grid dimensions. C dimensions and optionally some numerical parameters. C Description of file SEP C Additional parameters for this program C 'NET1'..String containing the name of the input file NET of C the 'net.for' program when it calculated the travel times C from the source point. C 'NET2'..String containing the name of the input file NET of C the 'net.for' program when it calculated the travel times C from the receiver point. Otherwise, file NET2 should be C similar to file NET1. C 'NET3'..String containing the name of the input file NET of C the 'net.for' program to perform network ray tracing in C the Fresnel volume. Program NETIND reads only the index C file IND from this file. C Index file IND is the output of program NETIND. C Filename NET3 may coincide with NET1. C Description of input data NET1, NET2 and NET3 C Defaults: 'SEP'='net.h', 'NET1'='net1.dat', 'NET2'='net2.dat', C 'NET3'='net3.dat'. C C C Data file SEP has the form of the SEP (Stanford Exploration Project) C parameter file: C Parameters common with program 'net.for' C Additional parameters for this program: C L1MAX=integer, L2MAX=integer, L3MAX=integer... Output big brick C may have at most L1MAX*L2MAX*L3MAX small bricks, C 0 means no limitation. C Do not specify different values of LiMAX in different C directions. C Defaults: L1MAX=2, L2MAX=2, L3MAX=2. C NL1MAX=integer, NL2MAX=integer, NL3MAX=integer... Maximum values C of N1*L1, N2*L2, N3*L3, respectively, C 0 means no limitation. C These parameters enable to limit the density of the C gridpoints in order to stop calculations at a desired C accuracy level and prevent extremely expensive C calculation. It is recommended to specify NL1MAX, C NL2MAX, NL3MAX as the same multiple of N1, N2, N3, C respectively. C Hint: C (a) Run 'net.for' on a reasonably dense grid. C (b) Look at the maximum errors of calculated travel C times and estimate how many times they should be C decreased. Let us denote the value by TIMES here. C (c) For network ray tracing (NFSMAX.GE.0), which is C a first-order method, select NLiMAX=TIMES*Ni, C where N1,N2,N3 are the values used at (a). C (d) Leave default values of LiMAX. C (e) Approximate NLiMAX by new values C NLiMAX=Ni*(LiMAX)**(ITER-1), C i.e., C NLiMAX=Ni*2**(ITER-1) for default LiMAX=2, C with reasonable values of N1, N2, N3. If resulting C values of N1, N2, N3, NL1MAX, NL2MAX, NL3MAX are C compatible with the RAM allocated in C ram.inc (see C net.inc), they may be used C to start ITER iterations of ray tracing within C Fresnel volumes. C If the accuracy is low and you wish to maximize it at C given RAM, replace the above procedure by: C (a) Leave default values of LiMAX and NLiMAX. C (b) Choose initial values of N1,N2,N3 which satisfy C N1*N2*N3=MRAM/4/LiMAX**(2*ITER-4) C in 2-D, or C N1*N2*N3=MRAM/5/LiMAX**(3*ITER-6) C in 3-D, where MRAM is declared in C ram.inc. C Number ITER of iterations is now just an estimation. C (c) If ITER.LE.2, increase ITER by decreasing Ni, or C choose maximum initial values of N1,N2,N3 which fit C in the memory according to the description in C net.inc). C For more details, refer to the considerations in C netfv.htm. C Defaults: NL1MAX=0, NL2MAX=0, NL3MAX=0. C C C Structure of input data files NET1, NET2, NET3: C Sequential files, read by list directed (free format) input, C containing model parameters, source/receiver coordinates, and C names of other input and output files for the 'net.for' program. C In the list of input data below, each numbered paragraph indicates C the beginning of a new input operation (new READ statement). C 'ITEMS' in the list of input variables enclosed in apostrophes C represent character strings enclosed in apostrophes. Otherwise, C if the first letter of the symbolic name in the list of input C variables is I-N, the corresponding value in input data is C integer, otherwise, the input parameter is of the type real. C / in the list of input variables indicates an obligatory slash. C The slash may also be used instead of default values. C (1) 'SRC','REC','RAYS','END',/ C 'SRC'...Name of the input file with source coordinates. C Description of input data SRC C 'REC'...Name of the input file with receiver coordinates. C If blank, no rays are stored within the file 'RAYS'. C Description of input data REC C 'RAYS'..Name of the output file with rays. C If blank, no rays are stored within the file 'RAYS'. C Description of data RAYS C 'END'...Name of the output file with endpoints of rays (receiver C coordinates, receiver arrival times, and estimates of the C corresponding maximum travel-time errors. C If blank, no file 'END' is generated. C Description of data END C Default: 'REC'=' ', 'RAYS'=' ', 'END'=' '. C NET1: Files SRC and END are input files for program NETIND. C NET2: Files SRC and REC from NET1 must be swopped. C NET3: This line is skipped. C (2) NREFL,/ C NREFL...Number of reflections. C Default: NREFL=0. C NET1, NET2 and NET3 must have the same NREFL. C (3) Once (3.1), then NREFL-times (3.2) and (3.1): C (3.1) 'IND(I)','VEL(I)','ICB(I)','TT(I)','ERR(I)','PRED(I)','NFS(I)',/ C 'IND(I)'... Name of the index file, specifying for each C big brick if its gridpoints belong to the network. C If it is blank, the default indexing is assumed. C Must not be blank if (L1.GT.1.OR.L2.GT.1.OR.L3.GT.1) at C input SEP file. C Description of data IND(I) C 'VEL(I)'... Name of the input file containing velocities at all C network nodes, for I-times reflected wave. C Has always to be specified. C Description of data VEL(I) C 'ICB(I)'... Name of the input file containing indices of C (geological) blocks. For more detail refer to the C description of this item in program C 'net.for'. C Description of data ICB(I) C 'TT(I)'... Name of the file containing travel-times at all C network nodes after I reflections. C Description of data TT(I) C 'ERR(I)'... Name of the output file containing estimated upper C bounds for the errors of the computed travel-times at all C network nodes after I reflections. C Description of data ERR(I) C 'PRED(I)'... Name of the file containing predecessors of C all network nodes after I reflections. C May be blank for most applications. C Description of data PRED(I) C 'NFS(I)'... Unimportant file. Refer to the description in C 'net.for'. C Default: 'IND(I)'=' ', 'VEL(I)'=' ', 'ICB(I)'=' ', C 'TT(I)'=' ','ERR(I)'=' ', 'PRED(I)'=' ', 'NFS(I)'=' '. C NET1 and NET2: Files IND(I), VEL(I) and ICB(I) must be the same C for each I. Files IND(I) may be blank. C NET1: Files TT(I) are the input files for program NETIND. C NET2: Files TT(I) are the input files for program NETIND. C NET3: Files IND(I) are the output files of program NETIND. C (3.2) 'INTF(I)',/ C 'INTF(I)'... Name of the input file containing refractor points. C Description of data INTF(I) C NET1, NET2 and NET3: This line is skipped. C Example of data set NET1 C Example of data set NET2 C Example of data set NET3 C C----------------------------------------------------------------------- C PROGRAM NETIND C INCLUDE 'ram.inc' C ram.inc INTEGER IRAM(MRAM) EQUIVALENCE (RAM,IRAM) C C....................................................................... C CHARACTER*80 FSEP,FNET1,FNET2,FNET3,FSRC,FEND,FIND,FTT1,FTT2,FOUT CHARACTER*80 FRAYS,FEND3 CHARACTER*80 FVEL1,FICB1,FIND2,FVEL2,FICB2,FERR,FPRED,FNFS CHARACTER*60 LINE CHARACTER*1 FAUX INTEGER LU1,LU2 PARAMETER (LU1=1,LU2=2) INTEGER MSMALL,NREFL,IREFL INTEGER N1,N2,N3,L1,L2,L3,L4,L1234,NBIG,IBIG,NPOS,IPOS,IADR INTEGER L1MAX,L2MAX,L3MAX INTEGER ISRC,ISRC1,ISRC2,ISRC3,IREC,IREC1,IREC2,IREC3 INTEGER IN1,IN2,IN3,IL1,IL2,IL3,I,J REAL D1,D2,D3,O1,O2,O3 REAL X1MIN,X1MAX,X2MIN,X2MAX,X3MIN,X3MAX,TTMAX REAL AUX1,AUX2,AUX3,AUX4,AUX5,AUX6 C C FNET1,FNET2,FNET3... Main input and output files. C FSRC,FEND,FIND,FTT1,FTT2,FOUT... Other input and output files. C FVEL1,FICB1,FIND2,FVEL2,FICB2,FAUX... Temporary filenames or text C strings. C LU1,LU2... Input-output logical unit numbers used for different C files. C MSMALL..Maximum number of the small bricks within the Fresnel C volume. C NREFL...Number of reflections. NREFL=0 for a refracted wave. C IREFL...Loop variable over reflections. IREFL=0 for a refracted C wave. C N1,N2,N3... Numbers of big bricks along gridlines. C L1,L2,L3... Numbers small bricks within a big brick. C L4... Input: Number of big bricks belonging to the network, C i.e. length of the travel-time files. C Output: Number of small bricks belonging to the Fresnel C volume. C L1234...L1*L2*L3*L4 for input values. C NBIG... Number of big bricks, i.e. length of the input index file, C NBIG=N1*N2*N3. C IBIG... Index of a big brick (IBIG=1,2,...,NBIG). C NPOS... Number of small bricks, i.e. length of the output index C file: NPOS=N1*N2*N3*L1*L2*L3. C IPOS... Index of a small brick (IPOS=1,2,...,NPOS). C IADR... Index within a travel time file or within a Fresnel volume C (IADR=1,2,3,...,L4 or IADR=0). C L1MAX,L2MAX,L3MAX... Maximum numbers of output small bricks in an C output big brick. C ISRC,ISRC1,ISRC2,ISRC3,IREC,IREC1,IREC2,IREC3... Positions of the C source and receiver small bricks. C IN1,IN2,IN3,IL1,IL2,IL3,I... Loop and temporary variables. C X1MIN,X1MAX,X2MIN,X2MAX,X3MIN,X3MAX ... Boundaries of the model C volume. C TTMAX...Maximum sum of travel times, limiting the Fresnel volume. C AUX1,AUX2,AUX3,AUX4,AUX5,AUX6... Temporary storage locations. C C....................................................................... C C Reading main input data from the * external unit: FSEP= 'net.h' FNET1='net1.dat' FNET2='net2.dat' FNET3='net3.dat' WRITE(*,'(2A)') '+NETIND: Enter 4 input filenames', * ' [''net.h'' ''net1.dat'' ''net2.dat'' ''net3.dat'']: ' READ(*,*) FSEP,FNET1,FNET2,FNET3 C FSEP,FNET1,FNET2,FNET3 are input/output data files. C C....................................................................... C C Loop over reflections IREFL=0 10 CONTINUE C C....................................................................... C C Reading input SEP parameter file: CALL RSEP1(LU1,FSEP) C CALL RSEP3I('NFSMAX',NFSMAX,0) IF(NFSMAX.LT.0) THEN C NETIND-03 CALL ERROR * ('NETIND-03: Second-order method is not supported now') C Present coding of the second-order method (NFSMAX.LT.0) does not C trace rays and does not include error estimation, which prevents C determination of Fresnel volumes. END IF C C Reading the 1-st input file NET1 for the NET program: OPEN(LU1,FILE=FNET1,STATUS='OLD') C (1) names of the files with source, receivers, rays, and errors: FEND=' ' READ(LU1,*) FSRC,FAUX,FAUX,FEND IF(FEND.EQ.' ') THEN C NETIND-01 CALL ERROR * ('NETIND-01: Name of file with times at receivers missing') END IF C (2) number of reflections: NREFL=0 READ(LU1,*) NREFL C (3) names of the output travel-time and predecessor files, C input velocity and index files, and input refractor-point files: DO 11 I=0,IREFL IF(I.GT.0) THEN READ(LU1,*) FAUX END IF FIND=' ' FVEL1=' ' FICB1=' ' FTT1=' ' READ(LU1,*) FIND,FVEL1,FICB1,FTT1,FAUX,FAUX,FAUX 11 CONTINUE IF(FIND.EQ.' ') THEN IF(L1.GT.1.OR.L2.GT.1.OR.L3.GT.1) THEN C NETIND-02 CALL ERROR('NETIND-02: No index file specified') END IF END IF CLOSE(LU1) C End of reading the 1-st main input data file. C FSRC and FEND are the source and endpoint (receiver) filenames. C NREFL is the number of reflections. C FTT1 is the input travel-time file, with times from the source. C FIND is the input index file. C C Reading the 2-nd input file NET2 for the NET program: OPEN(LU1,FILE=FNET2,STATUS='OLD') C (1) Names of the files with source, receivers, rays, and errors: READ(LU1,*) FAUX,FAUX,FAUX,FAUX C (2) Number of reflections: I=0 READ(LU1,*) I IF(I.NE.NREFL) THEN C NETIND-04 CALL ERROR('NETIND-04: Different number of reflections in NET2') END IF C (3) Names of the output travel-time and predecessor files, C input velocity and index files, and input refractor-point files: DO 12 I=0,NREFL-IREFL IF(I.GT.0) THEN READ(LU1,*) FAUX END IF FIND2=' ' FVEL2=' ' FICB2=' ' FTT2=' ' READ(LU1,*) FIND2,FVEL2,FICB2,FTT2,FAUX,FAUX,FAUX 12 CONTINUE IF(FIND.NE.FIND2) THEN C NETIND-05 CALL ERROR('NETIND-05: Different input index files') END IF IF(FVEL1.NE.FVEL2) THEN C NETIND-06 CALL ERROR('NETIND-06: Different velocity files') END IF IF(FICB1.NE.FICB2) THEN C NETIND-07 CALL ERROR('NETIND-07: Different block files') END IF CLOSE(LU1) C End of reading the 2-nd main input data file. C FTT2 is the input travel-time file, with times from the receiver. C C Reading the 3-rd input file NET3 for the NET program: OPEN(LU1,FILE=FNET3,STATUS='OLD') C (1) Names of the files with source, receivers, rays, and errors: FRAYS=' ' FEND3=' ' READ(LU1,*) FAUX,FAUX,FRAYS,FEND3 C (2) Number of reflections: I=0 READ(LU1,*) I IF(I.NE.NREFL) THEN C NETIND-08 CALL ERROR('NETIND-08: Different number of reflections in NET3') END IF C (3) Names of the output travel-time and predecessor files, C input velocity and index files, and input refractor-point files: DO 13 I=0,IREFL IF(I.GT.0) THEN READ(LU1,*) FAUX END IF FOUT=' ' FICB1=' ' FERR=' ' FPRED=' ' FNFS=' ' READ(LU1,*) FOUT,FAUX,FICB1,FAUX,FERR,FPRED,FNFS 13 CONTINUE CLOSE(LU1) C End of reading the 3-rd main input data file. C FOUT is the output index file. C C Numbers of gridpoints: CALL RSEP3I('N1',N1,1) CALL RSEP3I('N2',N2,1) CALL RSEP3I('N3',N3,1) CALL RSEP3I('L1',L1,1) CALL RSEP3I('L2',L2,1) CALL RSEP3I('L3',L3,1) IF(N1.LT.1.OR.N2.LT.1.OR.N3.LT.1.OR. * L1.LT.1.OR.L2.LT.1.OR.L3.LT.1) THEN C NETIND-09 CALL ERROR('NETIND-09: Number of gridpoints is not positive') END IF C Boundaries of the model volume: CALL RSEP3R('D1',D1,1.) CALL RSEP3R('D2',D2,1.) CALL RSEP3R('D3',D3,1.) CALL RSEP3R('O1',O1,0.) CALL RSEP3R('O2',O2,0.) CALL RSEP3R('O3',O3,0.) X1MIN=O1-0.5*D1 X2MIN=O2-0.5*D2 X3MIN=O3-0.5*D3 X1MAX=X1MIN+FLOAT(N1)*D1 X2MAX=X2MIN+FLOAT(N2)*D2 X3MAX=X3MIN+FLOAT(N3)*D3 C Input grid has N1*N2*N3 big bricks by L1*L2*L3 small bricks. C Boundaries of model volume: X1MIN,X1MAX,X2MIN,X2MAX,X3MIN,X3MAX. C Total number of big bricks NBIG=N1*N2*N3 C Total number of small bricks (i.e. of gridpoints) NPOS=NBIG*L1*L2*L3 IF(NPOS.GT.MRAM) THEN C NETIND-10 CALL ERROR * ('NETIND-10: Too many gridpoints to be stored in array IND') END IF C C Maximum numbers of small bricks inside a big brick: CALL RSEP3I('L1MAX',L1MAX,2) CALL RSEP3I('L2MAX',L2MAX,2) CALL RSEP3I('L3MAX',L3MAX,2) C Output big brick may have at most L1MAX*L2MAX*L3MAX small bricks. C (0 means no limitation) C C Maximum density of the gridpoints: CALL RSEP3I('NL1MAX',NL1MAX,0) CALL RSEP3I('NL2MAX',NL2MAX,0) CALL RSEP3I('NL3MAX',NL3MAX,0) C C FSEP is the name of the SEP parameter file to be updated. C C....................................................................... C C Reading coordinates of the source point from 'src': WRITE(*,'(2A)') '+NETIND: Reading source file: ',FSRC(1:48) OPEN(LU1,FILE=FSRC) READ(LU1,*) (FAUX,I=1,20) TTMAX=0. AUX5=0. READ(LU1,*) FAUX,AUX1,AUX2,AUX3,TTMAX,AUX5 TTMAX=TTMAX-AUX5 C TTERR=-AUX5 CLOSE(LU1) AUX4=(X1MAX-X1MIN)/(1000.*FLOAT(N1*L1)) AUX5=(X2MAX-X2MIN)/(1000.*FLOAT(N2*L2)) AUX6=(X3MAX-X3MIN)/(1000.*FLOAT(N3*L3)) CALL POSX(AUX1-AUX4,X1MIN,X1MAX,N1*L1,IN1) CALL POSX(AUX1+AUX4,X1MIN,X1MAX,N1*L1,IL1) CALL POSX(AUX2-AUX5,X2MIN,X2MAX,N2*L2,IN2) CALL POSX(AUX2+AUX5,X2MIN,X2MAX,N2*L2,IL2) CALL POSX(AUX3-AUX6,X3MIN,X3MAX,N3*L3,IN3) CALL POSX(AUX3+AUX6,X3MIN,X3MAX,N3*L3,IL3) ISRC=1+IN1+(IN2+IN3*N2*L2)*N1*L1 ISRC1= IL1-IN1 ISRC2=(IL2-IN2)*N1*L1 ISRC3=(IL3-IN3)*N2*L2*N1*L1 C Source point is situated in the ISRC-th small brick, C or in small bricks shifted by ISRC1 and/or ISRC2 and/or ISRC3. C C Reading coordinates of the receiver point and time from 'END': WRITE(*,'(2A)') '+NETIND: Reading endpoint file: ',FEND(1:48) OPEN(LU1,FILE=FEND) READ(LU1,*) (FAUX,I=1,20) AUX5=0. READ(LU1,*) FAUX,AUX1,AUX2,AUX3,AUX4,AUX5 TTMAX=TTMAX+AUX4+AUX5 C TTERR=TTERR+AUX5 CLOSE(LU1) AUX4=(X1MAX-X1MIN)/(1000.*FLOAT(N1*L1)) AUX5=(X2MAX-X2MIN)/(1000.*FLOAT(N2*L2)) AUX6=(X3MAX-X3MIN)/(1000.*FLOAT(N3*L3)) CALL POSX(AUX1-AUX4,X1MIN,X1MAX,N1*L1,IN1) CALL POSX(AUX1+AUX4,X1MIN,X1MAX,N1*L1,IL1) CALL POSX(AUX2-AUX5,X2MIN,X2MAX,N2*L2,IN2) CALL POSX(AUX2+AUX5,X2MIN,X2MAX,N2*L2,IL2) CALL POSX(AUX3-AUX6,X3MIN,X3MAX,N3*L3,IN3) CALL POSX(AUX3+AUX6,X3MIN,X3MAX,N3*L3,IL3) IREC=1+IN1+(IN2+IN3*N2*L2)*N1*L1 IREC1= IL1-IN1 IREC2=(IL2-IN2)*N1*L1 IREC3=(IL3-IN3)*N2*L2*N1*L1 C Receiver point is situated in the IREC-th small brick, C or in small bricks shifted by irec1 and/or IREC2 and/or IREC3. C TTMAX is maximum sum of travel times, limiting the Fresnel volume. C C READING INPUT INDEX FILE (DEFAULT: 1,2,3,4,...): WRITE(*,'(2A)') '+NETIND: Reading input index file: ',FIND(1:45) DO 21 IBIG=1,NBIG IRAM(IBIG)=IBIG 21 CONTINUE IF(FIND.NE.' ') THEN OPEN(LU1,FILE=FIND) READ(LU1,*) (IRAM(IBIG),IBIG=1,NBIG) CLOSE(LU1) END IF C C Number of bricks covered by the network: C Big bricks: L4=0 DO 22 IBIG=1,NBIG L4=MAX0(IRAM(IBIG),L4) 22 CONTINUE C Small bricks (number of travel times to be read in): L1234=L1*L2*L3*L4 C C Upgrading small bricks to big bricks (updating 'index file'): WRITE(*,'(A)') * '+NETIND: Updating index file... ' IPOS=NPOS+1 DO 36 IN3=N3-1,0,-1 DO 35 IL3=L3-1,0,-1 DO 34 IN2=N2-1,0,-1 DO 33 IL2=L2-1,0,-1 DO 32 IN1=N1,1,-1 IADR=IRAM(IN1+N1*(IN2+N2*IN3)) DO 31 IL1=L1-1,0,-1 IPOS=IPOS-1 IF(IADR.LE.0) THEN IRAM(IPOS)=0 ELSE IRAM(IPOS)=IL1+L1*(IL2+L2*(IL3+L3*IADR-L3))+1 END IF 31 CONTINUE 32 CONTINUE 33 CONTINUE 34 CONTINUE 35 CONTINUE 36 CONTINUE C C Reading travel times: IF(NPOS+2*L1234.GT.MRAM) THEN C NETIND-11 CALL ERROR * ('NETIND-11: Too many network nodes with given travel time') END IF WRITE(*,'(2A)') '+NETIND: Reading travel time field: ',FTT1(1:44) OPEN(LU1,FILE=FTT1) READ(LU1,*) (RAM(IADR),IADR=NPOS+1,NPOS+L1234) CLOSE(LU1) WRITE(*,'(2A)') '+NETIND: Reading travel time field: ',FTT2(1:44) OPEN(LU1,FILE=FTT2) READ(LU1,*) (RAM(IADR),IADR=NPOS+L1234+1,NPOS+2*L1234) CLOSE(LU1) C C Converting 'index file' into 'Fresnel volume index file': WRITE(*,'(A)') * '+NETIND: Labeling the Fresnel volume... ' L4=0 DO 41 IPOS=1,NPOS IADR=IRAM(IPOS) IRAM(IPOS)=0 IF(IADR.GT.0) THEN IF(RAM(NPOS+IADR)+RAM(NPOS+L1234+IADR).LE.TTMAX * .OR.IPOS.EQ.ISRC.OR.IPOS.EQ.IREC) THEN L4=L4+1 IRAM(IPOS)=L4 IF(IPOS.EQ.ISRC) THEN IF(ISRC1.LE.0.AND.ISRC2.LE.0) THEN ISRC=ISRC+ISRC3 ISRC3=-ISRC3 END IF IF(ISRC1.LE.0) THEN ISRC=ISRC+ISRC2 ISRC2=-ISRC2 END IF ISRC=ISRC+ISRC1 ISRC1=-ISRC1 END IF IF(IPOS.EQ.IREC) THEN IF(IREC1.LE.0.AND.IREC2.LE.0) THEN IREC=IREC+IREC3 IREC3=-IREC3 END IF IF(IREC1.LE.0) THEN IREC=IREC+IREC2 IREC2=-IREC2 END IF IREC=IREC+IREC1 IREC1=-IREC1 END IF END IF END IF 41 CONTINUE C C Writing Fresnel volume index file: WRITE(*,'(2A)') '+NETIND: Writing output index file: ',FOUT(1:44) OPEN(LU1,FILE=FOUT) WRITE(LU1,'(10I8)') (IRAM(IPOS),IPOS=1,NPOS) CLOSE(LU1) C C....................................................................... C IREFL=IREFL+1 IF(IREFL.LE.NREFL) GO TO 10 C End of loop for reflections C C....................................................................... C C New number of big bricks (N1*N2*N3): N1=N1*L1 N2=N2*L2 N3=N3*L3 IF(N1*N2*N3.GT.MRAM) THEN C NETIND-51 CALL WARN * ('NETIND-51: New big bricks are too small to fit in memory') END IF C C Calculating next memory requirements of 'net.for': IF(NFSMAX.GE.0) THEN C Network ray tracing: IF(FICB1.EQ.' ') THEN M1ICB=0 ELSE M1ICB=1 END IF IF(FPRED.EQ.' '.AND. * FERR.EQ.' '.AND.FRAYS.EQ.' '.AND.FEND3.EQ.' ') THEN M1PRED=0 ELSE M1PRED=1 END IF IF(FNFS.EQ.'*') THEN M1NFS=-1 ELSE M1NFS=0 END IF ELSE C Second-order grid travel-time tracing: M1ICB=0 M1PRED=0 M1NFS=0 END IF C C New number of small bricks (L1*L2*L3): MSMALL=(MRAM-N1*N2*N3)/(4+M1ICB+M1PRED+M1NFS) AUX1=FLOAT(MSMALL/L4) IF(N1.EQ.1.OR.N2.EQ.1.OR.N3.EQ.1) THEN L0=INT(SQRT(AUX1)) ELSE L0=INT(AUX1**0.333333) END IF L1=L0 L2=L0 L3=L0 IL1=2 IL2=2 IL3=2 IF(N1.EQ.1) THEN L1=1 IL1=1 END IF IF(N2.EQ.1) THEN L2=1 IL2=1 END IF IF(N3.EQ.1) THEN L3=1 IL3=1 END IF IF((N1*N2*N3+(4+M1ICB+M1PRED+M1NFS)*L4)*IL1*IL2*IL3.LE.MRAM) THEN C L1MAX, L2MAX and L3MAX do not apply to the last iteration IF(L1MAX.GT.0) THEN L1=MIN0(L1,L1MAX) END IF IF(L2MAX.GT.0) THEN L2=MIN0(L2,L2MAX) END IF IF(L3MAX.GT.0) THEN L3=MIN0(L3,L3MAX) END IF END IF IF(NL1MAX.GT.0) THEN L1=MIN0(L1,NL1MAX/N1) END IF IF(NL2MAX.GT.0) THEN L2=MIN0(L2,NL2MAX/N2) END IF IF(NL3MAX.GT.0) THEN L3=MIN0(L3,NL3MAX/N3) END IF C C New grid dimensions: D1=(X1MAX-X1MIN)/FLOAT(N1) D2=(X2MAX-X2MIN)/FLOAT(N2) D3=(X3MAX-X3MIN)/FLOAT(N3) O1=X1MIN+0.5*D1 O2=X2MIN+0.5*D2 O3=X3MIN+0.5*D3 C C Updating SEP history file: OPEN(LU1,FILE=FSEP) C Searching for the end of file 90 CONTINUE READ(LU1,'(A)',END=91) GO TO 90 91 CONTINUE C Appending new grid dimensions WRITE(LU1,'(A)') '# netind:' CALL WSEPI(LINE( 1:20),'N1',N1) CALL WSEPI(LINE(21:40),'N2',N2) CALL WSEPI(LINE(41:60),'N3',N3) WRITE(LU1,'(A)') LINE CALL WSEPI(LINE( 1:20),'L1',L1) CALL WSEPI(LINE(21:40),'L2',L2) CALL WSEPI(LINE(41:60),'L3',L3) WRITE(LU1,'(A)') LINE CALL WSEPR(LINE( 1:20),'D1',D1) CALL WSEPR(LINE(21:40),'D2',D2) CALL WSEPR(LINE(41:60),'D3',D3) WRITE(LU1,'(A)') LINE CALL WSEPR(LINE( 1:20),'O1',O1) CALL WSEPR(LINE(21:40),'O2',O2) CALL WSEPR(LINE(41:60),'O3',O3) WRITE(LU1,'(A)') LINE WRITE(LU1,'(A)') '# netind.' WRITE(LU1,'(A)') CLOSE(LU1) C C Screen output: WRITE(*,'(A,I6,A,I7,A,3(I3,A),3(I7,A))') * '+',L4,' of',N1*N2*N3,' big bricks,',L1,'*',L2,'*',L3,'*',L4, * '=',L1*L2*L3*L4,' of',MSMALL,' small bricks' WRITE(*,'(A)') ' in Fresnel volume.' C C End of computation: IF((N1.GT.1.AND.NL1MAX.GT.0.AND.2*N1*L1.GT.NL1MAX).OR. * (N2.GT.1.AND.NL2MAX.GT.0.AND.2*N2*L2.GT.NL2MAX).OR. * (N3.GT.1.AND.NL3MAX.GT.0.AND.2*N3*L3.GT.NL3MAX)) THEN WRITE(*,'(2A)') '+NETIND: *** One more iteration only -', * ' smaller bricks are not permitted ***' ELSE IF(N1*N2*N3*L1*L2*L3.GT.MRAM) THEN WRITE(*,'(2A)') '+NETIND: *** One more iteration only -', * ' more big bricks cannot fit in RAM ***' END IF IF(L0.LE.1) THEN C NETIND-52 CALL WARN * ('NETIND-52: Big bricks cannot be divided into small bricks') ELSE IF(L1.LE.1.AND.L2.LE.1.AND.L3.LE.1) THEN C NETIND-53 CALL WARN * ('NETIND-53: Big bricks will not be divided into small bricks') END IF WRITE(*,'(A)') * ' NETIND: Done. ' STOP END C C======================================================================= C SUBROUTINE POSX(X,XMIN,XMAX,NLX,IX) C C Subroutine determining the grid interval along the axis. C C Input: C X... A coordinate of a given point. C XMIN,XMAX... Limits of the grid line. C NLX... The grid line is divided into n1*l1 grid intervals. C C Output: C IX... The given point lies in the ix-th grid interval. C C Date: 1993, October 18 C coded by: Ludek Klimes C C----------------------------------------------------------------------- C C No auxiliary storage locations. C IF(NLX.EQ.1) THEN IX=0 ELSE IX=INT(FLOAT(NLX)*(X-XMIN)/(XMAX-XMIN)) IF(IX.LT.0.OR.NLX.LT.IX) THEN C NETIND-12 CALL ERROR * ('NETIND-12: Source or receiver point outside the model') ELSE IF(IX.GE.NLX) THEN IX=NLX-1 END IF END IF RETURN END C C======================================================================= C INCLUDE 'error.for' C error.for INCLUDE 'sep.for' C sep.for INCLUDE 'length.for' C length.for * INCLUDE 'forms.for' C forms.for C C======================================================================= Cfv/fv.pl 100666 1750 1750 5602 6617212246 11531 0 ustar klimes klimes #!perl #
# # Perl script 'fv.pl' to perform network ray tracing in Fresnel volumes # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Usage: # perl fv.pl $- # Parameters: # $-... Prefix of the input data files. # Input files required: # $-gri1.dat, $-net1.dat, $-net2.dat, # $-gri3.dat, $-net3.dat, $-net4.dat, $-net.h and files referred # from them. # First 3 files correspond to the first iteration, # latter 3 files correspond to all subsequent iterations. # Inside all these files $-net.out, which will be created of # $-net.h, has to be referred as the SEP parameter file describing # the grid dimensions and numerical parameters. # Note: # After each network ray tracing from the 1st (source) point to the # 2nd (receiver) point, you may Quit the iterations. Consecutive # network ray tracing in the opposite is not required during the # last iteration, which may be reported by program 'netind.for' or # indicated by a user. # ====================================================================== # Input files required: $PREFIX=$ARGV[0]; @ARGV=(); require 'go.pl' ; # &CHK("net/" ,"net.fs2" ); # just in 2-D # &CHK("net/" ,"net.fs3" ); # just in 3-D &CHK("net/fv/","${PREFIX}gri1.dat"); &CHK("net/fv/","${PREFIX}net1.dat"); &CHK("net/fv/","${PREFIX}net2.dat"); &CHK("net/fv/","${PREFIX}gri3.dat"); &CHK("net/fv/","${PREFIX}net3.dat"); &CHK("net/fv/","${PREFIX}net4.dat"); &CHK("net/fv/","${PREFIX}net.h" ); # &CHK("net/fv/","${PREFIX}src.dat" ); # or whatever is referred # &CHK("net/fv/","${PREFIX}rec.dat" ); # or whatever is referred # &CHK("net/fv/","vgr-mod.dat" ); # or whatever is referred # # Copy file $-net.h to $-net.out: ©("${PREFIX}net.h","${PREFIX}net.out"); # # First iteration: &RUN("grid" ,"'${PREFIX}net.out' '${PREFIX}gri1.dat' /"); &ECHO( ">>${PREFIX}net.out"," NET='${PREFIX}net1.dat'"); &RUN("net" ,"'${PREFIX}net.out' /"); &ECHO( ">>${PREFIX}net.out"," NET='${PREFIX}net2.dat'"); &RUN("net" ,"'${PREFIX}net.out' /"); &RUN("netind","'${PREFIX}net.out' '${PREFIX}net1.dat' '${PREFIX}net2.dat' '${PREFIX}net3.dat' /"); # # Next iterations: FV: &RUN("grid" ,"'${PREFIX}net.out' '${PREFIX}gri3.dat' /"); &ECHO( ">>${PREFIX}net.out"," NET='${PREFIX}net3.dat'"); &RUN("net" ,"'${PREFIX}net.out' /"); print "Type Q[uit] to terminate iterations, RETURN to continue: "; $ans=fv/fv-net.h 100666 1750 1750 4234 6611776252 12137 0 ustar klimes klimes # History file 'fv.h' to perform network ray tracing in Fresnel volumes # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Input files required: #chk.pl: "net/" "net.fs3" #chk.pl: "net/fv/" "fv-gri1.dat" #chk.pl: "net/fv/" "fv-net1.dat" #chk.pl: "net/fv/" "fv-net2.dat" #chk.pl: "net/fv/" "fv-gri3.dat" #chk.pl: "net/fv/" "fv-net3.dat" #chk.pl: "net/fv/" "fv-net4.dat" #chk.pl: "net/fv/" "fv-net.h" #chk.pl: "net/fv/" "fv-src.dat" #chk.pl: "net/fv/" "fv-rec.dat" #chk.pl: "net/fv/" "vgr-mod.dat" # Model: MODEL='vgr-mod.dat' # Initial grid dimensions: N1=25 N2=20 N3=25 D1=0.040 D2=0.040 D3=0.040 O1=0.020 O2=0.120 O3=0.020 # Maximum grid density (4 iterations, i.e. NLiMAX=Ni*2**4): NL1MAX=200 NL2MAX=160 NL3MAX=200 # This density would require MRAM=200*160*200*5, which corresponds to # 128MB RAM, for a single run of 'net.for' without iterations. # Moreover, MRAM=4000000, which needs 16MB RAM, is sufficient for a grid # twice denser in each direction, which would otherwise require 1GB RAM. # Numerical parameters for the NET program: NFSMAX=0 # Running the programs # ~~~~~~~~~~~~~~~~~~~~ # The same calculation may be performed by executing this history file: # perl go.pl fv-net.h fv-net.out # or by running Perl script 'fv.pl' with data prefix 'fv-': # perl fv.pl fv- # and quitting it during the fourth iteration. The former approach, # with the a priori known number of iterations, is recommended. # First iteration: grid: 'fv-net.h' 'fv-gri1.dat' / NET='fv-net1.dat' net: 'fv-net.h' / NET='fv-net2.dat' net: 'fv-net.h' / netind: 'fv-net.h' 'fv-net1.dat' 'fv-net2.dat' 'fv-net3.dat' / # Next iteration: grid: 'fv-net.h' 'fv-gri3.dat' / NET='fv-net3.dat' net: 'fv-net.h' / NET='fv-net4.dat' net: 'fv-net.h' / netind: 'fv-net.h' 'fv-net3.dat' 'fv-net4.dat' 'fv-net3.dat' / # Next iteration: grid: 'fv-net.h' 'fv-gri3.dat' / NET='fv-net3.dat' net: 'fv-net.h' / NET='fv-net4.dat' net: 'fv-net.h' / netind: 'fv-net.h' 'fv-net3.dat' 'fv-net4.dat' 'fv-net3.dat' / # Last iteration: grid: 'fv-net.h' 'fv-gri3.dat' / NET='fv-net3.dat' net: 'fv-net.h' / fv/vgr-mod.dat 100666 1750 1750 1327 6416564450 12632 0 ustar klimes klimes 'Constant Velocity GRadient model.' 0 1 1 / (Cartesian coordinates, velocities, loss factors) 0 1 0 1 0 1 / (boundaries of the model) 0 surfaces 1 simple block: / (bounded by no interface) 1 complex block: 1 / (list of simple blocks) 'END of surfaces' / (no data for surfaces) 'COMPLEX BLOCK' 1 'VP ' 1 (P wave velocity) 3 0 0 0 / (i.e. VP=W(X3), tension=0) 2 (numbers of grid points) 0 1 (X3 grid coordinates) 3 1 (velocities at grid points) 'END of complex blocks, end of the input data for the model' / ======================================================================== fv/fv-gri1.dat 100666 1750 1750 30 6602575614 12461 0 ustar klimes klimes ' ' 'fv-vel.out' ' '/ / fv/fv-net1.dat 100666 1750 1750 143 6602575650 12513 0 ustar klimes klimes 'fv-src.dat' 'fv-rec.dat' 'fv-rays1.out' 'fv-end1.out' / / ' ' 'fv-vel.out' ' ' 'fv-tt1.out' ' ' / fv/fv-net2.dat 100666 1750 1750 143 6602575650 12514 0 ustar klimes klimes 'fv-rec.dat' 'fv-src.dat' 'fv-rays2.out' 'fv-end2.out' / / ' ' 'fv-vel.out' ' ' 'fv-tt2.out' ' ' / fv/fv-gri3.dat 100666 1750 1750 41 6602575574 12472 0 ustar klimes klimes 'fv-ind.out' 'fv-vel.out' ' '/ / fv/fv-net3.dat 100666 1750 1750 154 6602575652 12521 0 ustar klimes klimes 'fv-src.dat' 'fv-rec.dat' 'fv-rays1.out' 'fv-end1.out' / / 'fv-ind.out' 'fv-vel.out' ' ' 'fv-tt1.out' ' ' / fv/fv-net4.dat 100666 1750 1750 154 6602575650 12520 0 ustar klimes klimes 'fv-rec.dat' 'fv-src.dat' 'fv-rays2.out' 'fv-end2.out' / / 'fv-ind.out' 'fv-vel.out' ' ' 'fv-tt2.out' ' ' / fv/fv-src.dat 100666 1750 1750 36 5526303470 12405 0 ustar klimes klimes / 'POINT1' 0.00 0.25 1.00 / / fv/fv-rec.dat 100666 1750 1750 110 6270550714 12402 0 ustar klimes klimes / 'POINT2' 1.00 0.75 0.50 / Exact travel time from 'POINT1': 0.783400 / len/ 40777 1750 1750 0 6613213032 10612 5 ustar klimes klimes len/len-net.h 100666 1750 1750 665 6611776256 12435 0 ustar klimes klimes # Model: MODEL='model.dat' # Grid dimensions: In the paper: N1=60 N2=40 N3=30 # N1=120 N2=80 N3=60 D1=1.0 D2=1.0 D3=1.0 # D1=0.5 D2=0.5 D3=0.5 O1=0.5 O2=-19.5 O3=-24.5 # O1=0.25 O2=-19.75 O3=-24.75 # List of input and output filenames: NET='len-net.dat' # Numerical parameters: NFSMAX=0 # Programs to run: grid: 'len-net.h' 'len-grid.dat' / net: 'len-net.h' / len/len-grid.dat 100666 1750 1750 44 6603046422 13046 0 ustar klimes klimes ' ' 'len-vel.out' 'len-icb.out' / / len/len-net.dat 100666 1750 1750 222 6614233442 12727 0 ustar klimes klimes 'lenn-src.dat' 'lenn-rec.dat' 'len-rays.out' 'len-end.out' / (points,rays) / ' ' 'len-vel.out' 'len-icb.out' 'len-tt.out' 'len-err.out' / (grids) len/lenn-src.dat 100666 1750 1750 73 6270550732 13074 0 ustar klimes klimes / ' ' 30. 5. -20. / (3 coordinates of the source point) / len/lenn-rec.dat 100666 1750 1750 3752 6270550724 13126 0 ustar klimes klimes 'Receiver coordinates, exact travel time' ' X1 X2 X3 TT ' / ' ' 1.000 -5.672 3.062 / 7.583 ' ' 2.000 -5.349 3.122 / 7.420 ' ' 3.000 -5.021 3.181 / 7.259 ' ' 4.000 -4.688 3.237 / 7.102 ' ' 5.000 -4.349 3.289 / 6.947 ' ' 6.000 -4.004 3.337 / 6.795 ' ' 7.000 -3.655 3.379 / 6.646 ' ' 8.000 -3.302 3.414 / 6.500 ' ' 9.000 -2.945 3.443 / 6.359 ' ' 10.000 -2.586 3.462 / 6.221 ' ' 11.000 -2.225 3.473 / 6.087 ' ' 12.000 -1.864 3.474 / 5.959 ' ' 13.000 -1.502 3.463 / 5.835 ' ' 14.000 -1.141 3.440 / 5.716 ' ' 15.000 -0.783 3.405 / 5.603 ' ' 16.000 -0.429 3.355 / 5.495 ' ' 17.000 -0.080 3.291 / 5.393 ' ' 18.000 0.264 3.211 / 5.296 ' ' 19.000 0.608 3.114 / 5.205 ' ' 20.000 0.953 3.000 / 5.117 ' ' 21.000 1.302 2.868 / 5.032 ' ' 22.000 1.655 2.720 / 4.950 ' ' 23.000 2.015 2.558 / 4.872 ' ' 24.000 2.384 2.384 / 4.796 ' ' 25.000 2.764 2.202 / 4.724 ' ' 26.000 3.548 2.013 / 4.642 ' ' 27.000 3.960 1.819 / 4.555 ' ' 28.000 4.373 1.624 / 4.478 ' ' 29.000 4.787 1.429 / 4.411 ' ' 30.000 5.203 1.237 / 4.357 ' ' 31.000 5.620 1.051 / 4.315 ' ' 32.000 6.040 0.872 / 4.287 ' ' 33.000 6.461 0.703 / 4.273 ' ' 34.000 6.884 0.546 / 4.273 ' ' 35.000 7.311 0.405 / 4.289 ' ' 36.001 7.740 0.280 / 4.320 ' ' 37.000 8.173 0.175 / 4.366 ' ' 38.000 8.612 0.091 / 4.428 ' ' 39.000 9.055 0.032 / 4.504 ' ' 40.000 9.507 0.000 / 4.596 ' ' 41.000 9.968 -0.004 / 4.703 ' ' 42.000 10.443 0.019 / 4.823 ' ' 43.000 10.941 0.069 / 4.957 ' ' 44.000 11.476 0.143 / 5.102 ' ' 45.000 12.066 0.241 / 5.259 ' ' 46.000 12.634 0.360 / 5.420 ' ' 47.000 13.114 0.499 / 5.580 ' ' 48.000 13.538 0.658 / 5.741 ' ' 49.000 13.931 0.833 / 5.904 ' ' 50.000 14.305 1.025 / 6.071 ' ' 51.000 14.666 1.231 / 6.242 ' ' 52.000 15.020 1.450 / 6.417 ' ' 53.000 15.377 1.681 / 6.597 ' ' 53.999 15.737 1.922 / 6.781 ' ' 55.000 16.100 2.172 / 6.969 ' ' 56.000 16.466 2.429 / 7.161 ' ' 57.000 16.835 2.692 / 7.356 ' ' 58.000 17.205 2.959 / 7.554 ' ' 59.000 17.578 3.228 / 7.754 / n2/ 40777 1750 1750 0 6613213030 10351 5 ustar klimes klimes n2/n2-net.h 100666 1750 1750 710 6611776250 11720 0 ustar klimes klimes # Model: MODEL='n2-mod.dat' # Grid dimensions: In the paper: N1=50 N2=50 N3=25 # N1=100 N2=100 N3=50 D1=0.8 D2=0.8 D3=0.8 # D1=0.4 D2=0.4 D3=0.4 O1=-19.6 O2=-19.6 O3=-19.6 # O1=-19.8 O2=-19.8 O3=-19.8 # List of input and output filenames: NET='n2-net.dat' # Numerical parameters: NFSMAX=0 # Programs to run: grid: 'n2-net.h' 'n2-grid.dat' / net: 'n2-net.h' / #sec: 'n2-sec.dat' / n2/n2-mod.dat 100666 1750 1750 1242 6416564462 12256 0 ustar klimes klimes 'Test model (N2) for network ray tracing.' 0 1 1 / -20 20 -20 20 -20 0 / 0 surfaces 1 simple block: / 1 complex block: 1 / 'END of surfaces' / 'COMPLEX BLOCK' 1 'VP ' 1 1 2 3 0 / 6 6 2 -20 -15 -5 5 15 20 -20 -15 -5 5 15 20 0 -20 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 5.5 5.5 5.5 5.5 5.5 5.5 5.5 6.0 5.0 6.0 5.0 5.5 5.5 5.0 6.0 5.0 6.0 5.5 5.5 6.0 5.0 6.0 5.0 5.5 5.5 5.0 6.0 5.0 6.0 5.5 5.5 5.5 5.5 5.5 5.5 5.5 'END of complex blocks, end of the input data for the model' / ======================================================================== n2/n2-grid.dat 100666 1750 1750 31 6603046416 12347 0 ustar klimes klimes ' ' 'n2-vel.out' ' ' / / n2/n2-net.dat 100666 1750 1750 224 6602575600 12235 0 ustar klimes klimes 'n2-src.dat' 'n2-rec.dat' 'n2-rays.out' 'n2-end.out' / (points, rays) / ' ' 'n2-vel.out' ' ' 'n2-tt.out' 'n2-err.out' / (grids) n2/n2-src.dat 100666 1750 1750 73 6270550722 12217 0 ustar klimes klimes / ' ' 0. 0. -20. / (3 coordinates of the source point) / n2/n2-rec.dat 100666 1750 1750 4321 6270550712 12240 0 ustar klimes klimes 'Receiver coordinates, exact travel time' ' X1 X2 X3 TT ' / ' ' 19.522 6.062 0.0 / 6.872 ' ' 11.029 17.229 0.0 / 6.741 ' ' -17.633 18.451 0.0 / 7.911 ' ' 13.999 4.646 0.0 / 5.918 ' ' 7.736 13.166 0.0 / 5.937 ' ' 0.488 16.838 0.0 / 6.268 ' ' -7.884 15.544 0.0 / 6.393 ' ' -13.600 14.330 0.0 / 6.886 ' ' -16.177 11.393 0.0 / 6.818 ' ' -10.814 -19.827 0.0 / 7.134 ' ' 19.418 -19.802 0.0 / 8.317 ' ' 9.234 3.312 0.0 / 5.279 ' ' 4.717 9.274 0.0 / 5.315 ' ' -1.026 12.339 0.0 / 5.672 ' ' -6.752 12.096 0.0 / 5.962 ' ' -10.678 11.049 0.0 / 6.227 ' ' -12.946 8.326 0.0 / 6.175 ' ' -15.475 1.776 0.0 / 6.083 ' ' -15.448 -5.966 0.0 / 6.193 ' ' -7.883 -15.401 0.0 / 6.275 ' ' -0.334 -18.502 0.0 / 6.520 ' ' 9.271 -16.690 0.0 / 6.645 ' ' 15.158 -15.522 0.0 / 7.220 ' ' 17.777 -11.970 0.0 / 7.064 ' ' 5.616 2.243 0.0 / 4.988 ' ' 2.575 6.128 0.0 / 5.019 ' ' -1.524 8.683 0.0 / 5.310 ' ' -5.543 9.201 0.0 / 5.613 ' ' -8.433 8.468 0.0 / 5.793 ' ' -10.237 6.226 0.0 / 5.756 ' ' -11.458 1.667 0.0 / 5.593 ' ' -10.327 -4.418 0.0 / 5.420 ' ' -4.948 -11.065 0.0 / 5.524 ' ' 1.341 -13.750 0.0 / 5.852 ' ' 7.735 -13.002 0.0 / 6.128 ' ' 11.818 -11.860 0.0 / 6.420 ' ' 14.184 -8.603 0.0 / 6.318 ' ' 17.202 -0.826 0.0 / 6.315 ' ' 2.895 1.319 0.0 / 4.882 ' ' 1.203 3.588 0.0 / 4.902 ' ' -1.305 5.453 0.0 / 5.054 ' ' -3.994 6.297 0.0 / 5.264 ' ' -6.163 5.977 0.0 / 5.400 ' ' -7.487 4.353 0.0 / 5.381 ' ' -7.842 1.226 0.0 / 5.224 ' ' -6.411 -3.054 0.0 / 5.041 ' ' -2.709 -7.485 0.0 / 5.116 ' ' 1.957 -9.936 0.0 / 5.448 ' ' 6.381 -10.071 0.0 / 5.754 ' ' 9.379 -9.117 0.0 / 5.932 ' ' 11.292 -6.439 0.0 / 5.865 ' ' 12.809 -1.088 0.0 / 5.730 ' ' 0.701 0.370 0.0 / 4.851 ' ' 0.333 1.273 0.0 / 4.856 ' ' -0.654 2.324 0.0 / 4.890 ' ' -2.044 3.095 0.0 / 4.960 ' ' -3.431 3.204 0.0 / 5.029 ' ' -4.379 2.413 0.0 / 5.041 ' ' -4.527 0.643 0.0 / 4.977 ' ' -3.541 -1.909 0.0 / 4.900 ' ' -1.293 -4.644 0.0 / 4.943 ' ' 1.778 -6.632 0.0 / 5.156 ' ' 4.846 -7.278 0.0 / 5.401 ' ' 7.138 -6.692 0.0 / 5.536 ' ' 8.525 -4.670 0.0 / 5.489 ' ' 8.957 -0.930 0.0 / 5.310 / n2/n2-sec.dat 100666 1750 1750 2705 6270550660 12247 0 ustar klimes klimes 'n2-mod.dat' 'net6ab.out' (input and output data files) 1 4 8 0.010 0.000250 (IPS, NC1, NC2, STEP, ERR) 3.2 3.4 3.6 3.8 4.0 4.2 4.4 4.6 4.8 5.001 5.2 5.4 5.6 5.8 5.999 / (values of isolines) -20 -20 -20 40 0 0 0 40 0 / (origin and side vectors of the section) -20 5 -20 40 0 0 0 0 20 / (origin and side vectors of the section) / ------------------------------------------------------------------------ The above data have been used for the final version of Figure 6 in Klimes and Kvasnicka (1994): 3-D network ray tracing, Geophys.J.int., 116, 726-738, although the data below would be better. ------------------------------------------------------------------------ 'model.n2' 'net6a.out' (input and output data files) 1 4 8 0.010 0.000250 (IPS, NC1, NC2, STEP, ERR) 5.0001 5.2 5.4 5.6 5.8 5.9999 / (values of isolines) -20 -20 -20 40 0 0 0 40 0 / (origin and side vectors of the section) / ------------------------------------------------------------------------ 'model.n2' 'net6b.out' (input and output data files) 1 31 1 0.010 0.000250 (IPS, NC1, NC2, STEP, ERR) 3.0 3.2 3.4 3.6 3.8 4.0 4.2 4.4 4.6 4.8 5.0 5.2 5.4 5.6 5.8 6.0 / (values of isolines) -20 5 -20 40 0 0 0 0 20 / (origin and side vectors of the section) / ======================================================================== net.dat 100666 1750 1750 742 6602575634 11415 0 ustar klimes klimes 'src.dat' 'rec.dat' 'rays.out' 'end.out' / / ' ' 'vel.dat' ' ' 'tt.out' 'err.out' / ------------------------------------------------------------------------ The above sample data for the 'NET' program specify a 2-D network ray tracing in a 1-D velocity gradient model by P.Podvin and I.Lecomte (1991), Geophys.J.int., 105, 271-284, Fig.13c. Note: Since there are no structural interfaces in this model, the input file 'ICB' with the indices of geological blocks is not specified. net.for 100666 1750 1750 554711 6603046434 11515 0 ustar klimes klimes C; exit 0 if $ans=~ /^[Qq]/; &ECHO( ">>${PREFIX}net.out"," NET='${PREFIX}net4.dat'"); &RUN("net" ,"'${PREFIX}net.out' /"); &RUN("netind","'${PREFIX}net.out' '${PREFIX}net3.dat' '${PREFIX}net4.dat' '${PREFIX}net3.dat' /"); goto FV; # 1; #
C Program NET for a network shortest path calculation of the first C arrival travel time and the corresponding rays, on a rectangular grid C of points. C C Version: 3.10 C Date: 1998, September 26 C C Authors: C Ludek Klimes C Department of Geophysics, Charles University Prague C Ke Karlovu 3 C 121 16 Praha 2, Czech Republic C E-mail: klimes@seis.karlov.mff.cuni.cz C Michal Kvasnicka C Department of Geophysics, Charles University Prague C Ke Karlovu 3 C 121 16 Praha 2, Czech Republic C E-mail: qasnicka@seis.karlov.mff.cuni.cz C C....................................................................... C C Program 'NET' is able to: C (A) Perform both 2-D and 3-D ray tracing in a rectangular grid C discretization of an arbitrarily complex model according to C the paper by Klimes and Kvasnicka (1994). C (B) Compute first arrivals of both direct and multiply reflected C waves. C (C) Compute first arrivals of both P-waves, S-waves and converted C waves. C (D) Employ forward stars of any kind (template forward stars are C stored in a disk file, and may be modified and optimized in C various ways). C (E) Trace rays both in the whole rectangular model volume and in a C Fresnel volume corresponding to a two-point ray, or in a volume C of any other shape. This may increase accuracy of two-point ray C tracing by one order, or to decrease computational complexity C by about two orders. C (F) Adjust the size of a forward star at a structural interface in C order to maximize the accuracy. C (G) Adjust the size of a forward star according to a local degree of C heterogeneity in order to maximize the accuracy. C (H) Estimate maximum errors of all computed arrival times. C (I) In a special 2-D mode referred hereinafter as TTT perform 2-D C grid travel-time tracing of the second order according to the C paper by Klimes (1996). C C References: C Klimes L. and Kvasnicka M. (1994): 3-D network ray tracing. C Geophys.J.int., 116, 726-738. C Klimes L. (1996): Grid travel-time tracing: second-order method C for the first arrivals in smooth media. C PAGEOPH, 148, 539-563. C C....................................................................... C C Notes concerning the method: C C Although the program deals with arbitrarily complex models, the C accuracy of the shortest path approximation of the travel time and C rays, of course, depends on the model discretization step and on the C model complexity. Fortunately, the relative travel-time error can C be estimated. C C Because of the local optimization of the sizes of forward stars, the C network becomes oriented (i.e. backward stars do not equal forward C stars) and the resulting shortest path travel time need not be C reciprocal. C C This program employs two-point (trapezoidal) travel time approximation C along a network edge. C C Hereinafter the way of building the rectangular grid and the network C is briefly described. C C Big bricks, small bricks, gridpoints: C The rectangular volume bounded by coordinate limits X1MIN,X1MAX, C X2MIN,X2MAX, and X3MIN,X3MAX is divided into N1*N2*N3 big bricks. C If the numbers L1,L2,L3 are specified in addition to N1,N2,N3, C each big brick is subdivided into L1*L2*L3 small bricks. C If the numbers L1,L2,L3 are not specified, each big brick contains C just one small brick, as large as big one. C Gridpoints are defined as centres of the small bricks. C C Gridpoint indexing (positions of network nodes): C Gridpoints are indexed by integers 1,2,...,N1*L1*N2*L2*N3*L3. C Indices of gridpoints describe the their locations within the C model volume. The gridpoint indexing is similar to 1-D indexing C of 3-D Fortran array. A gridpoint index define the location of C the network node situated at the gridpoint. C C Network node indexing (addresses of network nodes): C If L1,L2,L3 are not specified, gridpoint indices equal to the C corresponding gridpoint indices. C Description for experienced users: C Network nodes are indexed just within the computational volume C composed of big bricks. Nodes are indexed consecutively within C each big brick. The node indexing within a big brick is similar C to 1-D indexing of 3-D Fortran array. The number of indices C within each big brick is L1*L2*L3. If the number of big bricks C within the computational volume is L4, then the node indices take C the values 1,2,...,L1*L2*L3*L4. C C Index file: C Index file enables to specify the computational volume of a C complex shape. The network ray tracing is then performed only C in the specified computational volume instead of the whole C rectangular model volume. This enables, e.g., to perform the C network ray tracing just in the estimated Fresnel volume. C The option of the index file is designed for experienced users. C The index file to specifies mapping of gridpoints onto the network C nodes. If it exists, it contains N1*N2*N3 items (integer C indices), each corresponding to one big brick. Each item contains C the index of the first node of the big brick divided by L1*L2*L3. C C Network nodes: C The set of network nodes if composed of: C (1) Given source nodes. C (2) The subset of gridpoints: C A gridpoint belongs to the network if contained in the big C brick belonging to the network. The relation of big C bricks with respect to the network is defined by means of C the index file: C If the index file is not specified, all big bricks belong C to the network. C If the index file is specified, each its item (index) C corresponds to one big brick: C If the index is zero, the big brick does not belong to C the network. C If the index is not zero, the big brick belongs to the C network and the index denotes the set of nodes within C the brick. C Big bricks belonging to the network are assumed to be C indexed by positive integers. C (3) Given receiver nodes. C C Generation of network edges: C Template forward star: C The concept of a template forward star is based on the C idea of a set of nodes (gridpoints) periodic in the space: C Template forward star is of the same geometry for all C network nodes. The template forward star is assumed C symmetric with respect to axis reflections and C interchangings. The edges corresponding to the template C forward star are read from the file 'net.fs*'. C Template forward stars are considered to contain the edge C edge connecting the central node with itself, although C this edge is not explicitly referred in the file C 'net.fs*'. C Size of a template forward star roughly describes the C extent of the forward star in grid intervals. C Many different kinds of template forward stars may be C considered: C Full 3-D cubic forward star, size NFS: C Contains all edges connecting the central node with all C nodes within the cube of the linear size of 2*NFS+1 C nodes, centred at the central node. C Full 2-D square forward star, size NFS: C Contains all edges connecting the central node with all C nodes within the square of the linear size of 2*NFS+1 C nodes, centred at the central node. C Full 3-D spherical forward star, size NFS: C Contains all edges connecting the central node with all C nodes within the sphere of the radius of SQRT(NFS*NFS+2) C grid intervals, centred at the central node. C Full 3-D circular forward star, size NFS: C Contains all edges connecting the central node with all C nodes within the circle of the radius of SQRT(NFS*NFS+1) C grid intervals, centred at the central node. C Moser-Saito 3-D cubic forward star, size NFS: C Full 3-D cubic forward star, size NFS, without the edges C that would be parallel in a homogeneous medium. C Moser-Saito 2-D square forward star, size NFS: C Full 2-D square forward star, size NFS, without the C edges that would be parallel in a homogeneous medium. C Optimized 3-D spherical forward star, size NFS: C Full 3-D spherical forward star, size NFS, without the C edges that can be removed while keeping, C in a homogeneous medium, each angular cone of the C radius grater than 1/(SQRT(2)*NFS) radians covered by C edges. C Optimized 2-D circular forward star, size NFS: C Full 2-D circular forward star, size NFS, without the C edges that can be removed while keeping, C in a homogeneous medium, each angle of the size greater C than 1/NFS radians covered by edges. C Note that this forward star is not a subset of the C optimized 3-D spherical forward star. C C Actual forward stars (without receiver nodes): C All forward stars corresponding to nodes situated within C a same small brick are the same, equal to the forward C star corresponding to its central gridpoint. C A forward star corresponding to a gridpoint is the C intersection of the template forward star with the set of C network nodes. C At source nodes, full spherical or circular template C forward stars are considered. C At gridpoint nodes, optimized spherical or circular C template forward stars from the files 'net.fs3' and C 'net.fs2' are considered. C Receiver backward stars: C The edges generated by the backward stars of the receiver C nodes are added to the edges generated by the above C forward stars. The backward stars are the same as forward C stars from the central nodes of the corresponding small C bricks. C At receivers, full spherical or circular template C backward stars are considered. C C....................................................................... C C Files 'net.fs2' and 'net.fs3' with template forward stars: C The files describing forward stars of various sizes must have the C names 'net.fs2' and 'net.fs3'. Forward stars submitted with this C version: C 'net.fs2'... Optimized spherical 2-D forward stars, sizes 1-100. C 'net.fs3'... Optimized circular 3-D forward stars, sizes 1-27. C C Note: C Files 'net.fs2' and 'net.fs3' may be reduced to approximately 2/3 C of their size if replacing all multiple spaces by a single space. C This may slightly save disk space and speed up program starting. C C TTT mode: C Template forward stars 'net.fs2' and 'net.fs3' are not required. C C....................................................................... C C C Data files: C C Input data read from the * external unit: C The data consist of a single character string, read by list C directed (free format) input. Thus the string has to be enclosed C in apostrophes. The interactive * external unit may be redirected C to the file containing the string. C (1) 'SEP',/ C 'SEP'...String in apostrophes containing the name of the input SEP C parameter file containing the data specifying grid C dimensions, references to other data files and optionally C some numerical parameters. C Description of file SEP C Default: 'SEP'='net.h' C C C Data file SEP has the form of the SEP (Stanford Exploration Project) C parameter file: C All the data are specified in the form of PARAMETER=VALUE, e.g. C N1=50, with PARAMETER directly preceding = without intervening C spaces and with VALUE directly following = without intervening C spaces. The PARAMETER=VALUE couple must be delimited by a space C or comma from both sides. C The PARAMETER string is not case-sensitive. C PARAMETER= followed by a space resets the default parameter value. C All other text in the input files is ignored. The file thus may C contain unused data or comments without leading comment character. C Everything between comment character # and the end of the C respective line is ignored, too. C The PARAMETER=VALUE couples may be specified in any order. C The last appearance takes precedence. C Other data filenames: C NET=string... String with the name of the input data file C containing the references to other input and output files. C Description of input data NET C Default: NET='net.dat' C FSTAB=string... String with the name of the optional output file C containing the information on memory required to store C forward stars. Useful if array dimension MFS declared in C net.inc has to be updated. C The file is not created by default. C Default: FSTAB=' ' C Data specifying grid dimensions: C Boundaries of the model volume: C X1MIN=O1-0.5*D1, X1MAX=X1MIN+FLOAT(N1)*D1, C X2MIN=O2-0.5*D2, X2MAX=X2MIN+FLOAT(N2)*D2, C X3MIN=O3-0.5*D3, X3MAX=X3MIN+FLOAT(N3)*D3. C Because the model volume is divided into the small bricks C and the gridpoints are situated in the centres of the C small bricks, the left-hand model boundary is situated C half a grid interval to the left from the leftmost C gridpoints. Similarly for other model boundaries. C In a 2-D model, boundaries parallel with the model plane C are ignored. C N1=positive integer... Number of gridpoints along the X1 axis. C Default: N1=1 C N2=positive integer... Number of gridpoints along the X2 axis. C Default: N2=1 C N3=positive integer... Number of gridpoints along the X3 axis. C N3 need not be specified for a 2-D model. C Default: N3=1 C D1=positive real... Grid interval in the direction of the first C coordinate axis. C Default: D1=1. C D2=positive real... Grid interval in the direction of the second C coordinate axis. C Default: D2=1. C D3=positive real... Grid interval in the direction of the third C coordinate axis. C Default: D3=1. C O1=real... First coordinate of the grid origin (first point of the C grid). C Default: O1=0. C O2=real... Second coordinate of the grid origin. C Default: O2=0. C O3=real... Third coordinate of the grid origin. C Default: O3=0. C Additional parameters for network ray tracing in Fresnel volumes: C L1,L2,L3 may be left out and should only be specified by C experienced users. C (If the numbers L1,L2,L3 are not specified, each big brick C contains just one small brick, as large as big one.) C L1=positive integer... Number of small bricks in one big brick in C the direction of axis X1. If specified, must be positive. C Default: L1=1 C L2=positive integer... Number of small bricks in one big brick in C the direction of axis X2. If specified, must be positive. C Default: L2=1 C L3=positive integer... Number of small bricks in one big brick in C the direction of axis X3. If specified, must be positive. C Default: L3=1 C Note: Only one of N1*L1, N2*L2, N3*L3 may equal 1. C In such a case, two-dimensional ray tracing is performed: C Two-dimensional forward stars are considered, C model boundaries in the proper direction are ignored, C source and receiver coordinates perpendicular to the plane C of computation have to equal. C Numerical parameters: C NFSMAX=integer... Options: NFSMAX=positive integer, 0, -1. C Default: NFSMAX=0. C NFSMAX=positive integer: C NFSMAX is the maximum size of a forward star. C Simultaneously, the default size of a forward star if the C size is not adjusted. C The size of a forward star is measured in grid intervals, C and describes the maximum length of the edge between two C consecutive points (nodes) of a ray. C The maximum size of a forward star has to be estimated by C the user according the model, in order to prevent the ray C to skip over some details in the model. These details may C be, e.g., small low or high velocity regions or bumps on C the structural interfaces. C NFSMAX has to be positive and not exceeding dimension C MFSMAX in the common block /FS/. C NFSMAX=0: The maximum size of forward stars is determined C automatically: New NFSMAX**(-2) is average of NFS**(-2), C where NFS is optimum size at each node. This is default. C TTT mode (specified by NFSMAX=-1): C N1,N2,N3... N3=1 is obligatory in the input data. C L1,L2,L3... L1=L2=L3=1 is strongly recommended. C NFSMAX=-1: 2-D 'Second-order' grid travel-time tracing by Klimes C (1996) is used instead of network ray tracing. C Default: NFSMAX=0. C RIDGE1=positive real, RIDGE2=positive real... C Numerical parameters controlling the check for C the ridges of the first-arrival travel time. At the C ridges, the rays going from different directions meet. C The interpolation across the ridges should be avoided C because it would introduce the first-order errors. C Instead, paraxial approximations from gridpoints at each C side of the ridge should be applied. For the paraxial C approximations, the second travel-time derivative along C the gridline crossing the ridge is taken zero. C The serious problem is to indicate the ridge. C The slowness-vector difference across the ridge is C negative and lower than would correspond to the C slowness-vector difference along the neighbouring gridline C segment, i.e. to the second travel-time derivative at the C corresponding side of the ridge. C The following algorithm is now applied: C The slowness-vector difference along the neighbouring C gridline is multiplied by RIDGE1 if negative or by 0 if C positive, and decreased by RIDGE2 times the norm of the C slowness gradient. If the result is greater than the C slowness-vector difference along the gridline being C checked, the ridge is indicated. C RIDGE1 should thus aways be greater than 1, whereas C RIDGE2 should be positive, small with respect to 1. C Values like RIDGE1=1.1, 1.2, 1.3, 1.4, 1.5, 3.0, 6.0, C and RIDGE2=0.05, 0.10, 0.20, 1.00 have been tested with C very unstable results. The questionable defaults of C RIDGE1=1.5 and RIDGE2=0.10 have finally been chosen. C Very large values of RIDGE1 and RIDGE2 should disable C the test for ridges and thus correspond to program TTT-2D C version 0.17 (slightly fixed version 0.07). C Default: RIDGE1=1.5, RIDGE2=0.1. C VER1=real... If the distance of the centre of wavefront curvature C from the gridline segment is greater than VER1 grid C intervals: C Cubic interpolation of travel time along the gridline C segment, C else: cubic interpolation of travel time residual along C the gridline segment. The travel time residual is taken C with respect to spherical wavefronts having the common C centre at the point of intersection of two given C slowness vectors. C For more details refer to Klimes (1996), Sec.3.1.4, where C VER1 is denoted by N. C The results are not very sensitive to this parameter and C there has never arisen a need to change the default value. C Default: VER1=9.999. C VER2=real... Smoothing and stabilizing slowness vectors: C Residual travel times with respect to quadratic or C spherical interpolation are approximated by C TTRES=(1-VER2)*TTCUB+VER2*TTLIN, C where TTCUB is cubic interpolation, and TTLIN is linear C approximation adjusting the resulting slowness vector C according to travel time residuals. C VER1=0 corresponds to interpolation described in Sections C 3.1.3.1 and 3.1.4.1 and is default in TTT-2D ver. 0.06. C VER1=1 corresponds to interpolation described in Sections C 3.1.3.2 and 3.1.4.2 and is default since TTT-2D version C 0.07. C Default: VER2=1.0. C Example of data set SEP C C C Main input file 'NET': C Sequential file, read by list directed (free format) input, C containing model parameters, source/receiver coordinates, and C names of other input and output files. C In the list of input data below, each numbered paragraph indicates C the beginning of a new input operation (new read statement). C 'ITEMS' in the list of input variables enclosed in apostrophes C represent character strings enclosed in apostrophes. Otherwise, C if the first letter of the symbolic name in the list of input C variables is I-N, the corresponding value in input data is C integer, otherwise, the input parameter is of the type real. C / in the list of input variables indicates an obligatory slash. C The slash may also be used instead of default values. C (1) 'SRC','REC','RAYS','END',/ C 'SRC'...Name of the input file with source coordinates. C Description of input data SRC C 'REC'...Name of the input file with receiver coordinates. C If blank, no rays are stored within the file 'RAYS'. C Description of input data REC C 'RAYS'..Name of the output file with rays. C If blank, no rays are stored within the file 'RAYS'. C Description of output data RAYS C 'END'...Name of the output file with endpoints of rays (receiver C coordinates, receiver arrival times, and estimates of the C corresponding maximum travel-time errors. C If blank, no file 'END' is generated. C Description of output data END C Default: 'REC'=' ', 'RAYS'=' ', 'END'=' '. C TTT mode: C 'REC'...File read if specified but its data ignored. No receivers C are considered in the present version. C 'RAYS'..Ignored - output file not generated. C 'END'...Ignored - output file not generated. C (2) NREFL,/ C NREFL...Number of reflections. C Attention concerning this version: C If, in the case of reflections (NREFL.GT.0), some C 'VEL(I)' differs from 'VEL(0)' at lines (3.2) below, the C errors cannot be evaluated correctly and the filename C 'END' above should be left blank. C Note: To calculate a reflected wave, it is recommended to C keep NREFL=0 and to submit the reflector points as a set C 'REC' of the receiver points. Then to submit the output C 'END' file as the source file 'SRC' for the subsequent C calculation of the reflected wave. In this way, the C arrival time errors connected with the discretization of C the reflector can be removed. On the other hand, the C whole rays are split into several files 'RAYS' and have C to be put together after finishing the network ray C tracing. C Default: NREFL=0. C (3) Once (3.1), then NREFL-times (3.2) and (3.1): C TTT mode: NREFL=0. C (3.1) 'IND(I)','VEL(I)','ICB(I)','TT(I)','ERR(I)','PRED(I)','NFS(I)',/ C 'IND(I)'... Name of the input index file, specifying for each C big brick if its gridpoints belong to the network. C May be blank - then the default indexing is assumed. C Must not be blank if (L1.GT.1.OR.L2.GT.1.OR.L3.GT.1) at C input (1). C This file should only be used by experienced users, others C should leave it blank. C Description of input data IND(I) C 'VEL(I)'... Name of the input file containing velocities at all C network nodes, for I-times reflected wave. C Has to be specified. C Description of input data VEL(I) C 'ICB(I)'... Name of the input file containing indices of C (geological) blocks. Only network edges corresponding to C a forward star of the size NFS=1 are allowed to cross an C interface between two different blocks (i.e. blocks with C different indices). This considerably increases the C accuracy in presence of structural interfaces (often 5 C times). Note that the limitation to size 1 is considered C to be the optimum one, at least, for velocity contrasts of C 1.18/1 or greater. C 'ICB(I)' may be blank - especially in the case of a single C block (no structural interfaces). C In the presence of structural interfaces, this file is C recommended to be submitted in order to increase the C accuracy. C Description of input data ICB(I) C 'TT(I)'... Name of the output file containing travel-times at all C network nodes after I reflections. C If blank, the file is not generated. C Description of output data TT(I) C 'ERR(I)'... Name of the output file containing estimated upper C bounds for the errors of the computed travel-times at all C network nodes after I reflections. C If blank, the file is not generated. C Attentions concerning this version: C (a) in the presence of structural interfaces, the errors C are evaluated correctly only if the file 'ICB' is C submitted. C (b) if, in the case of reflections, 'VEL(I)' differs from C 'VEL(I-1)', the errors cannot be evaluated correctly and C the corresponding 'ERR(I)' should be left blank. C Description of output data ERR(I) C 'PRED(I)'... Name of the output file containing predecessors of C all network nodes after I reflections. C If blank, the file is not generated. C May be blank for most applications. C Description of output data PRED(I) C 'NFS(I)'... Just for debugging. The parameter should be left out C or blank in the input data. C String 'NFS(I)' may be blank, '*' or the name of the file C containing optimum sizes of forward stars, preceded by + C for input or by - for output. C 'NFS(I)'=' ': optimum sizes of forward stars at the C network nodes are estimated and used for calculation. C 'NFS(I)'='+...' (input): sizes of forward stars at the C network nodes are read from the file. C 'NFS(I)'='-...' (output): optimum sizes of forward stars C at the network nodes are estimated, used for calculation C and written to the file. C 'NFS(I)'='*': sizes of all forward stars equal NFSMAX from C the input (2). C Description of data NFS(I) C Default: 'IND(I)'=' ', 'VEL(I)'=' ', 'ICB(I)'=' ', C 'TT(I)'=' ','ERR(I)'=' ', 'PRED(I)'=' ', 'NFS(I)'=' '. C TTT mode: C 'IND(I)'... Should be blank. C No index file may be used in the presend version. C 'ICB(I)'... Indices of geological blocks are read but C not used. Should be blank. C 'ERR(I)'='P1(I)'... Name of the output file containing the first C slowness vector component. C If blank, the file is not generated. C 'PRED(I)'='P2(I)'... Name of the output file containing the second C slowness vector component. C If blank, the file is not generated. C 'NFS(I)'='P3(I)'... Name of the output file reserved for the third C slowness vector component. Presently should be blank. C No file is generated. C (3.2) 'INTF(I)',/ C 'INTF(I)'... Name of the input file containing refractor points. C Must not be blank if the reflection is considered. C Description of input data INTF(I) C Example of data set NET C C C Input file 'SRC' containing source coordinates: C (1) Several strings terminated by / (a slash). C The simplest way is to submit just the /. C (2) Several times (2.1): C (2.1) 'NAMSRC',X1S,X2S,X3S,TTS,TTSERR/ C 'NAMSRC'... Name of the source point. Truncated to the first six C characters. C X1S,X2S,X3S... Coordinates of a point of the source. C In a 2-D model, coordinates perpendicular to the model C plane have to be the same for all source points and all C receivers. C TTS... Initial arrival time at the source point. Must not be C negative. Zero initial time is o.k., but is changed to C a very small positive value. C TTSERR..Initial value of the arrival time error at the source C point. It is likely zero at the actual source and may C thus be omitted. It is introduced especially for the C purposes of tracing reflected waves. In such a case, C TTS is the arrival time of incident wave at the reflector C and TTSERR is its error resulting from network ray tracing C between the actual source and the reflector. C Default: TTS=0, TTSERR=0. C TTT mode: C Only a point source is considered in the present version. C (3) / (a slash). C Example of data set SRC C C C Input file 'REC' containing receiver coordinates: C (1) Several strings terminated by / (a slash). C The simplest way is to submit just the /. C (2) Several times (2.1): C (2.1) 'NAMREC(IR)',X1R(IR),X2R(IR),X3R(IR),/ C 'NAMREC(IR)'... Name of the receiver point. Truncated to the C first six characters. C X1R(IR),X2R(IR),X3R(IR)... Coordinates of the IR-th receiver. C (3) / (a slash). C Example of data set REC C C C Output file 'RAYS': C (1) / (a slash). C (2) For each receiver (2.1), (2.2), and (2.3): C (2.1) 'RAYnnnnn FROM NAMSRC TO NAMREC',/ C 'RAYnnnnn FROM NAMSRC TO NAMREC'... String in apostrophes, C composed of: C (a1) substring 'RAY', C (a2) the sequential index of the receiver written using C format (i5), C (b1) substring ' FROM ', C (b2) name of the source point truncated to the first 6 C characters, C (c1) substring ' TO ', C (c2) name of the receiver point truncated to the first 6 C characters. C If the name of the source point is blank, (b1) is replaced C by 6 spaces. C If the name of the receiver point is blank, (c1) and (c2) C are left out. C If both the names of the source and receiver point are C blank, (b1), (b2), (c1) and (c2) are left out. C Examples of the string: C 'RAY 112' C 'RAY 112 TO NAMREC' C 'RAY 112 FROM NAMSRC' C 'RAY 112 FROM NAMSRC TO NAMREC' C (2.2) For each point of the ray (2.1.1): C (2.2.1) X1,X2,X3,TT,/ C X1,X2,X3... Coordinates of the point of the ray. C TT... Arrival time at the point. C Note: Rays are stored backwards, starting with the receiver, C ending with the source point. C (2.3) / (a slash). C (3) / (a slash). C C C Output file 'END': C (1) / (a slash). C (2) For each receiver (2.1): C (2.1) 'NAMREC',X1R,X2R,X3R,TT,TTERR,/ C 'NAMREC'... Name of the receiver point truncated to the first six C characters. C X1R,X2R,X3R... Coordinates of the receiver. C TT... Arrival time at the receiver point. C TTERR...Estimated maximum error of the arrival time. C Attentions concerning this version: C (a) in the presence of structural interfaces, the errors C are evaluated correctly only if the file 'ICB' is C submitted. C (b) if, in the case of reflections, 'VEL(I)' differs from C 'VEL(I-1)', the errors cannot be evaluated correctly and C the corresponding 'ERR(I)' should be left blank. C (3) / (a slash). C C C Input index files 'IND(I)': C (1) (IND(I),I=1,N1*N2*N3) C IND(I)..Zero if the I-th big brick does not belong to the C network, C otherwise the index the big brick. The nodes within the C big brick are indexed by integers from C L1*L2*L3*(IND(I)-1)+1 to L1*L2*L3*IND(I). C Default: IND(I)=I. C C C Input files 'VEL(I)' containing velocities at network nodes: C (1) (V(I),I=1,L1234) C V(I)... Velocity at network node no.I. C L1234.. Maximum index of a network node. L1234=L1*L2*L3*L4, where C L4 is the maximum index of a big brick belonging to the C network, see the file 'IND' below. If the file 'IND' C is not specified, L4=N1*N2*N3 by the default. C Free space is indicated by a zero velocity V(I)=0. C Free space should not be indicated by a small positive C velocity. A small velocity considerably increases time of C computation. C Default: V(I)=1. C TTT mode: C At structural interfaces, it is recommended to specify average C slownesses over bricks. However, the method is unstable in block C models. C Example of data set VEL C C C Input index files 'ICB(I)': C (1) (ICB(I),I=1,L1234) C ICB(I)..Index of (geological) block in which the network node no.I C is situated. C Default: ICB(I)=1. C C C Output files 'TT(I)' (time field): C (1) (TT(I),I=1,L1234) C TT(I)... Travel time at network node no.I. C L1234.. Maximum index of a network node. C The output file is designed to be read by the list-directed input C (free format). The null values are generated in place of undefined C travel times in a free space. The null values are treated as default C values when read by list-directed input (free format). C Example: 124 null values are written as ' 124*'. C C C Output files 'ERR(I)' (time error field): C (1) (ERR(I),I=1,L1234) C ERR(I)..Estimated maximum absolute value of the travel-time error C at network node no.I. C Please, notice that the absolute (i.e. not relative) C travel-time errors are estimated and written. C L1234.. Maximum index of a network node. C The output file is designed to be read by the list-directed input C (free format). The null values are generated in place of undefined C errors in a free space. C C C Output files 'PRED(I)' (predecessors): C (1) (IPRED(I),I=1,L1234) C IPRED(I)... Predecessor to network node no.I. C IPRED(I)=I: node has no predecessor (is in a free space). C IPRED(I)=0: node belongs to a reflector, preceding node C has the same position. C IPRED(I).LT.0: preceding node is (-IPRED(I))-th source C point. C Otherwise, IPRED(I).GT.0.AND.IPRED(I).NE.I.: preceding C node is a gridpoint, IPRED(I) being its position index. C L1234.. Maximum index of a network node. C C C Output files 'NFS(I)': C (1) (NFS(I),I=1,L1234) C NFS(I)..Optimum forward star size at the network node no.I. C If NFS.GT.NFSMAX, it is automatically decreased to NFSMAX, C where NFSMAX takes its positive input value or is C determined automatically if NFSMAX=0 on input. C C C Input files 'INTF(I)' containing indices of gridpoints forming the C reflectors: C (1) (INTF(I),I=1,N),/ C INTF(I)... Index of the I-th gridpoint forming the reflector. C N... Number of points forming the reflector. C C....................................................................... C C List of routines: C C High-level: C NET... Main program calling subroutines: C INPUT, SOURCE, GENER, RESFIL, ERRORS, RECVRS, TRACER, and C OUTPUT. C NET C INPUT...Reads the whole main input data file 'NET', source and C receiver coordinates. C INPUT C SOURCE..Reads input data for each iteration, and initializes the C arrival-time field and other arrays. Under iteration we C understand here the computation between two reflections. C If reflectors are not specified, there is just one C iteration. C SOURCE C GENER...Performs shortest path ray tracing (one iteration). C GENER C RESFIL..In a case of reflections, stores the results of an C iteration in an unformatted direct-access scratch file C (one iteration). C RESFIL C ERRORS..Generates the field of arrival-time errors by means of C backward ray tracing - writes 'ERR(I)' (one iteration). C ERRORS C RECVRS..Updates arrival times at the receivers. C RECVRS C TRACER..Performs backward ray tracing from the receivers, C including the estimation of arrival-time errors. C TRACER C OUTPUT..Rewrites arrival-time fields and predecessors from memory C or scratch files to formatted output files 'TT(I)' and C 'IPRED(I)'. C OUTPUT C Updating: C LOOP,FREVOL,UPDATE,SRCREC... Auxiliary routines to SOURCE, GENER, C and RECVRS, updating a node of a network. C Loop with FREVOL or UPDATE: employed by GENER. C Loop with SRCREC: employed by SOURCE and RECVRS. C LOOP C FREVOL C UPDATE C SRCREC C Template forward stars: C READFS..Called by SOURCE, to read and construct optimized template C forward stars. C READFS C MAKEFS..Called by SOURCE and RECVRS, to construct full spherical C template forward stars. C MAKEFS C SETFS...Auxiliary subroutine to READFS and MAKEFS. C SETFS C STORFS..Auxiliary subroutine to SETFS. C STORFS C Backward ray tracing: C ONERAY..Subroutine called by ERRORS and TRACER, to perform C backward ray tracing. C ONERAY C Accuracy estimation: C SETERR..Subroutine called by ONERAY, to estimate and accumulate C the arrival-time errors during backward ray tracing. C SETERR C OPTNFS..Subroutine called by SOURCE and SETERR, to set up C optimum sizes of forward stars. C OPTNFS C OPTMAT..Auxiliary subroutine to SETERR and OPTNFS, to calculate C the matrix composed of the first and second slowness C derivatives. C OPTMAT C TRYMAT..Auxiliary subroutine to OPTMAT, to try the calculation of C the matrix. C TRYMAT C MIXDER..Auxiliary subroutine to TRYMAT, to calculate mixed second C partial slowness derivatives. C MIXDER C Slowness interpolation: C SLOW... Subroutine called by SOURCE, RECVRS, TRACER, and ONERAY, C to find a close gridpoint, and to interpolate the slowness C within the same geological block. C SLOW C POS... Auxiliary subroutine to SLOW, to find the nearest C gridpoint. C POS C Indexing of nodes: C INDX... Integer function, called by many subroutines, to return C the index of the node at the given gridpoint. C INDX C C....................................................................... C C External subroutines required and not contained within this file: C C Formatted output: C WARRAY..Auxiliary subroutine to ERRORS and OUTPUT, designed to C write the given array into the file. C Source code file 'forms.for'. C Eigenvalues: C EIGEN...Subroutine from the IBM scientific subroutine package, C called by OPTNFS. C Source code file 'eigen.for'. C C----------------------------------------------------------------------- C C C PROGRAM NET C C----------------------------------------------------------------------- C C Common blocks: INCLUDE 'net.inc' C net.inc C All common blocks are declared here. C C----------------------------------------------------------------------- C INTEGER IREFL * INTEGER IT1,IT2 * REAL TIME C C IREFL.. Number of reflections. IREFL=0: direct wave. C IT1,IT2,TIME... Auxiliary variables for time watching. C C....................................................................... C C Reading the input parameters CALL INPUT() C C Loop over reflections: DO 10 IREFL=0,NREFL C C Generating time field of the IREFL-times reflected wave: CALL SOURCE(IREFL) C C Example timer for Lahey Fortran77 compiler: * IT1=0 * CALL TIMER(IT1) C C Calculation of shortest paths and arrival times: CALL GENER(IREFL) C C Example timer for Lahey Fortran77 compiler: * IT2=0 * CALL TIMER(IT2) * TIME=0.01*(FLOAT(IT2)-FLOAT(IT1))/60. * WRITE(*,'(A,F10.3,A)') ' Time=',TIME,' min.' C C Post-processing: CALL RESFIL(IREFL) CALL ERRORS(IREFL) C 10 CONTINUE C End of loop over reflections. C C End of ray computation and writing the results: CALL RECVRS() CALL TRACER() CALL OUTPUT() STOP END C C======================================================================= C C C SUBROUTINE INPUT() C C Procedure to read the whole main input data file 'net', source and C receiver coordinates. C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ /NAMESR/ /POINTS/ /FILES/ /TTTPAR/ are C required here: INCLUDE 'net.inc' C net.inc INCLUDE 'ttt.inc' C ttt.inc C C----------------------------------------------------------------------- C INTEGER LU1,LU2 REAL DWARF,UNDEF PARAMETER(LU1=1) PARAMETER (DWARF=1.E-10,UNDEF=-999999.) C CHARACTER*80 TEXT INTEGER ISRC,IREC,I,L REAL D1,D2,D3,O1,O2,O3 C REAL A1111,A1122,A2222,A1133,A2233,A3333,A1123 C REAL A2223,A3323,A2323,A1113,A2213,A3313,A2313 C REAL A1313,A1112,A2212,A3312,A2312,A1312,A1212 C C TEXT...Names of input files NET and SEP, then a dummy storage C location for a text. C ID(II),JD(II),KD(II)... Vector specifying II-th node of the C forward star, in dimensions of a small brick. C A1111,A1122,A2222,A1133,A2233,A3333,A1123,A2223,A3323,A2323,A1113, C A2213,A3313,A2313,A1313,A1112,A2212,A3312,A2312,A1312, C A1212... Intended for future extension (anisotropy). C C....................................................................... C C Name of the main input data file is read from the * external unit: TEXT='net.h' WRITE(*,'(A)') * '+NET: Enter name of main input data file [''net.h'']: ' READ(*,*) TEXT C End of reading from the * unit. C C Reading SEP parameter file: CALL RSEP1(LU1,TEXT) C C Reading input data file NET: CALL RSEP3T('NET',TEXT,'net.dat') OPEN(LU1,FILE=TEXT,STATUS='OLD') WRITE(*,'(2A)') '+NET: Reading input data file: ',TEXT(1:36) C C Numbers of gridpoints: CALL RSEP3I('N1',N1,1) CALL RSEP3I('N2',N2,1) CALL RSEP3I('N3',N3,1) CALL RSEP3I('L1',L1,1) CALL RSEP3I('L2',L2,1) CALL RSEP3I('L3',L3,1) IF(N1.LE.0) THEN LN1=.TRUE. N1=1 L1=MAX0(1,L1) ELSE LN1=.FALSE. END IF IF(N1.LT.1.OR.N2.LT.1.OR.N3.LT.1.OR. * L1.LT.1.OR.L2.LT.1.OR.L3.LT.1) THEN C NET-10 CALL ERROR('NET-10: Number of gridpoints is not positive') C NET-10: Number of gridpoints is not positive: C N1,N2,N3, and, if specified, also L1,L2,L3, in input C file SEP must be positive. END IF NL1=N1*L1 NL2=N2*L2 NL3=N3*L3 C C Boundaries of the model volume: CALL RSEP3R('D1',D1,1.) CALL RSEP3R('D2',D2,1.) CALL RSEP3R('D3',D3,1.) CALL RSEP3R('O1',O1,0.) CALL RSEP3R('O2',O2,0.) CALL RSEP3R('O3',O3,0.) IF(D1.LE.0..OR.D2.LE.0..OR.D3.LE.0.) THEN C NET-56 CALL ERROR('NET-56: Grid interval D1, D2 or D3 is not positive') C NET-56: Grid interval D1, D2 or D3 is not positive: C Grid interval D1, D2 and D3 must be positive in this C version of the NET program, see the C description of input file SEP. END IF X1MIN=O1-0.5*D1 X2MIN=O2-0.5*D2 X3MIN=O3-0.5*D3 X1MAX=X1MIN+FLOAT(N1)*D1 X2MAX=X2MIN+FLOAT(N2)*D2 X3MAX=X3MIN+FLOAT(N3)*D3 C Space steps in the rectangular grid IF(LN1) THEN DSX1=(X1MAX-X1MIN)/FLOAT(NL2) ELSE IF(NL1.EQ.1) THEN DSX1=0. ELSE DSX1=(X1MAX-X1MIN)/FLOAT(NL1) END IF IF(NL2.EQ.1) THEN DSX2=0. ELSE DSX2=(X2MAX-X2MIN)/FLOAT(NL2) END IF IF(NL3.EQ.1) THEN DSX3=0. ELSE DSX3=(X3MAX-X3MIN)/FLOAT(NL3) END IF IF(LN1) THEN ASX1=0. ASX2=SQRT(DSX1**2+DSX2**2) ELSE ASX1=ABS(DSX1) ASX2=ABS(DSX2) ENDIF ASX3=ABS(DSX3) C C Size of the forward star and the interpolation method for TTT: C Size of the forward star: CALL RSEP3I('NFSMAX',NFSMAX,0) IF(NFSMAX.GT.MFSMAX) THEN C NET-07 CALL ERROR('NET-07: Maximum size of a forward star too great') C NET-07: Maximum size of a forward star too great: C NFSMAX in input data file SEP should C be decreased if positive, adjusted to MFSMAX if zero, C or the dimension MFSMAX in the common block /FS/ C in net.inc should be increased. END IF C Interpolation method: CALL RSEP3R('RIDGE1',RIDGE1,1.5 ) CALL RSEP3R('RIDGE2',RIDGE2,0.10 ) CALL RSEP3R('VER1' ,VER1 ,9.999) CALL RSEP3R('VER2' ,VER2 ,1.000) C C (1) Names of the files with source, receivers, rays, and errors: FREC=' ' FRAYS=' ' FEND=' ' READ(LU1,*) FSRC,FREC,FRAYS,FEND IF(FREC.EQ.' '.AND.(FRAYS.NE.' '.OR.FEND.NE.' ')) THEN C NET-12 CALL ERROR * ('NET-12: Name of input file with receivers not specified') C NET-12: Name of input file with receivers not specified: C If you want to generate output file with rays, or with C arrival times and their errors at the receivers, C you have to specify the name of input file with C receivers. C See the main input file NET, (2). END IF IF(FREC.NE.' '.AND.FRAYS.EQ.' '.AND.FEND.EQ.' ') THEN C NET-13 CALL ERROR * ('NET-13: Name of output file with rays not specified') C NET-13: Name of output file with rays not specified: C If you specify receiver positions at the receiver C file, you should specify the name of the output file C with rays, or with arrival times and their errors at C the receivers. C See the main input file NET, (2). END IF C C (2) Number of reflections: NREFL=0 READ(LU1,*) NREFL IF(NREFL.GT.MREFL) THEN C NET-14 CALL ERROR('NET-14: Too many reflections') C NET-14: Too many reflections: C Number NREFL (main input file NET, C (2)) should be decreased to satisfy the inequality C NREFL.LE.MREFL, C or the dimension MREFL in the common block /FILES/ C in net.inc should be increased. END IF C C (3) Names of the output travel-time and predecessor files, C input velocity and index files, and input refractor-point files: DO 32 L=0,NREFL IF(L.GT.0) THEN FINTF(L)=' ' READ(LU1,*) FINTF(L) IF(FINTF(L).EQ.' ') THEN C NET-15 CALL ERROR('NET-15: Reflector file not specified') C NET-15: Reflector file not specified: C If you want to compute reflected time field, you C must specify name of reflector file. C See main input file NET, (4.2). END IF END IF FIND(L)=' ' FVEL(L)=' ' FICB(L)=' ' FTT(L)=' ' FERR(L)=' ' FPRED(L)=' ' FNFS(L)=' ' READ(LU1,*) * FIND(L),FVEL(L),FICB(L),FTT(L),FERR(L),FPRED(L),FNFS(L) IF(FVEL(L).EQ.' ') THEN C NET-16 CALL ERROR('NET-16: Velocity file not specified') C NET-16: Velocity file not specified: C Velocity file has a fundamental importance for time C field computations. You must always specify name of C velocity file. C See main input file NET, (4.1). END IF 32 CONTINUE C C End of reading main input data file 'NET' CLOSE(LU1) C C....................................................................... C C Reading source coordinates: C WRITE(*,'(A)') * '+NET: Reading source coordinates ' OPEN(LU1,FILE=FSRC,STATUS='OLD') READ(LU1,*) (TEXT,I=1,20) DO 48 ISRC=1,MSRC X1S(ISRC)=UNDEF X2S(ISRC)=UNDEF X3S(ISRC)=UNDEF TTS(ISRC)=0. TTSERR(ISRC)=0. READ(LU1,*) * NAMES,X1S(ISRC),X2S(ISRC),X3S(ISRC),TTS(ISRC),TTSERR(ISRC) IF(X1S(ISRC).EQ.UNDEF.AND.X2S(ISRC).EQ.UNDEF.AND. * X3S(ISRC).EQ.UNDEF) THEN NSRC=ISRC-1 GO TO 49 END IF IF(X1S(ISRC).EQ.UNDEF) X1S(ISRC)=0. IF(X2S(ISRC).EQ.UNDEF) X2S(ISRC)=0. IF(X3S(ISRC).EQ.UNDEF) X3S(ISRC)=0. C Checking the initial arrival time at source points IF(TTS(ISRC).LT.0.) THEN C NET-17 CALL ERROR * ('NET-17: Negative time at the source not acceptable') C NET-17: Negative time at the source not acceptable: C Initial time at the source points must not be negative C for a correct function of this code. ELSE IF(TTS(ISRC).EQ.0.) THEN TTS(ISRC)=DWARF END IF C Checking source positions IF(ISRC.EQ.1) THEN IF(NL1.EQ.1.AND..NOT.LN1) THEN X1MIN=X1S(1) X1MAX=X1S(1) END IF IF(NL2.EQ.1) THEN X2MIN=X2S(1) X2MAX=X2S(1) END IF IF(NL3.EQ.1) THEN X3MIN=X3S(1) X3MAX=X3S(1) END IF ELSE IF(NL1.EQ.1.AND..NOT.LN1) THEN IF(X1S(L).NE.X1MIN) THEN C NET-18 CALL ERROR('NET-18: Different 1-st source coordinates') C NET-18: Different 1-st source coordinates: C In a 2-D model, coordinates perpendicular to the C model plane have to be the same for all source C points and all receivers. END IF END IF IF(NL2.EQ.1) THEN IF(X2S(L).NE.X2MIN) THEN C NET-19 CALL ERROR('NET-19: Different 2-nd source coordinates') C NET-19: Different 2-nd source coordinates: C In a 2-D model, coordinates perpendicular to the C model plane have to be the same for all source C points and all receivers. END IF END IF IF(NL3.EQ.1) THEN IF(X3S(L).NE.X3MIN) THEN C NET-20 CALL ERROR('NET-20: Different 3-rd source coordinates') C NET-20: Different 3-rd source coordinates: C In a 2-D model, coordinates perpendicular to the C model plane have to be the same for all source C points and all receivers. END IF END IF END IF IF(X1S(ISRC).LT.X1MIN.OR.X1MAX.LT.X1S(ISRC).OR. * X2S(ISRC).LT.X2MIN.OR.X2MAX.LT.X2S(ISRC).OR. * X3S(ISRC).LT.X3MIN.OR.X3MAX.LT.X3S(ISRC)) THEN C NET-21 CALL ERROR('NET-21: Source is not inside the model') C NET-21: Source is not inside the model: C Source coordinates X1S,X2S,X3S must satisfy conditions C X1MIN.LE.X1S.AND.X1S.LE.X1MAX, C X2MIN.LE.X2S.AND.X2S.LE.X2MAX, C X3MIN.LE.X3S.AND.X3S.LE.X3MAX. C See the main input file NET, (2), C and input file SRC. ENDIF 48 CONTINUE C NET-22 CALL ERROR('NET-22: Too many source points') C NET-22: Too many source points: C Number of receivers in input file REC C should be less than MREC, C or the dimension MREC in the common block /POINTS/ C should be increased. 49 CONTINUE CLOSE(LU1) IF(NSRC.LE.0) THEN C NET-23 CALL ERROR('NET-23: No source point given') C NET-23: No source point given: C You must specify at least one source point at the C input source file SRC. END IF C C....................................................................... C C Reading receiver coordinates: C WRITE(*,'(A)') * '+NET: Reading receiver coordinates ' IF(FREC.EQ.' '.OR.FRAYS.EQ.' ') THEN NREC=0 ELSE OPEN(LU1,FILE=FREC,STATUS='OLD') READ(LU1,*) (TEXT,I=1,20) DO 58 IREC=1,MREC X1R(IREC)=UNDEF X2R(IREC)=UNDEF X3R(IREC)=UNDEF READ(LU1,*) NAMER(IREC),X1R(IREC),X2R(IREC),X3R(IREC) IF(X1R(IREC).EQ.UNDEF.AND.X2R(IREC).EQ.UNDEF.AND. * X3R(IREC).EQ.UNDEF) THEN NREC=IREC-1 GO TO 59 END IF IF(X1R(IREC).EQ.UNDEF) X1R(IREC)=0. IF(X2R(IREC).EQ.UNDEF) X2R(IREC)=0. IF(X3R(IREC).EQ.UNDEF) X3R(IREC)=0. C Checking the receiver positions IF(NL1.EQ.1.AND..NOT.LN1) THEN IF(X1R(IREC).NE.X1MIN) THEN C NET-24 CALL ERROR * ('NET-24: Different 1-st source and receiver coordinate') C NET-24: Different 1-st source and receiver coordinate: C In a 2-D model, coordinates perpendicular to the C model plane have to be the same for all source C points and all receivers. END IF END IF IF(NL2.EQ.1) THEN IF(X2R(IREC).NE.X2MIN) THEN C NET-25 CALL ERROR * ('NET-25: Different 2-nd source and receiver coordinate') C NET-25: Different 2-nd source and receiver coordinate: C In a 2-D model, coordinates perpendicular to the C model plane have to be the same for all source C points and all receivers. END IF END IF IF(NL3.EQ.1) THEN IF(X3R(IREC).NE.X3MIN) THEN C NET-26 CALL ERROR * ('NET-26: Different 3-rd source and receiver coordinate') C NET-26: Different 3-rd source and receiver coordinate: C In a 2-D model, coordinates perpendicular to the C model plane have to be the same for all source C points and all receivers. END IF END IF IF(X1R(IREC).LT.X1MIN.OR.X1MAX.LT.X1R(IREC).OR. * X2R(IREC).LT.X2MIN.OR.X2MAX.LT.X2R(IREC).OR. * X3R(IREC).LT.X3MIN.OR.X3MAX.LT.X3R(IREC)) THEN C NET-27 CALL ERROR('NET-27: Receiver is not inside the model') C NET-27: Receiver is not inside the model: C Receiver coordinates X1R,X2R,X3R must satisfy C conditions C X1MIN.LE.X1R.AND.X1R.LE.X1MAX, C X2MIN.LE.X2R.AND.X2R.LE.X2MAX, C X3MIN.LE.X3R.AND.X3R.LE.X3MAX. C See the main input file NET, (2), C and input file REC. ENDIF 58 CONTINUE C NET-28 CALL ERROR('NET-28: Too many receivers') C NET-28: Too many receivers: C Number of receivers in the input file c REC should be less than MREC, C or the dimension MREC in the common block /POINTS/ C in net.inc should be increased. 59 CONTINUE CLOSE(LU1) END IF C RETURN END C C======================================================================= C C C SUBROUTINE SOURCE(IREFL) INTEGER IREFL C C Initialization procedure for starting the program from the source or C from the IREFL-th interface. Reads input data for the iteration, C and initializes the arrival-time field and other arrays. C C Input: C IREFL.. Number of reflections. C C No output. C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ /NAMESR/ /POINTS/ /FILES/ /NODE/ /SRCC/ C are required here: INCLUDE 'net.inc' C net.inc INCLUDE 'netnode.inc' C netnode.inc C C----------------------------------------------------------------------- C EXTERNAL SRCREC,TTTSRC,INDX INTEGER INDX C INTEGER LU1 PARAMETER (LU1=1) REAL GIANT PARAMETER (GIANT=1.0E+10) C INTEGER MIND,MGRID,MP2,MP3,MPRED,MNFS,MICB INTEGER N123,L123,ISRC,INDQ,NFSMAK,I,L,M INTEGER JPOS,JPOS1,JPOS2,JPOS3,JADR,NFSOPT,JCOUNT,NUMOPT REAL VMAX,V,C1,C2MIN,C2MAX,AUX,SUMOPT C C....................................................................... C WRITE(*,'(A)') '+NET: Reading velocities ' C C Reading the index array: IF(IREFL.GT.0) THEN IF(FIND(IREFL).EQ.FIND(IREFL-1)) THEN C The index array has not been changed GO TO 20 END IF END IF L4=0 IND0=0 C IF(FIND(IREFL).EQ.' ') THEN L1234=N1*N2*N3 IF(L1.GT.1.OR.L2.GT.1.OR.L3.GT.1) THEN C NET-29 CALL ERROR('NET-29: No index file specified') C NET-29: No index file specified: C If L1,L2,L3 (input data file SEP) C are specified, the index file IND has to be C submitted. See the main input file c NET, (4.1). END IF MIND=0 ELSE MIND=MRAM N123=N1*N2*N3 L123=L1*L2*L3 IF(N123.GT.MIND) THEN C NET-30 CALL ERROR('NET-30: Too many big bricks') C NET-30: Too many big bricks: C Numbers N1,N2,N3 (input data SEP) C should be decreased to satisfy the inequality C N1*N2*N3.LE.MRAM, C or the dimension MRAM of array RAM in include file C ram.inc should be C increased. END IF DO 11 L=1,N123 IRAM(IND0+L)=L 11 CONTINUE CALL RARRAI(LU1,FIND(IREFL),'FORMATTED', * .FALSE.,0,N123,IRAM(IND0+1)) DO 12 L=1,N123 L4=MAX0(IRAM(IND0+L),L4) IRAM(IND0+L)=(IRAM(IND0+L)-1)*L123+1 12 CONTINUE L1234=L1*L2*L3*L4 MIND=N123 END IF C C Dynamic array allocation: MGRID=L1234 IF(NFSMAX.GE.0) THEN C Network ray tracing: IF(FICB(IREFL).EQ.' ') THEN MICB=0 ELSE MICB=L1234 END IF IF(FNFS(IREFL).EQ.'*') THEN MNFS=0 ELSE MNFS=L1234 END IF IF(FPRED(IREFL).EQ.' '.AND. * FERR(IREFL).EQ.' '.AND.FRAYS.EQ.' '.AND.FEND.EQ.' ') THEN MPRED=0 ELSE MPRED=L1234 END IF MP2=0 MP3=0 ELSE C Second-order grid travel-time tracing: MICB=0 MNFS=0 MPRED=0 MP2=L1234 MP3=0 END IF ITT0 =IND0 +MIND IPOSQ0=ITT0 +MGRID IP0 =IPOSQ0+MGRID IP20 =IP0 +MGRID IP30 =IP20 +MP2 IPRED0=IP30 +MP3 NFS0 =IPRED0+MPRED ICB0 =NFS0 +MNFS I =ICB0 +MICB IF(I.GT.MRAM) THEN C NET-01 CALL ERROR('NET-01: Small array RAM') C NET-01: Small array RAM: C Dimension MRAM of array RAM allocated in C ram.inc C must be at least C MIND+L1*L2*L3*L4*(4+M1PRED+M1NFS+M1ICB), C where: C MIND=0 if 'IND'=' ', see 'index file' (usually C applicable), C MIND=N1*N2*N3 otherwise. C L4 is the number of nonempty big bricks. C L4=N1*N2*N3 and L1=1,L2=1,L3=1 without volume indexing C ('IND'=' '). C N1,N2,N3,L1,L2,L3 are given by input data file C SEP. C M1NFS=-1 without the optimization of sizes of forward C stars, C M1NFS=0 with the optimization of sizes of forward C stars and also for TTT, C M1PRED=0 if travel-time errors are not calculated and C the predecessor file is not generated and also C for TTT, C M1PRED=1 otherwise. C M1ICB=0 in models without structural interfaces and C also for TTT, C M1ICB=1 in models with structural interfaces. C N1,N2,N3 (input data file SEP) should C be decreased to satisfy the inequality N1*N2*N3.LE.MRAM, C or the dimension MRAM of array RAM in include file C ram.inc should be C increased. END IF C C Reading the velocity field 20 CONTINUE IF(IREFL.GT.0) THEN IF(FVEL(IREFL).EQ.FVEL(IREFL-1)) THEN C The velocity field has not been changed GO TO 30 END IF END IF IF(L1234.GT.MGRID) THEN C NET-31 CALL ERROR('NET-31: Too many network nodes') C NET-31: Too many network nodes: C The number of network nodes, see input file C SEP, should not exceed MGRID. C This error should not appear. Contact the authors. END IF IF(IREFL.GT.0) THEN IF(FERR(IREFL).NE.' ') THEN C NET-43 CALL ERROR * ('NET-43: Time errors cannot be computed after reflection') C NET-43: Time errors cannot be computed after reflection: C If the velocity field of the reflected wave is C different from the velocity field before the C reflection, the errors of the arrival times cannot be C computed correctly by this version. When the rays are C traced, only time fields and predecessors are C alternated in the memory, unlike slowness fields, see C subroutine SETERR. C Thus, if the filenames VEL(I) at the lines (4.1) of C main input data NET differ, the C filenames ERR(I) C should not be specified at the lines (4.1) for the C reflected waves. Simultaneously, if the filename C END C at the line (2) is specified, errors written in the C output file END are incorrect. END IF IF(FEND.NE.' ') THEN C NET-44 CALL ERROR * ('NET-44: Time errors cannot be computed after reflection.') C NET-44: Time errors cannot be computed after reflection: C If, in a case of reflection, filenames VEL(I) at the C lines (4.1) of main input data NET c differ and the filename END at line (2) is specified, C errors written in the output file END are incorrect. C For more details see also error NET-43 above. END IF END IF DO 21 L=1,L1234 RAM(IP0+L)=1. 21 CONTINUE CALL RARRAY(LU1,FVEL(IREFL),'FORMATTED', * .FALSE.,0.,L1234,RAM(IP0+1)) VMAX=0. AUX=1.001/GIANT DO 22 L=1,L1234 V=RAM(IP0+L) IF(ABS(V).LT.AUX) THEN RAM(IP0+L)=GIANT ELSE VMAX=AMAX1(V,VMAX) RAM(IP0+L)=1.0/V ENDIF 22 CONTINUE C C Reading the indices of blocks: 30 CONTINUE IF(IREFL.GT.0) THEN IF(FICB(IREFL).EQ.FICB(IREFL-1)) THEN C The indices of blocks have not been changed GO TO 40 END IF END IF IF(FICB(IREFL).EQ.' ') THEN LICB=.FALSE. ELSE LICB=.TRUE. IF(L1234.GT.MICB) THEN C NET-32 CALL ERROR * ('NET-32: Insufficient memory for indices of blocks') C NET-32: Insufficient memory for indices of blocks: C The number of network nodes, see input file C SEP, should not exceed MICB. C This error should not appear. Contact the authors. END IF DO 31 L=1,L1234 IRAM(ICB0+L)=1 31 CONTINUE CALL RARRAI(LU1,FICB(IREFL),'FORMATTED', * .FALSE.,0,L1234,IRAM(ICB0+1)) END IF C C Switch for storing predecessors: 40 CONTINUE IF(NFSMAX.LT.0) THEN C Second-order grid travel-time tracing (array for P2): LPRED=.FALSE. IF(L1234.GT.MP2) THEN C NET-52 CALL ERROR('NET-52: Insufficient memory for P2') C NET-52: Insufficient memory for P2: C This error should not appear. Contact the authors. END IF DO 42 L=1,L1234 RAM(IP20+L)=0. 42 CONTINUE ELSE IF(FREC.EQ.' '.AND.FPRED(IREFL).EQ.' ' * .AND.FERR (IREFL).EQ.' ') THEN LPRED=.FALSE. ELSE LPRED=.TRUE. IF(L1234.GT.MPRED) THEN C NET-33 CALL ERROR('NET-33: Insufficient memory for predecessors') C NET-33: Insufficient memory for predecessors: C The number of network nodes, see input file C SEP, should not exceed MPRED. C This error should not appear. Contact the authors. END IF END IF C C Computing the forward star sizes: IF(NFSMAX.LT.0) THEN C Second-order grid travel-time tracing (array for P3): LNFS=.FALSE. IF(NL3.GT.1.AND.L1234.GT.MP3) THEN C NET-53 CALL ERROR('NET-53: Insufficient memory for P3') C NET-53: Insufficient memory for P3: C This error should not appear. Contact the authors. END IF C DO 43 L=1,L1234 C RAM(IP30+L)=0. C 43 CONTINUE ELSE IF(FNFS(IREFL)(1:1).EQ.'*') THEN LNFS=.FALSE. IF(NFSMAX.LE.0) THEN C NET-08 CALL ERROR('NET-08: Zero maximum size of a forward star') C NET-08: Zero maximum size of a forward star: C For NFSMAX=0 in input data SEP, C option 'NFS(I)'='*' cannot be used in input data C NET in record (4.1). END IF ELSE LNFS=.TRUE. IF(L1234.GT.MNFS) THEN C NET-34 CALL ERROR * ('NET-34: Insufficient memory for forward star sizes') C NET-34: Insufficient memory for forward star sizes: C The number of network nodes, see input file C SEP, should not exceed MNFS. C This error should not appear. Contact the authors. END IF IF(FNFS(IREFL)(1:1).EQ.'+') THEN DO 51 L=1,L1234 IRAM(NFS0+L)=NFSMAX 51 CONTINUE CALL RARRAI(LU1,FNFS(IREFL)(2:LEN(FNFS(IREFL))),'FORMATTED', * .FALSE.,0,L1234,IRAM(NFS0+1)) IF(NFSMAX.EQ.0) THEN DO 52 L=1,L1234 IF(IRAM(NFS0+L).GT.NFSMAX) THEN NFSMAX=IRAM(NFS0+L) ENDIF 52 CONTINUE ELSE DO 53 L=1,L1234 IF(IRAM(NFS0+L).GT.NFSMAX) THEN IRAM(NFS0+L)=NFSMAX ENDIF 53 CONTINUE END IF ELSE JCOUNT=0 DO 58 JPOS3=0,NL3-1 DO 57 JPOS2=0,NL2-1 JPOS=NL1*(JPOS2+NL2*JPOS3) DO 56 JPOS1=0,NL1-1 JPOS=JPOS+1 C JPOS=1+JPOS1+NL1*(JPOS2+NL2*JPOS3) JADR=INDX(JPOS) IF(JADR.GT.0) THEN CALL OPTNFS * (JPOS,JPOS1,JPOS2,JPOS3,JADR,NFSOPT,C1,C2MIN,C2MAX) IRAM(NFS0+JADR)=NFSOPT JCOUNT=JCOUNT+1 IF(JCOUNT/1000*1000.EQ.JCOUNT) THEN WRITE(*,'(A,I7,A,I7)') * '+NET: Generating optimum sizes of forward stars:', * JCOUNT,' of',L1234 END IF END IF 56 CONTINUE 57 CONTINUE 58 CONTINUE IF(NFSMAX.EQ.0) THEN C Automatic estimation of NFSMAX: NUMOPT=0 SUMOPT=0. DO 61 L=1,L1234 I=IRAM(NFS0+L) IF(I.GT.0) THEN NUMOPT=NUMOPT+1 SUMOPT=SUMOPT+1./FLOAT(I)**2 END IF 61 CONTINUE SUMOPT=SQRT(FLOAT(NUMOPT)/SUMOPT) NFSMAX=INT(SUMOPT+0.5) NFSMAX=MIN0(NFSMAX,MAX0(N1*L1,N2*L2,N3*L3)-1) IF(NFSMAX.LE.0) THEN C NET-09 CALL ERROR('NET-09: Zero maximum size of a forward star') C NET-09: Zero maximum size of a forward star: C Contact the authors. END IF IF(NFSMAX.GT.MFSMAX) THEN C NET-11 CALL ERROR * ('NET-11: Maximum size of a forward star too great') C NET-11: Maximum size of a forward star too great: C NFSMAX in input data file SEP C should be decreased if positive, C adjusted to MFSMAX if zero, C or the dimension MFSMAX in the common block /FS/ C in net.inc should be increased. END IF DO 62 L=1,L1234 IF(IRAM(NFS0+L).GT.NFSMAX) THEN IRAM(NFS0+L)=NFSMAX END IF 62 CONTINUE END IF WRITE(*,'(A,I7,A,I7)') * '+NET: Generating optimum sizes of forward stars:', * JCOUNT,' of',L1234 IF(FNFS(IREFL).NE.' ') THEN CALL WARRAI(LU1,FNFS(IREFL)(2:LEN(FNFS(IREFL))),'FORMATTED', * .FALSE.,0,.FALSE.,0,L1234,IRAM(NFS0+1)) END IF END IF END IF C C 2-D or 3-D model: IF(NL3.EQ.1) THEN IF(NL2.EQ.1) THEN IF(NL1.EQ.1) THEN C NET-35 CALL ERROR('NET-35: One-point model') C NET-35: One-point model: C N1*L1=N2*L2=N3*L3=1 in input file C SEP. ELSE C NET-36 CALL ERROR('NET-36: Line model') C NET-36: Line model: C N2*L2=N3*L3=1 in input file SEP. END IF ELSE IF(NL1.EQ.1) THEN C NET-37 CALL ERROR('NET-37: Line model') C NET-37: Line model: C N1*L1=N3*L3=1 in input file SEP. ELSE DMIN=AMIN1(ASX1,ASX2)/VMAX END IF END IF ELSE IF(NL2.EQ.1) THEN IF(NL1.EQ.1) THEN C NET-38 CALL ERROR('NET-38: Line model') C NET-38: Line model: C N1*L1=N2*L2=1 in input file SEP. ELSE DMIN=AMIN1(ASX1,ASX3)/VMAX END IF ELSE IF(NL1.EQ.1) THEN DMIN=AMIN1(ASX2,ASX3)/VMAX ELSE DMIN=AMIN1(ASX1,ASX2,ASX3)/VMAX END IF END IF END IF IF(NFSMAX.LT.0) THEN C Second-order grid travel-time tracing: AUX=ASX1*ASX1+ASX2*ASX2+ASX3*ASX3 DMIN=SQRT(AUX)-SQRT(AUX-DMIN*DMIN) END IF C C....................................................................... C C Writing parameters on the screen: IF(IREFL.EQ.0) THEN WRITE(*,'(A,I2,A,3(I4,A),I9,A,I2,A,I4,A)') * '+',NREFL,' reflections,',NL1,'*',NL2,'*',NL3,'=',NL1*NL2*NL3, * ' gridpoints, f.s.size:',NFSMAX,',',NREC,' receivers' WRITE(*,*) END IF C C....................................................................... C C Initialization: C WRITE(*,'(A)') * '+NET: Initializing source nodes ' C IF(IREFL.LE.0) THEN C C Given source points: C C Initialization of arrays DO 71 I=1,NL1*NL2*NL3 IADR=INDX(I) IF(IADR.GT.0) THEN RAM(ITT0+IADR)=GIANT IF(LPRED) THEN IRAM(IPRED0+IADR)=I END IF END IF 71 CONTINUE C C MINQ,MAXQ describe the extent of the queue. MINQ=1 MAXQ=0 TTMIN=TTS(1) C C Extent of a dense forward star at source points: IF(LNFS) THEN NFSMAK=0 ELSE IF(NFSMAX.GE.0) THEN NFSMAK=NFSMAX CALL MAKEFS(NFSMAK) END IF C C Loop over source points DO 79 ISRC=1,NSRC C C Minimum first-arrival time: TTMIN=AMIN1(TTS(ISRC),TTMIN) C C Parameters of the source point: CALL SLOW(X1S(ISRC),X2S(ISRC),X3S(ISRC),DPOS1,DPOS2,DPOS3, * IPOS1,IPOS2,IPOS3,IPOS,IADR,PI) TTI=TTS(ISRC) ISRCI=-ISRC C C Updating: IF(NFSMAX.GE.0) THEN C Network ray tracing: C Adjusting extent of dense forward star at the source point IF(LNFS) THEN IF(IRAM(NFS0+IADR).NE.NFSMAK) THEN NFSMAK=IRAM(NFS0+IADR) CALL MAKEFS(NFSMAK) END IF END IF C Updating CALL LOOP(SRCREC) ELSE C Second-order grid travel-time tracing: CALL TTTSRC() END IF C 79 CONTINUE C C Reading and assembling optimized forward star: CALL READFS() C C....................................................................... C ELSE C C Given reflector: C C Reading the interface file: C Creating queue for travel-times on the interface DO 81 INDQ=1,MGRID IRAM(IPOSQ0+INDQ)=0 81 CONTINUE CALL RARRAI(LU1,FINTF(IREFL),'FORMATTED', * .FALSE.,0,L1234,IRAM(IPOSQ0+1)) DO 82 INDQ=1,MGRID IF(IRAM(IPOSQ0+INDQ).LE.0) THEN MAXQ=INDQ-1 GO TO 83 END IF 82 CONTINUE C NET-39 CALL ERROR('NET-39: Too many points of reflector') C NET-39: Too many points of reflector: C Number of reflector points should be less than the C number of network nodes (gridpoints). 83 CONTINUE C C Labeling the time field in the queue (TT(I)=RAM(ITT0+I).LT.0): M=0 TTMIN=GIANT DO 84 I=1,MAXQ IADR=INDX(IRAM(IPOSQ0+I)) C Check for the computational volume and for a free space: IF(IADR.GT.0) THEN IF(RAM(IP0+IADR).LT.GIANT) THEN M=M+1 IRAM(IPOSQ0+M)=IRAM(IPOSQ0+I) TTMIN=AMIN1(RAM(ITT0+IADR),TTMIN) RAM(ITT0+IADR)=-RAM(ITT0+IADR) END IF END IF 84 CONTINUE MINQ=1 MAXQ=M C C Defining the 1st approximation of the s.p.t. And initially C updating the interface: DO 88 I=1,NL1*NL2*NL3 IADR=INDX(I) IF(IADR.GT.0) THEN IF(RAM(ITT0+IADR).LT.0..AND.RAM(IP0+IADR).LT.GIANT) THEN RAM(ITT0+IADR)=-RAM(ITT0+IADR) IF(LPRED) THEN IRAM(IPRED0+IADR)=0 ENDIF ELSE RAM(ITT0+IADR)=GIANT IF(LPRED) THEN IRAM(IPRED0+IADR)=I ENDIF ENDIF ENDIF 88 CONTINUE C ENDIF IF(MAXQ.LT.MINQ) THEN C NET-50 CALL ERROR('NET-50: No source point') C NET-50: No source point: C This error should not appear. Contact the authors. ENDIF RETURN END C C======================================================================= C C C SUBROUTINE GENER(IREFL) INTEGER IREFL C C Procedure generating travel-time field and predecessors by performing C shortest path ray tracing (one iteration). C C Input: C IREFL.. Number of reflections. C C No output. C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ /NODE/ are required here: INCLUDE 'net.inc' C net.inc INCLUDE 'netnode.inc' C netnode.inc C C----------------------------------------------------------------------- C REAL GIANT PARAMETER (GIANT=1.E+10) C EXTERNAL INDX,UPDATE,TTTUPD,FREVOL INTEGER INDX C INTEGER NUMNOD,NUMA,NUMINC,NUMOLD,INDQ,I REAL TTINDQ PARAMETER (NUMINC=1000) C C NUMNOD..Number of network nodes not situated in a free space. C NUMA... Counter of finished nodes (nodes moved to set A). C NUMINC..Minimum increment of the number of finished nodes between C the reports on the screen. If the increment is smaller, C screen output is suppressed. C NUMOLD..Counter of finished nodes reported on the screen. C INDQ... Loop variable (index in Q). C I... Loop variable (index of a node). C TTINDQ..Travel time in the INDQ-th Q element. C C....................................................................... C C Check for a free space: WRITE(*,'(A)') * '+NET: Eliminating nodes in a free space. ' NUMNOD=L1234 DO 8 I=1,L1234 IF(RAM(IP0+I).GE.GIANT) THEN RAM(ITT0+I)=-GIANT NUMNOD=NUMNOD-1 ENDIF 8 CONTINUE C C Counter of finished nodes (nodes moved to set A): NUMA=0 NUMOLD=-NUMINC C C Loop for intervals: 10 CONTINUE C New interval: TTMIN=TTMIN+DMIN C C Determination of the first element MINQ of set B in Q: DO 21 INDQ=MINQ,MAXQ TTINDQ=RAM(ITT0+INDX(IRAM(IPOSQ0+INDQ))) IF(0..LT.TTINDQ) THEN MINQ=INDQ GO TO 22 END IF 21 CONTINUE MINQ=MAXQ+1 22 CONTINUE C C Screen output: IF(NUMA.GE.NUMOLD+NUMINC.OR.MINQ.GT.MAXQ) THEN WRITE(*,'(A,I2,4(A,I7))') * '+',IREFL,'-th reflection',NUMA,' nodes of',NUMNOD, * ' finished, QMIN=',MINQ,', QMAX=',MAXQ NUMOLD=NUMA END IF C C (4) Iteration check: testing the end of time field generation C condition to finish the generation of the s.p.t. IF(MINQ.GT.MAXQ) THEN DO 31 IADR=1,L1234 RAM(ITT0+IADR)=ABS(RAM(ITT0+IADR)) 31 CONTINUE RETURN ENDIF C DO 40 INDQ=MINQ,MAXQ C C (2) Selection: TTINDQ=RAM(ITT0+INDX(IRAM(IPOSQ0+INDQ))) IF(0..LT.TTINDQ.AND.TTINDQ.LT.TTMIN) THEN C C New node 'I' (position IPOS, address IADR): IPOS=IRAM(IPOSQ0+INDQ) IPOS1=IPOS-1 IPOS3=IPOS1/(NL1*NL2) IPOS2=IPOS1/NL1-IPOS3*NL2 IPOS1=IPOS1-(IPOS2+IPOS3*NL2)*NL1 IADR=INDX(IPOS) PI=RAM(IP0+IADR) TTI=RAM(ITT0+IADR) C C (3) Updating nodes 'J' of the forward star FS(I), which are C the neighbours to the node 'I': IF(NFSMAX.GE.0) THEN C Network ray tracing: IF(L4.EQ.0) THEN CALL LOOP(UPDATE) ELSE CALL LOOP(FREVOL) END IF ELSE C Second-order grid travel-time tracing: IF(L4.EQ.0) THEN CALL TTTUPD() ELSE C NET-51 CALL ERROR('NET-51: Fresnel volumes disabled') C NET-51: Fresnel volumes disabled: C Second-order grid travel-time tracing cannot be C performed in Fresnel or other volumes specified C by means of the index file. END IF END IF C C Moving 'I' from set B to set A: IADR=INDX(IPOS) RAM(ITT0+IADR)=-RAM(ITT0+IADR) C Increment of the counter (number of nodes in the set A): NUMA=NUMA+1 C END IF 40 CONTINUE C End of loop for nodes 'I', which are secondary sources of the C time field. C GO TO 10 C End of loop for intervals. END C C======================================================================= C C C SUBROUTINE RESFIL(IREFL) INTEGER IREFL C C In a case of reflections, stores the results of an iteration in an C unformatted direct-access scratch file (one iteration). C C Input: C IREFL.. Number of reflections. C C No output. C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FILES/ are required here: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C INTEGER LU0,LU PARAMETER(LU0=10) C INTEGER I C C I... Temporary loop variable. C C....................................................................... C WRITE(*,'(A)') * ' NET: Writing travel time field ' C IF(IREFL.LT.NREFL) THEN LU=LU0+IREFL OPEN(LU,RECL=8,FORM='UNFORMATTED',ACCESS='DIRECT', * STATUS='SCRATCH') IF(LPRED) THEN DO 11 I=1,L1234 WRITE(LU,REC=I) RAM(ITT0+I),IRAM(IPRED0+I) 11 CONTINUE ELSE DO 12 I=1,L1234 WRITE(LU,REC=I) RAM(ITT0+I) 12 CONTINUE END IF END IF RETURN END C C======================================================================= C C C SUBROUTINE ERRORS(IREFL) INTEGER IREFL C C Procedure generating the travel-time errors at all network nodes C coinciding with gridpoints by means of backward ray tracing. C Writes 'ERR(I)' (one iteration). C C Input: C IREFL.. Number of reflections. C C No output. C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ /FILES/ are required here: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C INTEGER LUERR PARAMETER (LUERR=5) C EXTERNAL INDX INTEGER INDX LOGICAL LTRACE,LRAYS,LEND INTEGER IPREDE,IEND1,IEND2,IEND3,IEND,IENDA,IAUX,JCOUNT REAL DUMMY C C ERR(I)=RAM(IERR0+I): INTEGER IERR0 EQUIVALENCE (IERR0,IPOSQ0) C C....................................................................... C IF(NFSMAX.LT.0) THEN C Second-order grid travel-time tracing: Errors are not generated RETURN END IF C WRITE(*,'(A)') * '+NET: Generating travel-time errors. ' C IF(FERR(IREFL).NE.' ') THEN LTRACE=.FALSE. LRAYS=.FALSE. LEND=.FALSE. C DO 10 IEND=1,L1234 RAM(IERR0+IEND)=-1. 10 CONTINUE C JCOUNT=0 DO 23 IEND3=0,NL3-1 DO 22 IEND2=0,NL2-1 IEND=NL1*(IEND2+NL2*IEND3) DO 21 IEND1=0,NL1-1 IEND=IEND+1 C IEND=1+IEND1+NL1*(IEND2+NL2*IEND3) IENDA=INDX(IEND) IF(IENDA.GT.0) THEN IF(RAM(IERR0+IENDA).LT.0.) THEN IPREDE=IRAM(IPRED0+IENDA) IF(IPREDE.NE.IEND) THEN CALL ONERAY(LTRACE,LRAYS,LEND,IAUX,IREFL,IPREDE, * IEND1,IEND2,IEND3,IENDA,RAM(ITT0+IENDA), * RAM(IERR0+1),DUMMY,IAUX) END IF END IF JCOUNT=JCOUNT+1 IF(JCOUNT/1000*1000.EQ.JCOUNT) THEN WRITE(*,'(A,I7,A,I7)') * '+NET: Generating travel-time errors:', * JCOUNT,' of',L1234 END IF END IF 21 CONTINUE 22 CONTINUE 23 CONTINUE C C....................................................................... C C Writing the travel-time error estimates: C WRITE(*,'(A)') * '+NET: Writing travel-time errors. ' C CALL WARRAY(LUERR,FERR(IREFL),'FORMATTED', * .TRUE.,-1.,.FALSE.,0.,L1234,RAM(IERR0+1)) C END IF RETURN END C C======================================================================= C C C SUBROUTINE RECVRS() C C Procedure updating arrival times at the receivers. C C No input, no output. C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ /NAMESR/ /POINTS/ /FILES/ /NODE/ /SRCC/ C are required here: INCLUDE 'net.inc' C net.inc INCLUDE 'netnode.inc' C netnode.inc C C----------------------------------------------------------------------- C EXTERNAL SRCREC C REAL GIANT PARAMETER (GIANT=1.E+10) C INTEGER IR,ISRC,NFSREC,NFSSRC,NFSMAK,I1,I2,I3,I4,I5 REAL DIM,PS,A1,A2,A3,DIST2,TTSR C C IR... Index of the receiver. C ISRC... Index of the source. C NFSREC..Size of the f.s. at the receiver. C NFSSRC..Size of the f.s. at the source. C NFSMAK..Size of recently generated full forward star at source C points. C DIM... 2 or 3 for 2-D or 3-D calculation, respectively. C PS... Slowness at the source. C A1,A2,A3,I1,I2,I3,I4,I5... Other source parameters. C DIST2.. Square of the source-reiver distance. C TTSR... Arrival time at the receiver from the source under C consideration. C C....................................................................... C IF(NFSMAX.LT.0) THEN C Second-order grid travel-time tracing: IF(NREC.GT.0) THEN WRITE(*,'(A)') *'+NET: Receivers are not supported by the 2-D second-order method' WRITE(*,'(A)') ' ' END IF RETURN END IF C C Computing approximate arrival time and rays at the receiver nodes: WRITE(*,'(A)') * '+NET: Updating receivers... ' C C Extent of a dense forward star at receiver points: IF(LNFS) THEN NFSMAK=0 ELSE NFSMAK=NFSMAX CALL MAKEFS(NFSMAK) END IF C C Loop over receivers: DO 90 IR=1,NREC C C Initially, receiver is considered not connected: IPREDR(IR)=0 C C Parameters of the receiver point: CALL SLOW(X1R(IR),X2R(IR),X3R(IR),DPOS1,DPOS2,DPOS3, * IPOS1,IPOS2,IPOS3,IPOS,IADR,PI) TTI=GIANT ISRCI=IR C C....................................................................... C C For no reflections, testing the source-receiver position: C IF(NREFL.EQ.0) THEN C Loop over source points: DO 39 ISRC=1,NSRC C C Square of the source-reiver distance: DIST2=0. IF(LN1) THEN DIST2=DIST2+((X1S(ISRC)-X1R(IR))**2 * +(X2S(ISRC)-X2R(IR))**2)/ASX2**2 END IF IF(NL1.GT.1) THEN DIST2=DIST2+((X1S(ISRC)-X1R(IR))/ASX1)**2 END IF IF(NL2.GT.1) THEN DIST2=DIST2+((X2S(ISRC)-X2R(IR))/ASX2)**2 END IF IF(NL3.GT.1) THEN DIST2=DIST2+((X3S(ISRC)-X3R(IR))/ASX3)**2 END IF C C Size of the f.s. at the receiver point: IF(LNFS) THEN NFSREC=IRAM(NFS0+IADR) ELSE NFSREC=NFSMAX END IF C C Dimension of the model and forward stars (2 or 3): IF(NL1.EQ.1.OR.NL2.EQ.1.OR.NL3.EQ.1) THEN DIM=2. ELSE DIM=3. END IF C IF(DIST2.LE.FLOAT(NFSREC)**2+DIM-1.) THEN C Source is situated within the receiver f.s. ellipsoid CALL SLOW(X1S(ISRC),X2S(ISRC),X3S(ISRC),A1,A2,A3, * I1,I2,I3,I4,I5,PS) C C Check for crossing an interface: IF(LICB) THEN IF(IRAM(ICB0+IADR).NE.IRAM(ICB0+I5)) THEN IF(DIST2.GT.DIM) GO TO 38 END IF END IF C C Size of the f.s. at the source point: IF(LNFS) THEN NFSSRC=IRAM(NFS0+I5) ELSE NFSSRC=NFSMAX END IF C C Updating: IF(DIST2.LE.FLOAT(NFSSRC)**2+DIM-1.) THEN C Travel time from source to the receiver TTSR=SQRT((X1R(IR)-X1S(ISRC))**2+ * (X2R(IR)-X2S(ISRC))**2+ * (X3R(IR)-X3S(ISRC))**2)*0.5*(PI+PS)+TTS(ISRC) C Updating IF(IPREDR(IR).LT.0) THEN IF(TTR(IR).GT.TTSR) THEN IPREDR(IR)=-ISRC TTR(IR)=TTSR END IF ELSE IPREDR(IR)=-ISRC TTR(IR)=TTSR END IF END IF C 38 CONTINUE END IF 39 CONTINUE END IF C C....................................................................... C C Connecting the receiver still not connected: C IF(IPREDR(IR).EQ.0) THEN C Adjusting extent of the dense forward star at the receiver C point: IF(LNFS) THEN IF(IRAM(NFS0+IADR).NE.NFSMAK) THEN NFSMAK=IRAM(NFS0+IADR) CALL MAKEFS(NFSMAK) END IF END IF C C Updating: CALL LOOP(SRCREC) TTR(IR)=TTI ENDIF C 90 CONTINUE RETURN END C C======================================================================= C C C SUBROUTINE TRACER() C C Procedure performing backward ray tracing from the receivers, C including the estimation of arrival-time errors. C C No input, no output. C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ /NAMESR/ /POINTS/ /FILES/ are required: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C INTEGER LURAYS,LUEND PARAMETER (LURAYS=4) PARAMETER (LUEND=5) C LOGICAL LTRACE,LRAYS,LEND INTEGER IPREDE,IEND1,IEND2,IEND3,IAUX,IENDA,IREC,ISRC REAL DUMMY1,DUMMY2,DUMMY3,PEND,TERR,DUMMY C C IREC... Loop variable - index of a receiver. C C....................................................................... C IF(NFSMAX.LT.0) THEN C Second-order grid travel-time tracing: No posterior ray tracing RETURN END IF C LTRACE=.TRUE. WRITE(*,'(A)') * '+NET: Backward ray tracing... ' IF(FRAYS.EQ.' ') THEN LRAYS=.FALSE. ELSE LRAYS=.TRUE. END IF IF(FEND.EQ.' ') THEN LEND=.FALSE. ELSE LEND=.TRUE. END IF C IF(LRAYS) THEN OPEN(LURAYS,FILE=FRAYS) WRITE(LURAYS,'(A)') '/' END IF IF(LEND) THEN OPEN(LUEND,FILE=FEND) WRITE(LUEND,'(A)') '/' END IF DO 80 IREC=1,NREC IPREDE=IPREDR(IREC) IF(IPREDE.NE.0) THEN IF(LRAYS) THEN IF(NAMES.EQ.' ') THEN IF(NAMER(IREC).EQ.' ') THEN WRITE(LURAYS,'(2A,I5,5A)') * '''','RAY',IREC, ''' /' ELSE WRITE(LURAYS,'(2A,I5,5A)') * '''','RAY',IREC,' ',NAMES,' TO ',NAMER(IREC),''' /' END IF ELSE IF(NAMER(IREC).EQ.' ') THEN WRITE(LURAYS,'(2A,I5,5A)') * '''','RAY',IREC,' FROM ',NAMES, ''' /' ELSE WRITE(LURAYS,'(2A,I5,5A)') * '''','RAY',IREC,' FROM ',NAMES,' TO ',NAMER(IREC),''' /' END IF END IF WRITE(LURAYS,'(4F12.6,A)') * X1R(IREC),X2R(IREC),X3R(IREC),TTR(IREC),' /' END IF IF(LEND) THEN CALL SLOW(X1R(IREC),X2R(IREC),X3R(IREC), * DUMMY1,DUMMY2,DUMMY3,IEND1,IEND2,IEND3,IAUX,IENDA,PEND) END IF CALL ONERAY(LTRACE,LRAYS,LEND,LURAYS,NREFL, * IPREDE,IEND1,IEND2,IEND3,IENDA,TTR(IREC),DUMMY,TERR,ISRC) IF(LRAYS) THEN WRITE(LURAYS,'(4F12.6,A)') * X1S(ISRC),X2S(ISRC),X3S(ISRC),TTS(ISRC),' /' WRITE(LURAYS,'(''/'')') END IF IF(LEND) THEN WRITE(LUEND,'(3A,5F12.6,A)') '''',NAMER(IREC),'''', * X1R(IREC),X2R(IREC),X3R(IREC),TTR(IREC),TERR,' /' END IF END IF 80 CONTINUE IF(LRAYS) THEN WRITE(LURAYS,'(''/'')') CLOSE(LURAYS) END IF IF(LEND) THEN WRITE(LUEND,'(''/'')') CLOSE(LUEND) END IF RETURN END C C======================================================================= C C C SUBROUTINE OUTPUT() C C Subroutine to rewrite arrival-time fields and predecessors from memory C or scratch files to formatted output files 'TT(I)' and 'IPRED(I)'. C C No input, no output. C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ /FILES/ are required here: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C INTEGER LU0,LU1,LU PARAMETER(LU0=10) PARAMETER(LU1=1) REAL GIANT PARAMETER (GIANT=1.0E+10) C INTEGER NF,I C NF,I... Loop variables. C C....................................................................... C WRITE(*,'(A)') * '+NET: Generating output files... ' C DO 30 NF=NREFL,0,-1 C C Reading scratch file: IF(NF.NE.NREFL) THEN LU=LU0+NF IF(FTT(NF).NE.' '.OR.FPRED(NF).NE.' ') THEN IF(LPRED) THEN DO 11 I=1,L1234 READ(LU,REC=I) RAM(ITT0+I),IRAM(IPRED0+I) 11 CONTINUE ELSE DO 12 I=1,L1234 READ(LU,REC=I) RAM(ITT0+I) 12 CONTINUE END IF END IF C Closing the scratch file C ********* CLOSE(LU) C ********* END IF C C Writing arrival times: IF(FTT(NF).NE.' ') THEN CALL WARRAY(LU1,FTT(NF),'FORMATTED', * .FALSE.,0.,.TRUE.,GIANT,L1234,RAM(ITT0+1)) END IF C C Writing predecessors: IF(NFSMAX.LT.0) THEN C Second-order grid travel-time tracing C (writing slowness vector): IF(N1.GT.1.AND.FERR(NF).NE.' ') THEN CALL WARRAY(LU1,FERR(NF),'FORMATTED', * .FALSE.,0.,.FALSE.,GIANT,L1234,RAM(IP0+1)) END IF IF(N2.GT.1.AND.FPRED(NF).NE.' ') THEN CALL WARRAY(LU1,FPRED(NF),'FORMATTED', * .FALSE.,0.,.FALSE.,GIANT,L1234,RAM(IP20+1)) END IF C IF(N3.GT.1.AND.FNFS(NF).NE.' ') THEN C CALL WARRAY(LU1,FNFS(NF),'FORMATTED', C * .FALSE.,0.,.FALSE.,GIANT,L1234,RAM(IP30+1)) C END IF ELSE IF(FPRED(NF).NE.' ') THEN CALL WARRAI(LU1,FPRED(NF),'FORMATTED', * .FALSE.,0,.FALSE.,0,L1234,IRAM(IPRED0+1)) END IF 30 CONTINUE C WRITE(*,'(A)') * '+NET: Done. ' RETURN END C C======================================================================= C C C SUBROUTINE LOOP(UPDATE) EXTERNAL UPDATE C C This subroutine performs the loop over the nodes 'J' of the forward C star FS(I). A clear but exact arrangement of the loop is expressed C inside asterisks. The code following the asterisk rectangular is C equivalent, but much longer and somewhat faster. C Auxiliary subroutine to SOURCE, GENER, and RECVRS. C LOOP(FREVOL) or LOOP(UPDATE): employed by GENER, C LOOP(SRCREC): employed by SOURCE and RECVRS. C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ /NODE/ are required here: INCLUDE 'net.inc' C net.inc INCLUDE 'netnode.inc' C netnode.inc C C----------------------------------------------------------------------- C INTEGER I1MIN,I1MAX,I2MIN,I2MAX,I3MIN,I3MAX,I1,I2,I3 INTEGER NFSOLD,NLEX1,NLEX2,NLEX3,IFSMIN,IFSMAX SAVE NFSOLD,NLEX1,NLEX2,NLEX3,IFSMIN,IFSMAX C Still no forward star used: DATA NFSOLD/0/ C C I1MIN,I1MAX,I2MIN,I2MAX,I3MIN,I3MAX... C I1,I2,I3... C NFSOLD... C NLEX1,NLEX2,NLEX3... C IFSMIN,IFSMAX... C C....................................................................... C C Additional check of input data IF(NFSMAX.LT.0) THEN C Second-order grid travel-time tracing -- inaccessible branch: C NET-55 CALL ERROR('NET-55: LOOP should not be called') C NET-55: LOOP should not be called: C This error should not appear. Contact the authors. END IF C C Index of the block (if applicable): IF(LICB) THEN ICBI=IRAM(ICB0+IADR) END IF C C Adjusting extent of the forward star: IF(NFSOLD.EQ.0) THEN NFSOLD=NFSMAX NLEX1=MIN0(NFSOLD,NL1-1) NLEX2=MIN0(NFSOLD,NL2-1) NLEX3=MIN0(NFSOLD,NL3-1) END IF IF(LNFS) THEN IF(IRAM(NFS0+IADR).NE.NFSOLD) THEN NFSOLD=IRAM(NFS0+IADR) NLEX1=MIN0(NFSOLD,NL1-1) NLEX2=MIN0(NFSOLD,NL2-1) NLEX3=MIN0(NFSOLD,NL3-1) END IF END IF C C Location of the forward star in the memory: IFSMIN=KFS0(NFSOLD-1)+1 IFSMAX=KFS0(NFSOLD) C C Extent of the intersection of the forward star with the grid: I1MIN= -IPOS1 I1MAX=NL1-1-IPOS1 I2MIN= -IPOS2 I2MAX=NL2-1-IPOS2 I3MIN= -IPOS3 I3MAX=NL3-1-IPOS3 C ************************************************************************ * DO 163 IFS=IFSMIN,IFSMAX * * I1=KFS1(IFS) * * I2=KFS2(IFS) * * I3=KFS3(IFS) * * IF(I1MIN.LE.I1.AND.I1.LE.I1MAX.AND. * * * I2MIN.LE.I2.AND.I2.LE.I2MAX.AND. * * * I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN * * CALL UPDATE() * * END IF * * 163 CONTINUE * ************************************************************************ C C This is an optimized version of the above loop: IF(I3MIN.LE.-NLEX3) THEN IF(NLEX3.LE.I3MAX) THEN IF(I2MIN.LE.-NLEX2) THEN IF(NLEX2.LE.I2MAX) THEN IF(I1MIN.LE.-NLEX1) THEN IF(NLEX1.LE.I1MAX) THEN DO 100 IFS=IFSMIN,IFSMAX CALL UPDATE() 100 CONTINUE ELSE DO 101 IFS=IFSMIN,IFSMAX IF(KFS1(IFS).LE.I1MAX) THEN CALL UPDATE() END IF 101 CONTINUE END IF ELSE IF(NLEX1.LE.I1MAX) THEN DO 102 IFS=IFSMIN,IFSMAX IF(I1MIN.LE.KFS1(IFS)) THEN CALL UPDATE() END IF 102 CONTINUE ELSE DO 103 IFS=IFSMIN,IFSMAX I1=KFS1(IFS) IF(I1MIN.LE.I1.AND.I1.LE.I1MAX) THEN CALL UPDATE() END IF 103 CONTINUE END IF END IF ELSE IF(I1MIN.LE.-NLEX1) THEN IF(NLEX1.LE.I1MAX) THEN DO 104 IFS=IFSMIN,IFSMAX IF(KFS2(IFS).LE.I2MAX) THEN CALL UPDATE() END IF 104 CONTINUE ELSE DO 105 IFS=IFSMIN,IFSMAX IF(KFS1(IFS).LE.I1MAX.AND. * KFS2(IFS).LE.I2MAX) THEN CALL UPDATE() END IF 105 CONTINUE END IF ELSE IF(NLEX1.LE.I1MAX) THEN DO 106 IFS=IFSMIN,IFSMAX IF(I1MIN.LE.KFS1(IFS).AND. * KFS2(IFS).LE.I2MAX) THEN CALL UPDATE() END IF 106 CONTINUE ELSE DO 107 IFS=IFSMIN,IFSMAX I1=KFS1(IFS) IF(I1MIN.LE.I1.AND.I1.LE.I1MAX.AND. * KFS2(IFS).LE.I2MAX) THEN CALL UPDATE() END IF 107 CONTINUE END IF END IF END IF ELSE IF(NLEX2.LE.I2MAX) THEN IF(I1MIN.LE.-NLEX1) THEN IF(NLEX1.LE.I1MAX) THEN DO 108 IFS=IFSMIN,IFSMAX IF(I2MIN.LE.KFS2(IFS)) THEN CALL UPDATE() END IF 108 CONTINUE ELSE DO 109 IFS=IFSMIN,IFSMAX IF( KFS1(IFS).LE.I1MAX.AND. * I2MIN.LE.KFS2(IFS)) THEN CALL UPDATE() END IF 109 CONTINUE END IF ELSE IF(NLEX1.LE.I1MAX) THEN DO 110 IFS=IFSMIN,IFSMAX IF(I1MIN.LE.KFS1(IFS).AND. * I2MIN.LE.KFS2(IFS)) THEN CALL UPDATE() END IF 110 CONTINUE ELSE DO 111 IFS=IFSMIN,IFSMAX I1=KFS1(IFS) IF(I1MIN.LE.I1.AND.I1.LE.I1MAX.AND. * I2MIN.LE.KFS2(IFS)) THEN CALL UPDATE() END IF 111 CONTINUE END IF END IF ELSE IF(I1MIN.LE.-NLEX1) THEN IF(NLEX1.LE.I1MAX) THEN DO 112 IFS=IFSMIN,IFSMAX I2=KFS2(IFS) IF(I2MIN.LE.I2.AND.I2.LE.I2MAX) THEN CALL UPDATE() END IF 112 CONTINUE ELSE DO 113 IFS=IFSMIN,IFSMAX I2=KFS2(IFS) IF( KFS1(IFS).LE.I1MAX.AND. * I2MIN.LE.I2.AND.I2.LE.I2MAX) THEN CALL UPDATE() END IF 113 CONTINUE END IF ELSE IF(NLEX1.LE.I1MAX) THEN DO 114 IFS=IFSMIN,IFSMAX I2=KFS2(IFS) IF(I1MIN.LE.KFS1(IFS).AND. * I2MIN.LE.I2.AND.I2.LE.I2MAX) THEN CALL UPDATE() END IF 114 CONTINUE ELSE DO 115 IFS=IFSMIN,IFSMAX I1=KFS1(IFS) I2=KFS2(IFS) IF(I1MIN.LE.I1.AND.I1.LE.I1MAX.AND. * I2MIN.LE.I2.AND.I2.LE.I2MAX) THEN CALL UPDATE() END IF 115 CONTINUE END IF END IF END IF END IF ELSE IF(I2MIN.LE.-NLEX2) THEN IF(NLEX2.LE.I2MAX) THEN IF(I1MIN.LE.-NLEX1) THEN IF(NLEX1.LE.I1MAX) THEN DO 116 IFS=IFSMIN,IFSMAX IF(KFS3(IFS).LE.I3MAX) THEN CALL UPDATE() END IF 116 CONTINUE ELSE DO 117 IFS=IFSMIN,IFSMAX IF(KFS1(IFS).LE.I1MAX.AND. * KFS3(IFS).LE.I3MAX) THEN CALL UPDATE() END IF 117 CONTINUE END IF ELSE IF(NLEX1.LE.I1MAX) THEN DO 118 IFS=IFSMIN,IFSMAX IF(I1MIN.LE.KFS1(IFS).AND. * KFS3(IFS).LE.I3MAX) THEN CALL UPDATE() END IF 118 CONTINUE ELSE DO 119 IFS=IFSMIN,IFSMAX I1=KFS1(IFS) IF(I1MIN.LE.I1.AND.I1.LE.I1MAX.AND. * KFS3(IFS).LE.I3MAX) THEN CALL UPDATE() END IF 119 CONTINUE END IF END IF ELSE IF(I1MIN.LE.-NLEX1) THEN IF(NLEX1.LE.I1MAX) THEN DO 120 IFS=IFSMIN,IFSMAX IF(KFS2(IFS).LE.I2MAX.AND. * KFS3(IFS).LE.I3MAX) THEN CALL UPDATE() END IF 120 CONTINUE ELSE DO 121 IFS=IFSMIN,IFSMAX IF(KFS1(IFS).LE.I1MAX.AND. * KFS2(IFS).LE.I2MAX.AND. * KFS3(IFS).LE.I3MAX) THEN CALL UPDATE() END IF 121 CONTINUE END IF ELSE IF(NLEX1.LE.I1MAX) THEN DO 122 IFS=IFSMIN,IFSMAX IF(I1MIN.LE.KFS1(IFS).AND. * KFS2(IFS).LE.I2MAX.AND. * KFS3(IFS).LE.I3MAX) THEN CALL UPDATE() END IF 122 CONTINUE ELSE DO 123 IFS=IFSMIN,IFSMAX I1=KFS1(IFS) IF(I1MIN.LE.I1.AND.I1.LE.I1MAX.AND. * KFS2(IFS).LE.I2MAX.AND. * KFS3(IFS).LE.I3MAX) THEN CALL UPDATE() END IF 123 CONTINUE END IF END IF END IF ELSE IF(NLEX2.LE.I2MAX) THEN IF(I1MIN.LE.-NLEX1) THEN IF(NLEX1.LE.I1MAX) THEN DO 124 IFS=IFSMIN,IFSMAX IF(I2MIN.LE.KFS2(IFS).AND. * KFS3(IFS).LE.I3MAX) THEN CALL UPDATE() END IF 124 CONTINUE ELSE DO 125 IFS=IFSMIN,IFSMAX IF( KFS1(IFS).LE.I1MAX.AND. * I2MIN.LE.KFS2(IFS).AND. * KFS3(IFS).LE.I3MAX) THEN CALL UPDATE() END IF 125 CONTINUE END IF ELSE IF(NLEX1.LE.I1MAX) THEN DO 126 IFS=IFSMIN,IFSMAX IF(I1MIN.LE.KFS1(IFS).AND. * I2MIN.LE.KFS2(IFS).AND. * KFS3(IFS).LE.I3MAX) THEN CALL UPDATE() END IF 126 CONTINUE ELSE DO 127 IFS=IFSMIN,IFSMAX I1=KFS1(IFS) IF(I1MIN.LE.I1.AND.I1.LE.I1MAX.AND. * I2MIN.LE.KFS2(IFS).AND. * KFS3(IFS).LE.I3MAX) THEN CALL UPDATE() END IF 127 CONTINUE END IF END IF ELSE IF(I1MIN.LE.-NLEX1) THEN IF(NLEX1.LE.I1MAX) THEN DO 128 IFS=IFSMIN,IFSMAX I2=KFS2(IFS) IF(I2MIN.LE.I2.AND.I2.LE.I2MAX.AND. * KFS3(IFS).LE.I3MAX) THEN CALL UPDATE() END IF 128 CONTINUE ELSE DO 129 IFS=IFSMIN,IFSMAX I2=KFS2(IFS) IF( KFS1(IFS).LE.I1MAX.AND. * I2MIN.LE.I2.AND.I2.LE.I2MAX.AND. * KFS3(IFS).LE.I3MAX) THEN CALL UPDATE() END IF 129 CONTINUE END IF ELSE IF(NLEX1.LE.I1MAX) THEN DO 130 IFS=IFSMIN,IFSMAX I2=KFS2(IFS) IF(I1MIN.LE.KFS1(IFS).AND. * I2MIN.LE.I2.AND.I2.LE.I2MAX.AND. * KFS3(IFS).LE.I3MAX) THEN CALL UPDATE() END IF 130 CONTINUE ELSE DO 131 IFS=IFSMIN,IFSMAX I1=KFS1(IFS) I2=KFS2(IFS) IF(I1MIN.LE.I1.AND.I1.LE.I1MAX.AND. * I2MIN.LE.I2.AND.I2.LE.I2MAX.AND. * KFS3(IFS).LE.I3MAX) THEN CALL UPDATE() END IF 131 CONTINUE END IF END IF END IF END IF END IF ELSE IF(NLEX3.LE.I3MAX) THEN IF(I2MIN.LE.-NLEX2) THEN IF(NLEX2.LE.I2MAX) THEN IF(I1MIN.LE.-NLEX1) THEN IF(NLEX1.LE.I1MAX) THEN DO 132 IFS=IFSMIN,IFSMAX IF(I3MIN.LE.KFS3(IFS)) THEN CALL UPDATE() END IF 132 CONTINUE ELSE DO 133 IFS=IFSMIN,IFSMAX IF( KFS1(IFS).LE.I1MAX.AND. * I3MIN.LE.KFS3(IFS)) THEN CALL UPDATE() END IF 133 CONTINUE END IF ELSE IF(NLEX1.LE.I1MAX) THEN DO 134 IFS=IFSMIN,IFSMAX IF(I1MIN.LE.KFS1(IFS).AND. * I3MIN.LE.KFS3(IFS)) THEN CALL UPDATE() END IF 134 CONTINUE ELSE DO 135 IFS=IFSMIN,IFSMAX I1=KFS1(IFS) IF(I1MIN.LE.I1.AND.I1.LE.I1MAX.AND. * I3MIN.LE.KFS3(IFS)) THEN CALL UPDATE() END IF 135 CONTINUE END IF END IF ELSE IF(I1MIN.LE.-NLEX1) THEN IF(NLEX1.LE.I1MAX) THEN DO 136 IFS=IFSMIN,IFSMAX IF( KFS2(IFS).LE.I2MAX.AND. * I3MIN.LE.KFS3(IFS)) THEN CALL UPDATE() END IF 136 CONTINUE ELSE DO 137 IFS=IFSMIN,IFSMAX IF( KFS1(IFS).LE.I1MAX.AND. * KFS2(IFS).LE.I2MAX.AND. * I3MIN.LE.KFS3(IFS)) THEN CALL UPDATE() END IF 137 CONTINUE END IF ELSE IF(NLEX1.LE.I1MAX) THEN DO 138 IFS=IFSMIN,IFSMAX IF(I1MIN.LE.KFS1(IFS).AND. * KFS2(IFS).LE.I2MAX.AND. * I3MIN.LE.KFS3(IFS)) THEN CALL UPDATE() END IF 138 CONTINUE ELSE DO 139 IFS=IFSMIN,IFSMAX I1=KFS1(IFS) IF(I1MIN.LE.I1.AND.I1.LE.I1MAX.AND. * KFS2(IFS).LE.I2MAX.AND. * I3MIN.LE.KFS3(IFS)) THEN CALL UPDATE() END IF 139 CONTINUE END IF END IF END IF ELSE IF(NLEX2.LE.I2MAX) THEN IF(I1MIN.LE.-NLEX1) THEN IF(NLEX1.LE.I1MAX) THEN DO 140 IFS=IFSMIN,IFSMAX IF(I2MIN.LE.KFS2(IFS).AND. * I3MIN.LE.KFS3(IFS)) THEN CALL UPDATE() END IF 140 CONTINUE ELSE DO 141 IFS=IFSMIN,IFSMAX IF( KFS1(IFS).LE.I1MAX.AND. * I2MIN.LE.KFS2(IFS).AND. * I3MIN.LE.KFS3(IFS)) THEN CALL UPDATE() END IF 141 CONTINUE END IF ELSE IF(NLEX1.LE.I1MAX) THEN DO 142 IFS=IFSMIN,IFSMAX IF(I1MIN.LE.KFS1(IFS).AND. * I2MIN.LE.KFS2(IFS).AND. * I3MIN.LE.KFS3(IFS)) THEN CALL UPDATE() END IF 142 CONTINUE ELSE DO 143 IFS=IFSMIN,IFSMAX I1=KFS1(IFS) IF(I1MIN.LE.I1.AND.I1.LE.I1MAX.AND. * I2MIN.LE.KFS2(IFS).AND. * I3MIN.LE.KFS3(IFS)) THEN CALL UPDATE() END IF 143 CONTINUE END IF END IF ELSE IF(I1MIN.LE.-NLEX1) THEN IF(NLEX1.LE.I1MAX) THEN DO 144 IFS=IFSMIN,IFSMAX I2=KFS2(IFS) IF(I2MIN.LE.I2.AND.I2.LE.I2MAX.AND. * I3MIN.LE.KFS3(IFS)) THEN CALL UPDATE() END IF 144 CONTINUE ELSE DO 145 IFS=IFSMIN,IFSMAX I2=KFS2(IFS) IF( KFS1(IFS).LE.I1MAX.AND. * I2MIN.LE.I2.AND.I2.LE.I2MAX.AND. * I3MIN.LE.KFS3(IFS)) THEN CALL UPDATE() END IF 145 CONTINUE END IF ELSE IF(NLEX1.LE.I1MAX) THEN DO 146 IFS=IFSMIN,IFSMAX I2=KFS2(IFS) IF(I1MIN.LE.KFS1(IFS).AND. * I2MIN.LE.I2.AND.I2.LE.I2MAX.AND. * I3MIN.LE.KFS3(IFS)) THEN CALL UPDATE() END IF 146 CONTINUE ELSE DO 147 IFS=IFSMIN,IFSMAX I1=KFS1(IFS) I2=KFS2(IFS) IF(I1MIN.LE.I1.AND.I1.LE.I1MAX.AND. * I2MIN.LE.I2.AND.I2.LE.I2MAX.AND. * I3MIN.LE.KFS3(IFS)) THEN CALL UPDATE() END IF 147 CONTINUE END IF END IF END IF END IF ELSE IF(I2MIN.LE.-NLEX2) THEN IF(NLEX2.LE.I2MAX) THEN IF(I1MIN.LE.-NLEX1) THEN IF(NLEX1.LE.I1MAX) THEN DO 148 IFS=IFSMIN,IFSMAX I3=KFS3(IFS) IF(I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN CALL UPDATE() END IF 148 CONTINUE ELSE DO 149 IFS=IFSMIN,IFSMAX I3=KFS3(IFS) IF( KFS1(IFS).LE.I1MAX.AND. * I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN CALL UPDATE() END IF 149 CONTINUE END IF ELSE IF(NLEX1.LE.I1MAX) THEN DO 150 IFS=IFSMIN,IFSMAX I3=KFS3(IFS) IF(I1MIN.LE.KFS1(IFS).AND. * I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN CALL UPDATE() END IF 150 CONTINUE ELSE DO 151 IFS=IFSMIN,IFSMAX I1=KFS1(IFS) I3=KFS3(IFS) IF(I1MIN.LE.I1.AND.I1.LE.I1MAX.AND. * I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN CALL UPDATE() END IF 151 CONTINUE END IF END IF ELSE IF(I1MIN.LE.-NLEX1) THEN IF(NLEX1.LE.I1MAX) THEN DO 152 IFS=IFSMIN,IFSMAX I3=KFS3(IFS) IF( KFS2(IFS).LE.I2MAX.AND. * I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN CALL UPDATE() END IF 152 CONTINUE ELSE DO 153 IFS=IFSMIN,IFSMAX I3=KFS3(IFS) IF( KFS1(IFS).LE.I1MAX.AND. * KFS2(IFS).LE.I2MAX.AND. * I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN CALL UPDATE() END IF 153 CONTINUE END IF ELSE IF(NLEX1.LE.I1MAX) THEN DO 154 IFS=IFSMIN,IFSMAX I3=KFS3(IFS) IF(I1MIN.LE.KFS1(IFS).AND. * KFS2(IFS).LE.I2MAX.AND. * I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN CALL UPDATE() END IF 154 CONTINUE ELSE DO 155 IFS=IFSMIN,IFSMAX I1=KFS1(IFS) I3=KFS3(IFS) IF(I1MIN.LE.I1.AND.I1.LE.I1MAX.AND. * KFS2(IFS).LE.I2MAX.AND. * I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN CALL UPDATE() END IF 155 CONTINUE END IF END IF END IF ELSE IF(NLEX2.LE.I2MAX) THEN IF(I1MIN.LE.-NLEX1) THEN IF(NLEX1.LE.I1MAX) THEN DO 156 IFS=IFSMIN,IFSMAX I3=KFS3(IFS) IF(I2MIN.LE.KFS2(IFS).AND. * I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN CALL UPDATE() END IF 156 CONTINUE ELSE DO 157 IFS=IFSMIN,IFSMAX I3=KFS3(IFS) IF( KFS1(IFS).LE.I1MAX.AND. * I2MIN.LE.KFS2(IFS).AND. * I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN CALL UPDATE() END IF 157 CONTINUE END IF ELSE IF(NLEX1.LE.I1MAX) THEN DO 158 IFS=IFSMIN,IFSMAX I3=KFS3(IFS) IF(I1MIN.LE.KFS1(IFS).AND. * I2MIN.LE.KFS2(IFS).AND. * I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN CALL UPDATE() END IF 158 CONTINUE ELSE DO 159 IFS=IFSMIN,IFSMAX I1=KFS1(IFS) I3=KFS3(IFS) IF(I1MIN.LE.I1.AND.I1.LE.I1MAX.AND. * I2MIN.LE.KFS2(IFS).AND. * I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN CALL UPDATE() END IF 159 CONTINUE END IF END IF ELSE IF(I1MIN.LE.-NLEX1) THEN IF(NLEX1.LE.I1MAX) THEN DO 160 IFS=IFSMIN,IFSMAX I2=KFS2(IFS) I3=KFS3(IFS) IF(I2MIN.LE.I2.AND.I2.LE.I2MAX.AND. * I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN CALL UPDATE() END IF 160 CONTINUE ELSE DO 161 IFS=IFSMIN,IFSMAX I2=KFS2(IFS) I3=KFS3(IFS) IF( KFS1(IFS).LE.I1MAX.AND. * I2MIN.LE.I2.AND.I2.LE.I2MAX.AND. * I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN CALL UPDATE() END IF 161 CONTINUE END IF ELSE IF(NLEX1.LE.I1MAX) THEN DO 162 IFS=IFSMIN,IFSMAX I2=KFS2(IFS) I3=KFS3(IFS) IF(I1MIN.LE.KFS1(IFS).AND. * I2MIN.LE.I2.AND.I2.LE.I2MAX.AND. * I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN CALL UPDATE() END IF 162 CONTINUE ELSE DO 163 IFS=IFSMIN,IFSMAX I1=KFS1(IFS) I2=KFS2(IFS) I3=KFS3(IFS) IF(I1MIN.LE.I1.AND.I1.LE.I1MAX.AND. * I2MIN.LE.I2.AND.I2.LE.I2MAX.AND. * I3MIN.LE.I3.AND.I3.LE.I3MAX) THEN CALL UPDATE() END IF 163 CONTINUE END IF END IF END IF END IF END IF END IF RETURN END C C======================================================================= C C C SUBROUTINE FREVOL() C C Procedure determining index of the node 'J', if its offset C respectively to the node 'I' is given. C This procedure has to be called if the indices of nodes differ from C the indices of gridpoints. C Called by LOOP if LOOP is called by GENER. C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ /NODE/ are required here: INCLUDE 'net.inc' C net.inc INCLUDE 'netnode.inc' C netnode.inc C C----------------------------------------------------------------------- C REAL GIANT PARAMETER (GIANT=1.E+10) C INTEGER JPOS1,JPOS2,JPOS3,JN1,JN2,JN3,JL1,JL2,JL3,JADR,J C C JPOS1,JPOS2,JPOS3... Position of the gridpoint 'J' within the C model. JPOSI=0,1,2,...,NLI-1. C JN1,JN2,JN3... Position of the big brick with 'J' within the C model. JNI=0,1,2,...,NI-1. C JL1,JL2,JL3... Position of the gridpoint 'J' within the big brick. C JLI=0,1,2,...,LI-1. C JADR... Index of the node 'J'. C J... Index of the first node of the big brick. C REAL TTJ,TTIJ C C TTJ... Arrival time at the node 'J'. C TTIJ... Arrival time through the node 'I' to the node 'J'. C C....................................................................... C C 22 integer operations JPOS1=IPOS1+KFS1(IFS) JPOS2=IPOS2+KFS2(IFS) JPOS3=IPOS3+KFS3(IFS) JN1=JPOS1/L1 JN2=JPOS2/L2 JN3=JPOS3/L3 J=IRAM(IND0+1+JN1+N1*(JN2+N2*JN3)) IF(J.LE.0) RETURN JL1=JPOS1-JN1*L1 JL2=JPOS2-JN2*L2 JL3=JPOS3-JN3*L3 JADR=J+JL1+L1*(JL2+L2*JL3) GO TO 20 C C======================================================================= C C C ENTRY UPDATE() C C Procedure updating travel time at node 'J' of the network. C Called by LOOP if LOOP is called by GENER. C C----------------------------------------------------------------------- C C Index of the node 'J': JADR=IPOS+KFS4(IFS) C 20 CONTINUE TTJ=RAM(ITT0+JADR) C IF(TTJ.LT.0.) RETURN C Node 'J' is not in the set A, may be updated. C C Check for crossing an interface: IF(LICB) THEN IF(IRAM(ICB0+JADR).NE.ICBI) THEN IF(KFS5(IFS).GT.1) RETURN END IF END IF C C*********************************************************************** C Consolidating forward and backward stars (optional): * IF(LNFS) THEN * IF(KFS5(IFS).GT.IRAM(NFS0+JADR)) RETURN * END IF C To guarantee the coincidence of forward and backward stars, it C is necessary not only to enable the above three statements, but C also to submit such template forward stars that each template C forward star is a subset of the forward stars of greater sizes. C*********************************************************************** C C Arrival time from the node 'I' to the node 'J': TTIJ=TTI+DFS(IFS)*(RAM(IP0+JADR)+PI) C C Test of Bellman's condition for shortest path IF(TTIJ.GE.TTJ) RETURN C C Testing if the node 'J' is in the queue IF(TTJ.GE.GIANT) THEN C Updating queue by adding 'J' as Q(MAXQ) MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=IPOS+KFS4(IFS) END IF C C Updating RAM(ITT0+JADR)=TTIJ IF(LPRED) THEN IRAM(IPRED0+JADR)=IPOS END IF C C END of IF C END of IF RETURN END C C======================================================================= C C C SUBROUTINE SRCREC() C C Auxiliary routine to LOOP updating a source or receiver node. C Called by LOOP if LOOP is called by SOURCE or RECVRS. C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ /NAMESR/ /POINTS/ /NODE/ /SRCC/ are C required here: INCLUDE 'net.inc' C net.inc INCLUDE 'netnode.inc' C netnode.inc C C----------------------------------------------------------------------- C EXTERNAL INDX INTEGER INDX C REAL GIANT PARAMETER (GIANT=1.E+10) C INTEGER JPOS,JADR REAL TTJ,TTIJ C C JPOS... Position of the gridpoint 'J' within the model. C JPOS=1,2,3,...,NL1*NL2*NL3. C JADR... Index of the node 'J'. C TTJ... Arrival time at the node 'J'. C TTIJ... Travel time from the node 'I' to the node 'J'. C C....................................................................... C C Index of the node 'J': JPOS=IPOS+KFS4(IFS) JADR=INDX(JPOS) C C Check for the Fresnel volume: IF(JADR.LE.0) RETURN C C Check for a free space: IF(RAM(IP0+JADR).GE.GIANT) RETURN C TTJ=RAM(ITT0+JADR) C C Check for crossing an interface: IF(LICB) THEN IF(IRAM(ICB0+JADR).NE.ICBI) THEN IF(KFS5(IFS).GT.1) RETURN END IF END IF C C*********************************************************************** C Consolidating forward and backward stars (optional): * IF(LNFS) THEN * IF(KFS5(IFS).GT.IRAM(NFS0+JADR)) RETURN * END IF C*********************************************************************** C C Travel time from the node 'I' to the node 'J': IF(LN1) THEN TTIJ=SQRT((FLOAT(KFS2(IFS))*DSX1-DPOS1)**2 * +(FLOAT(KFS2(IFS))*DSX2-DPOS2)**2 * +(FLOAT(KFS3(IFS))*DSX3-DPOS3)**2) * *0.5*(RAM(IP0+JADR)+PI) ELSE TTIJ=SQRT((FLOAT(KFS1(IFS))*DSX1-DPOS1)**2 * +(FLOAT(KFS2(IFS))*DSX2-DPOS2)**2 * +(FLOAT(KFS3(IFS))*DSX3-DPOS3)**2) * *0.5*(RAM(IP0+JADR)+PI) END IF C IF(ISRCI.LE.0) THEN IF(TTI+TTIJ.GE.TTJ) RETURN IF(TTJ.GE.GIANT) THEN C Updating queue by adding 'J' as Q(MAXQ) MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=IPOS+KFS4(IFS) END IF RAM(ITT0+JADR)=TTI+TTIJ IF(LPRED) THEN IRAM(IPRED0+JADR)=ISRCI END IF C END of IF ELSE IF(TTJ+TTIJ.GE.TTI) RETURN TTI=TTJ+TTIJ IPREDR(ISRCI)=JPOS C END of IF END IF C C END of IF C END of IF RETURN END C C======================================================================= C C C SUBROUTINE READFS() C C Procedure called by SOURCE, to read and construct optimized template C forward stars. C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ are required here: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C INTEGER LU1 PARAMETER(LU1=1) CHARACTER*80 FSTAB C INTEGER MD PARAMETER (MD=292) C MD=292 is good for optimized spherical 3-D forward stars up to C size MFSMAX=27. For minimum values of MD refer to files C net.fs2 and net.fs3. C INTEGER ID(MD),JD(MD),KD(MD) INTEGER JFS,ND,I1,I2,I3,I,L C C ID(II),JD(II),KD(II)... Vector specifying II-th node of the C forward star, in dimensions of a small brick. C JFS... Size of a template forward star currently being read. C ND... Number of nodes stored in the file for a forward star. C I1,I2,I3,I,L... Temporary and loop variables. C C....................................................................... C C Reading and assembling optimized forward star: WRITE(*,'(A)') * '+NET: Reading and assembling the forward star. ' C C Reading nodes of the forward stars: IF(NFSMAX.GT.0) THEN IF(NL1.EQ.1.OR.NL2.EQ.1.OR.NL3.EQ.1) THEN OPEN(LU1,FILE='net.fs2',STATUS='OLD') ELSE OPEN(LU1,FILE='net.fs3',STATUS='OLD') END IF END IF KFS0(0)=0 DO 79 JFS=1,NFSMAX READ(LU1,*) I,ND IF(I.NE.JFS) THEN C NET-40 CALL ERROR * ('NET-40: Template forward star not found in the file') C NET-40: Template forward star not found in the file: C The file 'net.fs3' or 'net.fs2' does not contain a C template forward star of the size NFSMAX. NFSMAX in C main input data file NET, (3), C should be decreased if positive, C adjusted if zero, C or larger forward stars should be added to file C 'net.fs3' or 'net.fs2'. END IF IF(ND.GT.MD) THEN C NET-41 CALL ERROR('NET-41: Too many input nodes of a forward star') C NET-41: Too many input nodes of a forward star: C NFSMAX in main input data file NET, C (3), should be decreased if positive, C adjusted if zero, C or the dimension MD in the subroutine READFS should be C increased. END IF READ(LU1,*) (ID(L),JD(L),KD(L),L=1,ND) C C Assembling whole optimized forward star from the given nodes: KFS0(JFS)=KFS0(JFS-1) DO 69 L=1,ND I1=ID(L) I2=JD(L) I3=KD(L) CALL SETFS(JFS,I1,I2,I3) 69 CONTINUE C 79 CONTINUE CLOSE(LU1) C C Printing the table of the numbers of nodes corresponding to the C template forward stars of sizes 1,2,...,NFSMAX: CALL RSEP3T('FSTAB',FSTAB,' ') IF(FSTAB.NE.' ') THEN OPEN(LU1,FILE=FSTAB) WRITE(LU1,'(A)') ' Size Number Sum of' WRITE(LU1,'(A)') ' (NFS) of nodes numbers' WRITE(LU1,'(3I10)') * (JFS,KFS0(JFS)-KFS0(JFS-1),KFS0(JFS),JFS=1,NFSMAX) CLOSE(LU1) WRITE(*,'(2A)') '+NET: FS table written to file ',FSTAB(1:48) C The central node of a forward star is not stored in the memory C and is not counted. END IF C RETURN END C C======================================================================= C C C SUBROUTINE MAKEFS(NFSMAK) INTEGER NFSMAK C C Procedure called by SOURCE and RECVRS, to construct full spherical C template forward stars. C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ are required here: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C INTEGER NDIM,NH,IH,I1,I2,I3,I3I3,I REAL DH C C....................................................................... C IF(NL1.EQ.1.OR.NL2.EQ.1.OR.NL3.EQ.1) THEN NDIM=2 ELSE NDIM=3 END IF NH=NFSMAK*NFSMAK+NDIM-1 DO 11 I=1,NFSMAK KFS0(I)=0 11 CONTINUE C DH=1./SQRT(12.*FLOAT(NH)) DH=DH/2. DO 69 IH=0,NH DO 58 I1=INT(SQRT(FLOAT(IH)/3.)-DH+1.),INT(SQRT(FLOAT(IH))+DH) I=IH-I1*I1 DO 57 I2=INT(SQRT(FLOAT(I)/2.)-DH+1.), * MIN0(INT(SQRT(FLOAT(I))+DH),I1) I3I3=I-I2*I2 I3=INT(SQRT(FLOAT(I3I3))+0.500) IF(I3*I3.EQ.I3I3.AND.I3.LE.I2) THEN C Assembling the forward star: CALL SETFS(NFSMAK,I3,I2,I1) END IF 57 CONTINUE 58 CONTINUE 69 CONTINUE C DO 71 I=NFSMAK,NFSMAX KFS0(I)=KFS0(NFSMAK) 71 CONTINUE RETURN END C C======================================================================= C C C SUBROUTINE SETFS(JFS,I1,I2,I3) INTEGER JFS,I1,I2,I3 C C Subroutine designed to set up all possible mirrorings of an edge C of the forward star. Auxiliary subroutine to READFS and MAKEFS. C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ are required here: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C INTEGER NLEX1,NLEX2,NLEX3,LFS,I REAL DIM C C NLEX1,NLEX2,NLEX3... C LFS... Number of template forward star nodes already stored. C NODES KFS0(JFS),...,LFS are being mirrored with respect to C the central node, while storing the results of mirroring. C I... Loop variable. C DIM... Dimension of the model (2-D or 3-D). C C....................................................................... C LFS=KFS0(JFS) IF(NL1.EQ.1.OR.NL2.EQ.1.OR.NL3.EQ.1) THEN DIM=2. ELSE DIM=3. END IF NLEX1=MIN0(JFS,NL1-1) NLEX2=MIN0(JFS,NL2-1) NLEX3=MIN0(JFS,NL3-1) C IF(I1.LE.NLEX1.AND.I2.LE.NLEX2.AND.I3.LE.NLEX3) THEN CALL STORFS(LFS,I1,I2,I3) END IF IF(I1.NE.I3) THEN IF(I2.LE.NLEX1.AND.I3.LE.NLEX2.AND.I1.LE.NLEX3) THEN CALL STORFS(LFS,I2,I3,I1) END IF IF(I3.LE.NLEX1.AND.I1.LE.NLEX2.AND.I2.LE.NLEX3) THEN CALL STORFS(LFS,I3,I1,I2) END IF IF(I1.NE.I2.AND.I2.NE.I3) THEN IF(I3.LE.NLEX1.AND.I2.LE.NLEX2.AND.I1.LE.NLEX3) THEN CALL STORFS(LFS,I3,I2,I1) END IF IF(I1.LE.NLEX1.AND.I3.LE.NLEX2.AND.I2.LE.NLEX3) THEN CALL STORFS(LFS,I1,I3,I2) END IF IF(I2.LE.NLEX1.AND.I1.LE.NLEX2.AND.I3.LE.NLEX3) THEN CALL STORFS(LFS,I2,I1,I3) END IF END IF END IF DO 61 I=KFS0(JFS)+1,LFS IF(KFS1(I).NE.0) THEN CALL STORFS(LFS,-KFS1(I), KFS2(I), KFS3(I)) END IF 61 CONTINUE DO 62 I=KFS0(JFS)+1,LFS IF(KFS2(I).NE.0) THEN CALL STORFS(LFS, KFS1(I),-KFS2(I), KFS3(I)) END IF 62 CONTINUE DO 63 I=KFS0(JFS)+1,LFS IF(KFS3(I).NE.0) THEN CALL STORFS(LFS, KFS1(I), KFS2(I),-KFS3(I)) END IF 63 CONTINUE DO 64 I=KFS0(JFS)+1,LFS KFS4(I)=KFS1(I)+NL1*(KFS2(I)+NL2*KFS3(I)) KFS5(I)=INT(SQRT(AMAX1(FLOAT(KFS1(I))**2 * +FLOAT(KFS2(I))**2 * +FLOAT(KFS3(I))**2-DIM+1.,1.))+0.999) DFS(I)=SQRT((FLOAT(KFS1(I))*ASX1)**2 * +(FLOAT(KFS2(I))*ASX2)**2 * +(FLOAT(KFS3(I))*ASX3)**2)/2. 64 CONTINUE C KFS0(JFS)=LFS RETURN END C C======================================================================= C C C SUBROUTINE STORFS(LFS,I1,I2,I3) INTEGER LFS,I1,I2,I3 C C Subroutine designed to store one edge of the forward star in the C memory. Auxiliary subroutine to SETFS. C C----------------------------------------------------------------------- C C Common block /FS/ is required here: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C LFS=LFS+1 IF(LFS.GT.MFS) THEN C NET-42 CALL ERROR('NET-42: Too big forward star') C NET-42: Too big forward star: C NFSMAX in main input data file NET, C (3), should be decreased if positive, adjusted if zero, C or the dimension MFS in the common block /FS/ C in net.inc should be increased. C The minimum value of the dimension MFS may be determined C as follows: C (a) Choose MFS as large as possible. C (b) Add parameter FSTAB='filename' into the input SEP C parameter file and adjust NFSMAX. C (c) Compile and run the program. C (d) Look at file 'filename' just having been C generated. The last integer in the file is the C minimum dimension MFS corresponding to the given C value of NFSMAX. C (e) Update MFS, restore NFSMAX and remove parameter C FSTAB='filename' from the data. END IF KFS1(LFS)=I1 KFS2(LFS)=I2 KFS3(LFS)=I3 RETURN END C C======================================================================= C C C SUBROUTINE ONERAY(LTRACE,LRAYS,LEND,LURAYS,IREFL, * IPREDE,IEND1,IEND2,IEND3,IENDA,TEND,ERR,TERR,ISRC) LOGICAL LTRACE,LRAYS,LEND INTEGER LURAYS,IREFL,IPREDE,IEND1,IEND2,IEND3,IENDA,ISRC REAL TEND,ERR(*),TERR C C Subroutine called by ERRORS and TRACER, to perform backward ray C tracing. C C Input: C LTRACE,LRAYS,LEND,LURAYS,IREFL,IPREDE,IEND1,IEND2,IEND3,IENDA,TEND C IPREDE... Must be positive. C C Output: C TERR C C----------------------------------------------------------------------- C C Common blocks /GRID/ /NAMESR/ /POINTS/ /FILES/ are required here: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C EXTERNAL INDX INTEGER INDX C INTEGER LU0,LU1,LU PARAMETER(LU0=10) PARAMETER(LU1=1) C INTEGER MTMP PARAMETER (MTMP=100) INTEGER KTMP(MTMP),NTMP,ITMP REAL TMPMIN(MTMP),TMPMAX(MTMP) C INTEGER IPREDI,IPNEW,NF,N123,L123,IPOS1,IPOS2,IPOS3,IPOS,IADR INTEGER IOLD1,IOLD2,IOLD3,ICBOLD,NFOLD,K REAL DPOS1,DPOS2,DPOS3,X1,X2,X3,T,TOLD,POLD,PAUX,ERRMIN,ERRMAX C C IPOS1,IPOS2,IPOS3,IPOS,IADR... Position and index (address) of the C nearest network node. C DPOS1,DPOS2,DPOS3... Offset from the nearest network node. C IPREDI..Predecessor of the current node. C IOLD1,IOLD2,IOLD3,ICBOLD,NFOLD,TOLD,POLD... Parameters of the last C network node along the ray. C X1,X2,X3,T,PAUX... Temporary storage locations. C C....................................................................... C IPREDI=IPREDE NTMP=0 IF(.NOT.LTRACE.OR.LEND) THEN IF(LICB) THEN ICBOLD=IRAM(ICB0+IENDA) ELSE ICBOLD=1 END IF IOLD1=IEND1 IOLD2=IEND2 IOLD3=IEND3 POLD=RAM(IP0+IENDA) C POLD is a constant approximation, not interpolation. TOLD=TEND NFOLD=IREFL ERRMIN=0. ERRMAX=0. END IF IF(IPREDI.GE.0) THEN DO 68 NF=IREFL,0,-1 IF(IPREDI.EQ.0) THEN C Endpoint of the ray at the reflector: C This is not possible at the receiver. C Thus, this is possible only if called by subroutine ERRORS. C Then IOLD1,IOLD2,IOLD3 are defined. IPREDI=1+IOLD1+(NL1*IOLD2+NL2*IOLD3) GO TO 66 ENDIF IF(NF.LT.IREFL) THEN LU=LU0+NF IF(L4.NE.0) THEN C Reading the index array: N123=N1*N2*N3 L123=L1*L2*L3 DO 11 K=1,N123 IRAM(IND0+K)=K 11 CONTINUE CALL RARRAI(LU1,FIND(NF),'FORMATTED', * .FALSE.,0,N123,IRAM(IND0+1)) DO 12 K=1,N123 IRAM(IND0+K)=(IRAM(IND0+K)-1)*L123+1 12 CONTINUE END IF END IF 50 CONTINUE IADR=INDX(IPREDI) IF(NF.LT.IREFL) THEN READ(LU,REC=IADR) T,IPNEW ELSE T=RAM(ITT0+IADR) IPNEW=IRAM(IPRED0+IADR) END IF IPOS1=IPREDI-1 IPOS2=IPOS1/NL1 IPOS3=IPOS2/NL2 IPOS1=IPOS1-IPOS2*NL1 IPOS2=IPOS2-IPOS3*NL2 IF(LTRACE.AND.LRAYS) THEN IF(LN1) THEN X1=X1MIN+(FLOAT(IPOS2)+0.5)*DSX1 ELSE X1=X1MIN+(FLOAT(IPOS1)+0.5)*DSX1 END IF X2=X2MIN+(FLOAT(IPOS2)+0.5)*DSX2 X3=X3MIN+(FLOAT(IPOS3)+0.5)*DSX3 WRITE(LURAYS,'(4F12.6,A)') X1,X2,X3,T,' /' END IF IF(.NOT.LTRACE.OR.LEND) THEN C Travel time error estimate: CALL SETERR(NF,IPREDI,IPOS1,IPOS2,IPOS3,IADR,T,NFOLD, * IOLD1,IOLD2,IOLD3,ICBOLD,POLD,TOLD,ERRMIN,ERRMAX) IF(.NOT.LTRACE) THEN IF(NF.EQ.IREFL) THEN IF(ERR(IADR).GE.0.) THEN ERRMIN=ERRMIN-ERR(IADR) ERRMAX=ERRMAX+ERR(IADR) GO TO 70 ELSE IF(NTMP.LT.MTMP) THEN NTMP=NTMP+1 KTMP(NTMP)=IADR TMPMIN(NTMP)=ERRMIN TMPMAX(NTMP)=ERRMAX END IF END IF END IF END IF END IF IF(IPNEW.EQ.0) THEN C Reflector: C The same point at the reflector is considered twice, C i.e. the ray segment of zero length is situated at the C reflector. GO TO 66 ELSE IF(IPNEW.LT.0) THEN C Source point: IPREDI=IPNEW GO TO 69 ELSE IPREDI=IPNEW ENDIF GO TO 50 66 CONTINUE C Node IPREDI is situated at a reflector. * AUX=POLD*AMAX1(ASX1,ASX2,ASX3)/2. * ERRMIN=ERRMIN-AUX * ERRMAX=ERRMIN+AUX 68 CONTINUE 69 CONTINUE END IF C Node IPREDI is a source point. ISRC=-IPREDI C C Source point: IF(.NOT.LTRACE.OR.LEND) THEN C Travel time error estimate: CALL SLOW(X1S(ISRC),X2S(ISRC),X3S(ISRC), * DPOS1,DPOS2,DPOS3,IPOS1,IPOS2,IPOS3,IPOS,IADR,PAUX) CALL SETERR(IREFL,IPOS,IPOS1,IPOS2,IPOS3,IADR,TTS(ISRC),NFOLD, * IOLD1,IOLD2,IOLD3,ICBOLD,POLD,TOLD,ERRMIN,ERRMAX) ERRMIN=ERRMIN-TTSERR(ISRC) ERRMAX=ERRMAX+TTSERR(ISRC) END IF C 70 CONTINUE C IF(.NOT.LTRACE) THEN C Rays are not traced, the end node is a gridpoint, C thus IENDA is defined. ERR(IENDA)=AMAX1(ERRMAX,-ERRMIN) DO 71 ITMP=1,NTMP ERR(KTMP(ITMP))= * AMAX1(ERRMAX-TMPMAX(ITMP),-ERRMIN+TMPMIN(ITMP)) 71 CONTINUE ELSE IF(LEND) THEN TERR=AMAX1(ERRMAX,-ERRMIN) END IF C RETURN END C C======================================================================= C C C SUBROUTINE SETERR(NF,IPOS,IPOS1,IPOS2,IPOS3,IADR,T,NFOLD, * IOLD1,IOLD2,IOLD3,ICBOLD,POLD,TOLD,ERRMIN,ERRMAX) INTEGER NF,IPOS,IPOS1,IPOS2,IPOS3,IADR INTEGER NFOLD,IOLD1,IOLD2,IOLD3,ICBOLD REAL T,POLD,TOLD,ERRMIN,ERRMAX C C Subroutine called by ONERAY, to estimate and accumulate the C arrival-time errors during backward ray tracing. C C Attention: C In this version, in a case of reflections, the slowness field is C correct only if it is the same for the direct wave and for all the C reflected waves. When the rays are traced, only time fields and C predecessors are alternated in the memory, unlike slowness fields. C C Input: C NF,IPOS,IPOS1,IPOS2,IPOS3,IADR,T, C NFOLD,IOLD1,IOLD2,IOLD3,ICBOLD,POLD,TOLD,ERRMIN,ERRMAX C C Output: C NFOLD,IOLD1,IOLD2,IOLD3,ICBOLD,POLD,TOLD... Values at the old node C are replaced by the values at the new node. C ERRMIN,ERRMAX... Input values increased by the increment of the C error bounds between the old node and the new node. C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ are required here: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C INTEGER ICBNEW,NFS1,IERR REAL UIJ(6),C1,C2MIN,C2MAX,ERR3,PMEAN REAL AUX1,AUX2,AUX3 C C....................................................................... C CALL OPTMAT(IPOS,IPOS1,IPOS2,IPOS3,IADR,IERR,UIJ) IF(LNFS) THEN IF(NF.EQ.NREFL) THEN NFS1=IRAM(NFS0+IADR) ELSE CALL OPTNFS(IPOS,IPOS1,IPOS2,IPOS3,IADR,NFS1,C1,C2MIN,C2MAX) END IF ELSE NFS1=NFSMAX END IF C C Calculating the coefficient of the network-geometry error: IF(NL1.EQ.1) THEN C1=((ASX2**2+ASX3**2)/AMIN1(ASX2,ASX3)**2-1.)/8. ELSE IF(NL2.EQ.1) THEN C1=((ASX1**2+ASX3**2)/AMIN1(ASX1,ASX3)**2-1.)/8. ELSE IF(NL3.EQ.1) THEN C1=((ASX1**2+ASX2**2)/AMIN1(ASX1,ASX2)**2-1.)/8. ELSE C1=((ASX1**2+ASX2**2+ASX3**2)/AMIN1(ASX1,ASX2,ASX3)**2-1.)/8. END IF C C Calculating the relative heterogeneity error: AUX1=FLOAT(IPOS1-IOLD1) AUX2=FLOAT(IPOS2-IOLD2) AUX3=FLOAT(IPOS3-IOLD3) AUX1=AUX1*(UIJ(1)*AUX1+2.*(UIJ(2)*AUX2+UIJ(4)*AUX3)) * +AUX2*(UIJ(3)*AUX2+2.*UIJ(5)*AUX3)+AUX3*UIJ(6)*AUX3 AUX1=AUX1/(12.*RAM(IP0+IADR)) C C Geometry and heterogeneity increments of the error bounds: ERRMIN=ERRMIN+(TOLD-T)* AUX1 ERRMAX=ERRMAX+(TOLD-T)*(AUX1+C1/FLOAT(NFS1*NFS1+1)) C C Error due to structural interfaces: IF(LICB) THEN ICBNEW=IRAM(ICB0+IADR) ELSE ICBNEW=1 END IF IF(ICBNEW.NE.ICBOLD) THEN C For ABS(DSX1)=ABS(DSX2)=ABS(DSX3)=DSX: C D(ERRMIN)=-DSX* D(P)*SQRT(N)/2 C D(ERRMAX)=DSX*MIN(P, C (D(P)*SQRT(2)-SQRT(MIN(P)**2+((SQRT(N)-SQRT(2))*P)**2)) AUX1=AMAX1(ASX1,ASX2,ASX3) AUX3=AMIN1(ASX1,ASX2,ASX3) AUX2=ASX1+ASX2+ASX3-AUX1-AUX3 PMEAN=(RAM(IP0+IADR)+POLD)/2. ERRMIN=ERRMIN-SQRT(AUX1*AUX1+AUX2*AUX2+AUX3*AUX3) * *ABS(RAM(IP0+IADR)-POLD)/2. ERR3=AMIN1(RAM(IP0+IADR),POLD) C In the worst case, interface is perpendicular to the greatest C grid step AUX1. IF(AUX3.LE.0.) THEN C 2-D: C Now, ERR3 is the time derivative in the direction AUX2. ERR3=PMEAN*SQRT(AUX1*AUX1+AUX2*AUX2)-ERR3*AUX2 ELSE C 3-D: ERR3=ERR3*ERR3-(PMEAN*( SQRT(AUX1*AUX1+AUX2*AUX2+AUX3*AUX3) * -SQRT(AUX1*AUX1+AUX3*AUX3) )/AUX2)**2 IF(ERR3.GT.0.) THEN ERR3=SQRT(ERR3) ELSE ERR3=0. END IF C Now, ERR3 is the time derivative in the direction AUX3. ERR3=PMEAN*SQRT(AUX1*AUX1+AUX3*AUX3)-ERR3*AUX3 END IF ERR3=AMIN1(ERR3,PMEAN*AUX1) ERRMAX=ERRMAX+ERR3 END IF C C Error due to reflections: IF(NFOLD.NE.NF) THEN AUX1=(RAM(IP0+IADR)+POLD)*AMAX1(ASX1,ASX2,ASX3)/2. ERRMIN=ERRMIN-AUX1 ERRMAX=ERRMIN+AUX1 NFOLD=NF END IF C ICBOLD=ICBNEW IOLD1=IPOS1 IOLD2=IPOS2 IOLD3=IPOS3 POLD=RAM(IP0+IADR) TOLD=T C RETURN END C C======================================================================= C C C SUBROUTINE OPTNFS * (IPOS,IPOS1,IPOS2,IPOS3,IADR,NFSOPT,C1,C2MIN,C2MAX) INTEGER IPOS,IPOS1,IPOS2,IPOS3,IADR,NFSOPT REAL C1,C2MIN,C2MAX C C Subroutine called by SOURCE and SETERR, designed to estimate the C optimum size of a forward star at the given node. C C Input: C IPOS,IPOS1,IPOS2,IPOS3... Indices of the given gridpoint, C describing the position of the network node situated at C the gridpoint. C IADR... Index of the network node. C C Output: C NFSOPT..Optimum size of the forward star at the given node. C Default of NFSOPT=1 is set if the optimum size cannot be C determined. C C1,C2MIN,C2MAX... Coefficients of the travel time error estimate. C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ are required here: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C REAL GIANT PARAMETER (GIANT=1.E+10) C INTEGER IERR REAL C1SAVE,C2,UIJ(6),AUX0 SAVE C1SAVE DATA C1SAVE/0./ C C C1SAVE..Coefficient C1. C C2... Maximum absolute value of coefficients C2MIN, C2MAX. C UIJ... Symmetric matrix describing the level of heterogeneity. C AUX0... Dummy storage location. C C....................................................................... C C Calculating the coefficient of the network-geometry error: IF(C1SAVE.EQ.0.) THEN IF(NL1.EQ.1) THEN C1SAVE=((ASX2**2+ASX3**2)/AMIN1(ASX2,ASX3)**2-1.)/8. ELSE IF(NL2.EQ.1) THEN C1SAVE=((ASX1**2+ASX3**2)/AMIN1(ASX1,ASX3)**2-1.)/8. ELSE IF(NL3.EQ.1) THEN C1SAVE=((ASX1**2+ASX2**2)/AMIN1(ASX1,ASX2)**2-1.)/8. ELSE C1SAVE= * ((ASX1**2+ASX2**2+ASX3**2)/AMIN1(ASX1,ASX2,ASX3)**2-1.)/8. END IF END IF C C Coefficient of the network-geometry error (rel.error=C1/NFS**2): C1=C1SAVE C C Check for a free space: IF(RAM(IP0+IADR).GE.GIANT) THEN NFSOPT=0 C2MIN=0. C2MAX=0. RETURN END IF C CALL OPTMAT(IPOS,IPOS1,IPOS2,IPOS3,IADR,IERR,UIJ) C IERR=0,1,...,16. Free space: IERR=16. IF(IERR.GE.16) THEN C Optimum size of a forward star cannot be determined: NFSOPT=1 RETURN END IF C C Coefficient of the heterogeneity error (rel.error=C2*NFS**2): CALL EIGEN(UIJ,AUX0,3,1) C2=12.*RAM(IP0+IADR) C2MAX=AMAX1(UIJ(1),0.)/C2 C2MIN=AMIN1(UIJ(6),0.)/C2 C2=AMAX1(C2MAX,-C2MIN-C2MAX) C C Maximum size of the forward star: IF(NFSMAX.GT.0) THEN NFSOPT=NFSMAX ELSE NFSOPT=999999 END IF C C Optimum size of the forward star: IF(C2.GT.0.) THEN NFSOPT=MAX0(1,MIN0(INT(SQRT(SQRT(C1/C2))+0.5),NFSOPT)) END IF C RETURN END C C======================================================================= C C C SUBROUTINE OPTMAT(IPOS,IPOS1,IPOS2,IPOS3,IADR,IERR,UIJ) INTEGER IPOS,IPOS1,IPOS2,IPOS3,IADR,IERR REAL UIJ(6) C C Auxiliary subroutine to SETERR and OPTNFS, designed to calculate the C symmetric matrix describing the level of heterogeneity at the given C node. The matrix is composed of the first and second slowness C derivatives. C C Input: C IPOS,IPOS1,IPOS2,IPOS3... Indices of the given gridpoint, C describing the position of the network node situated at C the gridpoint. C IADR... Index of the network node. C C Output: C IERR... IERR=0 if the matrix is determined. C UIJ... Symmetric matrix describing the level of heterogeneity. C C----------------------------------------------------------------------- C C Common block /GRID/ is required here: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C EXTERNAL INDX INTEGER INDX INTEGER ISHIFT(3),ICBOPT,I1,I2,I3,IP,IP1,IP2,IP3,IAUX INTEGER IP1OLD,IP2OLD,IP3OLD,IEROLD DATA ISHIFT/0,1,-1/ C C....................................................................... C ICBOPT=-999 CALL TRYMAT(IPOS,IPOS1,IPOS2,IPOS3,IADR,ICBOPT,IERR,UIJ) C ICBOPT unchanged: node not situated in the computational volume. C IERR.GT.0: matrix Uij has not been determined. C C Check whether matrix Uij is determined: IF(ICBOPT.NE.-999.AND.IERR.GT.0) THEN IEROLD=IERR IP1OLD=IPOS1 IP2OLD=IPOS2 IP3OLD=IPOS3 C C Looking for matrix Uij around: DO 13 I3=1,3 IP3=IPOS3+ISHIFT(I3) C Check for the model volume: IF(0.LE.IP3.AND.IP3.LT.NL3) THEN DO 12 I2=1,3 IP2=IPOS2+ISHIFT(I2) C Check for the model volume: IF(0.LE.IP2.AND.IP2.LT.NL2) THEN DO 11 I1=1,3 IF(I1.NE.1.OR.I2.NE.1.OR.I3.NE.1) THEN IP1=IPOS1+ISHIFT(I1) C Check for the model volume: IF(0.LE.IP1.AND.IP1.LT.NL1) THEN IP=1+IP1+NL1*(IP2+NL2*IP3) IAUX=INDX(IP) CALL TRYMAT(IP,IP1,IP2,IP3,IAUX,ICBOPT,IERR,UIJ) IF(IERR.EQ.0) THEN C Matrix Uij is determined RETURN ELSE IF(IERR.LT.IEROLD) THEN IEROLD=IERR IP1OLD=IP1 IP2OLD=IP2 IP3OLD=IP3 END IF END IF END IF 11 CONTINUE END IF 12 CONTINUE END IF 13 CONTINUE C IP=1+IP1OLD+NL1*(IP2OLD+NL2*IP3OLD) IAUX=INDX(IP) CALL TRYMAT(IP,IP1OLD,IP2OLD,IP3OLD,IAUX,ICBOPT,IERR,UIJ) END IF RETURN END C C======================================================================= C C C SUBROUTINE TRYMAT(IPOS,IPOS1,IPOS2,IPOS3,IADR,ICBOPT,IERR,UIJ) INTEGER IPOS,IPOS1,IPOS2,IPOS3,IADR,ICBOPT,IERR REAL UIJ(6) C C Auxiliary subroutine to OPTMAT, to try the calculation of the matrix C describing the level of heterogeneity at the given node. C The matrix is composed of the first and second slowness derivatives. C C Input: C IPOS,IPOS1,IPOS2,IPOS3... Indices of the given gridpoint, C describing the position of the network node situated at C the gridpoint. C IADR... Index of the network node. C C Output: C ICBOPT.. C IERR... IERR=0 if the matrix is determined. C UIJ... Symmetric matrix describing the level of heterogeneity. C C----------------------------------------------------------------------- C C Common block /GRID/ is required here: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C REAL GIANT PARAMETER (GIANT=1.E+10) C EXTERNAL INDX INTEGER INDX INTEGER IA0,IA2,IERR12,IERR13,IERR23 REAL U1,U2,U3,U11,U12,U22,U13,U23,U33,AUX0,AUX1,AUX2,AUX3 C C IERR12,IERR13,IERR23... Switches for evaluation of mixed second C derivatives. C U1,U2,U3,U11,U12,U22,U13,U23,U33... Slowness derivatives. C AUX0,AUX1,AUX2,AUX3... Temporary storage locations. C C....................................................................... C C IERR=0,1,...,16. IERR=16 if slowness is not defined at the point. C Otherwise, slowness derivatives cannot be determined along IERR/4 C axes. In addition, MOD(IERR,4) mixed derivatives cannot be C determined. Initially: IERR=16 IERR12=2 IERR13=2 IERR23=2 C C 2-D model and default in 3-D: U1 =0. U2 =0. U3 =0. U11=0. U12=0. U22=0. U13=0. U23=0. U33=0. C C Check for the computational volume at the given node: IF(IADR.EQ.0) THEN RETURN END IF C C Determination of the geological block at the given node: IF(ICBOPT.EQ.-999) THEN IF(LICB) THEN ICBOPT=IRAM(ICB0+IADR) ELSE ICBOPT=1 END IF END IF C C Check for the geological block at the given node: IF(LICB) THEN IF(IRAM(ICB0+IADR).NE.ICBOPT) THEN RETURN END IF END IF C Check for a free space: AUX1=RAM(IP0+IADR) IF(AUX1.GE.GIANT) THEN RETURN END IF IERR=IERR-4 C C First and second partial slowness derivatives along the X1 axis: IF(NL1.GT.1) THEN C 3-D model: C Check for the model volume: IF(IPOS1.LT.1.OR.NL1-2.LT.IPOS1) THEN GO TO 20 END IF C Check for the computational volume: IA0=INDX(IPOS-1) IA2=INDX(IPOS+1) IF(IA0.EQ.0) THEN GO TO 20 END IF IF(IA2.EQ.0) THEN GO TO 20 END IF C Check for the geological block: IF(LICB) THEN IF(IRAM(ICB0+IA0).NE.ICBOPT) THEN GO TO 20 END IF IF(IRAM(ICB0+IA2).NE.ICBOPT) THEN GO TO 20 END IF END IF C Check for a free space: AUX0=RAM(IP0+IA0) AUX2=RAM(IP0+IA2) IF(AUX0.GE.GIANT) THEN GO TO 20 END IF IF(AUX2.GE.GIANT) THEN GO TO 20 END IF C Partial slowness derivatives scaled by the grid step: U1 =(AUX2-AUX0)/2. U11=AUX2-2.*AUX1+AUX0 IERR12=IERR12-1 IERR13=IERR13-1 END IF IERR=IERR-4 C C First and second partial slowness derivatives along the X2 axis: 20 CONTINUE IF(NL2.GT.1) THEN C 3-D model: C Check for the model volume: IF(IPOS2.LT.1.OR.NL2-2.LT.IPOS2) THEN GO TO 30 END IF C Check for the computational volume: IA0=INDX(IPOS-NL1) IA2=INDX(IPOS+NL1) IF(IA0.EQ.0) THEN GO TO 30 END IF IF(IA2.EQ.0) THEN GO TO 30 END IF C Check for the geological block: IF(LICB) THEN IF(IRAM(ICB0+IA0).NE.ICBOPT) THEN GO TO 30 END IF IF(IRAM(ICB0+IA2).NE.ICBOPT) THEN GO TO 30 END IF END IF C Check for a free space: AUX0=RAM(IP0+IA0) AUX2=RAM(IP0+IA2) IF(AUX0.GE.GIANT) THEN GO TO 30 END IF IF(AUX2.GE.GIANT) THEN GO TO 30 END IF C Partial slowness derivatives scaled by the grid step: U2 =(AUX2-AUX0)/2. U22=AUX2-2.*AUX1+AUX0 IERR12=IERR12-1 IERR23=IERR23-1 END IF IERR=IERR-4 C C First and second partial slowness derivatives along the X3 axis: 30 CONTINUE IF(NL3.GT.1) THEN C 3-D model: C Check for the model volume: IF(IPOS3.LT.1.OR.NL3-2.LT.IPOS3) THEN GO TO 40 END IF C Check for the computational volume: IA0=INDX(IPOS-NL1*NL2) IA2=INDX(IPOS+NL1*NL2) IF(IA0.EQ.0) THEN GO TO 40 END IF IF(IA2.EQ.0) THEN GO TO 40 END IF C Check for the geological block: IF(LICB) THEN IF(IRAM(ICB0+IA0).NE.ICBOPT) THEN GO TO 40 END IF IF(IRAM(ICB0+IA2).NE.ICBOPT) THEN GO TO 40 END IF END IF C Check for a free space: AUX0=RAM(IP0+IA0) AUX2=RAM(IP0+IA2) IF(AUX0.GE.GIANT) THEN GO TO 40 END IF IF(AUX2.GE.GIANT) THEN GO TO 40 END IF C Partial slowness derivatives scaled by the grid step: U3 =(AUX2-AUX0)/2. U33=AUX2-2.*AUX1+AUX0 IERR13=IERR13-1 IERR23=IERR23-1 END IF IERR=IERR-4 C C Mixed second partial slowness derivatives: 40 CONTINUE IF(NL1.GT.1.AND.NL2.GT.1.AND.IERR12.EQ.0) THEN CALL MIXDER(IPOS, 1,NL1 ,ICBOPT,U12,IERR) END IF IF(NL1.GT.1.AND.NL3.GT.1.AND.IERR13.EQ.0) THEN CALL MIXDER(IPOS, 1,NL1*NL2,ICBOPT,U13,IERR) END IF IF(NL2.GT.1.AND.NL3.GT.1.AND.IERR23.EQ.0) THEN CALL MIXDER(IPOS,NL1,NL1*NL2,ICBOPT,U23,IERR) END IF C C Symmetric matrix describing the level of heterogeneity: AUX0=0.5/RAM(IP0+IADR) AUX1=U1*AUX0 AUX2=U2*AUX0 AUX3=U3*AUX0 AUX0=AUX1*U1+AUX2*U2+AUX3*U3 UIJ(1)=U11-AUX1*U1+AUX0 UIJ(2)=U12-AUX1*U2 UIJ(3)=U22-AUX2*U2+AUX0 UIJ(4)=U13-AUX1*U3 UIJ(5)=U23-AUX2*U3 UIJ(6)=U33-AUX3*U3+AUX0 C RETURN END C C======================================================================= C C C SUBROUTINE MIXDER(IPOS0,IPOS1,IPOS2,ICBREF,DERMIX,IERR) INTEGER IPOS0,IPOS1,IPOS2,ICBREF,IERR REAL DERMIX C C Auxiliary subroutine to TRYMAT, to calculate mixed second partial C slowness derivatives. C C----------------------------------------------------------------------- C C Common block /GRID/ is required here: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C REAL GIANT PARAMETER (GIANT=1.E+10) C EXTERNAL INDX INTEGER INDX INTEGER IA00,IA20,IA02,IA22 C C....................................................................... C C Addresses of the corner gridpoints: IA00=INDX(IPOS0-IPOS1-IPOS2) IA20=INDX(IPOS0+IPOS1-IPOS2) IA02=INDX(IPOS0-IPOS1+IPOS2) IA22=INDX(IPOS0+IPOS1+IPOS2) C C Check for the same geological block and for a free space: IF(IA00.GT.0) THEN IF(LICB) THEN IF(IRAM(ICB0+IA00).NE.ICBREF) THEN IA00=0 GO TO 11 END IF END IF IF(RAM(IP0+IA00).GE.GIANT) THEN IA00=0 END IF END IF 11 CONTINUE IF(IA20.GT.0) THEN IF(LICB) THEN IF(IRAM(ICB0+IA20).NE.ICBREF) THEN IA20=0 GO TO 12 END IF END IF IF(RAM(IP0+IA20).GE.GIANT) THEN IA20=0 END IF END IF 12 CONTINUE IF(IA02.GT.0) THEN IF(LICB) THEN IF(IRAM(ICB0+IA02).NE.ICBREF) THEN IA02=0 GO TO 13 END IF END IF IF(RAM(IP0+IA02).GE.GIANT) THEN IA02=0 END IF END IF 13 CONTINUE IF(IA22.GT.0) THEN IF(LICB) THEN IF(IRAM(ICB0+IA22).NE.ICBREF) THEN IA22=0 GO TO 14 END IF END IF IF(RAM(IP0+IA22).GE.GIANT) THEN IA22=0 END IF END IF 14 CONTINUE C C Calculating mixed second partial slowness derivatives: IF(IA22.GT.0) THEN IF(IA02.GT.0) THEN IF(IA20.GT.0) THEN IF(IA00.GT.0) THEN DERMIX=(RAM(IP0+IA00)-RAM(IP0+IA20) * -RAM(IP0+IA02)+RAM(IP0+IA22))/4. ELSE IA00=INDX(IPOS0-IPOS1) IA20=INDX(IPOS0+IPOS1) DERMIX=(RAM(IP0+IA00)-RAM(IP0+IA20) * -RAM(IP0+IA02)+RAM(IP0+IA22))/2. END IF ELSE IF(IA00.GT.0) THEN IA20=INDX(IPOS0-IPOS2) IA22=INDX(IPOS0+IPOS2) DERMIX=(RAM(IP0+IA00)-RAM(IP0+IA20) * -RAM(IP0+IA02)+RAM(IP0+IA22))/2. ELSE IA00=INDX(IPOS0-IPOS1) IA20=INDX(IPOS0+IPOS1) DERMIX=(RAM(IP0+IA00)-RAM(IP0+IA20) * -RAM(IP0+IA02)+RAM(IP0+IA22))/2. END IF END IF ELSE IF(IA20.GT.0) THEN IF(IA00.GT.0) THEN IA02=INDX(IPOS0-IPOS1) IA22=INDX(IPOS0+IPOS1) DERMIX=(RAM(IP0+IA00)-RAM(IP0+IA20) * -RAM(IP0+IA02)+RAM(IP0+IA22))/2. ELSE IA00=INDX(IPOS0-IPOS2) IA02=INDX(IPOS0+IPOS2) DERMIX=(RAM(IP0+IA00)-RAM(IP0+IA20) * -RAM(IP0+IA02)+RAM(IP0+IA22))/2. END IF ELSE IF(IA00.GT.0) THEN IA02=INDX(IPOS0-IPOS1) IA20=INDX(IPOS0-IPOS2) IA22=INDX(IPOS0) DERMIX= RAM(IP0+IA00)-RAM(IP0+IA20) * -RAM(IP0+IA02)+RAM(IP0+IA22) ELSE IA00=INDX(IPOS0) IA20=INDX(IPOS0+IPOS1) IA02=INDX(IPOS0+IPOS2) DERMIX= RAM(IP0+IA00)-RAM(IP0+IA20) * -RAM(IP0+IA02)+RAM(IP0+IA22) END IF END IF END IF ELSE IF(IA02.GT.0) THEN IF(IA20.GT.0) THEN IF(IA00.GT.0) THEN IA20=INDX(IPOS0-IPOS2) IA22=INDX(IPOS0+IPOS2) DERMIX=(RAM(IP0+IA00)-RAM(IP0+IA20) * -RAM(IP0+IA02)+RAM(IP0+IA22))/2. ELSE IA00=INDX(IPOS0-IPOS1) IA20=INDX(IPOS0) IA22=INDX(IPOS0+IPOS2) DERMIX= RAM(IP0+IA00)-RAM(IP0+IA20) * -RAM(IP0+IA02)+RAM(IP0+IA22) END IF ELSE IF(IA00.GT.0) THEN IA20=INDX(IPOS0-IPOS2) IA22=INDX(IPOS0+IPOS2) DERMIX=(RAM(IP0+IA00)-RAM(IP0+IA20) * -RAM(IP0+IA02)+RAM(IP0+IA22))/2. ELSE IA00=INDX(IPOS0-IPOS1) IA20=INDX(IPOS0) IA22=INDX(IPOS0+IPOS2) DERMIX= RAM(IP0+IA00)-RAM(IP0+IA20) * -RAM(IP0+IA02)+RAM(IP0+IA22) END IF END IF ELSE IF(IA20.GT.0) THEN IF(IA00.GT.0) THEN IA02=INDX(IPOS0-IPOS1) IA22=INDX(IPOS0+IPOS1) DERMIX=(RAM(IP0+IA00)-RAM(IP0+IA20) * -RAM(IP0+IA02)+RAM(IP0+IA22))/2. ELSE IA00=INDX(IPOS0-IPOS2) IA02=INDX(IPOS0) IA22=INDX(IPOS0+IPOS1) DERMIX= RAM(IP0+IA00)-RAM(IP0+IA20) * -RAM(IP0+IA02)+RAM(IP0+IA22) END IF ELSE IF(IA00.GT.0) THEN IA02=INDX(IPOS0-IPOS1) IA20=INDX(IPOS0-IPOS2) IA22=INDX(IPOS0) DERMIX= RAM(IP0+IA00)-RAM(IP0+IA20) * -RAM(IP0+IA02)+RAM(IP0+IA22) ELSE IERR=IERR+1 END IF END IF END IF END IF C RETURN END C C======================================================================= C C C SUBROUTINE SLOW(X1,X2,X3,DPOS1,DPOS2,DPOS3, * IPOS1,IPOS2,IPOS3,IPOS,IADR,PS) REAL X1,X2,X3,DPOS1,DPOS2,DPOS3,PS INTEGER IPOS1,IPOS2,IPOS3,IPOS,IADR C C Subroutine called by SOURCE, RECVRS, TRACER, and ONERAY, to find C a close gridpoint within the computational volume, and to interpolate C the slowness within the same geological block. C If the distance of the given point from the model volume is greater C than a grid step, an error message is generated. C If the point is outside the computational volume or in a free space, C another error message is generated. C C Input: C X1,X2,X3... Coordinates of the point. C C Output: C DPOS1,DPOS2,DPOS3... Vectorial distance from the nearest C gridpoint situated in the same geological block. C IPOS1,IPOS2,IPOS3... Positional indices of the nearest gridpoint. C IPOS... Index of the nearest gridpoint in the index array. C IADR... Storage address of the nearest gridpoint if it is located C in the computational volume, otherwise zero. C PS... Interpolated slowness. C C----------------------------------------------------------------------- C C Common block /GRID/ is required here: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C EXTERNAL INDX INTEGER INDX REAL GIANT PARAMETER (GIANT=1.E+10) C INTEGER I1,I2,I3,I1D,I2D,I3D,IAUX,ICBREF REAL DS,AUX C C I1,I2,I3... Loop variables - position of a gridpoint. C I1D,I2D,I3D... Loop increments. C IAUX... Index of the node at a gridpoint. C DS... Distance of the point from a gridpoint. C AUX... Temporary variable. C ICBREF... Index of the geological block. C C....................................................................... C C Determination of the nearest gridpoint: CALL POS(X1,X2,X3,DPOS1,DPOS2,DPOS3,IPOS1,IPOS2,IPOS3,IPOS,IADR) I1D=INT(SIGN(1.5,DSX1*DPOS1)) I2D=INT(SIGN(1.5,DSX2*DPOS2)) I3D=INT(SIGN(1.5,DSX3*DPOS3)) C C Slowness in the given point is determined by an interpolation C from neighbouring grid-point slownesses PS=0.0 DS=0.0 DO 23 I3=IPOS3,IPOS3+I3D,I3D DO 22 I2=IPOS2,IPOS2+I2D,I2D DO 21 I1=IPOS1,IPOS1+I1D,I1D IF(0.LE.I1.AND.I1.LE.NL1-1.AND. * 0.LE.I2.AND.I2.LE.NL2-1.AND. * 0.LE.I3.AND.I3.LE.NL3-1) THEN IAUX=1+I1+(I2+I3*NL2)*NL1 IAUX=INDX(IAUX) IF(IAUX.GT.0) THEN C C Test for nodes in a free space: IF(RAM(IP0+IAUX).GE.GIANT) THEN GO TO 20 ENDIF C C Check for the nearest gridpoint in the indexed volume IF(DS.EQ.0.) THEN C C Redefinition of the nearest gridpoint IF(IADR.NE.IAUX) THEN IF(LN1) THEN DPOS1=DPOS1+DSX1*FLOAT(IPOS2-I2) ELSE DPOS1=DPOS1+DSX1*FLOAT(IPOS1-I1) END IF DPOS2=DPOS2+DSX2*FLOAT(IPOS2-I2) DPOS3=DPOS3+DSX3*FLOAT(IPOS3-I3) IPOS1=I1 IPOS2=I2 IPOS3=I3 IPOS=1+I1+(I2+I3*NL2)*NL1 IADR=IAUX END IF C C Setting reference geological block IF(LICB) THEN ICBREF=IRAM(ICB0+IADR) END IF ELSE C C Check for the (geological) block: IF(LICB) THEN IF(IRAM(ICB0+IAUX).NE.ICBREF) THEN GO TO 20 ENDIF ENDIF ENDIF C C Interpolation: IF(LN1) THEN AUX=SQRT((FLOAT(I2-IPOS2)*DSX1-DPOS1)**2+ * (FLOAT(I2-IPOS2)*DSX2-DPOS2)**2+ * (FLOAT(I3-IPOS3)*DSX3-DPOS3)**2) ELSE AUX=SQRT((FLOAT(I1-IPOS1)*DSX1-DPOS1)**2+ * (FLOAT(I2-IPOS2)*DSX2-DPOS2)**2+ * (FLOAT(I3-IPOS3)*DSX3-DPOS3)**2) END IF IF(AUX.EQ.0.) THEN PS=RAM(IP0+IAUX) RETURN END IF PS=PS+RAM(IP0+IAUX)/AUX DS=DS+1.0/AUX C ENDIF ENDIF 20 CONTINUE 21 CONTINUE 22 CONTINUE 23 CONTINUE IF(DS.EQ.0.) THEN C NET-45 CALL ERROR('NET-45: Source or receiver point in a free space') C NET-45: Source or receiver point in a free space: C Source or receiver point is situated outside the indexed C computational volume or in a free space (zero velocity). ENDIF PS=PS/DS C RETURN END C C======================================================================= C C C SUBROUTINE POS(X1,X2,X3,DPOS1,DPOS2,DPOS3, * IPOS1,IPOS2,IPOS3,IPOS,IADR) REAL X1,X2,X3,DPOS1,DPOS2,DPOS3 INTEGER IPOS1,IPOS2,IPOS3,IPOS,IADR C C Auxiliary subroutine to SLOW, to find the nearest gridpoint. C This subroutine checks the position of the given point with respect to C the boundaries of the model volume. If the distance from the model C volume is greater than a grid step, the error message is generated. C C Input: C X1,X2,X3... Coordinates of the point. C C Output: C DPOS1,DPOS2,DPOS3... Vectorial distance from the nearest C gridpoint. C IPOS1,IPOS2,IPOS3... Positional indices of the nearest gridpoint. C IPOS... Index of the nearest gridpoint in the index array. C IADR... Storage address of the nearest gridpoint if it is located C in the computational volume, otherwise zero. C C----------------------------------------------------------------------- C C Common block /GRID/ is required here: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C EXTERNAL INDX INTEGER INDX C C....................................................................... C IF(LN1) THEN IPOS1=0 IPOS2=INT( ((X1-X1MIN)*DSX1+(X2-X2MIN)*DSX2)/(DSX1**2+DSX2**2) ) IF(IPOS2.LT.0.OR.NL2.LT.IPOS2) THEN C NET-46 CALL ERROR * ('NET-46: Source or receiver point outside the model') C NET-46: Source or receiver point outside the model: C Source or receiver point is situated outside the model C volume. ELSE IF(IPOS2.GE.NL2) THEN IPOS2=NL2-1 END IF DPOS1=X1-X1MIN-(FLOAT(IPOS2)+0.5)*DSX1 DPOS2=X2-X2MIN-(FLOAT(IPOS2)+0.5)*DSX2 ELSE IF(NL1.EQ.1) THEN IPOS1=0 DPOS1=0. ELSE IPOS1=INT((X1-X1MIN)/DSX1) IF(IPOS1.LT.0.OR.NL1.LT.IPOS1) THEN C NET-47 CALL ERROR * ('NET-47: Source or receiver point outside the model') C NET-47: Source or receiver point outside the model: C Source or receiver point is situated outside the C model volume. ELSE IF(IPOS1.GE.NL1) THEN IPOS1=NL1-1 END IF DPOS1=X1-X1MIN-(FLOAT(IPOS1)+0.5)*DSX1 END IF IF(NL2.EQ.1) THEN IPOS2=0 DPOS2=0. ELSE IPOS2=INT((X2-X2MIN)/DSX2) IF(IPOS2.LT.0.OR.NL2.LT.IPOS2) THEN C NET-48 CALL ERROR * ('NET-48: Source or receiver point outside the model') C NET-48: Source or receiver point outside the model: C Source or receiver point is situated outside the C model volume. ELSE IF(IPOS2.GE.NL2) THEN IPOS2=NL2-1 END IF DPOS2=X2-X2MIN-(FLOAT(IPOS2)+0.5)*DSX2 END IF END IF IF(NL3.EQ.1) THEN IPOS3=0 DPOS3=0. ELSE IPOS3=INT((X3-X3MIN)/DSX3) IF(IPOS3.LT.0.OR.NL3.LT.IPOS3) THEN C NET-54 CALL ERROR * ('NET-54: Source or receiver point outside the model') C NET-54: Source or receiver point outside the model. ELSE IF(IPOS3.GE.NL3) THEN IPOS3=NL3-1 END IF DPOS3=X3-X3MIN-(FLOAT(IPOS3)+0.5)*DSX3 END IF C IPOS =1+IPOS1+(IPOS2+IPOS3*NL2)*NL1 IADR=INDX(IPOS) RETURN END C C======================================================================= C C C INTEGER FUNCTION INDX(IPOS) INTEGER IPOS C C Integer function, called by many subroutines, to return the index of C the node at the given gridpoint. The subroutine does not check the C validity of the input argument. C C----------------------------------------------------------------------- C C Common block /GRID/ is required here: INCLUDE 'net.inc' C net.inc C C----------------------------------------------------------------------- C INTEGER IPOS1,IPOS2,IPOS3,I1,I2,I3,J1,J2,J3,J C C....................................................................... C IF(L4.EQ.0) THEN INDX=IPOS ELSE IPOS1=IPOS-1 IPOS2=IPOS1/NL1 IPOS3=IPOS2/NL2 IPOS1=IPOS1-IPOS2*NL1 IPOS2=IPOS2-IPOS3*NL2 J1=IPOS1/L1 J2=IPOS2/L2 J3=IPOS3/L3 J=IRAM(IND0+1+J1+N1*(J2+N2*J3)) IF(J.LE.0) THEN INDX=0 ELSE I1=IPOS1-J1*L1 I2=IPOS2-J2*L2 I3=IPOS3-J3*L3 INDX=J+I1+L1*(I2+L2*I3) END IF END IF RETURN END C C======================================================================= C INCLUDE 'ttt.for' C ttt.for INCLUDE 'error.for' C error.for INCLUDE 'sep.for' c sep.for INCLUDE 'length.for' c length.for INCLUDE 'forms.for' c forms.for INCLUDE 'eigen.for' C eigen.for C C======================================================================= Cnet.fs2 100666 1750 1750 152724 5263432052 11413 0 ustar klimes klimes 1 2 0 0 1 0 1 1 2 3 0 0 1 0 1 1 0 1 2 3 4 0 0 1 0 1 1 0 1 2 0 1 3 4 5 0 0 1 0 1 1 0 1 2 0 2 3 0 1 4 5 6 0 0 1 0 1 1 0 1 2 0 1 3 0 3 4 0 1 5 6 7 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 3 4 0 1 6 7 8 0 0 1 0 1 1 0 1 2 0 2 3 0 1 4 0 2 5 0 4 5 0 1 7 8 10 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 2 5 0 3 5 0 4 5 0 1 8 9 11 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 1 5 0 2 5 0 3 5 0 5 6 0 1 9 10 12 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 5 6 0 1 10 11 12 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 2 5 0 3 5 0 1 6 0 6 7 0 1 11 12 13 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 2 5 0 3 5 0 1 6 0 3 7 0 6 7 0 1 12 13 15 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 1 7 0 2 7 0 3 7 0 4 7 0 7 8 0 1 13 14 16 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 4 5 0 1 7 0 2 7 0 3 7 0 4 7 0 7 8 0 1 14 15 18 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 2 7 0 3 7 0 4 7 0 1 8 0 8 9 0 1 15 16 18 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 2 7 0 3 7 0 4 7 0 1 8 0 8 9 0 1 16 17 19 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 2 7 0 4 7 0 3 8 0 1 9 0 4 9 0 9 10 0 1 17 18 20 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 2 7 0 5 6 0 3 8 0 5 7 0 1 9 0 4 9 0 5 9 0 9 10 0 1 18 19 21 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 1 7 0 2 7 0 5 6 0 3 8 0 5 7 0 4 9 0 1 10 0 5 9 0 10 11 0 1 19 20 22 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 5 6 0 3 8 0 5 7 0 4 9 0 1 10 0 5 9 0 10 11 0 1 20 21 24 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 2 7 0 5 6 0 1 8 0 3 8 0 5 7 0 2 9 0 5 8 0 4 9 0 5 9 0 1 11 0 11 12 0 1 21 22 25 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 2 7 0 3 7 0 1 8 0 3 8 0 5 7 0 6 7 0 2 9 0 5 8 0 5 9 0 1 11 0 5 11 0 11 12 0 1 22 23 26 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 2 7 0 3 7 0 1 8 0 3 8 0 5 7 0 6 7 0 2 9 0 5 8 0 3 10 0 1 12 0 5 11 0 6 11 0 12 13 0 1 23 24 26 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 2 7 0 3 7 0 1 8 0 3 8 0 5 7 0 6 7 0 2 9 0 5 8 0 3 10 0 1 12 0 5 11 0 6 11 0 12 13 0 1 24 25 27 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 4 7 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 3 10 0 5 11 0 6 11 0 1 13 0 13 14 0 1 25 26 29 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 3 8 0 5 7 0 1 9 0 2 9 0 5 8 0 3 10 0 7 8 0 5 11 0 6 11 0 1 13 0 13 14 0 1 26 27 30 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 5 7 0 2 9 0 5 8 0 1 10 0 3 10 0 7 8 0 4 11 0 6 11 0 1 14 0 6 13 0 14 15 0 1 27 28 30 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 5 7 0 2 9 0 5 8 0 1 10 0 3 10 0 7 8 0 4 11 0 1 14 0 6 13 0 7 13 0 14 15 0 1 28 29 30 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 5 7 0 2 9 0 5 8 0 1 10 0 3 10 0 7 8 0 4 11 0 6 13 0 7 13 0 1 15 0 15 16 0 1 29 30 30 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 3 7 0 5 6 0 4 7 0 1 8 0 5 7 0 2 9 0 5 8 0 1 10 0 3 10 0 3 11 0 4 11 0 8 9 0 6 13 0 7 13 0 1 15 0 15 16 0 1 30 31 32 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 3 7 0 5 6 0 4 7 0 5 7 0 1 9 0 2 9 0 5 8 0 3 10 0 1 11 0 2 11 0 3 11 0 4 11 0 8 9 0 7 10 0 6 13 0 7 13 0 1 16 0 16 17 0 1 31 32 37 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 3 10 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 7 10 0 7 13 0 1 16 0 7 15 0 16 17 0 1 32 33 38 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 7 10 0 4 13 0 7 15 0 8 15 0 1 17 0 17 18 0 1 33 34 38 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 4 9 0 2 11 0 7 9 0 3 11 0 4 11 0 1 12 0 7 10 0 7 11 0 9 10 0 4 13 0 7 15 0 8 15 0 1 17 0 17 18 0 1 34 35 39 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 4 9 0 5 9 0 2 11 0 7 9 0 3 11 0 4 11 0 1 12 0 7 10 0 7 11 0 9 10 0 4 13 0 7 15 0 8 15 0 1 18 0 18 19 0 1 35 36 39 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 4 9 0 5 9 0 2 11 0 7 9 0 3 11 0 4 11 0 1 12 0 7 10 0 7 11 0 9 10 0 4 13 0 7 15 0 8 15 0 1 18 0 18 19 0 1 36 37 39 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 6 7 0 2 9 0 4 9 0 1 10 0 5 9 0 2 11 0 7 9 0 3 11 0 7 10 0 7 11 0 1 13 0 9 10 0 4 13 0 5 14 0 8 15 0 8 17 0 1 19 0 19 20 0 1 37 38 41 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 7 8 0 2 11 0 7 9 0 3 11 0 7 10 0 7 11 0 1 13 0 3 13 0 4 13 0 10 11 0 5 14 0 8 17 0 1 19 0 9 17 0 19 20 0 1 38 39 42 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 2 9 0 5 8 0 4 9 0 5 9 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 7 10 0 7 11 0 3 13 0 4 13 0 1 14 0 10 11 0 5 14 0 8 17 0 9 17 0 1 20 0 20 21 0 1 39 40 42 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 2 9 0 5 8 0 4 9 0 5 9 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 7 10 0 7 11 0 3 13 0 4 13 0 1 14 0 10 11 0 5 14 0 8 17 0 9 17 0 1 20 0 20 21 0 1 40 41 42 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 2 9 0 5 8 0 4 9 0 5 9 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 7 10 0 5 12 0 7 11 0 3 13 0 4 13 0 1 14 0 10 11 0 5 14 0 8 17 0 9 17 0 1 21 0 21 22 0 1 41 42 44 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 5 9 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 5 11 0 7 10 0 5 12 0 7 11 0 3 13 0 4 13 0 1 14 0 5 14 0 11 12 0 9 17 0 9 19 0 1 21 0 21 22 0 1 42 43 47 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 1 9 0 6 7 0 2 9 0 5 8 0 1 10 0 5 9 0 3 10 0 7 8 0 2 11 0 7 9 0 3 11 0 1 12 0 5 11 0 7 10 0 5 12 0 7 11 0 2 13 0 3 13 0 8 11 0 5 14 0 1 15 0 11 12 0 5 16 0 9 19 0 10 19 0 1 22 0 22 23 0 1 43 44 48 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 1 10 0 5 9 0 3 10 0 2 11 0 7 9 0 3 11 0 8 9 0 1 12 0 5 11 0 5 12 0 7 11 0 2 13 0 3 13 0 8 11 0 5 14 0 1 15 0 9 13 0 11 12 0 5 16 0 9 19 0 10 19 0 1 22 0 22 23 0 1 44 45 48 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 1 10 0 3 10 0 2 11 0 7 9 0 3 11 0 8 9 0 1 12 0 5 11 0 6 11 0 5 12 0 7 11 0 2 13 0 3 13 0 8 11 0 5 14 0 9 13 0 1 16 0 11 12 0 5 16 0 9 19 0 10 19 0 1 23 0 23 24 0 1 45 46 50 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 3 10 0 2 11 0 7 9 0 3 11 0 8 9 0 1 12 0 5 11 0 6 11 0 5 12 0 7 11 0 2 13 0 3 13 0 8 11 0 5 13 0 5 14 0 9 13 0 1 16 0 5 16 0 12 13 0 9 19 0 10 19 0 1 23 0 23 24 0 1 46 47 51 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 5 8 0 4 9 0 1 10 0 3 10 0 2 11 0 7 9 0 8 9 0 1 12 0 5 11 0 6 11 0 5 12 0 2 13 0 3 13 0 8 11 0 7 12 0 5 13 0 3 14 0 4 15 0 9 13 0 1 16 0 9 14 0 5 16 0 12 13 0 6 17 0 10 19 0 10 21 0 1 24 0 24 25 0 1 47 48 51 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 5 8 0 4 9 0 1 10 0 3 10 0 2 11 0 7 9 0 8 9 0 1 12 0 5 11 0 6 11 0 5 12 0 2 13 0 3 13 0 8 11 0 7 12 0 5 13 0 3 14 0 4 15 0 9 13 0 1 16 0 9 14 0 5 16 0 12 13 0 6 17 0 10 21 0 11 21 0 1 24 0 24 25 0 1 48 49 51 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 5 8 0 4 9 0 3 10 0 1 11 0 2 11 0 7 9 0 8 9 0 5 11 0 6 11 0 5 12 0 1 13 0 2 13 0 3 13 0 8 11 0 7 12 0 5 13 0 3 14 0 4 15 0 9 13 0 9 14 0 5 16 0 1 17 0 12 13 0 6 17 0 10 21 0 11 21 0 1 25 0 25 26 0 1 49 50 54 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 5 8 0 4 9 0 1 10 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 5 11 0 6 11 0 5 12 0 1 13 0 2 13 0 3 13 0 9 10 0 8 11 0 7 12 0 5 13 0 9 11 0 3 14 0 4 15 0 9 13 0 9 14 0 5 16 0 1 17 0 6 17 0 13 14 0 10 21 0 11 21 0 1 25 0 25 26 0 1 50 51 55 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 5 11 0 6 11 0 5 12 0 2 13 0 3 13 0 9 10 0 8 11 0 7 12 0 5 13 0 1 14 0 9 11 0 3 14 0 4 15 0 9 13 0 9 14 0 5 16 0 6 17 0 1 18 0 13 14 0 10 21 0 11 21 0 1 26 0 26 27 0 1 51 52 55 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 5 7 0 1 9 0 6 7 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 2 11 0 7 9 0 4 11 0 1 12 0 6 11 0 5 12 0 2 13 0 3 13 0 9 10 0 8 11 0 7 12 0 5 13 0 1 14 0 9 11 0 6 13 0 3 14 0 4 15 0 9 13 0 9 14 0 5 16 0 6 17 0 1 18 0 13 14 0 11 21 0 11 23 0 1 26 0 26 27 0 1 52 53 55 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 5 7 0 1 9 0 6 7 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 2 11 0 7 9 0 4 11 0 1 12 0 6 11 0 5 12 0 2 13 0 3 13 0 9 10 0 8 11 0 7 12 0 5 13 0 1 14 0 9 11 0 6 13 0 3 14 0 4 15 0 9 13 0 9 14 0 6 17 0 1 18 0 13 14 0 6 19 0 11 23 0 12 23 0 1 27 0 27 28 0 1 53 54 55 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 5 7 0 1 9 0 6 7 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 2 11 0 7 9 0 4 11 0 1 12 0 6 11 0 5 12 0 2 13 0 3 13 0 9 10 0 8 11 0 7 12 0 5 13 0 1 14 0 9 11 0 6 13 0 3 14 0 4 15 0 9 13 0 9 14 0 6 17 0 1 18 0 6 19 0 14 15 0 11 23 0 12 23 0 1 27 0 27 28 0 1 54 55 58 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 2 11 0 7 9 0 4 11 0 1 12 0 5 12 0 2 13 0 9 10 0 8 11 0 7 12 0 5 13 0 9 11 0 6 13 0 3 14 0 7 13 0 1 15 0 8 13 0 4 15 0 9 13 0 9 14 0 4 17 0 6 17 0 1 19 0 6 19 0 14 15 0 11 23 0 12 23 0 1 28 0 28 29 0 1 55 56 59 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 2 11 0 7 9 0 4 11 0 8 9 0 1 12 0 5 12 0 2 13 0 8 11 0 7 12 0 5 13 0 9 11 0 6 13 0 3 14 0 7 13 0 10 11 0 1 15 0 8 13 0 4 15 0 9 13 0 9 14 0 4 17 0 6 17 0 1 19 0 6 19 0 14 15 0 11 23 0 12 23 0 1 28 0 28 29 0 1 56 57 64 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 7 10 0 5 12 0 2 13 0 8 11 0 7 12 0 5 13 0 9 11 0 6 13 0 3 14 0 7 13 0 10 11 0 1 15 0 2 15 0 8 13 0 4 15 0 3 16 0 10 13 0 9 14 0 4 17 0 11 16 0 6 19 0 1 20 0 14 15 0 7 20 0 12 23 0 12 25 0 1 29 0 29 30 0 1 57 58 64 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 7 10 0 5 12 0 2 13 0 8 11 0 7 12 0 5 13 0 9 11 0 6 13 0 3 14 0 7 13 0 10 11 0 1 15 0 2 15 0 8 13 0 4 15 0 3 16 0 10 13 0 9 14 0 4 17 0 11 16 0 6 19 0 1 20 0 7 20 0 15 16 0 12 25 0 13 25 0 1 29 0 29 30 0 1 58 59 64 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 7 10 0 5 12 0 2 13 0 8 11 0 7 12 0 5 13 0 9 11 0 6 13 0 3 14 0 7 13 0 10 11 0 1 15 0 2 15 0 8 13 0 4 15 0 3 16 0 10 13 0 9 14 0 4 17 0 11 16 0 6 19 0 1 20 0 7 20 0 15 16 0 12 25 0 13 25 0 1 30 0 30 31 0 1 59 60 64 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 7 10 0 5 12 0 2 13 0 8 11 0 7 12 0 5 13 0 9 11 0 6 13 0 3 14 0 7 13 0 10 11 0 1 15 0 2 15 0 8 13 0 4 15 0 3 16 0 10 13 0 4 17 0 11 16 0 6 19 0 1 20 0 11 17 0 7 20 0 15 16 0 12 25 0 13 25 0 1 30 0 30 31 0 1 60 61 65 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 7 10 0 5 12 0 1 13 0 2 13 0 8 11 0 7 12 0 5 13 0 9 11 0 6 13 0 3 14 0 7 13 0 10 11 0 2 15 0 8 13 0 4 15 0 1 16 0 3 16 0 10 13 0 4 17 0 11 16 0 6 19 0 11 17 0 1 21 0 7 20 0 15 16 0 12 25 0 13 25 0 1 31 0 31 32 0 1 61 62 66 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 5 11 0 7 10 0 5 12 0 1 13 0 2 13 0 8 11 0 7 12 0 5 13 0 9 11 0 3 14 0 7 13 0 2 15 0 8 13 0 4 15 0 1 16 0 11 12 0 3 16 0 10 13 0 7 15 0 4 17 0 11 16 0 6 19 0 11 17 0 1 21 0 7 20 0 16 17 0 13 25 0 13 27 0 1 31 0 31 32 0 1 62 63 68 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 5 12 0 2 13 0 8 11 0 4 13 0 7 12 0 5 13 0 1 14 0 9 11 0 3 14 0 7 13 0 2 15 0 8 13 0 4 15 0 11 12 0 3 16 0 10 13 0 7 15 0 1 17 0 4 17 0 11 16 0 11 17 0 7 20 0 1 22 0 7 22 0 16 17 0 13 27 0 14 27 0 1 32 0 32 33 0 1 63 64 68 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 5 12 0 7 11 0 2 13 0 8 11 0 4 13 0 7 12 0 5 13 0 1 14 0 9 11 0 3 14 0 7 13 0 2 15 0 8 13 0 11 12 0 3 16 0 10 13 0 7 15 0 1 17 0 4 17 0 11 16 0 5 19 0 11 17 0 7 20 0 1 22 0 7 22 0 16 17 0 13 27 0 14 27 0 1 32 0 32 33 0 1 64 65 69 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 2 13 0 8 11 0 4 13 0 7 12 0 5 13 0 1 14 0 9 11 0 3 14 0 2 15 0 8 13 0 11 12 0 3 16 0 10 13 0 7 15 0 8 15 0 1 17 0 4 17 0 11 16 0 5 19 0 11 17 0 7 20 0 1 22 0 7 22 0 16 17 0 13 27 0 14 27 0 1 33 0 33 34 0 1 65 66 69 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 2 13 0 9 10 0 8 11 0 4 13 0 7 12 0 5 13 0 1 14 0 9 11 0 3 14 0 2 15 0 8 13 0 11 12 0 3 16 0 10 13 0 7 15 0 8 15 0 1 17 0 4 17 0 11 16 0 5 19 0 11 17 0 7 20 0 1 22 0 7 22 0 17 18 0 13 27 0 14 27 0 1 33 0 33 34 0 1 66 67 70 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 9 10 0 8 11 0 4 13 0 7 12 0 5 13 0 9 11 0 3 14 0 1 15 0 2 15 0 8 13 0 11 12 0 3 16 0 10 13 0 7 15 0 8 15 0 4 17 0 1 18 0 11 16 0 5 19 0 11 17 0 1 23 0 7 22 0 8 23 0 17 18 0 14 27 0 14 29 0 1 34 0 34 35 0 1 67 68 70 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 7 9 0 3 11 0 4 11 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 9 10 0 4 13 0 7 12 0 5 13 0 9 11 0 3 14 0 1 15 0 2 15 0 8 13 0 3 16 0 10 13 0 7 15 0 8 15 0 3 17 0 4 17 0 12 13 0 1 18 0 11 15 0 11 16 0 5 19 0 11 17 0 1 23 0 7 22 0 8 23 0 17 18 0 14 29 0 15 29 0 1 34 0 34 35 0 1 68 69 70 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 7 9 0 3 11 0 4 11 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 9 10 0 4 13 0 7 12 0 5 13 0 9 11 0 3 14 0 1 15 0 2 15 0 8 13 0 3 16 0 10 13 0 7 15 0 8 15 0 3 17 0 4 17 0 12 13 0 1 18 0 11 15 0 11 16 0 5 19 0 11 17 0 7 22 0 1 24 0 8 23 0 17 18 0 14 29 0 15 29 0 1 35 0 35 36 0 1 69 70 71 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 7 9 0 3 11 0 4 11 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 9 10 0 4 13 0 7 12 0 5 13 0 9 11 0 3 14 0 1 15 0 2 15 0 8 13 0 3 16 0 10 13 0 7 15 0 8 15 0 3 17 0 4 17 0 12 13 0 1 18 0 7 17 0 11 15 0 5 19 0 11 17 0 13 19 0 7 22 0 1 24 0 8 23 0 18 19 0 14 29 0 15 29 0 1 35 0 35 36 0 1 70 71 71 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 7 9 0 3 11 0 4 11 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 9 10 0 4 13 0 7 12 0 5 13 0 9 11 0 3 14 0 1 15 0 2 15 0 8 13 0 3 16 0 10 13 0 7 15 0 8 15 0 3 17 0 4 17 0 12 13 0 1 18 0 7 17 0 11 15 0 5 19 0 11 17 0 13 19 0 7 22 0 1 24 0 8 23 0 18 19 0 14 29 0 15 29 0 1 36 0 36 37 0 1 71 72 76 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 3 13 0 9 10 0 4 13 0 7 12 0 5 13 0 9 11 0 3 14 0 5 14 0 1 15 0 2 15 0 8 13 0 3 16 0 10 13 0 8 15 0 11 13 0 3 17 0 12 13 0 1 18 0 7 17 0 11 15 0 8 17 0 5 19 0 11 17 0 5 21 0 13 19 0 7 22 0 1 24 0 8 23 0 18 19 0 15 29 0 15 31 0 1 36 0 36 37 0 1 72 73 77 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 2 13 0 3 13 0 9 10 0 4 13 0 7 12 0 5 13 0 1 14 0 9 11 0 5 14 0 2 15 0 8 13 0 1 16 0 3 16 0 10 13 0 8 15 0 11 13 0 2 17 0 3 17 0 12 13 0 11 14 0 7 17 0 11 15 0 8 17 0 1 19 0 4 19 0 5 19 0 5 21 0 13 19 0 13 20 0 8 23 0 1 25 0 18 19 0 8 25 0 15 31 0 16 31 0 1 37 0 37 38 0 1 73 74 77 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 2 13 0 3 13 0 4 13 0 7 12 0 5 13 0 1 14 0 9 11 0 10 11 0 5 14 0 2 15 0 8 13 0 1 16 0 3 16 0 10 13 0 8 15 0 11 13 0 2 17 0 3 17 0 11 14 0 7 17 0 11 15 0 8 17 0 1 19 0 13 14 0 4 19 0 5 19 0 5 21 0 13 19 0 13 20 0 8 23 0 1 25 0 8 25 0 19 20 0 15 31 0 16 31 0 1 37 0 37 38 0 1 74 75 78 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 2 13 0 3 13 0 4 13 0 7 12 0 1 14 0 9 11 0 10 11 0 5 14 0 2 15 0 8 13 0 1 16 0 3 16 0 10 13 0 11 13 0 2 17 0 3 17 0 7 16 0 11 14 0 7 17 0 11 15 0 8 17 0 13 14 0 9 17 0 7 18 0 4 19 0 5 19 0 1 20 0 5 21 0 13 19 0 13 20 0 8 23 0 1 26 0 8 25 0 19 20 0 15 31 0 16 31 0 1 38 0 38 39 0 1 75 76 79 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 7 8 0 1 11 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 2 13 0 3 13 0 4 13 0 7 12 0 1 14 0 9 11 0 6 13 0 10 11 0 5 14 0 2 15 0 8 13 0 1 16 0 3 16 0 10 13 0 11 13 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 7 17 0 11 15 0 8 17 0 13 14 0 9 17 0 7 18 0 4 19 0 5 19 0 1 20 0 5 21 0 13 19 0 13 20 0 8 23 0 1 26 0 8 25 0 19 20 0 15 31 0 16 31 0 1 38 0 38 39 0 1 76 77 79 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 7 8 0 1 11 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 2 13 0 3 13 0 4 13 0 7 12 0 1 14 0 9 11 0 6 13 0 10 11 0 5 14 0 2 15 0 8 13 0 1 16 0 3 16 0 10 13 0 11 13 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 7 17 0 11 15 0 8 17 0 13 14 0 9 17 0 7 18 0 4 19 0 5 19 0 1 20 0 5 21 0 13 19 0 13 20 0 1 26 0 8 25 0 9 26 0 19 20 0 16 31 0 16 33 0 1 39 0 39 40 0 1 77 78 79 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 7 8 0 1 11 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 2 13 0 3 13 0 4 13 0 7 12 0 1 14 0 9 11 0 6 13 0 10 11 0 5 14 0 2 15 0 8 13 0 1 16 0 3 16 0 10 13 0 11 13 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 7 17 0 11 15 0 8 17 0 13 14 0 9 17 0 7 18 0 4 19 0 5 19 0 1 20 0 5 21 0 13 19 0 13 20 0 1 26 0 8 25 0 9 26 0 20 21 0 16 33 0 17 33 0 1 39 0 39 40 0 1 78 79 79 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 7 8 0 1 11 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 2 13 0 3 13 0 4 13 0 7 12 0 1 14 0 9 11 0 6 13 0 10 11 0 5 14 0 2 15 0 8 13 0 3 16 0 10 13 0 11 13 0 1 17 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 7 17 0 11 15 0 8 17 0 13 14 0 9 17 0 7 18 0 4 19 0 5 19 0 1 21 0 5 21 0 13 19 0 13 20 0 8 25 0 1 27 0 9 26 0 20 21 0 16 33 0 17 33 0 1 40 0 40 41 0 1 79 80 83 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 7 8 0 1 11 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 3 13 0 9 10 0 8 11 0 4 13 0 7 12 0 9 11 0 6 13 0 5 14 0 1 15 0 2 15 0 8 13 0 11 12 0 3 16 0 10 13 0 11 13 0 1 17 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 7 17 0 11 15 0 8 17 0 9 17 0 3 19 0 7 18 0 4 19 0 5 19 0 14 15 0 1 21 0 5 21 0 13 19 0 13 20 0 8 25 0 1 27 0 9 26 0 20 21 0 16 33 0 17 33 0 1 40 0 40 41 0 1 80 81 86 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 3 13 0 9 10 0 8 11 0 4 13 0 7 12 0 9 11 0 6 13 0 7 13 0 5 14 0 1 15 0 2 15 0 8 13 0 11 12 0 3 16 0 10 13 0 11 13 0 1 17 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 7 17 0 11 15 0 8 17 0 9 17 0 3 19 0 7 18 0 4 19 0 10 17 0 14 15 0 1 21 0 5 21 0 13 19 0 6 23 0 13 20 0 8 25 0 9 26 0 1 28 0 20 21 0 16 33 0 17 33 0 1 41 0 41 42 0 1 81 82 87 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 3 13 0 9 10 0 8 11 0 4 13 0 7 12 0 9 11 0 6 13 0 7 13 0 5 14 0 1 15 0 2 15 0 8 13 0 11 12 0 3 16 0 11 13 0 1 17 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 7 17 0 11 15 0 9 17 0 3 19 0 7 18 0 4 19 0 10 17 0 14 15 0 9 19 0 1 21 0 13 17 0 5 21 0 13 19 0 6 23 0 13 20 0 8 25 0 9 26 0 1 28 0 21 22 0 17 33 0 17 35 0 1 41 0 41 42 0 1 82 83 92 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 3 13 0 9 10 0 8 11 0 7 12 0 5 13 0 9 11 0 6 13 0 7 13 0 5 14 0 1 15 0 2 15 0 8 13 0 9 13 0 11 12 0 5 16 0 11 13 0 1 17 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 9 16 0 7 17 0 11 15 0 5 18 0 9 17 0 3 19 0 7 18 0 4 19 0 10 17 0 14 15 0 9 19 0 1 21 0 4 21 0 13 17 0 5 21 0 6 23 0 13 20 0 15 22 0 9 26 0 1 28 0 9 28 0 21 22 0 17 35 0 18 35 0 1 42 0 42 43 0 1 83 84 92 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 3 13 0 9 10 0 8 11 0 7 12 0 5 13 0 9 11 0 6 13 0 7 13 0 5 14 0 1 15 0 2 15 0 8 13 0 9 13 0 11 12 0 5 16 0 11 13 0 1 17 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 9 16 0 7 17 0 11 15 0 5 18 0 9 17 0 3 19 0 7 18 0 4 19 0 10 17 0 14 15 0 9 19 0 1 21 0 4 21 0 13 17 0 5 21 0 6 23 0 13 20 0 15 22 0 9 26 0 1 28 0 9 28 0 21 22 0 17 35 0 18 35 0 1 42 0 42 43 0 1 84 85 92 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 3 13 0 9 10 0 8 11 0 7 12 0 5 13 0 9 11 0 6 13 0 7 13 0 5 14 0 1 15 0 2 15 0 8 13 0 9 13 0 11 12 0 5 16 0 11 13 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 1 18 0 9 16 0 7 17 0 11 15 0 5 18 0 3 19 0 7 18 0 4 19 0 10 17 0 14 15 0 9 19 0 4 21 0 13 17 0 10 19 0 5 21 0 1 22 0 6 23 0 13 20 0 15 22 0 9 26 0 1 29 0 9 28 0 21 22 0 17 35 0 18 35 0 1 43 0 43 44 0 1 85 86 92 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 3 13 0 9 10 0 8 11 0 7 12 0 5 13 0 9 11 0 6 13 0 7 13 0 5 14 0 1 15 0 2 15 0 8 13 0 9 13 0 11 12 0 5 16 0 11 13 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 1 18 0 9 16 0 7 17 0 11 15 0 5 18 0 3 19 0 7 18 0 4 19 0 10 17 0 9 19 0 4 21 0 13 17 0 10 19 0 5 21 0 15 16 0 1 22 0 6 23 0 15 22 0 15 23 0 9 26 0 1 29 0 9 28 0 22 23 0 17 35 0 18 35 0 1 43 0 43 44 0 1 86 87 93 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 3 13 0 9 10 0 8 11 0 7 12 0 5 13 0 1 14 0 9 11 0 6 13 0 7 13 0 5 14 0 2 15 0 8 13 0 9 13 0 1 16 0 11 12 0 5 16 0 11 13 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 9 16 0 7 17 0 11 15 0 5 18 0 1 19 0 3 19 0 7 18 0 4 19 0 10 17 0 9 19 0 4 21 0 13 17 0 10 19 0 5 21 0 15 16 0 1 23 0 6 23 0 15 22 0 15 23 0 9 28 0 1 30 0 10 29 0 22 23 0 18 35 0 18 37 0 1 44 0 44 45 0 1 87 88 94 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 3 13 0 9 10 0 8 11 0 4 13 0 7 12 0 5 13 0 1 14 0 9 11 0 6 13 0 7 13 0 5 14 0 2 15 0 8 13 0 9 13 0 1 16 0 11 12 0 5 16 0 11 13 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 9 16 0 7 17 0 11 15 0 5 18 0 1 19 0 3 19 0 7 18 0 4 19 0 10 17 0 9 19 0 4 21 0 13 17 0 10 19 0 5 21 0 15 16 0 1 23 0 6 23 0 15 22 0 15 23 0 9 28 0 1 30 0 10 29 0 22 23 0 18 37 0 19 37 0 1 44 0 44 45 0 1 88 89 94 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 3 13 0 9 10 0 8 11 0 4 13 0 7 12 0 5 13 0 1 14 0 9 11 0 6 13 0 7 13 0 5 14 0 2 15 0 9 13 0 1 16 0 11 12 0 5 16 0 11 13 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 9 16 0 7 17 0 11 15 0 5 18 0 1 19 0 3 19 0 7 18 0 4 19 0 10 17 0 9 19 0 11 18 0 4 21 0 13 17 0 10 19 0 15 16 0 1 23 0 6 23 0 6 25 0 15 22 0 15 23 0 9 28 0 1 30 0 10 29 0 22 23 0 18 37 0 19 37 0 1 45 0 45 46 0 1 89 90 97 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 3 13 0 9 10 0 8 11 0 4 13 0 7 12 0 5 13 0 1 14 0 9 11 0 6 13 0 3 14 0 7 13 0 10 11 0 5 14 0 2 15 0 9 13 0 1 16 0 9 14 0 5 16 0 11 13 0 2 17 0 3 17 0 7 16 0 12 13 0 5 17 0 11 14 0 9 16 0 7 17 0 11 15 0 5 18 0 1 19 0 3 19 0 7 18 0 4 19 0 10 17 0 9 19 0 11 18 0 4 21 0 13 17 0 10 19 0 15 16 0 1 23 0 6 23 0 6 25 0 15 22 0 15 23 0 9 28 0 1 30 0 10 29 0 23 24 0 18 37 0 19 37 0 1 45 0 45 46 0 1 90 91 99 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 3 13 0 9 10 0 8 11 0 4 13 0 7 12 0 5 13 0 1 14 0 9 11 0 6 13 0 3 14 0 7 13 0 10 11 0 5 14 0 2 15 0 4 15 0 9 13 0 1 16 0 9 14 0 5 16 0 11 13 0 2 17 0 3 17 0 7 16 0 12 13 0 5 17 0 11 14 0 9 16 0 7 17 0 11 15 0 5 18 0 1 19 0 2 19 0 3 19 0 7 18 0 4 19 0 10 17 0 13 16 0 9 19 0 11 18 0 4 21 0 13 17 0 10 19 0 15 16 0 6 23 0 1 24 0 6 25 0 15 22 0 15 23 0 9 28 0 10 29 0 1 31 0 23 24 0 18 37 0 19 37 0 1 46 0 46 47 0 1 91 92 99 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 2 13 0 3 13 0 9 10 0 8 11 0 4 13 0 7 12 0 5 13 0 9 11 0 3 14 0 7 13 0 10 11 0 1 15 0 2 15 0 4 15 0 9 13 0 7 15 0 9 14 0 5 16 0 11 13 0 1 17 0 2 17 0 3 17 0 7 16 0 12 13 0 5 17 0 11 14 0 6 17 0 9 16 0 7 17 0 11 15 0 5 18 0 2 19 0 3 19 0 7 18 0 4 19 0 10 17 0 1 20 0 13 16 0 11 18 0 4 21 0 13 17 0 10 19 0 10 21 0 16 17 0 6 23 0 1 24 0 6 25 0 15 22 0 15 23 0 9 28 0 10 29 0 1 31 0 23 24 0 19 37 0 19 39 0 1 46 0 46 47 0 1 92 93 99 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 3 13 0 9 10 0 8 11 0 4 13 0 7 12 0 5 13 0 9 11 0 3 14 0 7 13 0 10 11 0 1 15 0 2 15 0 4 15 0 9 13 0 7 15 0 9 14 0 5 16 0 11 13 0 1 17 0 2 17 0 3 17 0 7 16 0 12 13 0 5 17 0 11 14 0 6 17 0 9 16 0 7 17 0 5 18 0 2 19 0 3 19 0 7 18 0 4 19 0 10 17 0 1 20 0 3 20 0 13 16 0 11 18 0 4 21 0 13 17 0 10 19 0 10 21 0 16 17 0 14 19 0 6 23 0 1 24 0 6 25 0 15 22 0 15 23 0 10 29 0 1 32 0 10 31 0 23 24 0 19 39 0 20 39 0 1 47 0 47 48 0 1 93 94 99 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 3 13 0 9 10 0 8 11 0 4 13 0 7 12 0 5 13 0 9 11 0 3 14 0 7 13 0 10 11 0 1 15 0 2 15 0 4 15 0 9 13 0 7 15 0 9 14 0 5 16 0 11 13 0 1 17 0 2 17 0 3 17 0 7 16 0 12 13 0 5 17 0 11 14 0 6 17 0 9 16 0 7 17 0 5 18 0 2 19 0 3 19 0 7 18 0 4 19 0 10 17 0 1 20 0 3 20 0 13 16 0 11 18 0 4 21 0 13 17 0 10 19 0 10 21 0 16 17 0 14 19 0 6 23 0 1 24 0 6 25 0 15 22 0 15 23 0 10 29 0 1 32 0 10 31 0 24 25 0 19 39 0 20 39 0 1 47 0 47 48 0 1 94 95 99 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 3 13 0 9 10 0 8 11 0 4 13 0 7 12 0 5 13 0 9 11 0 3 14 0 10 11 0 1 15 0 2 15 0 4 15 0 9 13 0 7 15 0 9 14 0 5 16 0 8 15 0 11 13 0 1 17 0 2 17 0 3 17 0 7 16 0 12 13 0 5 17 0 11 14 0 6 17 0 9 16 0 7 17 0 5 18 0 2 19 0 3 19 0 7 18 0 4 19 0 10 17 0 1 20 0 3 20 0 13 16 0 11 18 0 4 21 0 13 17 0 10 21 0 16 17 0 14 19 0 11 21 0 6 23 0 1 24 0 6 25 0 15 22 0 15 23 0 10 29 0 1 32 0 10 31 0 24 25 0 19 39 0 20 39 0 1 48 0 48 49 0 1 95 96 99 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 3 13 0 9 10 0 8 11 0 4 13 0 7 12 0 5 13 0 9 11 0 3 14 0 10 11 0 1 15 0 2 15 0 4 15 0 9 13 0 7 15 0 9 14 0 5 16 0 8 15 0 11 13 0 1 17 0 2 17 0 3 17 0 7 16 0 12 13 0 5 17 0 11 14 0 6 17 0 9 16 0 7 17 0 5 18 0 2 19 0 3 19 0 7 18 0 4 19 0 10 17 0 1 20 0 3 20 0 13 16 0 11 18 0 4 21 0 13 17 0 10 21 0 16 17 0 14 19 0 11 21 0 6 23 0 1 24 0 6 25 0 15 23 0 17 25 0 10 29 0 1 32 0 10 31 0 24 25 0 19 39 0 20 39 0 1 48 0 48 49 0 1 96 97 100 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 3 13 0 9 10 0 8 11 0 4 13 0 7 12 0 5 13 0 9 11 0 3 14 0 10 11 0 1 15 0 2 15 0 4 15 0 9 13 0 7 15 0 9 14 0 5 16 0 8 15 0 11 13 0 1 17 0 2 17 0 3 17 0 7 16 0 12 13 0 5 17 0 11 14 0 6 17 0 9 16 0 7 17 0 5 18 0 2 19 0 3 19 0 7 18 0 4 19 0 10 17 0 1 20 0 3 20 0 13 16 0 11 18 0 4 21 0 13 17 0 10 21 0 16 17 0 14 19 0 11 21 0 6 23 0 1 25 0 6 25 0 15 23 0 17 25 0 10 31 0 1 33 0 11 32 0 24 25 0 20 39 0 20 41 0 1 49 0 49 50 0 1 97 98 102 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 3 13 0 9 10 0 8 11 0 4 13 0 7 12 0 5 13 0 1 14 0 9 11 0 3 14 0 1 15 0 2 15 0 4 15 0 9 13 0 11 12 0 7 15 0 9 14 0 5 16 0 8 15 0 11 13 0 1 17 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 6 17 0 9 16 0 7 17 0 5 18 0 13 14 0 2 19 0 3 19 0 7 18 0 4 19 0 10 17 0 13 15 0 1 20 0 3 20 0 13 16 0 11 18 0 4 21 0 13 17 0 10 21 0 14 19 0 11 21 0 17 18 0 1 25 0 6 25 0 15 23 0 7 27 0 17 25 0 10 31 0 1 33 0 11 32 0 25 26 0 20 41 0 21 41 0 1 49 0 49 50 0 1 98 99 103 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 3 13 0 9 10 0 8 11 0 4 13 0 7 12 0 5 13 0 1 14 0 9 11 0 3 14 0 2 15 0 4 15 0 9 13 0 1 16 0 11 12 0 7 15 0 9 14 0 5 16 0 8 15 0 11 13 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 6 17 0 1 18 0 9 16 0 5 18 0 13 14 0 2 19 0 3 19 0 7 18 0 10 17 0 13 15 0 3 20 0 13 16 0 8 19 0 1 21 0 11 18 0 4 21 0 13 17 0 10 21 0 14 19 0 11 21 0 9 22 0 5 24 0 17 18 0 6 25 0 1 26 0 7 27 0 17 25 0 17 26 0 10 31 0 11 32 0 1 34 0 25 26 0 20 41 0 21 41 0 1 50 0 50 51 0 1 99 100 106 0 0 1 0 1 1 0 1 2 0 1 3 0 2 3 0 1 4 0 3 4 0 1 5 0 2 5 0 3 5 0 1 6 0 4 5 0 1 7 0 2 7 0 3 7 0 5 6 0 4 7 0 1 8 0 3 8 0 5 7 0 1 9 0 6 7 0 2 9 0 5 8 0 4 9 0 1 10 0 5 9 0 3 10 0 7 8 0 1 11 0 2 11 0 7 9 0 3 11 0 4 11 0 8 9 0 1 12 0 5 11 0 7 10 0 6 11 0 5 12 0 7 11 0 1 13 0 3 13 0 9 10 0 8 11 0 4 13 0 7 12 0 5 13 0 1 14 0 9 11 0 6 13 0 3 14 0 2 15 0 8 13 0 4 15 0 9 13 0 1 16 0 11 12 0 7 15 0 9 14 0 5 16 0 8 15 0 11 13 0 2 17 0 3 17 0 7 16 0 5 17 0 11 14 0 6 17 0 1 18 0 9 16 0 5 18 0 13 14 0 2 19 0 3 19 0 7 18 0 10 17 0 13 15 0 3 20 0 7 19 0 13 16 0 8 19 0 1 21 0 11 18 0 4 21 0 13 17 0 10 21 0 14 19 0 11 21 0 9 22 0 5 24 0 17 18 0 6 25 0 1 26 0 7 27 0 17 25 0 17 26 0 10 31 0 11 32 0 1 34 0 25 26 0 20 41 0 21 41 0 1 50 0 50 51 0 1 100 0 0 net.fs3 100666 1750 1750 72446 5263432036 11400 0 ustar klimes klimes 1 3 0 0 1 0 1 1 1 1 1 2 5 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 3 8 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 4 11 0 0 1 0 1 1 1 1 1 0 1 2 1 2 2 1 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 1 4 5 16 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 0 1 3 0 2 3 1 2 3 2 2 3 1 1 4 1 3 3 1 2 4 2 3 3 1 3 4 0 1 5 1 1 5 6 21 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 1 2 3 2 2 3 1 2 4 2 3 3 0 3 4 1 3 4 0 1 5 1 1 5 2 3 4 1 2 5 1 4 4 1 3 5 1 1 6 7 28 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 1 1 3 0 2 3 2 2 3 0 1 4 1 1 4 1 2 4 2 3 3 0 3 4 2 3 4 0 2 5 1 4 4 2 2 5 3 3 4 1 3 5 2 3 5 1 1 6 1 2 6 1 4 5 2 4 5 1 3 6 0 1 7 1 1 7 8 33 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 1 1 4 1 3 3 1 2 4 0 1 5 1 2 5 2 2 5 3 3 4 0 3 5 2 3 5 1 1 6 3 4 4 1 4 5 3 3 5 2 4 5 1 3 6 3 4 5 1 5 5 1 4 6 1 2 7 1 3 7 0 5 6 0 1 8 1 1 8 9 41 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 1 1 4 1 3 3 1 2 4 2 3 3 0 3 4 1 3 4 0 1 5 1 1 5 2 3 4 0 2 5 1 2 5 2 2 5 3 3 4 1 3 5 2 3 5 3 4 4 1 2 6 3 3 5 2 4 5 2 3 6 3 4 5 1 4 6 1 3 7 0 5 6 1 5 6 1 4 7 1 2 8 1 6 6 1 3 8 0 1 9 1 1 9 10 48 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 3 3 1 2 4 1 3 4 1 1 5 2 3 4 0 2 5 1 2 5 1 4 4 2 2 5 0 3 5 1 3 5 0 1 6 2 3 5 3 4 4 0 4 5 1 2 6 1 4 5 3 3 5 2 4 5 2 3 6 3 4 5 4 4 5 2 2 7 3 5 5 1 3 7 3 4 6 2 3 7 2 5 6 1 6 6 1 5 7 1 4 8 1 6 7 1 2 9 1 5 8 1 3 9 0 1 10 1 1 10 11 57 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 1 4 1 3 3 1 2 4 2 3 3 0 3 4 1 3 4 2 3 4 0 2 5 1 2 5 1 4 4 1 3 5 0 1 6 1 1 6 1 2 6 1 4 5 3 3 5 2 4 5 2 3 6 3 4 5 0 2 7 4 4 5 3 4 6 2 3 7 2 5 6 0 4 7 4 5 5 1 4 7 3 3 7 2 4 7 1 2 8 3 5 6 3 4 7 4 5 6 2 3 8 1 4 8 0 6 7 1 6 7 1 5 8 1 3 9 1 4 9 1 7 7 1 6 8 1 2 10 0 1 11 1 1 11 12 66 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 1 4 1 2 4 2 3 3 0 3 4 0 1 5 1 1 5 1 2 5 1 4 4 2 2 5 3 3 4 0 3 5 1 3 5 1 1 6 0 4 5 1 2 6 1 4 5 2 4 5 1 3 6 2 3 6 3 4 5 0 1 7 1 4 6 2 5 5 1 2 7 0 3 7 3 4 6 2 3 7 4 5 5 3 3 7 2 4 7 3 5 6 3 4 7 4 5 6 2 5 7 4 4 7 1 4 8 3 5 7 0 6 7 5 5 6 1 2 9 2 6 7 4 5 7 2 3 9 1 4 9 1 7 7 1 6 8 1 5 9 1 3 10 1 7 8 1 4 10 1 6 9 1 2 11 0 1 12 1 1 12 13 77 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 1 4 1 3 3 1 2 4 2 3 3 0 3 4 1 3 4 1 1 5 2 3 4 1 2 5 1 4 4 2 2 5 3 3 4 0 3 5 1 3 5 2 3 5 0 4 5 1 2 6 2 4 5 1 3 6 0 1 7 1 1 7 1 4 6 2 5 5 1 2 7 2 2 7 0 3 7 3 4 6 1 5 6 2 3 7 2 5 6 0 4 7 3 3 7 2 4 7 1 2 8 3 4 7 4 5 6 2 3 8 2 5 7 4 4 7 3 5 7 0 2 9 5 5 6 2 6 7 3 4 8 4 5 7 1 5 8 3 6 7 2 3 9 5 6 6 1 4 9 4 6 7 1 2 10 1 5 9 1 7 8 1 4 10 1 6 9 1 5 10 1 8 8 1 7 9 1 3 11 1 4 11 0 8 9 1 2 12 0 1 13 1 1 13 14 87 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 0 1 4 1 1 4 1 3 3 1 2 4 2 3 3 0 3 4 1 3 4 0 1 5 1 1 5 2 3 4 0 2 5 1 2 5 2 2 5 0 3 5 1 3 5 2 3 5 0 4 5 1 2 6 1 4 5 3 3 5 2 4 5 1 3 6 2 3 6 1 5 5 1 1 7 1 4 6 2 5 5 1 2 7 2 2 7 0 3 7 3 5 5 1 3 7 1 5 6 2 3 7 2 5 6 0 1 8 3 3 7 2 4 7 1 2 8 3 5 6 3 4 7 4 5 6 2 3 8 2 5 7 3 5 7 5 5 6 3 4 8 4 5 7 2 5 8 3 6 7 5 6 6 5 5 7 4 6 7 4 5 8 1 2 10 3 4 9 0 5 9 1 5 9 0 3 10 5 6 7 1 3 10 2 3 10 2 7 8 1 4 10 1 5 10 1 7 9 1 6 10 1 4 11 0 8 9 1 8 9 1 5 11 1 7 10 1 3 12 1 9 9 0 1 13 1 2 13 1 1 14 15 100 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 1 4 1 3 3 1 2 4 2 3 3 0 3 4 1 3 4 0 1 5 1 1 5 2 3 4 1 2 5 1 4 4 2 2 5 3 3 4 1 3 5 2 3 5 1 1 6 3 4 4 0 4 5 1 2 6 1 4 5 3 3 5 2 4 5 1 3 6 2 3 6 1 5 5 1 4 6 0 2 7 2 5 5 2 2 7 0 3 7 1 3 7 1 5 6 2 3 7 2 5 6 0 4 7 0 1 8 1 4 7 1 1 8 2 4 7 1 2 8 3 5 6 1 6 6 0 3 8 1 5 7 4 5 6 2 3 8 2 5 7 4 4 7 3 5 7 3 4 8 4 5 7 2 5 8 3 6 7 2 3 9 5 6 6 3 5 8 4 6 7 2 4 9 4 5 8 3 4 9 5 6 7 0 7 8 4 4 9 4 7 7 2 7 8 6 6 7 3 7 8 4 5 9 5 6 8 3 4 10 1 5 10 1 2 11 1 8 8 1 3 11 2 3 11 1 4 11 1 5 11 1 7 10 1 6 11 1 4 12 1 8 10 1 5 12 1 7 11 1 3 13 1 9 10 0 1 14 1 2 14 1 1 15 16 115 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 1 4 1 3 3 1 2 4 2 3 3 0 3 4 1 3 4 0 1 5 1 1 5 2 3 4 1 2 5 1 4 4 2 2 5 3 3 4 0 3 5 1 3 5 0 1 6 2 3 5 1 1 6 3 4 4 1 2 6 1 4 5 3 3 5 1 3 6 2 3 6 3 4 5 1 5 5 1 4 6 0 2 7 2 5 5 1 2 7 3 5 5 1 3 7 3 4 6 0 5 6 2 3 7 2 5 6 0 4 7 1 4 7 1 1 8 2 4 7 1 2 8 3 5 6 0 3 8 1 3 8 1 5 7 4 5 6 2 3 8 2 5 7 0 1 9 3 5 7 1 6 7 2 6 7 3 4 8 4 5 7 2 5 8 3 6 7 2 3 9 0 4 9 2 4 9 4 5 8 1 2 10 3 4 9 0 5 9 3 6 8 2 5 9 4 4 9 3 5 9 3 3 10 6 6 7 2 6 9 3 7 8 4 5 9 5 6 8 3 4 10 4 7 8 2 2 11 5 5 9 6 7 7 2 3 11 1 6 10 5 7 8 1 4 11 1 5 11 6 7 8 2 8 9 1 3 12 1 6 11 1 4 12 1 8 10 1 5 12 1 7 11 1 1 13 0 9 10 1 6 12 1 9 10 1 8 11 1 4 13 0 5 13 1 10 10 1 2 14 1 3 14 0 1 15 1 1 16 17 125 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 1 2 3 2 2 3 0 1 4 1 1 4 1 3 3 1 2 4 2 3 3 1 3 4 1 1 5 2 3 4 0 2 5 1 2 5 1 4 4 3 3 4 0 3 5 1 3 5 0 1 6 2 3 5 1 1 6 3 4 4 0 4 5 1 2 6 3 3 5 2 4 5 1 3 6 2 3 6 3 4 5 1 4 6 0 2 7 1 2 7 2 2 7 0 3 7 3 5 5 1 3 7 1 5 6 2 3 7 2 5 6 1 4 7 1 1 8 3 3 7 2 4 7 3 5 6 1 6 6 0 5 7 1 3 8 1 5 7 4 5 6 2 5 7 1 4 8 3 3 8 3 5 7 1 6 7 1 2 9 2 6 7 0 5 8 4 5 7 1 5 8 2 5 8 3 6 7 2 3 9 3 5 8 4 6 7 2 4 9 0 1 10 2 7 7 4 5 8 1 2 10 3 4 9 3 7 7 3 6 8 2 5 9 2 3 10 3 5 9 2 6 9 3 7 8 4 5 9 5 6 8 3 4 10 4 7 8 2 2 11 0 7 9 5 5 9 4 6 9 6 7 7 2 7 9 5 7 8 4 5 10 5 6 9 0 8 9 3 4 11 6 7 8 2 8 9 3 8 9 1 3 12 0 6 11 2 3 12 1 6 11 1 4 12 7 7 8 1 5 12 1 1 13 0 3 13 1 6 12 1 8 11 1 7 12 1 5 13 1 10 10 1 9 11 1 6 13 1 8 12 1 4 14 0 5 14 1 10 11 1 2 15 1 3 15 0 1 16 1 1 17 18 139 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 1 4 1 3 3 1 2 4 1 3 4 1 1 5 2 3 4 0 2 5 1 2 5 1 4 4 2 2 5 3 3 4 0 3 5 1 3 5 0 1 6 1 1 6 3 4 4 0 4 5 1 2 6 1 4 5 3 3 5 2 4 5 1 3 6 2 3 6 3 4 5 0 1 7 1 1 7 1 4 6 2 5 5 1 2 7 4 4 5 2 2 7 0 3 7 3 5 5 1 3 7 3 4 6 2 3 7 1 4 7 1 1 8 2 4 7 1 2 8 1 6 6 0 3 8 3 4 7 0 5 7 1 3 8 2 3 8 2 5 7 4 4 7 1 4 8 3 3 8 3 5 7 0 6 7 0 2 9 1 6 7 2 6 7 4 5 7 1 5 8 1 3 9 2 5 8 2 3 9 0 4 9 3 5 8 4 6 7 1 6 8 2 4 9 0 1 10 2 7 7 1 2 10 0 5 9 3 6 8 0 3 10 5 6 7 2 5 9 4 4 9 2 3 10 3 5 9 2 7 8 3 7 8 4 5 9 5 7 7 5 6 8 3 4 10 4 7 8 4 6 9 6 7 7 2 3 11 5 7 8 3 7 9 3 3 11 4 5 10 5 6 9 4 7 9 3 4 11 6 7 8 2 7 10 3 8 9 4 8 9 5 6 10 7 7 8 4 5 11 6 7 9 1 5 12 1 2 13 1 3 13 1 6 12 2 3 13 2 9 10 1 8 11 1 4 13 1 7 12 1 5 13 1 1 14 1 9 11 1 6 13 1 8 12 1 7 13 1 10 11 1 5 14 1 9 12 1 8 13 1 3 15 1 4 15 1 11 11 1 2 16 0 11 12 0 1 17 1 1 18 19 154 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 1 4 1 3 3 1 2 4 2 3 3 1 3 4 1 1 5 2 3 4 0 2 5 1 2 5 1 4 4 2 2 5 3 3 4 0 3 5 1 3 5 0 1 6 2 3 5 1 1 6 3 4 4 0 4 5 1 2 6 1 4 5 3 3 5 2 4 5 1 3 6 3 4 5 0 1 7 1 1 7 1 4 6 0 2 7 1 2 7 4 4 5 2 2 7 1 3 7 3 4 6 1 5 6 2 3 7 0 4 7 1 4 7 2 4 7 1 2 8 3 5 6 1 6 6 0 3 8 3 4 7 0 5 7 1 3 8 1 5 7 2 3 8 2 5 7 1 4 8 3 3 8 3 5 7 0 6 7 0 2 9 2 6 7 3 4 8 2 2 9 4 5 7 1 5 8 1 3 9 2 5 8 2 3 9 3 5 8 4 6 7 1 6 8 2 4 9 1 1 10 3 4 9 3 7 7 3 6 8 0 3 10 5 6 7 2 5 9 2 3 10 4 7 7 1 7 8 3 5 9 2 7 8 2 6 9 3 7 8 0 1 11 3 4 10 1 2 11 4 7 8 5 5 9 4 6 9 3 5 10 2 3 11 3 8 8 5 7 8 3 7 9 3 3 11 4 5 10 5 6 9 3 6 10 4 7 9 3 4 11 0 5 11 2 5 11 2 7 10 0 6 11 4 8 9 5 6 10 7 7 8 4 5 11 6 7 9 3 4 12 5 8 9 0 7 11 5 5 11 7 8 8 6 8 9 5 6 11 6 7 10 2 9 10 3 9 10 7 8 9 1 7 12 1 5 13 1 2 14 1 6 13 1 3 14 1 8 12 2 3 14 1 4 14 1 7 13 1 5 14 1 6 14 1 8 13 1 10 12 1 7 14 1 9 13 1 5 15 0 11 12 1 11 12 1 3 16 1 10 13 1 4 16 1 12 12 0 1 17 1 2 17 1 1 19 20 169 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 1 4 1 3 3 1 2 4 2 3 3 1 3 4 0 1 5 1 1 5 2 3 4 1 2 5 1 4 4 0 3 5 1 3 5 0 1 6 3 4 4 0 4 5 1 2 6 1 4 5 3 3 5 2 4 5 2 3 6 3 4 5 0 1 7 1 5 5 1 4 6 0 2 7 2 5 5 1 2 7 4 4 5 0 3 7 1 3 7 3 4 6 0 5 6 1 5 6 2 3 7 0 4 7 4 5 5 1 4 7 1 1 8 3 3 7 2 4 7 1 2 8 3 5 6 0 3 8 3 4 7 1 3 8 1 5 7 2 3 8 4 4 7 1 4 8 3 3 8 0 2 9 2 6 7 2 2 9 4 5 7 1 5 8 1 3 9 2 5 8 0 4 9 3 5 8 1 4 9 5 5 7 1 7 7 4 6 7 1 6 8 2 4 9 1 1 10 4 5 8 1 2 10 3 7 7 3 6 8 5 6 7 2 5 9 4 7 7 1 7 8 3 5 9 3 3 10 2 6 9 3 7 8 0 1 11 3 4 10 1 2 11 4 7 8 2 5 10 1 7 9 4 6 9 2 7 9 3 5 10 2 3 11 0 4 11 5 7 8 3 7 9 4 5 10 2 4 11 5 6 9 3 6 10 4 7 9 3 4 11 2 8 9 2 5 11 5 8 8 2 7 10 3 8 9 2 3 12 3 7 10 4 8 9 5 6 10 2 6 11 4 5 11 4 7 10 6 7 9 3 4 12 5 8 9 5 5 11 3 8 10 4 6 11 7 8 8 2 2 13 7 7 9 6 8 9 0 9 10 5 6 11 6 7 10 0 8 11 4 5 12 3 9 10 6 6 11 7 8 9 3 4 13 1 3 14 8 8 9 2 3 14 1 4 14 1 7 13 1 5 14 2 10 11 1 9 12 1 2 15 1 6 14 1 8 13 1 3 15 1 11 11 1 7 14 1 9 13 1 8 14 1 6 15 1 10 13 1 4 16 1 7 15 1 9 14 1 5 16 0 8 15 1 11 13 1 3 17 1 12 13 0 1 18 1 2 18 1 1 20 21 190 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 1 4 1 3 3 1 2 4 2 3 3 0 3 4 1 3 4 0 1 5 1 1 5 2 3 4 0 2 5 1 2 5 1 4 4 2 2 5 3 3 4 0 3 5 1 3 5 0 1 6 1 1 6 3 4 4 0 4 5 1 2 6 1 4 5 3 3 5 2 4 5 1 3 6 2 3 6 3 4 5 0 1 7 1 5 5 1 1 7 1 4 6 2 5 5 1 2 7 4 4 5 2 2 7 0 3 7 3 4 6 1 5 6 2 3 7 2 5 6 0 1 8 4 5 5 1 4 7 1 1 8 2 4 7 1 2 8 3 5 6 3 4 7 0 5 7 1 3 8 2 3 8 1 4 8 3 3 8 3 5 7 1 2 9 2 6 7 0 5 8 2 2 9 4 5 7 1 5 8 1 3 9 2 5 8 2 3 9 0 4 9 3 5 8 1 4 9 1 7 7 1 6 8 2 4 9 2 7 7 3 4 9 0 5 9 3 7 7 1 5 9 3 6 8 2 5 9 1 3 10 0 7 8 4 4 9 2 3 10 1 7 8 3 5 9 2 7 8 1 6 9 3 3 10 2 6 9 1 1 11 5 6 8 1 2 11 4 7 8 1 8 8 2 5 10 0 3 11 1 7 9 4 6 9 2 7 9 3 5 10 5 7 8 3 7 9 2 4 11 3 6 10 0 1 12 4 7 9 3 4 11 0 5 11 6 7 8 2 8 9 1 2 12 2 5 11 5 8 8 3 8 9 5 7 9 3 5 11 2 3 12 3 7 10 4 8 9 5 6 10 2 6 11 4 5 11 4 7 10 3 4 12 5 8 9 3 8 10 4 6 11 2 5 12 3 5 12 3 7 11 6 8 9 5 6 11 2 3 13 6 7 10 4 5 12 0 4 13 5 9 9 2 8 11 3 9 10 6 6 11 5 7 11 4 9 10 7 7 10 5 6 12 0 3 14 6 7 11 8 8 9 4 5 13 7 8 10 3 4 14 0 5 14 2 10 11 8 9 9 1 2 15 1 6 14 1 3 15 2 3 15 1 4 15 8 9 10 1 7 14 1 9 13 1 5 15 1 8 14 1 6 15 1 7 15 1 9 14 1 8 15 1 11 13 1 6 16 1 10 14 1 4 17 1 9 15 0 12 13 1 12 13 1 5 17 1 11 14 1 3 18 1 13 13 0 1 19 1 2 19 1 1 21 22 201 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 1 4 1 3 3 1 2 4 2 3 3 0 3 4 1 3 4 0 1 5 1 1 5 2 3 4 0 2 5 1 2 5 1 4 4 2 2 5 3 3 4 1 3 5 0 1 6 2 3 5 1 1 6 3 4 4 0 4 5 1 2 6 1 4 5 3 3 5 2 4 5 1 3 6 2 3 6 3 4 5 1 5 5 1 4 6 1 2 7 4 4 5 3 5 5 1 3 7 3 4 6 0 5 6 1 5 6 2 3 7 2 5 6 0 4 7 0 1 8 4 5 5 1 4 7 1 1 8 2 4 7 1 2 8 3 5 6 0 3 8 3 4 7 1 3 8 1 5 7 4 5 6 2 3 8 2 5 7 1 4 8 3 3 8 3 5 7 0 6 7 1 6 7 1 2 9 2 6 7 3 4 8 0 5 8 2 2 9 4 5 7 1 5 8 1 3 9 2 5 8 3 6 7 2 3 9 3 5 8 1 4 9 5 5 7 1 7 7 4 6 7 1 6 8 2 4 9 3 4 9 0 5 9 1 5 9 3 6 8 0 3 10 2 5 9 1 3 10 4 7 7 5 5 8 3 5 9 2 7 8 1 4 10 1 6 9 2 6 9 1 1 11 0 2 11 2 5 10 5 5 9 1 7 9 4 6 9 2 7 9 3 5 10 2 3 11 3 8 8 5 7 8 3 7 9 3 3 11 2 4 11 3 6 10 0 1 12 4 7 9 1 8 9 3 4 11 6 7 8 2 8 9 0 7 10 1 2 12 2 5 11 3 8 9 5 7 9 3 5 11 2 3 12 3 7 10 4 8 9 2 6 11 4 7 10 3 4 12 0 5 12 5 8 9 5 5 11 3 8 10 4 6 11 2 5 12 2 7 11 4 9 9 3 5 12 3 7 11 5 6 11 2 3 13 6 7 10 4 5 12 2 8 11 5 7 11 4 9 10 4 4 13 5 6 12 0 6 13 5 9 10 6 7 11 8 8 9 4 5 13 7 8 10 6 9 10 0 7 13 3 4 14 8 9 9 6 7 12 7 9 10 3 10 11 5 6 13 7 8 11 0 4 15 1 4 15 8 9 10 1 8 14 1 2 16 1 6 15 0 11 12 1 3 16 2 11 12 2 3 16 1 4 16 1 7 15 1 9 14 1 5 16 1 8 15 1 6 16 1 7 16 1 9 15 1 5 17 1 11 14 1 8 16 1 10 15 1 6 17 1 13 13 1 12 14 1 4 18 1 11 15 1 13 14 1 3 19 0 1 20 1 2 20 1 1 22 23 223 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 1 4 1 3 3 1 2 4 2 3 3 0 3 4 1 3 4 1 1 5 2 3 4 1 2 5 1 4 4 2 2 5 3 3 4 0 3 5 1 3 5 0 1 6 2 3 5 1 1 6 1 2 6 1 4 5 2 4 5 1 3 6 2 3 6 3 4 5 1 5 5 1 4 6 0 2 7 2 5 5 1 2 7 2 2 7 0 3 7 3 5 5 1 3 7 3 4 6 0 5 6 1 5 6 2 3 7 2 5 6 0 4 7 0 1 8 4 5 5 1 4 7 1 1 8 3 3 7 2 4 7 1 2 8 3 5 6 0 3 8 3 4 7 1 3 8 1 5 7 4 5 6 2 3 8 2 5 7 4 4 7 1 4 8 3 3 8 3 5 7 0 2 9 5 5 6 1 2 9 3 4 8 0 5 8 2 2 9 4 5 7 1 5 8 1 3 9 2 5 8 3 6 7 2 3 9 1 4 9 5 5 7 4 6 7 2 4 9 2 7 7 1 2 10 3 4 9 1 5 9 3 6 8 0 3 10 2 5 9 1 3 10 0 7 8 2 3 10 4 7 7 5 5 8 1 7 8 3 5 9 2 7 8 1 4 10 1 6 9 3 3 10 2 6 9 3 7 8 5 7 7 1 1 11 0 2 11 1 5 10 1 8 8 2 5 10 2 2 11 1 7 9 1 3 11 4 6 9 2 7 9 3 5 10 2 3 11 1 4 11 3 7 9 2 4 11 3 6 10 4 7 9 1 8 9 0 5 11 6 7 8 2 8 9 0 7 10 1 2 12 2 5 11 2 7 10 5 7 9 3 5 11 2 3 12 3 7 10 4 8 9 2 6 11 4 5 11 4 7 10 6 7 9 2 9 9 3 6 11 3 4 12 5 8 9 0 1 13 3 8 10 4 6 11 2 5 12 5 7 10 2 7 11 4 9 9 3 5 12 3 7 11 6 8 9 2 3 13 6 7 10 4 5 12 4 7 11 3 3 13 3 9 10 6 6 11 3 4 13 0 5 13 5 7 11 4 9 10 1 2 14 5 6 12 5 9 10 6 7 11 2 6 13 4 5 13 3 9 11 6 9 10 3 4 14 8 9 9 6 7 12 2 9 12 7 9 10 3 10 11 5 6 13 2 2 15 7 8 11 4 10 11 4 5 14 6 6 13 8 9 10 6 7 13 9 9 10 8 9 11 2 11 12 0 10 13 2 3 16 1 4 16 1 5 16 1 8 15 1 6 16 1 10 14 1 3 17 1 7 16 1 4 17 1 9 15 1 8 16 1 10 15 1 6 17 1 9 16 1 7 17 1 12 14 1 11 15 1 5 18 1 8 17 1 10 16 1 6 18 1 1 19 1 13 14 1 12 15 0 9 17 1 4 19 1 14 14 1 2 20 1 3 20 0 14 15 0 1 21 1 1 23 24 234 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 1 4 1 3 3 1 2 4 2 3 3 0 3 4 1 3 4 1 1 5 2 3 4 0 2 5 1 2 5 1 4 4 2 2 5 3 3 4 0 3 5 1 3 5 0 1 6 2 3 5 1 1 6 0 4 5 1 2 6 1 4 5 3 3 5 2 4 5 1 3 6 2 3 6 3 4 5 1 5 5 1 1 7 1 4 6 0 2 7 2 5 5 1 2 7 4 4 5 2 2 7 0 3 7 3 5 5 1 3 7 3 4 6 0 5 6 1 5 6 2 3 7 2 5 6 0 1 8 4 5 5 1 4 7 1 1 8 3 3 7 1 2 8 3 5 6 3 4 7 0 5 7 1 3 8 1 5 7 4 5 6 2 3 8 2 5 7 4 4 7 1 4 8 0 1 9 3 5 7 1 1 9 0 2 9 5 5 6 1 6 7 1 2 9 4 5 7 1 5 8 1 3 9 2 5 8 3 6 7 2 3 9 0 4 9 3 5 8 1 4 9 5 5 7 4 6 7 1 6 8 2 4 9 2 7 7 1 2 10 3 4 9 3 7 7 1 5 9 3 6 8 0 3 10 2 5 9 1 3 10 2 3 10 5 5 8 3 5 9 2 7 8 1 4 10 1 6 9 3 3 10 3 7 8 5 7 7 1 1 11 0 2 11 1 5 10 1 8 8 2 5 10 1 3 11 4 6 9 2 7 9 3 5 10 1 6 10 0 4 11 1 4 11 3 7 9 3 3 11 4 5 10 2 4 11 0 8 9 3 6 10 4 7 9 1 8 9 2 8 9 1 2 12 1 7 10 2 5 11 2 7 10 4 4 11 5 7 9 3 5 11 0 6 11 2 3 12 3 7 10 2 6 11 4 7 10 1 8 10 6 7 9 3 6 11 3 4 12 5 8 9 0 7 11 3 8 10 4 6 11 2 5 12 5 7 10 2 7 11 3 5 12 0 3 13 3 7 11 2 3 13 2 9 10 4 5 12 5 9 9 3 9 10 0 7 12 7 8 9 3 4 13 5 7 11 4 9 10 0 1 14 4 8 11 1 2 14 3 7 12 3 5 13 5 6 12 0 6 13 5 9 10 6 7 11 4 7 12 2 6 13 2 3 14 4 5 13 3 9 11 3 3 14 6 9 10 3 8 12 2 7 13 6 7 12 2 9 12 5 6 13 7 8 11 4 10 11 4 5 14 6 6 13 5 10 11 3 4 15 6 7 13 7 8 12 5 6 14 9 9 10 8 9 11 7 7 13 7 10 11 3 11 12 9 10 10 8 10 11 1 3 17 9 10 11 2 3 17 1 7 16 1 4 17 1 9 15 1 5 17 2 12 13 1 8 16 1 10 15 1 6 17 1 9 16 1 7 17 1 8 17 1 10 16 1 1 19 1 13 14 1 12 15 1 9 17 1 7 18 1 11 16 1 5 19 1 13 15 1 6 19 1 12 16 1 4 20 0 14 15 0 1 21 1 2 21 1 15 15 1 3 21 1 1 24 25 253 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 1 4 1 3 3 1 2 4 2 3 3 0 3 4 1 3 4 0 1 5 1 1 5 2 3 4 0 2 5 1 2 5 2 2 5 3 3 4 0 3 5 1 3 5 0 1 6 2 3 5 1 1 6 1 2 6 1 4 5 3 3 5 2 4 5 1 3 6 2 3 6 3 4 5 0 1 7 1 5 5 1 1 7 1 4 6 0 2 7 2 5 5 1 2 7 4 4 5 0 3 7 3 5 5 1 3 7 3 4 6 0 5 6 1 5 6 2 3 7 2 5 6 4 5 5 1 4 7 1 1 8 3 3 7 1 2 8 3 5 6 0 3 8 3 4 7 0 5 7 1 3 8 1 5 7 4 5 6 2 3 8 2 5 7 4 4 7 1 4 8 0 1 9 3 5 7 1 1 9 0 2 9 5 5 6 2 6 7 3 4 8 0 5 8 4 5 7 1 5 8 1 3 9 2 5 8 3 6 7 2 3 9 5 6 6 1 4 9 5 5 7 4 6 7 1 6 8 2 4 9 2 7 7 1 2 10 3 4 9 0 5 9 1 5 9 3 6 8 0 3 10 2 5 9 1 3 10 2 3 10 5 5 8 1 7 8 3 5 9 1 4 10 1 6 9 3 3 10 2 6 9 3 7 8 5 7 7 1 1 11 5 6 8 1 5 10 1 8 8 2 5 10 2 2 11 0 7 9 0 3 11 4 6 9 2 7 9 3 5 10 2 3 11 1 6 10 1 4 11 3 7 9 3 3 11 2 4 11 5 6 9 0 8 9 3 6 10 4 7 9 2 8 9 1 7 10 2 5 11 2 7 10 4 4 11 1 3 12 5 7 9 3 5 11 3 7 10 5 6 10 2 6 11 4 7 10 1 8 10 6 7 9 2 9 9 3 6 11 5 5 11 3 8 10 4 6 11 2 5 12 5 7 10 2 7 11 4 9 9 3 5 12 3 7 11 6 8 9 1 9 10 2 3 13 2 9 10 4 5 12 4 7 11 5 9 9 3 3 13 2 8 11 2 4 13 3 9 10 7 8 9 3 4 13 5 7 11 4 9 10 0 1 14 2 5 13 4 8 11 1 2 14 3 7 12 3 5 13 0 3 14 5 9 10 4 7 12 2 6 13 4 5 13 7 8 10 6 9 10 3 8 12 4 6 13 3 4 14 0 5 14 2 7 13 5 9 11 6 7 12 5 6 13 5 8 12 7 8 11 4 10 11 4 5 14 2 3 15 5 7 13 5 10 11 3 10 12 6 7 13 6 10 11 7 8 12 5 6 14 8 9 11 4 5 15 7 7 13 7 10 11 2 10 13 3 11 12 0 7 15 9 10 10 4 11 12 6 7 14 3 4 16 7 8 13 8 10 11 0 8 15 9 10 11 0 12 13 1 5 17 2 12 13 10 10 11 1 2 18 1 3 18 2 3 18 1 9 16 1 7 17 1 4 18 1 11 15 1 5 18 1 8 17 1 10 16 1 6 18 1 1 19 1 9 17 1 7 18 1 11 16 1 8 18 1 10 17 1 14 14 1 13 15 1 6 19 1 12 16 1 9 18 1 11 17 1 7 19 1 13 16 1 5 20 1 3 21 1 4 21 1 15 16 0 1 22 1 2 22 1 1 25 26 275 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 1 4 1 3 3 1 2 4 2 3 3 0 3 4 1 3 4 0 1 5 1 1 5 2 3 4 0 2 5 1 2 5 1 4 4 2 2 5 3 3 4 0 3 5 1 3 5 0 1 6 2 3 5 1 1 6 3 4 4 0 4 5 1 2 6 1 4 5 3 3 5 2 4 5 1 3 6 2 3 6 3 4 5 0 1 7 1 5 5 1 1 7 1 4 6 2 5 5 1 2 7 4 4 5 0 3 7 3 5 5 1 3 7 3 4 6 1 5 6 2 5 6 0 4 7 4 5 5 1 4 7 3 3 7 1 2 8 3 5 6 1 6 6 0 3 8 3 4 7 1 3 8 1 5 7 4 5 6 2 3 8 2 5 7 4 4 7 1 4 8 3 3 8 0 1 9 3 5 7 0 2 9 5 5 6 1 6 7 1 2 9 2 6 7 3 4 8 0 5 8 1 5 8 1 3 9 2 5 8 3 6 7 2 3 9 5 6 6 1 4 9 5 5 7 4 6 7 2 4 9 1 1 10 4 5 8 3 4 9 0 5 9 1 5 9 3 6 8 0 3 10 2 5 9 1 3 10 4 4 9 2 3 10 3 5 9 1 4 10 1 6 9 3 3 10 2 6 9 5 7 7 5 6 8 3 4 10 1 5 10 1 2 11 2 5 10 0 3 11 1 7 9 1 3 11 4 6 9 2 7 9 3 5 10 2 3 11 3 8 8 1 6 10 5 7 8 1 4 11 2 4 11 5 6 9 0 8 9 3 6 10 4 7 9 0 5 11 1 1 12 1 5 11 2 8 9 0 7 10 2 5 11 5 8 8 2 7 10 4 4 11 5 7 9 3 5 11 3 7 10 2 6 11 1 4 12 1 9 9 4 7 10 2 9 9 3 6 11 3 8 10 4 6 11 2 5 12 5 7 10 2 7 11 1 2 13 4 9 9 3 5 12 3 7 11 1 3 13 6 8 9 1 9 10 2 3 13 6 7 10 2 9 10 4 7 11 1 8 11 3 3 13 5 8 10 2 8 11 2 4 13 3 9 10 6 6 11 7 8 9 4 9 10 2 7 12 0 1 14 2 5 13 4 8 11 1 2 14 3 7 12 1 9 11 3 5 13 5 9 10 3 10 10 4 7 12 2 6 13 2 3 14 4 5 13 7 8 10 6 9 10 3 8 12 4 9 11 7 7 11 6 8 11 4 6 13 3 4 14 2 7 13 2 10 11 2 5 14 5 9 11 3 10 11 5 6 13 5 8 12 7 8 11 4 10 11 4 5 14 2 3 15 4 9 12 6 6 13 5 7 13 5 10 11 3 10 12 6 7 13 6 10 11 7 8 12 5 6 14 4 4 15 3 9 13 4 5 15 6 8 13 7 10 11 2 10 13 3 11 12 3 3 16 6 11 11 9 10 10 4 11 12 6 7 14 3 4 16 7 8 13 8 10 11 5 6 15 8 9 12 0 11 13 4 5 16 2 2 17 9 10 11 7 8 14 10 10 11 9 10 12 2 3 18 0 11 15 1 5 18 1 8 17 1 2 19 2 13 14 1 9 17 1 3 19 1 7 18 1 11 16 1 4 19 1 5 19 1 8 18 1 10 17 1 6 19 1 1 20 1 9 18 1 11 17 1 7 19 1 10 18 1 13 16 1 8 19 1 12 17 1 6 20 0 9 19 1 11 18 1 7 20 1 14 16 1 4 21 1 13 17 0 10 19 1 5 21 0 15 16 1 15 16 1 3 22 1 16 16 0 1 23 1 2 23 1 1 26 27 292 0 0 1 0 1 1 1 1 1 0 1 2 1 1 2 1 2 2 0 1 3 1 1 3 0 2 3 1 2 3 2 2 3 0 1 4 1 1 4 1 3 3 1 2 4 2 3 3 0 3 4 1 3 4 0 1 5 2 3 4 0 2 5 1 2 5 1 4 4 2 2 5 3 3 4 0 3 5 1 3 5 0 1 6 2 3 5 1 1 6 3 4 4 0 4 5 1 2 6 1 4 5 3 3 5 2 4 5 1 3 6 2 3 6 3 4 5 0 1 7 1 5 5 1 1 7 1 4 6 0 2 7 2 5 5 1 2 7 4 4 5 2 2 7 0 3 7 3 5 5 1 3 7 3 4 6 2 3 7 2 5 6 0 4 7 1 4 7 3 3 7 2 4 7 1 2 8 3 5 6 1 6 6 0 3 8 3 4 7 1 3 8 1 5 7 4 5 6 2 3 8 4 4 7 1 4 8 3 3 8 0 1 9 1 1 9 0 6 7 5 5 6 1 6 7 1 2 9 2 6 7 3 4 8 2 2 9 4 5 7 1 5 8 1 3 9 2 5 8 3 6 7 2 3 9 5 6 6 0 4 9 1 4 9 5 5 7 4 6 7 2 4 9 0 1 10 2 7 7 1 1 10 4 5 8 3 4 9 1 5 9 5 6 7 2 5 9 1 3 10 2 3 10 5 5 8 1 4 10 1 6 9 2 6 9 3 7 8 4 5 9 5 6 8 3 4 10 1 5 10 1 2 11 4 7 8 2 5 10 1 7 9 1 3 11 4 6 9 2 7 9 3 5 10 2 3 11 3 8 8 1 6 10 5 7 8 1 4 11 2 4 11 5 6 9 4 7 9 0 5 11 1 5 11 2 8 9 0 7 10 2 5 11 2 7 10 5 7 9 3 5 11 2 3 12 3 7 10 1 6 11 2 6 11 1 4 12 1 9 9 4 7 10 3 6 11 0 7 11 1 5 12 1 7 11 3 8 10 4 6 11 2 5 12 0 2 13 5 7 10 2 7 11 4 9 9 3 5 12 3 7 11 1 3 13 0 9 10 1 9 10 0 4 13 4 7 11 1 8 11 5 9 9 5 8 10 2 8 11 2 4 13 7 8 9 3 8 11 3 4 13 2 7 12 2 5 13 1 1 14 1 10 10 4 8 11 4 4 13 1 2 14 3 7 12 1 9 11 0 3 14 2 9 11 4 7 12 2 6 13 2 3 14 5 8 11 4 5 13 3 9 11 7 8 10 3 6 13 3 8 12 4 9 11 0 7 13 6 8 11 4 6 13 3 4 14 0 5 14 2 7 13 2 10 11 2 5 14 5 9 11 3 7 13 7 9 10 3 10 11 5 6 13 3 5 14 1 2 15 5 8 12 4 7 13 4 10 11 4 5 14 4 9 12 0 4 15 5 7 13 5 10 11 5 5 14 7 10 10 4 8 13 5 9 12 3 4 15 3 10 12 6 10 11 7 8 12 5 6 14 4 4 15 0 1 16 5 8 13 3 9 13 4 5 15 7 7 13 6 8 13 2 3 16 7 10 11 2 10 13 0 7 15 3 3 16 4 11 12 6 7 14 7 8 13 5 6 15 8 9 12 5 11 12 2 11 13 4 5 16 6 11 12 7 8 14 6 7 15 7 11 12 8 9 13 3 4 17 0 11 14 10 10 11 3 12 13 7 7 15 9 10 12 4 12 13 7 8 15 10 11 11 9 11 12 10 11 12 0 13 14 1 2 19 2 13 14 1 12 15 1 3 19 2 3 19 1 11 16 1 4 19 1 5 19 1 8 18 1 10 17 1 6 19 1 9 18 1 11 17 1 7 19 1 10 18 1 8 19 1 9 19 1 11 18 1 15 15 1 14 16 1 13 17 1 10 19 1 8 20 1 5 21 1 12 18 1 6 21 1 14 17 1 7 21 1 13 18 1 4 22 1 3 23 1 16 17 0 1 24 1 2 24 1 1 27 0 0 net.h 100666 1750 1750 343 6603046420 11054 0 ustar klimes klimes # Grid dimensions: N1=201 N2=201 D1=0.005 D2=0.005 O1=0.000 O2=0.000 # List of input and output filenames: NET='net.dat' # Numerical parameters for the NET program: NFSMAX=0 # Program to run: net: 'net.h' / net.htm 100666 1750 1750 54511 6614233412 11464 0 ustar klimes klimes
neterr.htm 100666 1750 1750 7066 6613241234 12160 0 ustar klimes klimesNetwork ray tracing program package NET (general description)
Version: 3.10 Date: 1998, October 24 Authors: Ludek Klimes Department of Geophysics, Charles University Prague, Ke Karlovu 3, 121 16 Praha 2, Czech Republic, E-mail: klimes@seis.karlov.mff.cuni.cz Michal Kvasnicka Department of Geophysics, Charles University Prague, Ke Karlovu 3, 121 16 Praha 2, Czech Republic, E-mail: qasnicka@seis.karlov.mff.cuni.cz This is just a general overview, the detailed description of input data, procedures, and other important topics is included within the individual FORTRAN77 source code files. References: Klimes L. and Kvasnicka M. (1994): 3-D network ray tracing. Geophys.J.int., 116, 726-738. Klimes L. (1996): Grid travel-time tracing: second-order method for the first arrivals in smooth media. PAGEOPH, 148, 539-563. Purpose: Network ray tracing is designed to calculate first-arrival travel times and the corresponding rays. For your application, please, do not confuse the first-arrival travel times with the ray-theory body-wave travel times. The first-arrival travel times from the given source of any shape are calculated at all grid points of a given rectangular grid of points. Together with the first-arrival travel times, also their maximum errors may be automatically estimated. Model specification: For network ray tracing, the seismic model is specified in terms of grid velocities at a rectangular grid. The density of the grid should correspond to the accuracy required and to the computer memory available. In a layered or blocky medium, also the indices of geological blocks at gridpoints are recommended to be specified in addition to the velocities, in order to improve accuracy considerably. The model specification subroutine package MODEL is recommended to describe the models and to generate the grid values, unless the user prefers his own model specification system. Attention: Array dimensions MIND, MGRID, MICB, MNFS, MPRED, MFS, MSRC, and MREC in 'net.for' should be adjusted according to a particular computer memory and particular application. In the basic version delivered, arrays in 'net.for' are roughly dimensioned for a computer with 16MB of RAM (see 'net.inc'), assuming no indexing of Fresnel volumes, and assuming all other options like forward-star optimization and geological block indexing enabled. If having adjusted the array dimensions in 'net.inc' and going to use 'netind.for', it is strongly recommended to adjust array dimensions MPOS and MTT in 'netind.for' according to MIND and MGRID in 'net.for'. ...................................................................... Application of the network shortest path ray tracing program NET in the models described in terms of model specification subroutines of the package MODEL, version 4.00 or later (MODEL ver. 5.10 or later is strongly recommended): (1) Compile and link the program 'grid.for' of the package MODEL. See the package MODEL for details. Compile and link the program 'net.for' of this package. (2) Prepare the input data for the package MODEL, describing the seismic model of the medium. Example: In the demo data (E) of this package, the demo model data file 'model.dat' of the package MODEL is assumed. (3) Program 'grid.for' of the package MODEL generates the velocities and indices of geological blocks in the given rectangular grid of points. Example: In the demo data (E), the main input data file for 'grid.for' is called 'len-grid.dat' (thus, this name, embedded in apostrophes, has to be submitted manually to the program when it starts and asks for the filename). The input model file is 'model.dat' and the grid is described within the input data 'len-net.dat'. The output files with velocities and indices of geological blocks are generated under filenames 'vel.out' and 'icb.out', respectively. (4) The program 'net.for' of this package performs the network shortest path calculation of the first-arrival travel times in the generated discretized (raster) representation of the model. Example: In the demo data (E), the main input data file for 'net.for' is called 'len-net.dat'. This filename, in apostrophes, has to be submitted manually to the program when it starts and asks for the filename. Other input files are 'lenn-src.dat', 'lenn-rec.dat', 'vel.out', and 'icb.out'. The generated output files 'tt.out' and 'err.out' contain first-arrival travel times and their estimated maximum errors. ...................................................................... Acknowledgements: The development of the NET package and the related algorithms has been partially supported by: Faculty of Mathematics and Physics, Charles University, Prague. Institute of Geotechnics, Czechoslovak Academy of Sciences, Prague. Grant agency of the Academy of Sciences of the Czech Republic under Contracts 31223 and 346110. Grant Agency of the Charles University under Contracts 8/94 and 38/94. Grant Agency of the Czech Republic under Contract 205/95/1465. European Commission within the framework of the JOULE II Project 'Integrated Structural Imaging of Seismic Data'. Members of consortium 'Seismic Waves in Complex 3-D Structures'. ======================================================================
ran/ 40777 1750 1750 0 6613213034 10616 5 ustar klimes klimes ran/ran-net.h 100666 1750 1750 12607 6617733626 12500 0 ustar klimes klimes # History file 'ran-net.h' to generate a 2-D representation of the # Laguerr random medium and to calculate first arrival travel times # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # The propagation velocities are similar to the 2-D representation of # the Laguerr random medium displayed in Figure 8 of paper # Klimes, L. (1997): Correlation functions of random media. # In: Seismic Waves in Complex 3-D Structures, Report 6. # Department of Geophysics, Charles University, Prague, # pp.25-40, # but the Gaussian corrrelation length is twice enlarged to aG=0.010. # Input files required: #chk.pl: "net/" "net.fs2" # 2-D forward stars of 'net.for' #chk.pl: "net/ran/" "ran-net.dat" # data for program 'net.for' #chk.pl: "net/ran/" "ran-src.dat" # source coordinates #chk.pl: "forms/" "atan2.cal" # Grid dimensions: N1=501 N2=501 D1=0.002 D2=0.002 O1=0.000 O2=0.000 # Laguerr correlation function (data for GRDRAN2D): CTYPE='D' POWERN=-0.2 ACORG=0.010 ACOR= # Particular pseudo-random representation: ISEED=-13 # Velocities between 0.0 and 2.0, with mean value of 1.0 (for GRDRAN2D): DSD=0.500 VMEAN=1.000 DEVMAX=1.000 DEVEXP=2. # Dimensions of the figures (unimportant data for GRDPS): HSIZE=16.032 HOFFSET=2.484 # Colours to plot velocities (data for GRDPS): VCIRC=2.000 VREF=1.000 CREF=.166667 # Colour scale # List of input and output filenames for the NET program: NET='ran-net.dat' # Numerical parameters for the NET program (setting TTT mode): NFSMAX=-1 # Generating a representation of the random medium: grdran2d: 'ran-net.h' 'ran-vel.out' / # Plotting the representation of the random medium: grdps: 'ran-net.h' 'ran-vel.out' 'ran-vel.ps' / # Calculating first-arrival travel times: net: 'ran-net.h' / # Plotting first-arrival travel times ("wavefronts"): VCIRC=0.050 VREF=0.000 CREF=.166667 # Colour scale grdps: 'ran-net.h' 'ran-tt.out' 'ran-tt.ps' / # Plotting directions of propagation: VCIRC=6.283185 VREF=0.000 CREF=.166667 # Colour scale grdcal: 'ran-net.h' 'atan2' 'ran-p1.out' 'ran-p2.out' 'ran-dir.tmp' / grdps: 'ran-net.h' 'ran-dir.tmp' 'ran-dir.ps' / # Checking the accuracy of travel times (disabled by default): # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Input files required: #chk.pl: "net/ran/" "ran-net2.dat" # Input data file for 'net.for' # for the check of accuracy #chk.pl: "forms/" "absdif.cal" #chk.pl: "forms/" "reldif.cal" # Changing input and output filenames for the NET program: NET='ran-net2.dat' # Grid dimensions for the test of accuracy: # N1=1001 N2=1001 D1=0.001 D2=0.001 O1=0.000 O2=0.000 # Above grid requires MRAM=4008004, at the least, in 'ram.inc'. # It is thus reduced to # N1=999 N2=999 D1=0.001002 D2=0.001002 O1=0.000002 O2=0.000002 # to fit into the default of MRAM=4000000. # Calculating first-arrival travel times on the denser grid: N1NEW=999 N2NEW=999 D1NEW=0.001002 D2NEW=0.001002 O1NEW=0.000002 O2NEW=0.000002 #grdnew: 'ran-net.h' 'ran-vel.out' 'ran-vel.tmp' / N1=999 N2=999 D1=0.001002 D2=0.001002 O1=0.000002 O2=0.000002 #net: 'ran-net.h' / N1NEW=501 N2NEW=501 D1NEW=0.002 D2NEW=0.002 O1NEW=0.000 O2NEW=0.000 #grdnew: 'ran-net.h' 'ran-tt.tmp' 'ran-tt2.out' / # Restoring original grid dimensions: N1=501 N2=501 D1=0.002 D2=0.002 O1=0.000 O2=0.000 N1NEW= N2NEW= D1NEW= D2NEW= O1NEW= O2NEW= # Colours to plot absolute travel-time errors: VCIRC=0.006 VREF=0.000 CREF=.166667 #grdcal: 'ran-net.h' 'absdif' 'ran-tt.out' 'ran-tt2.out' 'ran-err.out' / #grdps: 'ran-net.h' 'ran-err.out' 'ran-err.ps' / # Colours to plot relative travel-time errors: VCIRC=0.012 VREF=0.000 CREF=.166667 #grdcal: 'ran-net.h' 'reldif' 'ran-tt.out' 'ran-tt2.out' 'ran-rel.out' / #grdps: 'ran-net.h' 'ran-rel.out' 'ran-rel.ps' / # ====================================================================== # Temporary files (may be deleted): # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # '*.tmp' # List of output files: # ~~~~~~~~~~~~~~~~~~~~~ # Output data files: # 'ran-vel.out' Propagation velocities on grid 501*501 # 'ran-tt.out' First arrival travel times on grid 501*501 # 'ran-p1.out', 'ran-p2.out' Slowness-vector components # PostScript figures are in files: # 'ran-vel.ps' Propagation velocities on grid 501*501 # 'ran-tt.ps' First arrival travel times on grid 501*501 # 'ran-dir.ps' Directions of propagation on grid 501*501 # List of output files of the accuracy test: # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Output data files: # 'ran-tt2.out' First arrival travel times on the original grid, # calculated on the denser grid. # 'ran-err.out' Absolute value of travel-time differences between # 'ran-tt.out' and 'ran-tt2.out' # 'ran-rel.out' Relative travel-time differences between # 'ran-tt.out' and 'ran-tt2.out' # PostScript figures are in files: # 'ran-err.ps' Absolute diferences of first arrival travel times # 'ran-rel.ps' Relative diferences of first arrival travel times # # Colour: Absolute Relative # errors: errors: # yellow 0.000 0.000 # green 0.001 0.002 # cyan 0.002 0.004 # blue 0.003 0.006 # magenta 0.004 0.008 # red 0.005 0.010 ran/ran-net.dat 100666 1750 1750 121 6602575632 12740 0 ustar klimes klimes 'ran-src.dat' / / ' ' 'ran-vel.out' ' ' 'ran-tt.out' 'ran-p1.out' 'ran-p2.out' / ran/ran-src.dat 100666 1750 1750 33 6424522060 12710 0 ustar klimes klimes / 'hypocentre' 0.5 0.5 / / ran/ran-net2.dat 100666 1750 1750 121 6602575636 13026 0 ustar klimes klimes 'ran-src.dat' / / ' ' 'ran-vel.tmp' ' ' 'ran-tt.tmp' 'ran-p1.tmp' 'ran-p2.tmp' / rec.dat 100666 1750 1750 1417 5525562026 11412 0 ustar klimes klimes / ' ' 0. 1. 0. / ' ' 0.05 1. 0. / ' ' 0.10 1. 0. / ' ' 0.15 1. 0. / ' ' 0.20 1. 0. / ' ' 0.25 1. 0. / ' ' 0.30 1. 0. / ' ' 0.35 1. 0. / ' ' 0.40 1. 0. / ' ' 0.45 1. 0. / ' ' 0.50 1. 0. / ' ' 0.55 1. 0. / ' ' 0.60 1. 0. / ' ' 0.65 1. 0. / ' ' 0.70 1. 0. / ' ' 0.75 1. 0. / ' ' 0.80 1. 0. / ' ' 0.85 1. 0. / ' ' 0.90 1. 0. / ' ' 0.95 1. 0. / ' ' 1. 1. 0. / ' ' 1. 0.95 0. / ' ' 1. 0.90 0. / ' ' 1. 0.85 0. / ' ' 1. 0.80 0. / ' ' 1. 0.75 0. / ' ' 1. 0.70 0. / ' ' 1. 0.65 0. / ' ' 1. 0.60 0. / ' ' 1. 0.55 0. / ' ' 1. 0.50 0. / ' ' 1. 0.45 0. / ' ' 1. 0.40 0. / ' ' 1. 0.35 0. / ' ' 1. 0.30 0. / ' ' 1. 0.25 0. / ' ' 1. 0.20 0. / ' ' 1. 0.15 0. / ' ' 1. 0.10 0. / ' ' 1. 0.05 0. / ' ' 1. 0. 0. / / src.dat 100666 1750 1750 23 5525571120 11353 0 ustar klimes klimes / ' ' 0. 1. 0. / / ttt.for 100666 1750 1750 44676 6367247312 11533 0 ustar klimes klimes C Grid travel time tracing: second-order method for the first arrivals C in smooth models. Testing 2-D version based on the NET program. C C Version: 3.00 C Date: 1996, June 18 C C Author: C Ludek Klimes C Department of Geophysics, Charles University Prague C Ke Karlovu 3 C 121 16 Praha 2, Czech Republic C E-mail: klimes@seis.karlov.mff.cuni.cz C C To be linked with 'net.for' version 3.00 or later. C C Reference: C Klimes, L. (1996): Grid travel-time tracing: second-order method C for the first arrivals in smooth media. C PAGEOPH, 148, 539-563. C C======================================================================= C SUBROUTINE TTTSRC() C C Auxiliary subroutine to SOURCE. C C Date: 1996, June 18 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ /NODE/ /SRCC/ are required here: INCLUDE 'net.inc' INCLUDE 'netnode.inc' C C----------------------------------------------------------------------- C INTEGER I1,I2,I REAL U2,UG1,UG2,AUX0,AUX1,AUX2 C C....................................................................... C C Annulling second slowness-vector components: DO 10 I=1,NL1*NL2*NL3 RAM(IP20+I)=0. 10 CONTINUE C C Slowness gradient: IF(0.LT.IPOS1) THEN IF(IPOS1.LT.NL1-1) THEN UG1=(RAM(IP10+IPOS+1)-RAM(IP10+IPOS-1))/(DSX1+DSX1) ELSE UG1=(RAM(IP10+IPOS) -RAM(IP10+IPOS-1))/ DSX1 END IF ELSE IF(IPOS1.LT.NL1-1) THEN UG1=(RAM(IP10+IPOS+1)-RAM(IP10+IPOS) )/ DSX1 ELSE UG1=0. END IF END IF IF(0.LT.IPOS2) THEN IF(IPOS2.LT.NL2-1) THEN UG2=(RAM(IP10+IPOS+NL1)-RAM(IP10+IPOS-NL1))/(DSX2+DSX2) ELSE UG2=(RAM(IP10+IPOS) -RAM(IP10+IPOS-NL1))/ DSX2 END IF ELSE IF(IPOS1.LT.NL1-1) THEN UG2=(RAM(IP10+IPOS+NL1)-RAM(IP10+IPOS) )/ DSX2 ELSE UG2=0. END IF END IF C C Loop over forward star of size 1: DO 22 I2=MAX0(-IPOS2,-1),MIN0(NL2-1-IPOS2,1) DO 21 I1=MAX0(-IPOS1,-1),MIN0(NL1-1-IPOS1,1) I=IPOS+I1+NL1*I2 U2=RAM(IP10+I) AUX1=FLOAT(I1)*DSX1-DPOS1 AUX2=FLOAT(I2)*DSX2-DPOS2 AUX0=SQRT(AUX1*AUX1+AUX2*AUX2) RAM(ITT0+I)=TTI+0.5*(PI+U2)*AUX0 IF(AUX0.NE.0.) THEN C AUX1=0.5*((PI+U2)*AUX1/AUX0+UG1*AUX0) C AUX2=0.5*((PI+U2)*AUX2/AUX0+UG2*AUX0) AUX0=AUX0*AUX0/(PI+U2) AUX1=AUX1+UG1*AUX0 AUX2=AUX2+UG2*AUX0 AUX0=SQRT(AUX1*AUX1+AUX2*AUX2) RAM(IP10+I)=U2*AUX1/AUX0 RAM(IP20+I)=U2*AUX2/AUX0 ELSE RAM(IP10+I)=U2 RAM(IP20+I)=0. END IF C Updating queue by adding new node as Q(MAXQ) MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I IF(I1.EQ.0.AND.I2.EQ.0) THEN RAM(ITT0+I)=-RAM(ITT0+I) END IF 21 CONTINUE 22 CONTINUE RETURN END C C======================================================================= C SUBROUTINE TTTUPD() C C This subroutine performs the loop over the grid-line-neighbour nodes. C C Auxiliary subroutine to GENER. C C Date: 1996, June 18 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Common blocks /GRID/ /FS/ /NODE/ are required here: INCLUDE 'net.inc' INCLUDE 'netnode.inc' C C----------------------------------------------------------------------- C REAL GIANT PARAMETER (GIANT=1.E+10) C INTEGER I,I1 REAL TT0,P10,P20,TT1,P11,P21,PR2 C C....................................................................... C C Loop over gridline segments starting at node IPOS: TT0=RAM(ITT0+IPOS) P10=RAM(IP10+IPOS) P20=RAM(IP20+IPOS) IF(IPOS1.GT.0) THEN I1=IPOS-1 TT1=RAM(ITT0+I1) P11=RAM(IP10+I1) P21=RAM(IP20+I1) IF(ABS(TT1).LE.TT0) THEN PR2=P11+P11-P10 IF(IPOS1.GT.1) THEN IF(ABS(RAM(ITT0+IPOS-2)).LE.TT0) THEN PR2=RAM(IP10+IPOS-2) END IF END IF IF(IPOS2.GT.0) THEN I=I1 -NL1 IF(RAM(ITT0+I).GE.GIANT) THEN MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I END IF CALL TTT(TT1,P11,P21, DSX1,TT0,P10,P20, * -DSX2,RAM(ITT0+I),RAM(IP10+I),RAM(IP20+I),-P10,-P11,-PR2) I=IPOS-NL1 IF(RAM(ITT0+I).GE.GIANT) THEN MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I END IF CALL TTT(TT0,P10,P20,-DSX1,TT1,P11,P21, * -DSX2,RAM(ITT0+I),RAM(IP10+I),RAM(IP20+I),-P10,-P11,-PR2) END IF IF(IPOS2.LT.NL2-1) THEN I=I1 +NL1 IF(RAM(ITT0+I).GE.GIANT) THEN MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I END IF CALL TTT(TT1,P11,P21, DSX1,TT0,P10,P20, * DSX2,RAM(ITT0+I),RAM(IP10+I),RAM(IP20+I),-P10,-P11,-PR2) I=IPOS+NL1 IF(RAM(ITT0+I).GE.GIANT) THEN MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I END IF CALL TTT(TT0,P10,P20,-DSX1,TT1,P11,P21, * DSX2,RAM(ITT0+I),RAM(IP10+I),RAM(IP20+I),-P10,-P11,-PR2) END IF END IF END IF IF(IPOS1.LT.NL1-1) THEN I1=IPOS+1 TT1=RAM(ITT0+I1) P11=RAM(IP10+I1) P21=RAM(IP20+I1) IF(ABS(TT1).LE.TT0) THEN PR2=P11+P11-P10 IF(IPOS1.LT.NL1-2) THEN IF(ABS(RAM(ITT0+IPOS+2)).LE.TT0) THEN PR2=RAM(IP10+IPOS+2) END IF END IF IF(IPOS2.GT.0) THEN I=I1 -NL1 IF(RAM(ITT0+I).GE.GIANT) THEN MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I END IF CALL TTT(TT1,P11,P21,-DSX1,TT0,P10,P20, * -DSX2,RAM(ITT0+I),RAM(IP10+I),RAM(IP20+I), P10, P11, PR2) I=IPOS-NL1 IF(RAM(ITT0+I).GE.GIANT) THEN MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I END IF CALL TTT(TT0,P10,P20, DSX1,TT1,P11,P21, * -DSX2,RAM(ITT0+I),RAM(IP10+I),RAM(IP20+I), P10, P11, PR2) END IF IF(IPOS2.LT.NL2-1) THEN I=I1 +NL1 IF(RAM(ITT0+I).GE.GIANT) THEN MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I END IF CALL TTT(TT1,P11,P21,-DSX1,TT0,P10,P20, * DSX2,RAM(ITT0+I),RAM(IP10+I),RAM(IP20+I), P10, P11, PR2) I=IPOS+NL1 IF(RAM(ITT0+I).GE.GIANT) THEN MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I END IF CALL TTT(TT0,P10,P20, DSX1,TT1,P11,P21, * DSX2,RAM(ITT0+I),RAM(IP10+I),RAM(IP20+I), P10, P11, PR2) END IF END IF END IF IF(IPOS2.GT.0) THEN I1=IPOS-NL1 TT1=RAM(ITT0+I1) P11=RAM(IP10+I1) P21=RAM(IP20+I1) IF(ABS(TT1).LE.TT0) THEN PR2=P21+P21-P20 IF(IPOS2.GT.1) THEN IF(ABS(RAM(ITT0+IPOS-2*NL1)).LE.TT0) THEN PR2=RAM(IP20+IPOS-2*NL1) END IF END IF IF(IPOS1.GT.0) THEN I=I1 -1 IF(RAM(ITT0+I).GE.GIANT) THEN MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I END IF CALL TTT(TT1,P21,P11, DSX2,TT0,P20,P10, * -DSX1,RAM(ITT0+I),RAM(IP20+I),RAM(IP10+I),-P20,-P21,-PR2) I=IPOS-1 IF(RAM(ITT0+I).GE.GIANT) THEN MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I END IF CALL TTT(TT0,P20,P10,-DSX2,TT1,P21,P11, * -DSX1,RAM(ITT0+I),RAM(IP20+I),RAM(IP10+I),-P20,-P21,-PR2) END IF IF(IPOS1.LT.NL1-1) THEN I=I1 +1 IF(RAM(ITT0+I).GE.GIANT) THEN MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I END IF CALL TTT(TT1,P21,P11, DSX2,TT0,P20,P10, * DSX1,RAM(ITT0+I),RAM(IP20+I),RAM(IP10+I),-P20,-P21,-PR2) I=IPOS+1 IF(RAM(ITT0+I).GE.GIANT) THEN MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I END IF CALL TTT(TT0,P20,P10,-DSX2,TT1,P21,P11, * DSX1,RAM(ITT0+I),RAM(IP20+I),RAM(IP10+I),-P20,-P21,-PR2) END IF END IF END IF IF(IPOS2.LT.NL2-1) THEN I1=IPOS+NL1 TT1=RAM(ITT0+I1) P11=RAM(IP10+I1) P21=RAM(IP20+I1) IF(ABS(TT1).LE.TT0) THEN PR2=P21+P21-P20 IF(IPOS2.LT.NL2-2) THEN IF(ABS(RAM(ITT0+IPOS+2*NL1)).LE.TT0) THEN PR2=RAM(IP20+IPOS+2*NL1) END IF END IF IF(IPOS1.GT.0) THEN I=I1 -1 IF(RAM(ITT0+I).GE.GIANT) THEN MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I END IF CALL TTT(TT1,P21,P11,-DSX2,TT0,P20,P10, * -DSX1,RAM(ITT0+I),RAM(IP20+I),RAM(IP10+I), P20, P21, PR2) I=IPOS-1 IF(RAM(ITT0+I).GE.GIANT) THEN MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I END IF CALL TTT(TT0,P20,P10, DSX2,TT1,P21,P11, * -DSX1,RAM(ITT0+I),RAM(IP20+I),RAM(IP10+I), P20, P21, PR2) END IF IF(IPOS1.LT.NL1-1) THEN I=I1 +1 IF(RAM(ITT0+I).GE.GIANT) THEN MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I END IF CALL TTT(TT1,P21,P11,-DSX2,TT0,P20,P10, * DSX1,RAM(ITT0+I),RAM(IP20+I),RAM(IP10+I), P20, P21, PR2) I=IPOS+1 IF(RAM(ITT0+I).GE.GIANT) THEN MAXQ=MAXQ+1 IRAM(IPOSQ0+MAXQ)=I END IF CALL TTT(TT0,P20,P10, DSX2,TT1,P21,P11, * DSX1,RAM(ITT0+I),RAM(IP20+I),RAM(IP10+I), P20, P21, PR2) END IF END IF END IF C RETURN END C C======================================================================= C SUBROUTINE TTT * (TT0,P10,P20,DX1,TT1,P11,P21,DX2,TT2,P12,P22,PR0,PR1,PR2) REAL TT0,P10,P20,DX1,TT1,P11,P21,DX2,TT2,P12,P22,PR0,PR1,PR2 C C Subroutine calculating, in 2-D rectangular grid, travel time of the C wave propagating from the segment between 2 given gridpoints Y0,Y1 to C the third given gridpoint Y2. Diffracted waves from the gridpoints C Y0,Y1 are also calculated at Y2 and the first arrival is considered. C Travel time is between points y0 and y1 interpolated by means of the C Aitken-Hermite polynomial interpolation of the third order. C C Input: C DX1,DX2... Grid steps in temporary Cartesian coordinates X1,X2 C defined as follows: C (0,0)... Point Y0 C (DX1,0)... Point Y1 C (0,DX2)... Point Y2 C TT0,P10,P20... Travel time and slowness vector at point Y0. C TT1,P11,P21... Travel time and slowness vector at point Y1. C TT1 may have the minus sign which is ignored. C TT2,P12,P22... Travel time and slowness vector at point Y2. C PR0,PR1,PR2... First slowness components at points Y0,Y1,2*Y1-Y0 C for Y0.GT.Y1, or Y1,Y0,2*Y0-Y1 for Y1.GT.Y0. C The sign corresponds to the coordinate increasing C from PR0 to PR2. C C Output: C TT2,P12,P22... Travel time and slowness vector at point Y2 C calculated from points Y0,Y1, if it is less than input C value of TT2. Otherwise unchanged input. C C No subroutines and external functions required. C C Date: 1996, December 22 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Common block /TTTPAR/ is required here: INCLUDE 'ttt.inc' C C----------------------------------------------------------------------- C REAL ABSTT0,ABSTT1,U0,U1,U2,U,UG1,UG2,X1,TT,T1,T2,T11,T12,T22 REAL P1,P2,A0,A1,A01,A001,A011,A0A1,AUX0,AUX1,AUX2,AUX3 REAL P10P20,P11P21,X1C,X2C,X2CX2C,UG1X2C,UC,R10,R11 C C ABSTT0..ABS(TT0) C ABSTT1..ABS(TT1) C U0,U1,U2,U...Slownesses at points Y0,Y1,Y2,Y. C UG1,UG2... Slowness gradient. C X1... X1 coordinate of point Y. C TT,T1,T2,T11,T12,T22... Travel time and its first and second C derivatives at point Y. C TT,P1,P2... Travel time and its first derivatives at point Y2. C A0,A1...Relative position of point Y with respect to points Y0,Y1. C A01,A001,A011,A0A1,AUX0,AUX1,AUX2,AUX3... Temporary storage c locations. C C....................................................................... C C Travel times at points Y0,Y1: ABSTT0=ABS(TT0) ABSTT1=ABS(TT1) C C Slownesses at points Y0,Y1,Y2: U0=SQRT(P10*P10+P20*P20) U1=SQRT(P11*P11+P21*P21) U2=SQRT(P12*P12+P22*P22) C C Slowness gradient: UG1=(U1-U0)/DX1 UG2=(U2-U0)/DX2 C C Diffraction at point Y0: AUX0=ABS(DX2) TT=ABSTT0+0.5*(U0+U2)*AUX0 IF(TT.LT.TT2) THEN TT2=TT C AUX1= 0. C AUX2= DX2 C AUX1=0.5*((U0+U2)*AUX1/AUX0+UG1*AUX0) C AUX2=0.5*((U0+U2)*AUX2/AUX0+UG2*AUX0) C AUX1=0.5*( UG1*AUX0) C AUX2=0.5*((U0+U2)* DX2/AUX0+UG2*AUX0) AUX0=AUX0*AUX0/(U0+U2) AUX1= UG1*AUX0 AUX2= DX2+UG2*AUX0 AUX0=SQRT(AUX1*AUX1+AUX2*AUX2) P12=U2*AUX1/AUX0 P22=U2*AUX2/AUX0 END IF C C Diffraction at point Y1: AUX0=SQRT(DX1*DX1+DX2*DX2) TT=ABSTT1+0.5*(U1+U2)*AUX0 IF(TT.LT.TT2) THEN TT2=TT AUX1=-DX1 AUX2= DX2 C AUX1=0.5*((U1+U2)*AUX1/AUX0+UG1*AUX0) C AUX2=0.5*((U1+U2)*AUX2/AUX0+UG2*AUX0) AUX0=AUX0*AUX0/(U1+U2) AUX1=AUX1+UG1*AUX0 AUX2=AUX2+UG2*AUX0 AUX0=SQRT(AUX1*AUX1+AUX2*AUX2) P12=U2*AUX1/AUX0 P22=U2*AUX2/AUX0 END IF C C Check for the vicinity of the point source: AUX1=0.20*(U0+U1)*ABS(DX1) IF(ABSTT0.LT.AUX1.OR.ABSTT1.LT.AUX1) THEN C Not updating inside very close vicinity of the point source RETURN END IF C C Check for the travel-time ridge: AUX1=U1-U0 AUX2=U2-U0 IF(PR1-PR0.LT. * RIDGE1*AMIN1(PR2-PR1,0.)-RIDGE2*SQRT(AUX1*AUX1+AUX2*AUX2)) THEN IF(P20/DX2.GT.0..AND.-P20/DX2.LE.P10/DX1.AND. * P10/DX1.LE.0.) THEN T12= U*UG1 /P20 T22=(U*UG2-P10*T12)/P20 P1 =P10 +T12*DX2 P2 =P20 +T22*DX2 AUX0=SQRT(P1*P1+P2*P2) P1 =P1*U2/AUX0 P2 =P2*U2/AUX0 TT =ABSTT0+0.5* (P2+P20)*DX2 IF(TT.LE.TT2) THEN TT2=TT P12=P1 P22=P2 END IF END IF IF(P21/DX2.GT.0..AND.-P21/DX2.LE.P11/DX1.AND. * P11/DX1.LE.0.) THEN T12= U*UG1 /P21 T22=(U*UG2-P11*T12)/P21 P1 =P11 +T12*DX2 P2 =P21-T12*DX1+T22*DX2 AUX0=SQRT(P1*P1+P2*P2) P1 =P1*U2/AUX0 P2 =P2*U2/AUX0 TT =ABSTT1+0.5*((P2+P21)*DX2-(P1+P11)*DX1) IF(TT.LE.TT2) THEN TT2=TT P12=P1 P22=P2 END IF END IF RETURN END IF C C Check for the direction of propagation (from Y0 and Y1 to Y2): IF(P20/DX2.LE..000001*U0/ABS(DX2).OR. * P21/DX2.LE..000001*U1/ABS(DX2)) THEN RETURN END IF C C Projecting points y0,y1 onto the parallel grid line through y2: P10P20=P10/P20 P11P21=P11/P21 A0= DX2*P10P20 A1=DX1+DX2*P11P21 C Now: A0,A1 are X1-coordinates of the projections of points Y0,Y1. C C Check for the position of point Y2 between projections of Y0,Y1: IF(A0/DX1.GE.0..OR.A1/DX1.LE.0.) THEN RETURN END IF C C Backprojecting point Y2 onto point Y at gridline through Y0,Y1: AUX0=A0-A1 A0=A0/AUX0 A1=A1/AUX0 X1=A0*DX1 C Now: A0=(X1-X10)/(X11-X10), A1=(X1-X11)/(X11-X10), A0-A1=1, C where X1,X10,X11 are X1-coordinates of points Y,Y0,Y1. C C Slowness at point Y: C U =A0*U1-A1*U0 U =U0+UG1*X1 C IF(VER1*ABS(P10P20-P11P21).GE.1.) THEN C X2C=DX1/(P10P20-P11P21) X1C=X2C*P10P20 C Now: X1C,X2C is the crosssection of two given slowness vectors. C C Travel-time spherical correction UC=U0+UG1*X1C X2CX2C=X2C*X2C UG1X2C=UG1*X2CX2C AUX1= -X1C AUX0=SQRT(AUX1*AUX1+X2CX2C) ABSTT0=ABSTT0-0.5*(AUX0*(U0+UC)-UG1X2C*ALOG(AUX0+AUX1)) AUX1=DX1-X1C AUX0=SQRT(AUX1*AUX1+X2CX2C) ABSTT1=ABSTT1-0.5*(AUX0*(U1+UC)-UG1X2C*ALOG(AUX0+AUX1)) AUX1= X1-X1C AUX0=SQRT(AUX1*AUX1+X2CX2C) TT = 0.5*(AUX0*(U +UC)-UG1X2C*ALOG(AUX0+AUX1)) T1 = U *AUX1/AUX0 T11 =(UG1*AUX1+U*X2CX2C/AUX0/AUX0)/AUX0 C C Travel-time cubic polynomial correction AUX0=ABSTT0-ABSTT1 AUX1=6.*AUX0/DX1 AUX2=1.-VER2 TT =TT +AUX2*((A0+A0+1.)*A1*A1*AUX0 )+ABSTT1 T1 =T1 +AUX2*( A0*A1*AUX1 ) T11=T11+AUX2*( (A0+A1)*AUX1)/DX1 TT =TT -VER2*A1*AUX0 T1 =T1 -VER2*AUX1/6. C ELSE C C Interpolating travel-time and its derivatives at point Y by C means of the third-order interpolation from Y0,Y1: A01=A0+A1 A001=A0+A01 A011=A01+A1 A0A1=A0*A1 AUX0=ABSTT0-ABSTT1 AUX1=6.*AUX0/DX1 AUX3=VER2*((P10+P11)/2.+AUX1/6.) R10= P10-AUX3 R11= P11-AUX3 TT =(A0+A0+1.)*A1*A1*AUX0+ABSTT1+A0A1*(A1*R10+ A0*R11)*DX1 T1 = A0A1 *AUX1 + A001*A1*R10+A011*A0*R11 T11=( A01 *AUX1 +2.*(A011*R10+ A001*R11))/DX1 C END IF C C Second-order Taylor expansion of travel time at point Y: T2=U*U-T1*T1 IF(T2.LT.0.) THEN WRITE(*,'(1X,11F7.4)') * TT0,P10,P20,DX1,TT1,P11,P21,DX2,TT2,P12,P22 WRITE(*,'(A)') ' TOO LARGE SLOWNESS COMPONENT' RETURN END IF T2=SIGN(SQRT(T2),DX2) T12=(U*UG1-T1*T11)/T2 T22=(U*UG2-T1*T12)/T2 P1 =T1-T11*X1+T12*DX2 P2 =T2-T12*X1+T22*DX2 AUX0=SQRT(P1*P1+P2*P2) P1=P1*U2/AUX0 P2=P2*U2/AUX0 TT =TT+0.5*((P2+T2)*DX2-(P1+T1)*X1) IF(TT.LE.TT2) THEN TT2=TT P12=P1 P22=P2 END IF C RETURN END C C======================================================================= C ttt.inc 100666 1750 1750 502 6367247274 11441 0 ustar klimes klimes C Common block for program NET, subroutines TTT: C C----------------------------------------------------------------------- C C Numerical parameters for TTT: C REAL RIDGE1,RIDGE2,VER1,VER2 COMMON /TTTPAR/ RIDGE1,RIDGE2,VER1,VER2 C C======================================================================= C vel.dat 100666 1750 1750 3421 5456130100 11407 0 ustar klimes klimes 201*3.00 201*2.99 201*2.98 201*2.97 201*2.96 201*2.95 201*2.94 201*2.93 201*2.92 201*2.91 201*2.90 201*2.89 201*2.88 201*2.87 201*2.86 201*2.85 201*2.84 201*2.83 201*2.82 201*2.81 201*2.80 201*2.79 201*2.78 201*2.77 201*2.76 201*2.75 201*2.74 201*2.73 201*2.72 201*2.71 201*2.70 201*2.69 201*2.68 201*2.67 201*2.66 201*2.65 201*2.64 201*2.63 201*2.62 201*2.61 201*2.60 201*2.59 201*2.58 201*2.57 201*2.56 201*2.55 201*2.54 201*2.53 201*2.52 201*2.51 201*2.50 201*2.49 201*2.48 201*2.47 201*2.46 201*2.45 201*2.44 201*2.43 201*2.42 201*2.41 201*2.40 201*2.39 201*2.38 201*2.37 201*2.36 201*2.35 201*2.34 201*2.33 201*2.32 201*2.31 201*2.30 201*2.29 201*2.28 201*2.27 201*2.26 201*2.25 201*2.24 201*2.23 201*2.22 201*2.21 201*2.20 201*2.19 201*2.18 201*2.17 201*2.16 201*2.15 201*2.14 201*2.13 201*2.12 201*2.11 201*2.10 201*2.09 201*2.08 201*2.07 201*2.06 201*2.05 201*2.04 201*2.03 201*2.02 201*2.01 201*2.00 201*1.99 201*1.98 201*1.97 201*1.96 201*1.95 201*1.94 201*1.93 201*1.92 201*1.91 201*1.90 201*1.89 201*1.88 201*1.87 201*1.86 201*1.85 201*1.84 201*1.83 201*1.82 201*1.81 201*1.80 201*1.79 201*1.78 201*1.77 201*1.76 201*1.75 201*1.74 201*1.73 201*1.72 201*1.71 201*1.70 201*1.69 201*1.68 201*1.67 201*1.66 201*1.65 201*1.64 201*1.63 201*1.62 201*1.61 201*1.60 201*1.59 201*1.58 201*1.57 201*1.56 201*1.55 201*1.54 201*1.53 201*1.52 201*1.51 201*1.50 201*1.49 201*1.48 201*1.47 201*1.46 201*1.45 201*1.44 201*1.43 201*1.42 201*1.41 201*1.40 201*1.39 201*1.38 201*1.37 201*1.36 201*1.35 201*1.34 201*1.33 201*1.32 201*1.31 201*1.30 201*1.29 201*1.28 201*1.27 201*1.26 201*1.25 201*1.24 201*1.23 201*1.22 201*1.21 201*1.20 201*1.19 201*1.18 201*1.17 201*1.16 201*1.15 201*1.14 201*1.13 201*1.12 201*1.11 201*1.10 201*1.09 201*1.08 201*1.07 201*1.06 201*1.05 201*1.04 201*1.03 201*1.02 201*1.01 201*1.00Released versions of package NET
1.00 (1992, October): First released version. Includes optimization of forward-star sizes. No reasonable check for the computational volume or free space. 1.10 (1992, December): Input and output of forward stars enabled. Optional print of the numbers of template forward-star nodes. Important changes in subroutines SOURCE, GENER, and SRCREC, concerning free space and the computational (Fresnel) volume indexing. 1.20 (1993, January): Subroutines reordered and now listed. Name of the data file read from the * unit instead of the whole data file. Subroutine SETERR: evaluation of the negative travel-time error bound fixed. Subroutines OPTNFS, OPTMAT, and TRYMAT: considerable improvements with influence on the forward-star sizes. Subroutines TRACER, ONERAY, and SLOW: other corrections. The version likely able to properly consider free space, and computational (e.g. Fresnel) volume indexing. Complemented with demo-data package 'MOD-NET', ver.1.00. 1.30 (1993, April): Initial travel-time errors at source points enabled. WRTOUT: new subroutine with the code to generate the output files containing calculated grid values. Subroutine SETERR: evaluation of travel-time errors fixed. Subroutine OPTNFS: estimation of optimum forward-star sizes improved (according to Klimes and Kvasnicka, 1994). 1.40 (1993, June): Fatal formal array-indexing error in subroutine MIXDER fixed (error had no influence on the numerical results). Subroutine WRTOUT: null values generated in place of undefined grid values, and other minor changes. 2.00 (1994, August): Program 'net.for' merged with demo-data package 'MOD-NET' and extended to program package 'NET'. 'net.for': Subroutines SLOW and POS corrected. *** New input/output formats of points and rays. *** Error messages, previously generated by statements like STOP 'Error...', are now generated by PAUSE 'Error...' followed by the STOP statement, in order to suspend the batch files in the case of error. Some changes intended for future extensions has been made. Subroutine WRTOUT replaced by subroutine WARRAY of the 'MODEL' package, and then the following two files have been split off: 'array.for': Subroutines replacing subroutine WRTOUT. Common with package 'MODEL'. 'eigen.for': Subroutine EIGEN of the IBM Scientific Subroutine Package. 'mod-*.dat': Data files revised to correspond to Sec.6.3 of Klimes and Kvasnicka (1994). *** new ***: 'fs-opt2.for', 'fs-opt3.for', 'fs-mcir2.for', 'fs-msph3.for', 'fs-msqr2.for', 'fs-mcub3.for': New programs to generate 2-D or 3-D template forward stars. 'n2-*.dat': Demo data files related to Sec.6.2 of Klimes and Kvasnicka (1994). 'netind.for': Program to generate index files specifying Fresnel volumes. 'fv.bat', 'vgr-mod.dat', 'fv-*.dat': Batch file and demo data to perform iterative two-point network ray tracing in Fresnel volumes. 3.00 (1997, October): *** probably not all changes are listed here *** 'forms.doc': renamed to 'formsdoc.htm' and moved to package FORMS. 'net.for': Reading grid values and writing integer grid values through subroutines RARRAY, RARRAI, WARRAI. 'array.for': Renamed to 'forms.for', updated, supplemented with subroutines FORM1 and FORM2, moved to package FORMS. All error descriptions moved towards the corresponding reporting statements. *** new ***: Files converted from UPPERCASE to both UpperCase and LowerCase (for better reading and Unix systems). Fortran files supplemented with HTML references. All files with main programs supplemented with the INCLUDE statements to include all files with called subroutines to simplify the compilation and linking considerably. '*.inc': Include files with COMMON blocks. INCLUDE statement introduced for COMMON blocks. SAVE statement is now used consistently for COMMON blocks 'net.for', 'net.inc': Automatic memory allocation according to 'ram.inc' of package FORMS. 'net.for': Automatic determination of the maximum f.s. size NFSMAX (for NFSMAX=0 on input) added. Otherwise (NFSMAX>0), network ray tracing remains identical to Ver.2.00. 'net.for', 'ttt.for': 2-D grid travel-time tracing of the second order according to the paper by Klimes (1996) added for testing purposes (NFSMAX=-1). 'net.for','netind.for': Grid dimensions specified by SEP parameter file. 3.10 (1998, October): All error messages in the Fortran files, previously generated by statements like PAUSE 'Error ...', are now generated by CALL ERROR('...') in order to enable to fit the error handling for a particular computer by editting file 'error.for' (the date of subroutines not updated). Most warning messages in the Fortran files, previously generated by statements like PAUSE 'Warning ...', are now generated by CALL WARN('...'). 'eigen.for': *** Moved to package FORMS. *** 'netdoc.htm' split into 'netdoc.htm', 'netver.htm' and 'fv/netfv.htm', list of files moved to 'net.htm'. 'net.for': *** Input data changed. *** Minor corrections: now checking for positive grid intervals, fixing integer overflow when determining the maximum size of forward stars. 'net.inc': Comments updated. 'netind.for': *** Input data changed. *** Memory allocation and division of big bricks into small bricks controlled with help of 'ram.inc'. *** Optimization of iterations further automatized. *** 'len-src.dat' and 'len-rec.dat' renamed to 'lenn-src.dat' and 'lenn-rec.dat' to avoid the filename collision with package CRT. *** new *** All MS-DOS batch files '*.bat' and Unix scripts '*' replaced by corresponding Perl scripts '*.pl' or by history files '*.h' containing the lines specifying how to run the programs.