ap.for 100666 1750 1750 154550 6425373367 11336 0 ustar klimes klimes C
C Subroutine file 'ap.for': Applications and processing of the results C of complete ray tracing. C C Date: 1997, October 30 C Coded by Ludek Klimes C C This file contains subroutines related to the Chapter 7 of the paper C on C.R.T., designed to read from the files the quantities describing C the points of rays, and to evaluate many other quantities used in C seismology and discussed in the Chapter C.R.T.7. These subroutines C may be included in user's application programs following the complete C ray tracing program. Individual subroutines correspond to the C individual sections of the Chapter C.R.T.7, and may call other C subroutines of the files of the packages 'MODEL' and 'CRT' composing C the complete ray tracing program. C C Attention: The lines dealing with curvilinear coordinates are denoted C by '*' in the first column. That is why this code works properly only C in Cartesian coordinates. To consider curvilinear coordinates, each C '*' in the first column has to be replaced by a space. In such a C case, subroutine METR1 has to be called first to specify the C coordinate system. C C This is a preliminary version, containing only some of the routines C corresponding to sections of the Chapter C.R.T.7. The routines C denoted by * in the second column will likely be coded in the near C future, others later on. C C This file consists of the following external procedures: C POINTB..Block data subroutine defining common block /POINTC/ to C store the quantities describing a point on a ray. C POINTB C AP00... Subroutine designed to read from the files the quantities C describing a point on a ray, and to store them into the C common block /POINTC/. The input files are assumed to C have the structure of the output files of the complete ray C tracing program 'CRT', written by the subroutines of the C file 'writ.for'. C AP00 C AP01... Subroutine designed to evaluate the travel time from the C initial point of a ray to a point situated on a ray, see C C.R.T.7.1. C AP01 C AP02... Subroutine designed to evaluate the components of the C slowness vector either at the initial point of a ray or at C a point situated on a ray, see C.R.T.7.2. C AP02 C AP03... Subroutine designed to evaluate the covariant components C of the basis vectors of the ray-centred coordinate system C at the initial point of a ray or at a point situated on a C ray, see C.R.T.7.3. C AP03 C AP03A...Auxiliary subroutine to AP03, evaluating the basis of the C intrinsic ray-centred coordinate system at the given C point. C AP04 C* AP04 C AP05... Subroutine designed to evaluate the components of the C matrix of geometrical spreading at a point situated on a C ray, see C.R.T.7.5. C AP05 C AP06... Subroutine designed to evaluate the components of the C transformation matrix P at a point situated on a ray, see C C.R.T.7.6. C AP06 C AP07... Subroutine designed to evaluate the geometrical spreading C at a point situated on a ray, see C.R.T.7.7. C AP07 C AP08... Subroutine designed to evaluate the components of the C symmetric 3*3 matrices M and N of second derivatives of C the travel-time field at a point situated on a ray, see C C.R.T.7.8. Subroutine AP03 should be called before the C invocation of AP08 to define the basis of R.C.C.S. C AP08 C* AP09 C* AP10(XI,X) C AP11... Subroutine designed to evaluate two ray-centred C coordinates of a given paraxial ray. C AP11 C* AP12(XI,X) C* AP13(XI,XF,X) C* AP14 C AP15... Subroutine designed to evaluate the ray amplitudes at a C point situated on a ray, see C.R.T.7.15. Subroutine AP03 C should be called before the invocation of AP15 to define C the basis of R.C.C.S. C AP15 C* AP16 C AP21... Subroutine designed to evaluate the ray-theory C elastodynamic Green function according to C.R.T.7.21. C AP21 C C Note: There are no application routines corresponding to the sections C 7.18, 7.23 and 7.27 of the paper on C.R.T. AP28 and subsequent C applications, located in subroutine file 'apvar.for' do not correspond C to any section of the paper on C.R.T. C C Storage in the memory: C When processing of the results of complete ray tracing, the C quantities describing some points on a ray are required to be C known. In the Chapter 7 of the paper on C.R.T., three different C points situated on a ray are introduced: C O/O (O subscript O)... Initial point of the ray. C O/S (O subscript S)... Another point situated on the ray. In some C applications it may be treated as the endpoint of the ray. C O/F (O subscript F)... Another point situated on the ray, usually C situated between the points O/O and O/S, see C.R.T.7.13: C Fresnel volumes. This point is required just by few C applications and usually need not be defined. C The quantities describing the points O/O, O/S (and, possibly, O/F) C of a ray are stored by the subroutine AP00 into the common block C /POINTC/ defined in the following subroutine: C ------------------------------------------------------------------ C pointc.inc DATA IWAVE/0/,IRAY/0/ END C ------------------------------------------------------------------ C C======================================================================= C C C SUBROUTINE AP00(LU1,LU2,LU3) INTEGER LU1,LU2,LU3 C C This subroutine reads from the given files the quantities describing C some points on a ray, and stores them into the common block /POINTC/. C The input files are assumed to have the structure of the output files C of the complete ray tracing program 'CRT', written by the subroutines C of the file 'writ.for'. When all points of the given files are read C over, IWAVE and IRAY of the common block /POINTC/ are set to zeros. C The locations IWAVE and IRAY of the common block /POINTC/ should not C be changed but with the following exception: They must be set to zeros C before this subroutine is called with altered (reopened) files C corresponding to the input parameters LU1, LU2 and LU3. C In the Chapter 7 of the paper on C.R.T., the initial point of the ray C is denoted O/O (O subscript O) and the points on the ray are denoted C O/F and O/S. After the invocation of this subroutine, a user may want C to call his own subroutine deciding whether the point on a ray is to C be ignored (e.g. when it is too far from the receivers) or processed C on. C C Input: C LU1... Zero if the point O/F of the ray need not be defined. C Otherwise the logical unit number of the external input C device containing a file with the quantities along rays C (see C.R.T.5.5.1) or a file with the quantities at a C specified surface (see C.R.T.5.5.2). The points O/F will C be read from this file. If there will be a point O/S of C the same ray in the file LU2, the quantities corresponding C to these points will be stored into the common block C /POINTC/. C LU2... Logical unit number of the external input device C containing a file with the quantities along rays (see C C.R.T.5.5.1, just for LU1=0) or a file with the quantities C at a specified surface (see C.R.T.5.5.2). For LU1=0, all C points O/S from this file will be successively stored into C the common block /POINTC/. C If LU1=0 and LU2=0, only initial points of rays will be C read from LU3 and stored in common block /POINTC/, one C initial point per each invocation of AP00. C LU3... Logical unit number of the external input device C containing the file with the quantities at the initial C points of rays, corresponding to the above file LU1 or LU2 C (see C.R.T.6.1). C The input parameters are not altered. C C No output. C C Common block /POINTC/: INCLUDE 'pointc.inc' C pointc.inc C All the storage locations of the common blocks are defined in this C subroutine. C C Subroutines and external functions required: EXTERNAL POINTB C POINTB..Block data subroutine of this file. C C Date: 1997, September 7 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Auxiliary storage locations: INTEGER IWAVEF,IRAYF,IWAVEI,IRAYI,I C IWAVEF,IRAYF... Values of IWAVE,IRAY corresponding to the last C point O/F of a ray read in during the current invocation. C IWAVEI,IRAYI... Values of IWAVE,IRAY corresponding to the last C read in initial point of a ray. C I... Auxiliary loop variable. C IF(LU2.NE.0) THEN C C Reading the results of the complete ray tracing: IWAVEF=-1 IRAYF=0 NYF=0 IWAVEI=IWAVE IRAYI=IRAY C C Points O/F and O/S on a ray: C For LU1=0 just the point O/S is being read, C otherwise, points O/F and O/S must be situated on the same ray. 10 CONTINUE IF(LU1.NE.0.AND.(IWAVEF.LT.IWAVE.OR. * (IWAVEF.EQ.IWAVE.AND.IRAYF.LT.IRAY))) THEN C New point O/F on a ray: READ(LU1,END=80) * IWAVEF,IRAYF,NYF,ICB1F,ISRFF,XF,YLF,(YF(I),I=1,NYF) IF (IWAVEF.LE.0) THEN C 701 PAUSE 'Error 701 in AP00: Wrong file with computed points' STOP C Index of the elementary wave is not positive. Maybe, the C file LU1 has the structure of a file LU3. END IF GO TO 10 END IF IF(LU1.EQ.0.OR.IWAVEF.GT.IWAVE.OR. * (IWAVEF.EQ.IWAVE.AND.IRAYF.GT.IRAY)) THEN C New point O/S on a ray: READ(LU2,END=80) IWAVE,IRAY,NY,ICB1,ISRF,X,YL,(Y(I),I=1,NY) IF (IWAVE.LE.0) THEN C 702 PAUSE 'Error 702 in AP00: Wrong file with computed points' STOP C Index of the elementary wave is not positive. Maybe, the C file LU2 has the structure of a file LU3. END IF IF(LU1.NE.0) THEN GO TO 10 END IF END IF C C Defining IPT: IF(IWAVE.NE.IWAVEI) THEN IPT=0 ELSE IF(IRAY.NE.IRAYI) THEN IPT=1 ELSE IPT=MAX0(1,IPT)+1 END IF C C Initial point O/O of a ray: 20 CONTINUE IF(IWAVE.NE.IWAVEI.OR.IRAY.NE.IRAYI) THEN IF(IWAVE.LT.IWAVEI) THEN C 704 WRITE(*,'('' WAVE:'',I4,'', RAY:'',I6)') IWAVE,IRAY PAUSE 'Error 704 in AP00: The wave not found' STOP C The initial point of a ray from file LU2 is not found in C the file LU3. ELSE IF(IWAVE.EQ.IWAVEI.AND.IRAY.LT.IRAYI) THEN C 705 WRITE(*,'('' WAVE:'',I4,'', RAY:'',I6)') IWAVE,IRAY PAUSE'Error 705 in AP00: Initial point of the ray not found' STOP C The initial point of a ray from file LU2 is not found in C the file LU3. ELSE C Initial point O/O of a ray READ(LU3,END=90) IWAVEI,IRAYI,ICB1I,IEND,ISHEET,IREC,YLI,YI IF(IWAVEI.LT.0) THEN IWAVEI=-IWAVEI ELSE C GO TO 89 END IF GO TO 20 END IF END IF RETURN C ELSE C C Reading only initial point of a ray: READ(LU3,END=80) IWAVE,IRAY,ICB1I,IEND,ISHEET,IREC,YLI,YI IF(IWAVE.LT.0) THEN IWAVE=-IWAVE ELSE C GO TO 89 END IF IPT=0 RETURN C END IF C C End of the file with the computed points: 80 CONTINUE IWAVE=0 IRAY=0 IPT=0 RETURN C C End of the file with the initial points of rays: 89 CONTINUE C 703 PAUSE 'Error 703 in AP00: Wrong file with initial points' STOP C Index of the elementary wave is not supplied with a minus C sign. Maybe, the file LU3 has the structure of a file LU2. C C End of the file with the initial points of rays: 90 CONTINUE C 706 PAUSE 'Error 706 in AP00: End of the file with initial points' STOP C The initial point of a ray from file LU2 is not found in file LU3. END C C======================================================================= C C C SUBROUTINE AP01(TT,TTIM) REAL TT,TTIM C C This subroutine evaluates the travel time from the initial point of a C ray to a point situated on a ray, see C.R.T.7.1. C C No input. C C Output: C TT... Travel time from the initial point O/O of a ray to the C point O/S read into the common block /POINTC/ by the last C invocation of the subroutine AP00. C TTIM... Imaginary travel time from the initial point O/O of a ray C to the point O/S (see C.R.T.7.1). C C Common block /POINTC/: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C No subroutines and external functions required. C C Date: 1994, January 23 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C TT =Y(1)-YI(1) TTIM=Y(2)-YI(2) RETURN END C C======================================================================= C C C SUBROUTINE AP02(PI,P) REAL PI(6),P(6) C C This subroutine evaluates the components of the slowness vector either C at the initial point of a ray or at a point situated on a ray, see C C.R.T.7.2. C C No input. C C Output: C PI... Three covariant (PI(1:3)) and three contravariant C (PI(4:6)) components of the gradient of the travel time C field at the initial point O/O of a ray. C P... Three covariant (P(1:3)) and three contravariant (P(4:6)) C components of the gradient of the travel time field at the C point O/S read into the common block /POINTC/ by the last C invocation of the subroutine AP00. C C Common block /POINTC/: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C Subroutines and external functions required: * INTEGER KOOR * EXTERNAL KOOR,METRIC,SMVPRD C KOOR,METRIC... File 'metric.for' of the package 'MODEL'. C SMVPRD... File 'means.for' of the package 'MODEL'. C C Date: 1994, January 23 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Auxiliary storage locations for local model parameters: FAUX(10), C G(12),GAMMA(18),GSQRD, UP(10),US(10),RO,QP,QS, VP,VS,VD(10),QL: INCLUDE 'auxmod.inc' C auxmod.inc C C....................................................................... C * REAL PI4,PI5,PI6 * SAVE PI4,PI5,PI6 * INTEGER JWAVE,JRAY * SAVE JWAVE,JRAY * DATA JWAVE,JRAY/0,0/ C C....................................................................... C C Covariant components: PI(1)=YI(6) PI(2)=YI(7) PI(3)=YI(8) P (1)=Y (6) P (2)=Y (7) P (3)=Y (8) C C Contravariant components: * IF(KOOR().NE.0) THEN C Curvilinear coordinates: * IF(IWAVE.NE.JWAVE.OR.IRAY.NE.JRAY) THEN * CALL METRIC(YI(3),GSQRD,G,GAMMA) * CALL SMVPRD(G(7),YI(6),YI(7),YI(8),PI4,PI5,PI6) * JWAVE=IWAVE * JRAY=IRAY * END IF * PI(4)=PI4 * PI(5)=PI5 * PI(6)=PI6 * CALL METRIC(Y (3),GSQRD,G,GAMMA) * CALL SMVPRD(G(7),Y(6),Y(7),Y(8),P(4),P(5),P(6)) * ELSE C Cartesian coordinates: PI(4)=YI(6) PI(5)=YI(7) PI(6)=YI(8) P (4)=Y (6) P (5)=Y (7) P (6)=Y (8) * END IF RETURN END C C======================================================================= C C C SUBROUTINE AP03(IUSER,HI,H,HUI) INTEGER IUSER REAL HI(18),H(18),HUI(9) C C This subroutine evaluates the covariant components of the basis C vectors of the ray-centred coordinate system at the initial point of a C ray or at a point situated on a ray, see C.R.T.7.3. C C Input: C IUSER...IUSER=0... Intrinsic choice of polarization vectors. C Any other input need not be specified. C IUSER=1... User's choice of polarization vectors at the C initial point O/O of the ray. C HI(1:9) must be specified. C If HUI(1:9) has already been evaluated for the ray, it C must be specified on the input too. C IUSER=2... User's choice of polarization vectors at the C initial point O/O of the ray. C HI(10:18) must be specified. C If HUI(1:9) has already been evaluated for the ray, it C must be specified on the input too. C IUSER=3... Transformation matrix from the intrinsic C ray-centred to the user's ray-centred coordinate system C is given. C HI(1:9) need not be specified. C HUI(1:9) has to be specified. C HI(1:9)... Covariant components of the basis vectors of the user's C ray-centred coordinate system at the initial point O/O of C a ray. C HUI... Components of the 3*3 transformation matrix from the C intrinsic to the user's ray-centred coordinate system. C C Output: C HI... Covariant (HI(1:9)) and contravariant (HI(10:18)) C components of the basis vectors of the user's ray-centred C coordinate system at the initial point O/O of a ray. C If HI(1:18) has already been evaluated for the ray, just C the copy of input values. C H... Covariant (H(1:9)) and contravariant (H(10:18)) components C of the basis vectors of the user's ray-centred coordinate C system at the point O/S read into the common block C /POINTC/ by the last invocation of the subroutine AP00. C HUI... Components of the 3*3 transformation matrix from the C intrinsic to the user's ray-centred coordinate system. C C Common block /POINTC/: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C Subroutines and external functions required: EXTERNAL AP03A C KOOR,METRIC... File 'metric.for' of the package 'MODEL'. C SMVPRD..File 'means.for' of the package 'MODEL'. C AP03A...This file. C C Date: 1994, January 23 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C REAL HA(18),HA01,HA02,HA03,HA04,HA05,HA06,HA07,HA08,HA09 REAL HA10,HA11,HA12,HA13,HA14,HA15,HA16,HA17,HA18 EQUIVALENCE (HA(01),HA01),(HA(02),HA02),(HA(03),HA03) EQUIVALENCE (HA(04),HA04),(HA(05),HA05),(HA(06),HA06) EQUIVALENCE (HA(07),HA07),(HA(08),HA08),(HA(09),HA09) EQUIVALENCE (HA(10),HA10),(HA(11),HA11),(HA(12),HA12) EQUIVALENCE (HA(13),HA13),(HA(14),HA14),(HA(15),HA15) EQUIVALENCE (HA(16),HA16),(HA(17),HA17),(HA(18),HA18) C C HA... Auxiliary storage location for covariant (HA(1:9)) and C contravariant (HA(10:18)) components of the basis vectors C of the intrinsic ray-centred coordinate system. C INTEGER JWAVE,JRAY SAVE JWAVE,JRAY DATA JWAVE,JRAY/0,0/ C C....................................................................... C IF(IWAVE.NE.JWAVE.OR.IRAY.NE.JRAY) THEN IF(IUSER.EQ.0) THEN CALL AP03A(YI,HI) HUI(1)=1. HUI(2)=0. HUI(3)=0. HUI(4)=0. HUI(5)=1. HUI(6)=0. HUI(7)=0. HUI(8)=0. HUI(9)=1. ELSE CALL AP03A(YI,HA) IF(IUSER.NE.2) THEN IF(IUSER.EQ.1) THEN HUI(1)=HI(1)*HA10+HI(2)*HA11+HI(3)*HA12 HUI(2)=HI(4)*HA10+HI(5)*HA11+HI(6)*HA12 HUI(3)=HI(7)*HA10+HI(8)*HA11+HI(9)*HA12 HUI(4)=HI(1)*HA13+HI(2)*HA14+HI(3)*HA15 HUI(5)=HI(4)*HA13+HI(5)*HA14+HI(6)*HA15 HUI(6)=HI(7)*HA13+HI(8)*HA14+HI(9)*HA15 HUI(7)=HI(1)*HA16+HI(2)*HA17+HI(3)*HA18 HUI(8)=HI(4)*HA16+HI(5)*HA17+HI(6)*HA18 HUI(9)=HI(7)*HA16+HI(8)*HA17+HI(9)*HA18 END IF HI(10)=HUI(1)*HA10+HUI(4)*HA11+HUI(7)*HA12 HI(11)=HUI(2)*HA10+HUI(5)*HA11+HUI(8)*HA12 HI(12)=HUI(3)*HA10+HUI(6)*HA11+HUI(9)*HA12 HI(13)=HUI(1)*HA13+HUI(4)*HA14+HUI(7)*HA15 HI(14)=HUI(2)*HA13+HUI(5)*HA14+HUI(8)*HA15 HI(15)=HUI(3)*HA13+HUI(6)*HA14+HUI(9)*HA15 HI(16)=HUI(1)*HA16+HUI(4)*HA17+HUI(7)*HA18 HI(17)=HUI(2)*HA16+HUI(5)*HA17+HUI(8)*HA18 HI(18)=HUI(3)*HA16+HUI(6)*HA17+HUI(9)*HA18 END IF IF(IUSER.NE.1) THEN IF(IUSER.EQ.2) THEN HUI(1)=HI(10)*HA01+HI(11)*HA02+HI(12)*HA03 HUI(2)=HI(13)*HA01+HI(14)*HA02+HI(15)*HA03 HUI(3)=HI(16)*HA01+HI(17)*HA02+HI(18)*HA03 HUI(4)=HI(10)*HA04+HI(11)*HA05+HI(12)*HA06 HUI(5)=HI(13)*HA04+HI(14)*HA05+HI(15)*HA06 HUI(6)=HI(16)*HA04+HI(17)*HA05+HI(18)*HA06 HUI(7)=HI(10)*HA07+HI(11)*HA08+HI(12)*HA09 HUI(8)=HI(13)*HA07+HI(14)*HA08+HI(15)*HA09 HUI(9)=HI(16)*HA07+HI(17)*HA08+HI(18)*HA09 END IF HI( 1)=HUI(1)*HA01+HUI(4)*HA02+HUI(7)*HA03 HI( 2)=HUI(2)*HA01+HUI(5)*HA02+HUI(8)*HA03 HI( 3)=HUI(3)*HA01+HUI(6)*HA02+HUI(9)*HA03 HI( 4)=HUI(1)*HA04+HUI(4)*HA05+HUI(7)*HA06 HI( 5)=HUI(2)*HA04+HUI(5)*HA05+HUI(8)*HA06 HI( 6)=HUI(3)*HA04+HUI(6)*HA05+HUI(9)*HA06 HI( 7)=HUI(1)*HA07+HUI(4)*HA08+HUI(7)*HA09 HI( 8)=HUI(2)*HA07+HUI(5)*HA08+HUI(8)*HA09 HI( 9)=HUI(3)*HA07+HUI(6)*HA08+HUI(9)*HA09 END IF END IF JWAVE=IWAVE JRAY=IRAY END IF C IF(IUSER.EQ.0) THEN CALL AP03A(Y,H) ELSE CALL AP03A(Y,HA) H( 1)=HUI(1)*HA01+HUI(4)*HA02+HUI(7)*HA03 H( 2)=HUI(2)*HA01+HUI(5)*HA02+HUI(8)*HA03 H( 3)=HUI(3)*HA01+HUI(6)*HA02+HUI(9)*HA03 H( 4)=HUI(1)*HA04+HUI(4)*HA05+HUI(7)*HA06 H( 5)=HUI(2)*HA04+HUI(5)*HA05+HUI(8)*HA06 H( 6)=HUI(3)*HA04+HUI(6)*HA05+HUI(9)*HA06 H( 7)=HUI(1)*HA07+HUI(4)*HA08+HUI(7)*HA09 H( 8)=HUI(2)*HA07+HUI(5)*HA08+HUI(8)*HA09 H( 9)=HUI(3)*HA07+HUI(6)*HA08+HUI(9)*HA09 H(10)=HUI(1)*HA10+HUI(4)*HA11+HUI(7)*HA12 H(11)=HUI(2)*HA10+HUI(5)*HA11+HUI(8)*HA12 H(12)=HUI(3)*HA10+HUI(6)*HA11+HUI(9)*HA12 H(13)=HUI(1)*HA13+HUI(4)*HA14+HUI(7)*HA15 H(14)=HUI(2)*HA13+HUI(5)*HA14+HUI(8)*HA15 H(15)=HUI(3)*HA13+HUI(6)*HA14+HUI(9)*HA15 H(16)=HUI(1)*HA16+HUI(4)*HA17+HUI(7)*HA18 H(17)=HUI(2)*HA16+HUI(5)*HA17+HUI(8)*HA18 H(18)=HUI(3)*HA16+HUI(6)*HA17+HUI(9)*HA18 END IF RETURN END C C======================================================================= C C C SUBROUTINE AP03A(YA,HA) REAL YA(11),HA(18) C C Auxiliary subroutine to AP03, evaluates the basis of the intrinsic C ray-centred coordinate system at the given point. C C Input: C YA... Quantities describing a point of a ray C C Output: C HA... Covariant (HA(1:9)) and contravariant (HA(10:18)) C components of the basis vectors of the intrinsic C ray-centred coordinate system at the given point. C C Subroutines and external functions required: * INTEGER KOOR * EXTERNAL KOOR,METRIC,SMVPRD C KOOR,METRIC... File 'metric.for' of the package 'MODEL'. C SMVPRD...File 'means.for' of the package 'MODEL'. C C Date: 1994, January 15 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Auxiliary storage locations for local model parameters: FAUX(10), C G(12),GAMMA(18),GSQRD, UP(10),US(10),RO,QP,QS, VP,VS,VD(10),QL: INCLUDE 'auxmod.inc' C auxmod.inc C C....................................................................... C REAL AUX C C....................................................................... C HA(01)=YA( 9) HA(02)=YA(10) HA(03)=YA(11) * IF(KOOR().NE.0) THEN C Curvilinear coordinates: * CALL METRIC(YA(3),GSQRD,G,GAMMA) * CALL SMVPRD(G(7),HA(01),HA(02),HA(03),HA(10),HA(11),HA(12)) * CALL SMVPRD(G(7),YA(6),YA(7),YA(8),HA(16),HA(17),HA(18)) * AUX=SQRT(YA(6)*HA(16)+YA(7)*HA(17)+YA(8)*HA(18)) * HA(07)=YA(6)/AUX * HA(08)=YA(7)/AUX * HA(09)=YA(8)/AUX * HA(16)=HA(16)/AUX * HA(17)=HA(17)/AUX * HA(18)=HA(18)/AUX * HA(04)=(HA(17)*HA(12)-HA(18)*HA(11))*GSQRD * HA(05)=(HA(18)*HA(10)-HA(16)*HA(12))*GSQRD * HA(06)=(HA(16)*HA(11)-HA(17)*HA(10))*GSQRD * HA(13)=(HA(08)*HA(03)-HA(09)*HA(02))/GSQRD * HA(14)=(HA(09)*HA(01)-HA(07)*HA(03))/GSQRD * HA(15)=(HA(07)*HA(02)-HA(06)*HA(01))/GSQRD * ELSE C Cartesian coordinates: AUX=SQRT(YA(6)*YA(6)+YA(7)*YA(7)+YA(8)*YA(8)) HA(07)=YA(6)/AUX HA(08)=YA(7)/AUX HA(09)=YA(8)/AUX HA(10)=HA(01) HA(11)=HA(02) HA(12)=HA(03) HA(16)=HA(07) HA(17)=HA(08) HA(18)=HA(09) HA(04)=HA(17)*HA(12)-HA(18)*HA(11) HA(05)=HA(18)*HA(10)-HA(16)*HA(12) HA(06)=HA(16)*HA(11)-HA(17)*HA(10) HA(13)=HA(04) HA(14)=HA(05) HA(15)=HA(06) * END IF RETURN END C C======================================================================= C C C SUBROUTINE AP05(IUSER,HUI,Q11,Q21,Q12,Q22) INTEGER IUSER REAL HUI(5),Q11,Q21,Q12,Q22 C C This subroutine evaluates the components of the matrix of geometrical C spreading at a point situated on a ray, see C.R.T.7.5. C C Input: C IUSER...IUSER=0... Intrinsic choice of polarization vectors. C Any other input need not be specified. C Otherwise, user's choice of polarization vectors at the C initial point O/O of the ray. C HUI(1:9) has to be specified. C HUI(1),HUI(2),HUI(4),HUI(5)... Components HUI11,HUI21,HUI12,HUI22 C of the 2*2 transformation matrix from the intrinsic to the C user's ray-centred coordinate system. C C Output: C Q11,Q21,Q12,Q22... Components of the matrix of geometrical C spreading in the user's ray-centred coordinate system at C the point O/S read into the common block /POINTC/ by the C last invocation of the subroutine AP00. C C Common block /POINTC/: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C No subroutines and external functions required. C C Date: 1994, January 23 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C REAL AUX C Q11=Y(12)*YI(12)+Y(16)*YI(13)+Y(20)*YI(14)+Y(24)*YI(15) Q21=Y(13)*YI(12)+Y(17)*YI(13)+Y(21)*YI(14)+Y(25)*YI(15) Q12=Y(12)*YI(16)+Y(16)*YI(17)+Y(20)*YI(18)+Y(24)*YI(19) Q22=Y(13)*YI(16)+Y(17)*YI(17)+Y(21)*YI(18)+Y(25)*YI(19) IF(IUSER.NE.0) THEN AUX=Q11 Q11=HUI(1)*AUX+HUI(4)*Q21 Q21=HUI(2)*AUX+HUI(5)*Q21 AUX=Q12 Q12=HUI(1)*AUX+HUI(4)*Q22 Q22=HUI(2)*AUX+HUI(5)*Q22 END IF RETURN END C C======================================================================= C C C SUBROUTINE AP06(IUSER,HUI,P11,P21,P12,P22) INTEGER IUSER REAL HUI(5),P11,P21,P12,P22 C C This subroutine evaluates the components of the transformation matrix C P at a point situated on a ray, see C.R.T.7.6. C C Input: C IUSER...IUSER=0... Intrinsic choice of polarization vectors. C Any other input need not be specified. C Otherwise, user's choice of polarization vectors at the C initial point O/O of the ray. C HUI(1:9) has to be specified. C HUI(1),HUI(2),HUI(4),HUI(5)... Components HUI11,HUI21,HUI12,HUI22 C of the 2*2 transformation matrix from the intrinsic to the C user's ray-centred coordinate system. C C Output: C P11,P21,P12,P22... Components of the transformation matrix P from C ray coordinates to the user's ray-centred components of C the slowness vector at the point O/S read into the common C block /POINTC/ by the last invocation of the subroutine C AP00. C C Common block /POINTC/: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C No subroutines and external functions required. C C Date: 1994, January 23 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C REAL AUX C P11=Y(14)*YI(12)+Y(18)*YI(13)+Y(22)*YI(14)+Y(26)*YI(15) P21=Y(15)*YI(12)+Y(19)*YI(13)+Y(23)*YI(14)+Y(27)*YI(15) P12=Y(14)*YI(16)+Y(18)*YI(17)+Y(22)*YI(18)+Y(26)*YI(19) P22=Y(15)*YI(16)+Y(19)*YI(17)+Y(23)*YI(18)+Y(27)*YI(19) IF(IUSER.NE.0) THEN AUX=P11 P11=HUI(1)*AUX+HUI(4)*P21 P21=HUI(2)*AUX+HUI(5)*P21 AUX=P12 P12=HUI(1)*AUX+HUI(4)*P22 P22=HUI(2)*AUX+HUI(5)*P22 END IF RETURN END C C======================================================================= C C C SUBROUTINE AP07(QDETI,QDET,VI,V,RHOI,RHO,INIDIM) REAL QDETI,QDET,VI,V,RHOI,RHO INTEGER INIDIM C C This subroutine evaluates the geometrical spreading at a point C situated on a ray, see C.R.T.7.7. C C No input. C C Output: C QDETI.. For a regular surface source, geometrical spreading at the C initial point O/O of the ray. C For a line source, geometrical spreading at the distance C epsilon from the initial point O/O, measured along the C ray, divided by the square root from distance epsilon C (limit for epsilon approaching zero from the right). C For a point source, geometrical spreading at the distance C epsilon from the initial point O/O, divided by distance C epsilon (limit for epsilon approaching zero from the C right). Refer to equation (7.47) divided by equation C (7.49) in C.R.T.7.15. C QDET... Geometrical spreading at the point O/S read into common C block /POINTC/ by the last invocation of subroutine AP00. C VI... Velocity at the initial point O/O of the ray. C V... Velocity at the point O/S read into common block /POINTC/ C by the last invocation of subroutine AP00. C RHOI... Density at the initial point O/O of the ray. C RHO... Density at the point O/S read into common block /POINTC/ C by the last invocation of subroutine AP00. C INIDIM..0: Point source C 1: Line source C 2: Regular surface source C C Common block /POINTC/: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C Subroutines and external functions required: EXTERNAL AP05 C AP05... This file. C C Date: 1995, August 11 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C REAL DUMMY(5),Q11,Q21,Q12,Q22 C C Velocities and densities: VI=1./SQRT(YI(6)**2+YI(7)**2+YI(8)**2) V =1./SQRT(Y (6)**2+Y (7)**2+Y (8)**2) RHOI=YLI(3) RHO =YL (3) C C Geometrical spreading at the initial point: IF(YI(12).EQ.0..AND.YI(13).EQ.0..AND. * YI(16).EQ.0..AND.YI(17).EQ.0.) THEN C Point source INIDIM=0 QDETI=ABS((YI(14)*YI(19)-YI(15)*YI(18)))*VI*VI ELSE C Surface source INIDIM=2 QDETI=ABS(YI(12)*YI(17)-YI(13)*YI(16)) IF(QDETI.LT.0.000001*ABS(YI(12)*YI(17))) THEN C Line source INIDIM=1 QDETI=ABS((YI(12)*YI(19)-YI(13)*YI(18) * +YI(14)*YI(17)-YI(15)*YI(16)))*VI END IF END IF C C Geometrical spreading at the ray point: CALL AP05(0,DUMMY,Q11,Q21,Q12,Q22) QDET=ABS(Q11*Q22-Q12*Q21) RETURN END C C======================================================================= C C C SUBROUTINE AP08(IUSER,H,HUI,RM,RN) INTEGER IUSER REAL H(9),HUI(9),RM(6),RN(6) C C This subroutine evaluates the components of the symmetric 3*3 matrices C M and N of second derivatives of the travel-time field at a point C situated on a ray, see C.R.T.7.8. Subroutine AP03 should be called C before the invocation of AP08 to define input arguments H and HUI, see C below. C C Input: C IUSER...IUSER=0... Intrinsic choice of polarization vectors. C HUI(1:9) need not be specified. C Otherwise, user's choice of polarization vectors at the C initial point O/O of the ray. C HUI(1:9) has to be specified. C H... Covariant components of the basis vectors of the user's C ray-centred coordinate system at the point O/S read into C the common block /POINTC/ by the last invocation of the C subroutine AP00. C HUI... Components of the 3*3 transformation matrix from the C intrinsic to the user's ray-centred coordinate system. C C Output: C RM... Components M11,M12,M22,M13,M23,M33 of the second covariant C derivatives of the travel-time field in the user's C ray-centred coordinate system, at the point O/S read into C the common block /POINTC/ by the last invocation of the C subroutine AP00. C RN... Components N11,N12,N22,N13,N23,N33 of the second partial C derivatives of the travel-time field in the general model C coordinates, at the point O/S read into the common block C /POINTC/ by the last invocation of the subroutine AP00. C C Common block /POINTC/: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C Subroutines and external functions required: * INTEGER KOOR * EXTERNAL KOOR,METRIC C KOOR,METRIC... File 'metric.for' of the package 'MODEL'. C C Date: 1997, October 25 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Auxiliary storage locations for local model parameters: FAUX(10), C G(12),GAMMA(18),GSQRD, UP(10),US(10),RO,QP,QS, VP,VS,VD(10),QL: INCLUDE 'auxmod.inc' C auxmod.inc C C....................................................................... C REAL QDET,Q11,Q21,Q12,Q22,P11,P21,P12,P22 REAL RM1,RM2,RM3,AUX1,AUX2,AUX3 C C Matrix M in the intrinsic R.C.C.S. CALL AP05(0,HUI,Q11,Q21,Q12,Q22) CALL AP06(0,HUI,P11,P21,P12,P22) QDET=Q11*Q22-Q12*Q21 IF(QDET.EQ.0.) THEN QDET=1.0E-12*(Q11+Q22)**2 END IF RM(1)=( P11*Q22-P12*Q21)/QDET RM(2)=( P21*Q22-P22*Q21)/QDET RM(3)=(-P21*Q12+P22*Q11)/QDET IF(ICB1.GE.0) THEN AUX2=YL(1)**2 ELSE AUX2=YL(2)**2 END IF C Slowness gradient in R.C.C.S. RM(4)=-(H(1)*YL(4)+H(2)*YL(5)+H(3)*YL(6))/AUX2 RM(5)=-(H(4)*YL(4)+H(5)*YL(5)+H(6)*YL(6))/AUX2 RM(6)=-(H(7)*YL(4)+H(8)*YL(5)+H(9)*YL(6))/AUX2 C IF(IUSER.NE.0) THEN AUX1=RM(1)*HUI(1)+RM(2)*HUI(4)+RM(4)*HUI(7) AUX2=RM(2)*HUI(1)+RM(3)*HUI(4)+RM(5)*HUI(7) AUX3=RM(4)*HUI(1)+RM(5)*HUI(4)+RM(6)*HUI(7) RM1 =HUI(1)*AUX1+HUI(4)*AUX2+HUI(7)*AUX3 AUX1=RM(1)*HUI(2)+RM(2)*HUI(5)+RM(4)*HUI(8) AUX2=RM(2)*HUI(2)+RM(3)*HUI(5)+RM(5)*HUI(8) AUX3=RM(4)*HUI(2)+RM(5)*HUI(5)+RM(6)*HUI(8) RM2 =HUI(1)*AUX1+HUI(4)*AUX2+HUI(7)*AUX3 RM3 =HUI(2)*AUX1+HUI(5)*AUX2+HUI(8)*AUX3 AUX1=RM(1)*HUI(3)+RM(2)*HUI(6)+RM(4)*HUI(9) AUX2=RM(2)*HUI(3)+RM(3)*HUI(6)+RM(5)*HUI(9) AUX3=RM(4)*HUI(3)+RM(5)*HUI(6)+RM(6)*HUI(9) RM(4)=HUI(1)*AUX1+HUI(4)*AUX2+HUI(7)*AUX3 RM(5)=HUI(2)*AUX1+HUI(5)*AUX2+HUI(8)*AUX3 RM(6)=HUI(3)*AUX1+HUI(6)*AUX2+HUI(9)*AUX3 RM(1)=RM1 RM(2)=RM2 RM(3)=RM3 END IF AUX1=RM(1)*H(1)+RM(2)*H(4)+RM(4)*H(7) AUX2=RM(2)*H(1)+RM(3)*H(4)+RM(5)*H(7) AUX3=RM(4)*H(1)+RM(5)*H(4)+RM(6)*H(7) RN(1)=H(1)*AUX1+H(4)*AUX2+H(7)*AUX3 AUX1=RM(1)*H(2)+RM(2)*H(5)+RM(4)*H(8) AUX2=RM(2)*H(2)+RM(3)*H(5)+RM(5)*H(8) AUX3=RM(4)*H(2)+RM(5)*H(5)+RM(6)*H(8) RN(2)=H(1)*AUX1+H(4)*AUX2+H(7)*AUX3 RN(3)=H(2)*AUX1+H(5)*AUX2+H(8)*AUX3 AUX1=RM(1)*H(3)+RM(2)*H(6)+RM(4)*H(9) AUX2=RM(2)*H(3)+RM(3)*H(6)+RM(5)*H(9) AUX3=RM(4)*H(3)+RM(5)*H(6)+RM(6)*H(9) RN(4)=H(1)*AUX1+H(4)*AUX2+H(7)*AUX3 RN(5)=H(2)*AUX1+H(5)*AUX2+H(8)*AUX3 RN(6)=H(3)*AUX1+H(6)*AUX2+H(9)*AUX3 * IF(KOOR().NE.0) THEN C curvilinear coordinates: * CALL METRIC(Y(3),GSQRD,G,GAMMA) * RN(1)=RN(1)+GAMMA(1)*Y(6)+GAMMA( 7)*Y(6)+GAMMA(13)*Y(8) * RN(2)=RN(2)+GAMMA(2)*Y(6)+GAMMA( 8)*Y(6)+GAMMA(14)*Y(8) * RN(3)=RN(3)+GAMMA(3)*Y(6)+GAMMA( 9)*Y(6)+GAMMA(15)*Y(8) * RN(4)=RN(4)+GAMMA(4)*Y(6)+GAMMA(10)*Y(6)+GAMMA(16)*Y(8) * RN(5)=RN(5)+GAMMA(5)*Y(6)+GAMMA(11)*Y(6)+GAMMA(17)*Y(8) * RN(6)=RN(6)+GAMMA(6)*Y(6)+GAMMA(12)*Y(6)+GAMMA(18)*Y(8) * END IF RETURN END C C======================================================================= C C C SUBROUTINE AP11(IUSER,HUI,DPAR1,DPAR2,DQ1,DQ2,DP1,DP2) INTEGER IUSER REAL HUI(5),DPAR1,DPAR2,DQ1,DQ2,DP1,DP2 C C Subroutine designed to evaluate two ray-centred coordinates of a given C paraxial ray, see C.R.T.7.11. C C Input: C IUSER...IUSER=0... Intrinsic choice of polarization vectors. C Any other input need not be specified. C Otherwise, user's choice of polarization vectors at the C initial point O/O of the ray. C HUI(1:9) has to be specified. C HUI(1),HUI(2),HUI(4),HUI(5)... Components HUI11,HUI21,HUI12,HUI22 C of the 2*2 transformation matrix from the intrinsic to the C user's ray-centred coordinate system. C DPAR1,DPAR2... Increment in take-off ray parameters of a paraxial C ray. C C Output: C DQ1,DQ2... Ray-centred coordinates of a point of the paraxial ray. C DP1,DP2... Ray-centred components of the slowness vector the C paraxial ray. C C Subroutines and external functions required: EXTERNAL AP05,AP06 C AP05... This file. C AP06... This file. C C Date: 1995, August 11 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C REAL Q11,Q21,Q12,Q22,P11,P21,P12,P22 C CALL AP05(IUSER,HUI,Q11,Q21,Q12,Q22) CALL AP06(IUSER,HUI,P11,P21,P12,P22) DQ1=Q11*DPAR1+Q12*DPAR2 DQ2=Q21*DPAR1+Q22*DPAR2 DP1=P11*DPAR1+P12*DPAR2 DP2=P21*DPAR1+P22*DPAR2 C RETURN END C C======================================================================= C C C SUBROUTINE AP15(IUSER,HI,H,HUI,ZI,Z,AMPLI,AMPL) INTEGER IUSER REAL HI(18),H(18),HUI(9),ZI(9),Z(9),AMPLI(6),AMPL(6) C C This subroutine evaluates the ray amplitudes at a point situated on a C ray, see C.R.T.7.15. Subroutine AP03 should be called before the C invocation of AP15 to define the input arguments HI and H, see below. C C Input: C IUSER...IUSER=0... Intrinsic choice of polarization vectors. C HUI(1:9) need not be specified. C Otherwise, user's choice of polarization vectors at the C initial point O/O of the ray. C HUI(1:9) has to be specified. C HI... Covariant (HI(1:9)) and contravariant (HI(10:18)) C components of the basis vectors of the user's ray-centred C coordinate system at the initial point O/O of a ray. C H... Covariant (H(1:9)) and contravariant (H(10:18)) components C of the basis vectors of the user's ray-centred coordinate C system at the point O/S read into the common block C /POINTC/ by the last invocation of the subroutine AP00. C HUI... Components of the 3*3 transformation matrix from the C intrinsic to the user's ray-centred coordinate system. C ZI... Contravariant components of the basis vectors of the local C coordinate system at the initial point O/O of a ray. C See C.R.T.7.15, eq.(7.44). C Z... Contravariant components of the basis vectors of the local C recording coordinate system at the point O/S read into the C common block /POINTC/ by the last invocation of the C subroutine AP00. See C.R.T.7.15, eq.(7.43). C AMPLI...Components Re(A1),Im(A1),Re(A2),Im(A2),Re(A3),Im(A3) of C the ray amplitude in the local coordinate system C multiplied by the square root of the geometrical C spreading, at the initial point O/O of a ray. C See C.R.T.7.15, eq.(7.47). C C Output: C AMPL... Components Re(A1),Im(A1),Re(A2),Im(A2),Re(A3),Im(A3) of C the ray amplitude in the local recording coordinate system C at the point O/S read into the common block /POINTC/ by C the last invocation of the subroutine AP00. C See C.R.T.7.15, eq.(7.45). C C Common block /POINTC/: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C Subroutines and external functions required: EXTERNAL AP07 C AP05... This file. C AP07... This file. C C Date: 1996, September 30 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C INTEGER INIDIM,I REAL QDETI,QDET,VI,V,RHOI,RHO REAL AUX01,AUX02,AUX03,AUX04,AUX05,AUX06,AUX07,AUX08,AUX09,AUX10 REAL AUX11,AUX12,AUX13,AUX14,AUX15,AUX16,AUX17,AUX18,AUX19,SCALAR C IF(IUSER.NE.0) THEN C 715 PAUSE'Error 715 in AP15: User''s choice of R.C.C.S. not allowed' STOP C Nonzero input parameter IUSER of the subroutine AP15 indicates C user's choice of polarization vectors. This option has not been C included in this subroutine yet. Subroutine AP03 should be C called before the invocation of AP15 with IUSER=0. END IF C C Scalar multiplication factor in eq.(7.45) CALL AP07(QDETI,QDET,VI,V,RHOI,RHO,INIDIM) SCALAR=YLI(3)/(YL(3)*QDET) IF(ICB1.GT.0) THEN C P-wave SCALAR=SCALAR/YL(1) ELSE C S-wave SCALAR=SCALAR/YL(2) END IF C Note: The square root and velocity at the initial point of the ray C will be applied later on. C C Transposed inverse matrix to Z multiplied by its determinant AUX01=Z(5)*Z(9)-Z(6)*Z(8) AUX02=Z(6)*Z(7)-Z(4)*Z(9) AUX03=Z(4)*Z(8)-Z(5)*Z(7) AUX04=Z(3)*Z(8)-Z(2)*Z(9) AUX05=Z(1)*Z(9)-Z(3)*Z(7) AUX06=Z(2)*Z(7)-Z(1)*Z(8) AUX07=Z(2)*Z(6)-Z(3)*Z(5) AUX08=Z(3)*Z(4)-Z(1)*Z(6) AUX09=Z(1)*Z(5)-Z(2)*Z(4) AUX10=Z(1)*AUX01+Z(2)*AUX02+Z(3)*AUX03 C C Transformation matrix from R.C.C.S. to the local recording C coordinate system Z IF(ICB1.GT.0.OR.NY.EQ.33.OR.NY.EQ.39) THEN C P-wave or interface conversion coefficients applied AUX17=AUX01*H(16)+AUX04*H(17)+AUX07*H(18) AUX18=AUX02*H(16)+AUX05*H(17)+AUX08*H(18) AUX19=AUX03*H(16)+AUX06*H(17)+AUX09*H(18) END IF IF(ICB1.LT.0.OR.NY.EQ.33.OR.NY.EQ.39) THEN C S-wave or interface conversion coefficients applied AUX11=AUX01*H(10)+AUX04*H(11)+AUX07*H(12) AUX12=AUX02*H(10)+AUX05*H(11)+AUX08*H(12) AUX13=AUX03*H(10)+AUX06*H(11)+AUX09*H(12) AUX14=AUX01*H(13)+AUX04*H(14)+AUX07*H(15) AUX15=AUX02*H(13)+AUX05*H(14)+AUX08*H(15) AUX16=AUX03*H(13)+AUX06*H(14)+AUX09*H(15) END IF C IF(ICB1I.GT.0) THEN C P-wave at the initial point: SCALAR=SQRT(SCALAR*YLI(1))/AUX10 C Matrix ZI in R.C.C.S. AUX01=HI(16)*ZI(1)+HI(17)*ZI(2)+HI(18)*ZI(3) AUX02=HI(16)*ZI(4)+HI(17)*ZI(5)+HI(18)*ZI(6) AUX03=HI(16)*ZI(7)+HI(17)*ZI(8)+HI(18)*ZI(9) C AMPLI in R.C.C.S. multiplied by scalar AUX07=SCALAR*(AUX01*AMPLI(1)+AUX02*AMPLI(3)+AUX03*AMPLI(5)) AUX08=SCALAR*(AUX01*AMPLI(2)+AUX02*AMPLI(4)+AUX03*AMPLI(6)) C AMPL in R.C.C.S. AUX01=Y(28)*AUX07-Y(29)*AUX08 AUX02=Y(29)*AUX07+Y(28)*AUX08 IF(NY.GT.29) THEN C P-wave to S-wave or interface conversion coefficients applied AUX03=Y(30)*AUX07-Y(31)*AUX08 AUX04=Y(31)*AUX07+Y(30)*AUX08 IF(NY.GT.31) THEN C Interface conversion coefficients applied AUX05=Y(32)*AUX07-Y(33)*AUX08 AUX06=Y(33)*AUX07+Y(32)*AUX08 END IF END IF ELSE C S-wave at the initial point: SCALAR=SQRT(SCALAR*YLI(2))/AUX10 C Matrix ZI in R.C.C.S. AUX01=HI(10)*ZI(1)+HI(11)*ZI(2)+HI(12)*ZI(3) AUX02=HI(10)*ZI(4)+HI(11)*ZI(5)+HI(12)*ZI(6) AUX03=HI(10)*ZI(7)+HI(11)*ZI(8)+HI(12)*ZI(9) AUX04=HI(13)*ZI(1)+HI(14)*ZI(2)+HI(15)*ZI(3) AUX05=HI(13)*ZI(4)+HI(14)*ZI(5)+HI(15)*ZI(6) AUX06=HI(13)*ZI(7)+HI(14)*ZI(8)+HI(15)*ZI(9) C AMPLI in R.C.C.S. Multiplied by scalar AUX07=SCALAR*(AUX01*AMPLI(1)+AUX02*AMPLI(3)+AUX03*AMPLI(5)) AUX08=SCALAR*(AUX01*AMPLI(2)+AUX02*AMPLI(4)+AUX03*AMPLI(6)) AUX09=SCALAR*(AUX04*AMPLI(1)+AUX05*AMPLI(3)+AUX06*AMPLI(5)) AUX10=SCALAR*(AUX04*AMPLI(2)+AUX05*AMPLI(4)+AUX06*AMPLI(6)) C AMPL in R.C.C.S. I=(NY+27)/2 AUX01=Y(28)*AUX07-Y(29)*AUX08+Y(I+1)*AUX09-Y(I+2)*AUX10 AUX02=Y(29)*AUX07+Y(28)*AUX08+Y(I+2)*AUX09+Y(I+1)*AUX10 IF(NY.GT.31) THEN C S-wave to S-wave or interface conversion coefficients applied AUX03=Y(30)*AUX07-Y(31)*AUX08+Y(I+3)*AUX09-Y(I+4)*AUX10 AUX04=Y(31)*AUX07+Y(30)*AUX08+Y(I+4)*AUX09-Y(I+3)*AUX10 IF(NY.GT.35) THEN C Interface conversion coefficients applied AUX05=Y(32)*AUX07-Y(33)*AUX08+Y(38)*AUX09-Y(39)*AUX10 AUX06=Y(33)*AUX07+Y(32)*AUX08+Y(39)*AUX09-Y(38)*AUX10 END IF END IF END IF C C AMPL in the local recording coordinate system Z IF(NY.EQ.33.OR.NY.EQ.39) THEN C Interface conversion coefficients applied AMPL(1)=AUX11*AUX01+AUX14*AUX03+AUX17*AUX05 AMPL(2)=AUX11*AUX02+AUX14*AUX04+AUX17*AUX06 AMPL(3)=AUX12*AUX01+AUX15*AUX03+AUX18*AUX05 AMPL(4)=AUX12*AUX02+AUX15*AUX04+AUX18*AUX06 AMPL(5)=AUX13*AUX01+AUX16*AUX03+AUX19*AUX05 AMPL(6)=AUX13*AUX02+AUX16*AUX04+AUX19*AUX06 ELSE IF(ICB1.GT.0) THEN C P-wave AMPL(1)=AUX17*AUX01 AMPL(2)=AUX17*AUX02 AMPL(3)=AUX18*AUX01 AMPL(4)=AUX18*AUX02 AMPL(5)=AUX19*AUX01 AMPL(6)=AUX19*AUX02 ELSE C S-wave AMPL(1)=AUX11*AUX01+AUX14*AUX03 AMPL(2)=AUX11*AUX02+AUX14*AUX04 AMPL(3)=AUX12*AUX01+AUX15*AUX03 AMPL(4)=AUX12*AUX02+AUX15*AUX04 AMPL(5)=AUX13*AUX01+AUX16*AUX03 AMPL(6)=AUX13*AUX02+AUX16*AUX04 END IF RETURN END C C======================================================================= C C C SUBROUTINE AP21(GREEN) REAL GREEN(32) C C This subroutine evaluates the ray-theory elastodynamic Green function c according to C.R.T.7.21. C C Attention: C This subroutine should be applied only to the rays starting from C common initial point (point source). Otherwise, the phase shift C due to caustics would be incorrect. C C No input. C C Output: C GREEN(1)... Travel time between receiver and source. C GREEN(2)... Imaginary part of the complex-valued travel time C between receiver and source due to attenuation. C GREEN(3:8)... Coordinates of the receiver and coordinates of the C source. C GREEN(9:14)... Derivatives of the travel time with respect to the C coordinates of the receiver and coordinates of the source. C GREEN(15:32)... Amplitude of the Green function: contravariant C components of the complex-valued 3*3 matrix Gij in model C coordinates, where the first subscript corresponds to the C receiver and the second subscript corresponds to the C source. The components are ordered as C Re(G11),Im(G11),Re(G21),Im(G21),Re(G31),Im(G31), C Re(G12),Im(G12),Re(G22),Im(G22),Re(G32),Im(G32), C Re(G13),Im(G13),Re(G23),Im(G23),Re(G33),Im(G33). C C Common block /POINTC/: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C Subroutines and external functions required: EXTERNAL AP03 C AP03,AP03A...This file. C KOOR,METRIC... File 'metric.for' of the package 'MODEL'. C SMVPRD..File 'means.for' of the package 'MODEL'. C C Date: 1997, September 30 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C REAL VI,V,RHOI,RHO,DETQ2,A,HI(18),H(18),HUI(9),AUX1,AUX2,AUX3 REAL AR11,AR21,AR31,AR12,AR22,AR32,AR13,AR23,AR33 REAL AI11,AI21,AI31,AI12,AI22,AI32,AI13,AI23,AI33 C GREEN( 1)=Y(1)-YI(1) GREEN( 2)=Y(2)-YI(2) GREEN( 3)= Y (3) GREEN( 4)= Y (4) GREEN( 5)= Y (5) GREEN( 6)= YI(3) GREEN( 7)= YI(4) GREEN( 8)= YI(5) GREEN( 9)= Y (6) GREEN(10)= Y (7) GREEN(11)= Y (8) GREEN(12)=-YI(6) GREEN(13)=-YI(7) GREEN(14)=-YI(8) C C Velocities, densities, reciprocal geometrical spreading: VI=1./SQRT(YI(6)**2+YI(7)**2+YI(8)**2) V =1./SQRT(Y (6)**2+Y (7)**2+Y (8)**2) RHOI=YLI(3) RHO =YL (3) DETQ2=ABS(Y(20)*Y(25)-Y(21)*Y(24)) C C Scalar multiplication factor (7.71): A=1./12.56637/SQRT(VI*RHOI*V*RHO*DETQ2) C C Amplitude of the Green function in R.C.C.S., see 5.2.1 and 5.4.4: AR11=0. AI11=0. AR21=0. AI21=0. AR31=0. AI31=0. AR12=0. AI12=0. AR22=0. AI22=0. AR32=0. AI32=0. AR13=0. AI13=0. AR23=0. AI23=0. AR33=0. AI33=0. IF(NY.EQ.29.AND.ICB1I.GT.0.AND.ICB1.GT.0) THEN AR33=A*Y(28) AI33=A*Y(29) ELSE IF(NY.EQ.31) THEN IF(ICB1I.GT.0.AND.ICB1.LT.0) THEN AR13=A*Y(28) AI13=A*Y(29) AR23=A*Y(30) AI23=A*Y(31) ELSE IF(ICB1I.LT.0.AND.ICB1.GT.0) THEN AR31=A*Y(28) AI31=A*Y(29) AR32=A*Y(30) AI32=A*Y(31) END IF ELSE IF(NY.EQ.35.AND.ICB1I.LT.0.AND.ICB1.LT.0) THEN AR11=A*Y(28) AI11=A*Y(29) AR21=A*Y(30) AI21=A*Y(31) AR12=A*Y(32) AI12=A*Y(33) AR22=A*Y(34) AI22=A*Y(35) ELSE IF(NY.EQ.33.AND.ICB1I.GT.0) THEN AR13=A*Y(28) AI13=A*Y(29) AR23=A*Y(30) AI23=A*Y(31) AR33=A*Y(32) AI33=A*Y(33) ELSE IF(NY.EQ.39.AND.ICB1I.LT.0) THEN AR11=A*Y(28) AI11=A*Y(29) AR21=A*Y(30) AI21=A*Y(31) AR31=A*Y(32) AI31=A*Y(33) AR12=A*Y(34) AI12=A*Y(35) AR22=A*Y(36) AI22=A*Y(37) AR32=A*Y(38) AI32=A*Y(39) END IF C C Basis of R.C.C.S.: CALL AP03(0,HI,H,HUI) C Contravariant components of the basis vectors: HI(10:18),H(10:18). C C Contravariant components of the amplitude of the Green function: AUX1=AR11*HI(10)+AR12*HI(13)+AR13*HI(16) AUX2=AR21*HI(10)+AR22*HI(13)+AR23*HI(16) AUX3=AR31*HI(10)+AR32*HI(13)+AR33*HI(16) GREEN(15)=H(10)*AUX1+H(13)*AUX2+H(16)*AUX3 GREEN(17)=H(11)*AUX1+H(14)*AUX2+H(17)*AUX3 GREEN(19)=H(12)*AUX1+H(15)*AUX2+H(18)*AUX3 AUX1=AI11*HI(10)+AI12*HI(13)+AI13*HI(16) AUX2=AI21*HI(10)+AI22*HI(13)+AI23*HI(16) AUX3=AI31*HI(10)+AI32*HI(13)+AI33*HI(16) GREEN(16)=H(10)*AUX1+H(13)*AUX2+H(16)*AUX3 GREEN(18)=H(11)*AUX1+H(14)*AUX2+H(17)*AUX3 GREEN(20)=H(12)*AUX1+H(15)*AUX2+H(18)*AUX3 AUX1=AR11*HI(11)+AR12*HI(14)+AR13*HI(17) AUX2=AR21*HI(11)+AR22*HI(14)+AR23*HI(17) AUX3=AR31*HI(11)+AR32*HI(14)+AR33*HI(17) GREEN(21)=H(10)*AUX1+H(13)*AUX2+H(16)*AUX3 GREEN(23)=H(11)*AUX1+H(14)*AUX2+H(17)*AUX3 GREEN(25)=H(12)*AUX1+H(15)*AUX2+H(18)*AUX3 AUX1=AI11*HI(11)+AI12*HI(14)+AI13*HI(17) AUX2=AI21*HI(11)+AI22*HI(14)+AI23*HI(17) AUX3=AI31*HI(11)+AI32*HI(14)+AI33*HI(17) GREEN(22)=H(10)*AUX1+H(13)*AUX2+H(16)*AUX3 GREEN(24)=H(11)*AUX1+H(14)*AUX2+H(17)*AUX3 GREEN(26)=H(12)*AUX1+H(15)*AUX2+H(18)*AUX3 AUX1=AR11*HI(12)+AR12*HI(15)+AR13*HI(18) AUX2=AR21*HI(12)+AR22*HI(15)+AR23*HI(18) AUX3=AR31*HI(12)+AR32*HI(15)+AR33*HI(18) GREEN(27)=H(10)*AUX1+H(13)*AUX2+H(16)*AUX3 GREEN(29)=H(11)*AUX1+H(14)*AUX2+H(17)*AUX3 GREEN(31)=H(12)*AUX1+H(15)*AUX2+H(18)*AUX3 AUX1=AI11*HI(12)+AI12*HI(15)+AI13*HI(18) AUX2=AI21*HI(12)+AI22*HI(15)+AI23*HI(18) AUX3=AI31*HI(12)+AI32*HI(15)+AI33*HI(18) GREEN(28)=H(10)*AUX1+H(13)*AUX2+H(16)*AUX3 GREEN(30)=H(11)*AUX1+H(14)*AUX2+H(17)*AUX3 GREEN(32)=H(12)*AUX1+H(15)*AUX2+H(18)*AUX3 C RETURN END C C======================================================================= Capvar.for 100666 1750 1750 47126 6425373367 12027 0 ustar klimes klimes C
C Subroutine file 'apvar.for': Applications and processing of the C results of complete ray tracing --- Part2: Travel-time variations C C By Ludek Klimes C C This file consists of the following external procedures: C AP28... Subroutine designed to perform the numerical quadrature of C the set of given functions along a ray. It has to be C called once at each point along the ray in which the C computed quantities are stored, i.e. after each invocation C of the subroutine AP00 which reads the quantities into the C common block /POINTC/. C AP28 C AP29... Subroutine designed to evaluate the variations of the C travel time with respect to the model coefficients. C It has to be called once at each point along the ray at C which the computed quantities are stored, i.e. after each C invocation of the subroutine AP00 which reads the C quantities into the common block /POINTC/. C AP29 C AP29A...Auxiliary subroutine to AP29. C AP29A C C Date: 1994, January 15 C Coded by Ludek Klimes C C======================================================================= C C C SUBROUTINE AP28(NSUM,SUM,IX,NDER,STEP, * NFUN1,IFUN1,FUN1,NFUN2,IFUN2,FUN2) INTEGER NSUM,IX,NDER,NFUN1,IFUN1(*),NFUN2,IFUN2(NFUN2) REAL SUM(NSUM),STEP,FUN1(*),FUN2(NFUN2*NDER) C C This subroutine performs the numerical quadrature of the set of given C functions along a whole ray. It has to be called once at each point C along the ray in which the computed quantities are stored, i.e. after C each invocation of the subroutine AP00 which reads the quantities into C the common block /POINTC/. C C Input: C NSUM... Total number of the functions to be numerically integrated C along the ray. C SUM... Array of dimension at least NSUM, in which the integrals C of the given functions are accumulated. Its elements are C set to zeros at the initial point of the ray by this C subroutine. C IX... Specifies the independent variable along the ray: C IX=0 independent variable is X, i.e. the same as for the C ray tracing. C IX=1 independent variable is the travel time. C NDER... NDER=1 if just the functional values of the integrated C functions are submitted. Then the relative error of the C numerical quadrature is proportional to the third power C of the step along the ray (see the parameter store in C the input data (3) for the file 'ray.for'). C When integrating a B-spline in a regular grid, the error C is about 0.01 for the step of half the size of the grid C interval. C NDER=2 if both the functional values and first derivatives C of the integrated functions are submitted. Then the C relative error of the numerical quadrature is C proportional to the fourth power of the step along the C ray (see the parameter STORE in the input data (3) for C the file 'ray.for'). C When integrating a B-spline in a regular grid, the error C is about 0.01 for the step of the size of the grid C interval. C STEP... Step in the independent variable along the ray (see the C parameter STORE in the input data (3) for the file C 'ray.for'). Required just if NDER=1. If NDER=1 and STEP C has not the correct value, the relative error of the C numerical quadrature is proportional to the second power C of the actual step along the ray. When integrating a C B-spline with NDER=1 and STEP=0, in a regular grid, the C error is about 0.01 for the step of the size of 0.4 grid C interval. C NFUN1...Number of functions having nonzero values (or nonzero C first derivatives if NDER=2) at the previous point along C the ray. C IFUN1...IFUN(1:NFUN1)... Indices in the array SUM corresponding to C the functions having nonzero values (or nonzero first C derivatives if NDER=2) at the previous point along the C ray. C FUN1... FUN(1:NFUN1)... Values of the functions having nonzero C values (or nonzero first derivatives if NDER=2) at the C previous point along the ray. C FUN(NFUN1+1:2*NFUN1)... For NDER=2, first derivatives with C respect to the independent variable along the ray at the C previous point along the ray, of the functions having C nonzero values or nonzero first derivatives. C If this subroutine is invoked at the first point after the C initial point of the ray, the input values of NFUN1, IFUN C and FUN1 correspond to the initial (zero) point of the C ray. At the subsequent points along the ray, the input C values of NFUN1, IFUN and FUN1 are the output from the C previous invocation of this subroutine. C NFUN2...Number of functions having nonzero values (or nonzero C first derivatives if NDER=2) at the current point along C the ray. C IFUN2...Indices in the array SUM corresponding to the functions C having nonzero values (or nonzero first derivatives if C NDER=2) at the current point along the ray. C FUN2... FUN(1:NFUN2)... Values of the functions having nonzero C values (or nonzero first derivatives if NDER=2) at the C current point along the ray. C FUN(NFUN2+1:2*NFUN2)... For NDER=2, first derivatives with C respect to the independent variable along the ray at the C previous point along the ray, of the functions having C nonzero values or nonzero first derivatives. C C Output: C SUM... Integrals of the given functions with respect to the C independent variable along the ray, from the initial point C of the ray to the current point along the ray (stored in C the common block /POINTC/). C NFUN1,IFUN1,FUN1... Copies of the input values of NFUN2, IFUN2 and C FUN2. C C Common block /POINTC/: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C No subroutines and external functions required. C C Date: 1994, January 23 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Auxiliary storage locations: C REAL X1,X2,W1,W2 INTEGER ISRF1,ISRF2,ISUM,I SAVE X1,ISRF1 C C X1... Independent variable along the ray at the previous point. C X2... Independent variable along the ray at the current point. C ISRF1...Index of the surface at which the previous point is C situated, zero inside a complex block. C ISRF2...Index of the surface at which the current point is C situated, zero inside a complex block. C W1,W2...Weighting coefficients of the numerical quadrature. C ISUM... Index in the array SUM corresponding to the function under C consideration. C I... Loop variable. C C....................................................................... C C Integrals are set to zeros at the initial point of the ray IF(IPT.LE.1) THEN DO 10 ISUM=1,NSUM SUM(ISUM)=0. 10 CONTINUE ISRF1=1 IF(IX.LE.0) THEN X1=0. ELSE X1=YI(IX) END IF END IF IF(NYF.GT.0) THEN ISRF2=ISRFF IF(IX.LE.0) THEN X2=XF ELSE X2=YF(IX) END IF ELSE ISRF2=ISRF IF(IX.LE.0) THEN X2=X ELSE X2=Y(IX) END IF END IF C C Numerical quadrature IF(X2.NE.X1) THEN W1=(X2-X1)/2. W2=W1 IF(NDER.EQ.1) THEN IF(ISRF1.NE.0) THEN IF(ISRF2.EQ.0) THEN C First interval of the ray element W1=W1-(STEP*STEP)/(12.*(X2-X1)) W2=W2+(STEP*STEP)/(12.*(X2-X1)) END IF ELSE IF(ISRF2.NE.0) THEN C Last interval of the ray element W1=W1+(STEP*STEP)/(12.*(X2-X1)) W2=W2-(STEP*STEP)/(12.*(X2-X1)) END IF END IF END IF DO 21 I=1,NFUN1 ISUM=IFUN1(I) SUM(ISUM)=SUM(ISUM)+W1*FUN1(I) 21 CONTINUE DO 22 I=1,NFUN2 ISUM=IFUN2(I) SUM(ISUM)=SUM(ISUM)+W2*FUN2(I) 22 CONTINUE IF(NDER.EQ.2) THEN W1=((X2-X1)**2)/12. W2=-W1 DO 31 I=1,NFUN1 ISUM=IFUN1(I) SUM(ISUM)=SUM(ISUM)+W1*FUN1(NFUN1+I) 31 CONTINUE DO 32 I=1,NFUN2 ISUM=IFUN2(I) SUM(ISUM)=SUM(ISUM)+W2*FUN2(NFUN2+I) 32 CONTINUE END IF END IF C C Copying NFUN2,IFUN2,FUN2 into NFUN1,IFUN1,FUN1 NFUN1=NFUN2 DO 91 I=1,NFUN2 IFUN1(I)=IFUN2(I) FUN1(I)=FUN2(I) 91 CONTINUE DO 92 I=NFUN2+1,NDER*NFUN2 FUN1(I)=FUN2(I) 92 CONTINUE C X1=X2 ISRF1=ISRF2 RETURN END C C======================================================================= C C C SUBROUTINE AP29(NSUM,SUM) INTEGER NSUM REAL SUM(NSUM) C C This subroutine evaluates variations of the travel time with respect C to the model coefficients. It has to be called once at each point C along the ray at which the computed quantities are stored, i.e. after C each invocation of the subroutine AP00 which reads the quantities into C the common block /POINTC/. C Subroutine PARM2 is called to evaluate the material parameters at the C current point and, at a structural interface, also subroutine SRFC2 is C called to evaluate the function describing the interface. After the C invocation of PARM2 or SRFC2, respectively, subroutine VAR6 is called C to recall the variations of the model parameters or of the interface, C with respect to the model coefficients. If the user replaces the C subroutine file 'parm.for' or 'srfc.for' by his own version, it is his C own responsibility to call subroutines VAR1 to VAR5 (see the file C 'var.for') in such a way that the required variations are stored when C returning from his own subroutine PARM2 or SRFC2. C C Input: C NSUM... Total number of the coefficients describing the model. C SUM... Array of dimension at least NSUM, in which the variations C of the travel time with respect to the model coefficients C are accumulated. Its elements are set to zeros at the C initial point of the ray by this subroutine. C C Output: C SUM... Variations of the travel time (from the initial point of C the ray to the current point along the ray) with respect C to the model coefficients. C C Common block /POINTC/: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C Subroutines and external functions required: INTEGER KOOR EXTERNAL KOOR,METRIC,SRFC2,VAR6,AP28 C SMVPRD C PARM2,VELOC C C Date: 1996, September 30 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Auxiliary storage locations for local model parameters: FAUX(10), C G(12),GAMMA(18),GSQRD, UP(10),US(10),RO,QP,QS, VP,VS,VD(10),QL: INCLUDE 'auxmod.inc' C auxmod.inc C C....................................................................... C C Auxiliary storage locations: C INTEGER ISR,II,IBI,MFUN PARAMETER (MFUN=64) INTEGER NFUN1,IFUN1(MFUN),NFUN2,IFUN2(MFUN) REAL B0I,B1I,B2I,B3I,FUN1(2*MFUN),FUN2(2*MFUN) REAL PIN1,PIN2,PIN3,C(3),P1,P2,P3,AUX0 SAVE NFUN1,IFUN1,FUN1,PIN1,PIN2,PIN3 C C ISR... Index of the surface covering the interface. C II... Loop variable (sequential number of the required C variation). C IBI... Absolute index of the function coefficient. C B0I,B1I,B2I,B3I... Variation of the functional value and the three C first derivatives, with respect to the IBI-th coefficient C of the model. C NFUN1...Number of functions having nonzero values or nonzero first C derivatives at the previous point along the ray. C IFUN1...IFUN(1:NFUN1)... Indices in the array SUM corresponding to C the functions having nonzero values or nonzero first C derivatives at the previous point along the ray. C FUN1... FUN(1:NFUN1)... Values of the functions having nonzero C values or nonzero first derivatives at the previous C point along the ray. C FUN(NFUN1+1:2*NFUN1)... First derivatives with respect to C the independent variable along the ray at the previous C point along the ray, of the functions having nonzero C values or nonzero first derivatives. C At the first point after the initial point of the ray, C the values of NFUN1, IFUN and FUN1 correspond to the C initial (zero) point of the ray. C NFUN2...Number of functions having nonzero values or nonzero C first derivatives at the current point along the ray. C IFUN2...Indices in the array SUM corresponding to the functions C having nonzero values or nonzero first derivatives at the C current point along the ray. C FUN2... FUN(1:NFUN2)... Values of the functions having nonzero C values or nonzero first derivatives at the current point C along the ray. C FUN(NFUN2+1:2*NFUN2)... First derivatives with respect to C the independent variable along the ray at the previous C point along the ray, of the functions having nonzero C values or nonzero first derivatives. C PIN1,PIN2,PIN3... Contravariant components of the slowness vector C at the point of incidence. C C... Coordinates. C P1,P2,P3... Contravariant components of the slowness vector. C AUX0... Temporary storage location. C C....................................................................... C C Initial point of the ray: IF(IPT.LE.1) THEN PIN1=0. PIN2=0. PIN3=0. CALL AP29A(ICB1I,0,YI,ISR,C,P1,P2,P3,MFUN,NFUN1,IFUN1,FUN1) END IF C C Another point of the ray: IF(NYF.GT.0) THEN CALL AP29A(ICB1F,ISRFF,YF,ISR,C,P1,P2,P3,MFUN,NFUN2,IFUN2,FUN2) ELSE CALL AP29A(ICB1, ISRF ,Y ,ISR,C,P1,P2,P3,MFUN,NFUN2,IFUN2,FUN2) END IF C C Numerical quadrature: CALL AP28(NSUM,SUM,1,2,0.,NFUN1,IFUN1,FUN1,NFUN2,IFUN2,FUN2) C C Structural interface: IF(ISR.NE.0) THEN IF(PIN1.EQ.0..AND.PIN2.EQ.0..AND.PIN3.EQ.0.) THEN C incident ray: PIN1=P1 PIN2=P2 PIN3=P3 ELSE C Reflected/transmitted ray: C Including the variation of the travel time with respect to the C structural interface CALL SRFC2(IABS(ISR),C,VD) IF(KOOR().NE.0) THEN CALL METRIC(C,GSQRD,G,GAMMA) AUX0=VD(2)*(G(7)*VD(2)+2.*(G(8)*VD(3)+G(10)*VD(4))) + * VD(3)*(G(9)*VD(3)+2.*G(11)*VD(4)) + VD(4)*G(12)*VD(4) ELSE AUX0=VD(2)*VD(2)+VD(3)*VD(3)+VD(4)*VD(4) END IF AUX0=( VD(2)*(P1-PIN1)+VD(3)*(P2-PIN2)+VD(4)*(P3-PIN3) )/AUX0 II=0 30 CONTINUE II=II+1 CALL VAR6(1,II,NFUN2,IBI,B0I,B1I,B2I,B3I) IF(II.LE.NFUN2) THEN SUM(IBI)=SUM(IBI)+AUX0*B0I END IF IF(II.LT.NFUN2) GO TO 30 PIN1=0. PIN2=0. PIN3=0. END IF END IF C RETURN END C C----------------------------------------------------------------------- C C C SUBROUTINE AP29A(ICB1,ISRF,Y,ISR,C,P1,P2,P3,MFUN,NFUN,IFUN,FUN) INTEGER ICB1,ISRF,ISR,MFUN,NFUN,IFUN(MFUN) REAL Y(8),C(3),P1,P2,P3,FUN(2*MFUN) C C Auxiliary subroutine to AP29. C C Input: C ICB1... Index of the complex block. C ISRF... Index of the surface covering the interface. C Y... Quantities computed along a ray. C MFUN... Array dimension. C C Output: C ISR... Index of the surface covering the interface. C C... Coordinates. C P1,P2,P3... Contravariant components of the slowness vector. C NFUN... Number of variations. C IFUN... Indices of variations. C FUN... FUN(1:NFUN)... Values of variations. C FUN(NFUN+1:2*NFUN)... First derivatives of variations C with respect to the independent variable along the ray. C C Subroutines and external functions required: INTEGER KOOR EXTERNAL KOOR,METRIC,SMVPRD,PARM2,VELOC,VAR6 C C....................................................................... C C Auxiliary storage locations for local model parameters: FAUX(10), C G(12),GAMMA(18),GSQRD, UP(10),US(10),RO,QP,QS, VP,VS,VD(10),QL: INCLUDE 'auxmod.inc' C auxmod.inc C C....................................................................... C REAL AUX0,AUX1,AUX2,AUX3,AUX4 INTEGER NEXPS,IVAL,II PARAMETER (NEXPS=0) REAL B0I,B1I,B2I,B3I C C AUX0,AUX1,AUX2,AUX3,AUX4... Auxiliary storage locations C for local model parameters or temporary variables. C IVAL... Index of the function describing the model. C IVAL=1 for P-wave, C IVAL=2 for S-wave. C II... Loop variable (sequential number of the required C variation). C B0I,B1I,B2I,B3I... Variation of the functional value and the three C first derivatives, with respect to the IBI-th coefficient C of the model. C C....................................................................... C C Assignments: ISR=ISRF C(1)=Y(3) C(2)=Y(4) C(3)=Y(5) IF(KOOR().NE.0) THEN CALL METRIC(Y(3),GSQRD,G,GAMMA) CALL SMVPRD(G(7),Y(6),Y(7),Y(8),P1,P2,P3) ELSE P1=Y(6) P2=Y(7) P3=Y(8) END IF C C Material parameters: CALL PARM2(IABS(ICB1),Y(3),UP,US,AUX0,AUX1,AUX2) CALL VELOC(ICB1,UP,US,AUX1,AUX2,AUX3,AUX4,VD,AUX0) C Material parameters and their variations are defined. C AUX0=-VD(1)**(-NEXPS-1) AUX4=-VD(1)**(-NEXPS-NEXPS+1) AUX1=AUX4*P1 AUX2=AUX4*P2 AUX3=AUX4*P3 AUX4=-FLOAT(NEXPS+1)*(VD(2)*AUX1+VD(3)*AUX2+VD(4)*AUX3)/VD(1) IF(ICB1.GT.0) THEN C P-wave: IVAL=1 ELSE C S-wave: IVAL=2 END IF II=0 20 CONTINUE II=II+1 CALL VAR6(IVAL,II,NFUN,IFUN(II),B0I,B1I,B2I,B3I) IF(II.LE.NFUN) THEN IF(NFUN.GT.MFUN) THEN C 729 PAUSE 'Error 729 in AP29: Array index out of range' STOP C Dimension MFUN of arrays IFUN1, FUN1, IFUN2, FUN2 should C be increased. END IF FUN(II)=AUX0*B0I FUN(NFUN+II)=AUX1*B1I+AUX2*B2I+AUX3*B3I+AUX4*B0I END IF IF(II.LT.NFUN) GO TO 20 RETURN END C C======================================================================= Ccalcomp.cfg 100666 1750 1750 237 6425373367 12235 0 ustar klimes klimes 0 / INTERACTIVE WORKSTATION 1 / OPEN WORKSTATIONS 29.700000 21.000000 / CALCOMP PLOT WINDOW 15 / COLOR REPETITION code.dat 100666 1750 1750 1140 6425373370 11546 0 ustar klimes klimes 'Data file code.dat: Codes of elementary waves' / 5 1 1 1 1 1 1 1 1 / (Reflection-transmission code, refracted wave) 5 1 2 1 1 1 1 1 1 / (Reflection-transmission code, reflected wave) 5 1 1 2 1 1 1 1 1 / (Reflection-transmission code, reflected wave) / ------------------------------------------------------------------------ Above sample input data set code.dat specifies three elementary waves to be computed. The general description of the input data specifying elementary waves may be found in file 'code.for'. ======================================================================== code.for 100666 1750 1750 75444 6425373366 11633 0 ustar klimes klimes C
C Subroutine file 'code.for' - codes for elementary waves. C C Date: 1993, August 3 C Coded by Ludek Klimes C C....................................................................... C C This file consists of: C Codes for elementary waves - general description C Codes for elementary waves C CODE1...Subroutine designed to read the input data for the codes C of elementary waves and to store them in the common block C /COD/. C CODE1 C LCODE...Integer function returning the length of the code of the C current elementary wave. C LCODE C NELEM...Integer function returning the number of ray elements C corresponding to the given position in the code of the C elementary wave. C NELEM C CODE... Subroutine designed to transform the used numerical code C of the elementary wave under consideration into C instructions specifying the behaviour of the wave at the C initial points of rays and at all points of incidence of C the rays at interfaces (boundaries of complex blocks). C CODE C C....................................................................... C C C Input data CODE for the codes of elementary waves: C The data are read in by the list directed input (free format). In C the list of input data below, each numbered paragraph indicates C the beginning of a new input operation (new READ statement). If C the first letter of the symbolic name of the input variable is C I-N, the corresponding value in input data must be of the type C INTEGER. Otherwise (except TEXTC), the input parameter is of the C type REAL. C (1) TEXTC C String describing the data. Only the first 80 characters of the C string are significant. C (2) NSKIP C The number of elementary waves to be skipped over. The C (NSKIP+1)-th elementary wave in these input data will be the first C computed wave. Default value: 0. C For each elementary wave IWAVE the following data (3): C (3) KODTYP,KODE C KODTYP..Determines the type of the code C 1... Block-surface code 1 C 2... Basic block code 2 C 3... Compound-element block code 3 C 4... Generalized layer code 4 C 5... Transmission-reflection code 5 C KODE... The code of the elementary wave in the form of a finite C sequence of integers terminated by a slash. C Attention: C Generally, different types of the code may be combined C within the same input data, but the user has then be very C careful. If combining the different types of the code, C output parameters IWAVE0 and IKODE of subroutine CODE1 may C have no sense. Then: C If the parameter MODCRT of the data set 'DCRT' (see source C code file 'ray.for') is zero, the output parameters C IWAVE0 and IKODE of subroutine CODE1 are hopefully C unused. C If the parameter MODCRT of the data set 'DCRT' is not C zero, mixing the types of the wave code should be C avoided unless the user finds a way how to do it C reasonably. C (4) a slash. C Example of data set CODE C C....................................................................... C C Storage in the memory: C The input data (2) for the computed elementary wave are stored in C the common block /COD/ defined in the include file 'code.inc'. C code.inc C C======================================================================= C C C Codes for elementary waves - general description C C We consider ordinary seismic body waves, such as refracted, C primarily or multiply reflected, possibly converted waves. In C general, incidence of a wave at an interface (boundary of a C complex block) produces four waves, reflected P and S, and C transmitted P and S waves. When performing complete ray tracing, C we must know a priori which of the four generated waves to follow. C This decision must be made at each interface. The alphanumeric C string specifying the behaviour of a ray from its initial point to C its endpoint is a 'code'. In the following, we shall consider the C code to be a sequence of nonzero integers. C C The term 'elementary wave' does not have unique meaning in the C literature. Here we apply the term elementary wave to that part C of the wavefield that is described by one specific code. Since C there may be various types of codes, there is also a variety of C divisions of the wave field into elementary waves. C C We introduce the term 'element of a ray', which has an important C meaning in the construction of codes. By an element of a ray, we C denote that part of the ray that is situated in one complex block C between two successive points of reflection/transmission, or C between the initial point or endpoint of the ray and the closest C point of reflection/transmission, or between the initial point and C the endpoint of the ray, if the ray is entirely situated in one C complex block. C C In the following, we present several possible types of numerical C codes of elementary waves. C C Examples of code types C C (1) Block-surface code C Two integers are used for any element of the ray. The C absolute value of the first integer specifies the index of C the complex block, in which the element of the ray is C situated, the sign specifies the type of the wave (plus C sign... P wave, minus sign... S wave). The second C number is the index of the smooth surface, at which the C element terminates. The code of the ray is a chain of the C above doublets describing the ray from its initial point C to its endpoint. The index of a surface, at which the C last element of a ray terminates, need not be specified. C In this case the ray is allowed to terminate on any C surface bounding the complex block in which the last C element of the ray is situated. Application of this code C is straightforward. C C If any complex block is bounded by several smooth C surfaces, the block-surface code may divide artificially C the wave field into several elementary waves. This would C result in repeated application of the complete ray tracing C to all of the elementary waves, what may be time C consuming. In such situations, it is therefore desirable C to use other codes, for which the elementary wave has a C more general meaning. C C C (2) Basic block code C This code may be obtained from the block-surface code if C the indices of the surfaces, at which individual elements C of a ray terminate, are omitted. Then, any element of the C ray is described by a single integer specifying the C complex block and wave type, and it may terminate at any C surface bounding the complex block. The code of the ray C is again a chain of the numbers describing successively C its individual elements. C C Elementary waves specified by the block-surface code, C passing through the same complex blocks, and reflected C from different surfaces bounding a complex block, are C united into one elementary wave in the basic block code. C Similarly, elementary waves specified by the block-surface C code and transmitted from a block into the neighbouring C block across different surfaces separating these blocks, C are united into one elementary wave by the basic block C code. C C C (3) Compound-element block code C Let us introduce the terms simple and compound element of C a ray. For this purpose, we call the 'lower-index C boundary' of a complex block that part of its boundary, C which separates the complex block either from complex C blocks with lower indices or from a free space. The C remaining part of the boundary is called the C 'higher-index boundary' of the complex block. The initial C point of a ray is treated in the same way as the points C situated at a lower-index boundary. C C An element of a ray is called 'simple element' if its C initial point (e.g. the point where the wave enters the C corresponding complex block) and its endpoint (e.g. the C point at which the wave leaves the complex block) are C situated one on the lower-index and the other on the C higher-index boundary of the complex block. The C 'compound element' is such an element for which its C initial point and its endpoint are both situated either C on the lower-index or on the higher-index boundary of the C complex block. The compound element is formally C considered as two simple elements. C C Often it is convenient to work with waves, the rays of C which have either a compound element in a complex block or C two simple elements of the same wave type (unconverted C reflection) in the same block, as with one elementary C wave. The compound-element block code makes a division of C the wave field into such elementary waves possible. C C We introduce the compound-element block code as follows. C For any simple element of a ray one number is used. The C absolute value of this number specifies the index of the C complex block, in which the simple element is situated. C The sign of this number specifies the type of the wave C (plus sign... P wave, minus sign... S wave). For any C compound element of a ray, two identical numbers are used. C A compound element and a doublet of simple elements, C described by the same numbers, are not distinguished. The C code of a ray is a chain of these numbers describing the C ray from its initial point to its endpoint. The use of C the compound-element block code leads to more general C elementary waves. C C C (4) Generalized layer code C Another code may be obtained from the compound-element C block code if the modified interpretation of the model C structure is used. The modified interpretation consists C in assuming an existence of fictitious parts of blocks of C a zero thickness situated between every neighbouring C complex blocks, the indices of which are not sequentially C ordered. The number of fictitious blocks is considered to C be just the number, which is necessary to fill the gap C between indices of the two neighbouring complex blocks. C The ray can only pass through the fictitious blocks, no C reflection in fictitious blocks being allowed. Similarly, C no conversion is allowed neither at interfaces between C fictitious blocks nor at the interface at which the ray C leaves a fictitious block (conversion may take place only C at the interface at which the ray enters the fictitious C block). If any of these prohibited situations is C specified by the code, it leads to the termination of C computations of the corresponding ray. C C This code is a generalization of the code used in the 2-D C program package 'SEIS83' and is described in Cerveny, C Molotkov and Psencik: Ray Method in Seismology, Charles C University, Prague 1977. It enables any block structure C to be interpreted as locally layered structure with C fictitious layers. Thus, the routines for automatic or C semiautomatic generation of ray codes for layered C structures may be used for this code even in general block C structures. Its effective use is conditioned by proper C indexing of complex blocks, which minimizes the number of C fictitious layers. For example, in a layered structure, C the blocks (layers) should be indexed sequentially from C the top to the bottom. C C C (5) Reflection-transmission code C For any element of a ray one integer is used. The first C element of the ray, i.e. the element containing the C initial point of the ray, is denoted by 1 for P and by -1 C for S wave. Any other element is denoted by 1 or -1 (P or C S wave) if the ray is transmitted at the initial point of C the element, and by 2 or -2 (P or S wave) if the ray is C reflected at the initial point of the element. The code C of a ray is a chain of the above numbers corresponding to C individual elements of the ray from its initial point to C its endpoint. In a layered model, this code is very C convenient for the description of refracted and primary C reflected waves. The application of this code is C straightforward. C C Specification of an elementary wave C an elementary wave is specified by the following data: C (1) Integer KODTYP, which determines the type of the code C 1... Block-surface code, C 2... Basic block code, C 3... Compound-element block code, C 4... Generalized layer code, C 5... Transmission-reflection code. C (2) Integer array KODE containing the code of the elementary C wave. The code is a finite sequence of nonzero integers. C A zero indicates the end of a code in the input data. C The data (1) and (2) should be stored in common block C ------------------------------- C COMMON /COD/ KODTYP,KODE(MKODE), see 'code.inc'. C code.inc C ------------------------------- C The dimension MKODE of the array KODE may be adjusted by the user. C C Date: 1988, June 3 C Written by Vlastislav Cerveny, Ludek Klimes, Ivan Psencik C C======================================================================= C C C SUBROUTINE CODE1(LUN,IWAVE,IWAVE0,IKODE) INTEGER LUN,IWAVE,IWAVE0,IKODE C C This subroutine is called when starting the computation of a new C elementary wave. It stores the code of the elementary wave into the C common block /COD/. C C Input: C LUN... Logical unit number of the external input device C containing the input data. C IWAVE...Zero when starting the complete ray tracing program, C otherwise the index of the last elementary wave which has C been computed (i.e. the output from the previous C invocation of the subroutine CODE1). C C Output: C IWAVE...Zero if all required elementary waves are computed and the C complete ray tracing program will be terminated. C Otherwise, the index of the elementary wave which will be C computed (i.e. NSKIP+1 for the first computed elementary C wave, where NSKIP is the number of elementary waves having C been skipped over, otherwise the input value increased by C one). C IWAVE0..Index of the already computed elementary wave having the C most numerous common elements with the current elementary C wave. In the case of several possibilities, the first C computed wave of them is taken. C IKODE...The length of the common part of the codes of the IWAVE-th C and IWAVE0-th elementary waves. C C Common block /COD/: INCLUDE 'code.inc' C code.inc C All the storage locations of the common block are defined in this C subroutine. C C Subroutines and external functions required: EXTERNAL LCODE INTEGER LCODE C LCODE.. This file. C C Date: 1996, September 30 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Storage for previous codes: INTEGER MKODES PARAMETER (MKODES=1024) INTEGER KODES(0:MKODES) SAVE KODES C C Auxiliary storage locations: CHARACTER*80 TEXTC INTEGER NSKIP,I,J,K,L SAVE NSKIP C C TEXTC...The name of the data. String of 80 characters. C NSKIP...The number of elementary waves to be skipped over. C I,J... Auxiliary loop variables. C K... Auxiliary variable - index in array KODES. C L... Auxiliary variable - length of the current code. C C....................................................................... C IF(IWAVE.EQ.0) THEN C Reading the name of the input data READ(LUN,*) TEXTC C C Reading the number of elementary waves to be skipped over NSKIP=0 READ(LUN,*) NSKIP C No codes of elementary waves are read and stored now KODES(0)=0 END IF C C Reading the code of the elementary wave 10 CONTINUE KODTYP=0 DO 11 I=1,MKODE KODE(I)=0 11 CONTINUE READ(LUN,*) KODTYP,KODE IF(KODTYP.EQ.0) THEN IWAVE=0 RETURN ELSE K=KODES(IWAVE)+1 L=LCODE() IWAVE=IWAVE+1 IF(K+L.GT.MKODES) THEN C 401 PAUSE 'Error 401 in CODE1: Insufficient memory for codes' STOP C The dimension MKODES of the array KODES(0:MKODES) in C this subroutine should be increased. The dimension MKODES C should at least equal to the number of elementary waves C plus the total number of all indices forming the codes of C the waves. C Note: C If the parameter MODCRT of the data set 'DCRT' (see source C code file 'ray.for') is zero, the output parameters IWAVE0 C and IKODE of this subroutine are likely unused. Then, C instead of increasing MKODES, the PAUSE and STOP C statements generating this error message may be disabled C to save the computer memory. Then this subroutine will C work, but considering only the first several elementary C waves when calculating output values of IWAVE0 and IKODE. ELSE C Storing the codes DO 12 I=L,1,-1 KODES(K+I)=KODE(I) 12 CONTINUE DO 13 I=K-1,IWAVE,-1 KODES(I+1)=KODES(I) 13 CONTINUE KODES(IWAVE)=K+L DO 14 I=IWAVE-1,0,-1 KODES(I)=KODES(I)+1 14 CONTINUE END IF END IF IF(IWAVE.LE.NSKIP) GO TO 10 C C Determining elementary wave having the most numerous common C elements with the current elementary wave IKODE=0 IWAVE0=0 L=LCODE() DO 39 J=1,MIN0(KODES(0),IWAVE-1) K=KODES(J-1) DO 31 I=1,MIN0(KODES(J)-K,L) IF(KODE(I).NE.KODES(K+I)) THEN GO TO 32 END IF 31 CONTINUE 32 CONTINUE I=I-1 IF(I.GT.IKODE) THEN IKODE=I IWAVE0=J END IF 39 CONTINUE RETURN END C C======================================================================= C C C INTEGER FUNCTION LCODE() C C Integer function LCODE is designed to return the length of the code of C the current elementary wave. C C No input. C C Output: C LCODE...Length of the code of the current elementary wave, i.e. C the count of the numeric items in the array KODE which C describes the behaviour of a ray at interfaces. The array C is called here the code of elementary wave. C C Common block /COD/: INCLUDE 'code.inc' C code.inc C None of the storage locations of the common block are altered. C C No subroutines and external functions required. C C Date: 1996, June 12 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Auxiliary storage locations: INTEGER I C DO 1 I=1,MKODE IF(KODE(I).EQ.0) THEN LCODE=I-1 GO TO 2 END IF 1 CONTINUE LCODE=MKODE 2 CONTINUE RETURN END C C======================================================================= C C C INTEGER FUNCTION NELEM(KODIND) INTEGER KODIND C C This function is designed to return the maximum possible number of ray C elements corresponding to the given position in the code of the C elementary wave. C C Input: C KODIND..Position in the code (index in array KODE) C None of the input parameters are altered. C C Output: C NELEM...Number of ray elements between the initial point of the C ray and the end of the element corresponding to the given C position in the code. Note that, for a particular ray, C some of these possible ray elements may be left out or C coupled into one virtual element. C C Common block /COD/: INCLUDE 'code.inc' C code.inc C None of the storage locations of the common block are altered. C C No subroutines and external functions required. C C Date: 1989, December 19 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C No auxiliary storage locations. C IF(KODTYP.EQ.1) THEN NELEM=(KODIND+1)/2 ELSE NELEM=KODIND END IF RETURN END C C======================================================================= C C C SUBROUTINE CODE(IY,KODIND,ICBNEW,IEND) INTEGER IY(12),KODIND,ICBNEW,IEND C C This subroutine transforms the used numerical code of the elementary C wave under consideration into instructions specifying the behaviour C of the wave at the initial points of rays and at all points of C incidence of the rays at interfaces (boundaries of complex blocks). C Thus, it is first called at the initial point of a ray and then C successively at all points of incidence. C C Input: C IY... Integer array. Its numerical storage units 2, 3, 5, 6, 8 C must be defined as follows: C IY(2)... Position in the code (index in array KODE) C corresponding to the last computed element of a ray. C IY(2)=0 at the initial point of the ray, C IY(2)=KODIND from the last invocation of subroutine CODE C at other points of the ray. C IY(3)=ICB0... Index of the neighbouring complex block, C from which the ray entered the complex block in which C the last computed element of the ray is situated. C IY(3)=0 before leaving the complex block, in which the C initial point of the ray is situated. C At the initial point of the ray (IY(2)=0), IY(3) is C ignored. C IY(5)=ICB1... Index of the complex block containing the C computed element of the ray, supplemented by the sign C '+' for P wave and sign '-' for S wave. C ICB1 is ignored at the initial point of the ray C (IY(2)=0). C IY(6)=ISRF... Index of the surface at which the endpoint C of the last computed element of the ray is situated. C The sign of IY(6) is ignored. C IY(6)=0 at the initial point of the ray. C IY(8)=ICB2... Index of the complex block touching the C complex block ICB1 from the other side of the surface C ISRF at the endpoint of the last computed element of the C ray. IY(8)=0 for a free space. C At the initial point of the ray, ICB2 is the index of C the complex block containing the initial point. C The input parameter is not altered. C C Output: C KODIND..Position in the code (index in the array KODE) C corresponding to the next element of the ray. C ICBNEW..The index of the complex block in which the next C element of the ray is to be situated, supplemented C by the sign "+" for P wave or "-" for S wave. C IEND... Information on the process of the interpretation C of the code: C IEND.EQ.0... Computation of the ray continues. C IEND.NE.0... The computation of the ray terminates. C Different values of IEND specify the reason for the C termination: C 10... Ray satisfies the whole code (regular termination C of the ray). C 21... The point of incidence is situated at a different C surface than that required by the code. C 22... The next element of the ray is required by the C code to be situated in a complex block that does not C touch the point of incidence. C 23... Transmission is required by the code at a free C surface, or the initial point of the ray is situated C in free space. C 30... Reflection or wave conversion at the fictitious C part of the interface. C C Common block /COD/: C ------------------------------------------------------------------ INCLUDE 'code.inc' C code.inc C ------------------------------------------------------------------ C KODTYP..Determines the type of the code: C 1... Block-surface code, C 2... Basic block code, C 3... Compound-element block code, C 4... Generalized layer code, C 5... Transmission-reflection code. C KODE... Array containing the code of the elementary wave. C The code is a finite sequence of nonzero integers. C Zero indicates the end of a code. C None of the storage locations of the common block are altered. C C No subroutines and external functions required. C C Date: 1990, November 18 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Auxiliary storage locations: INTEGER I,J C KODIND=IY(2) GO TO (10,20,30,30,50),KODTYP C C Block-surface code: 10 CONTINUE IF(KODIND.GT.0) THEN C Check on the surface: KODIND=KODIND+1 IF(KODE(KODIND).EQ.0) THEN C End of code IEND=10 RETURN ELSE IF(KODE(KODIND).NE.IABS(IY(6))) THEN C Wrong surface IEND=21 RETURN END IF END IF C The rest of interpretation is the same as in the basic block code C C Basic block code: 20 CONTINUE KODIND=KODIND+1 ICBNEW=KODE(KODIND) IF(ICBNEW.EQ.0) THEN C End of code IEND=10 ELSE IF(IABS(ICBNEW).EQ.IY(8)) THEN C Transmission IEND=0 ELSE IF(KODIND.GT.1.AND.IABS(ICBNEW).EQ.IABS(IY(5))) THEN C Reflection IEND=0 ELSE C Required complex block is not attainable IEND=22 END IF RETURN C C Compound-element block code: 30 CONTINUE IF(KODIND.GT.0) THEN I=IABS(IY(5)) J=(I-IABS(IY(3)))*(I-IY(8)) DO 31 I=KODIND-1,1,-1 IF(KODE(I).NE.KODE(KODIND)) GO TO 32 J=-J 31 CONTINUE 32 CONTINUE IF(J.GT.0) THEN C Compound element: KODIND=KODIND+1 IF(KODE(KODIND).NE.IY(5)) THEN C Wrong surface IEND=21 RETURN END IF END IF END IF C Rest of interpretation is the same as in Basic block code IF(KODTYP.EQ.3) GO TO 20 C C Generalized layer code: C Interpretation of compound elements is the same as in C Compound-element block code, then: KODIND=KODIND+1 ICBNEW=KODE(KODIND) IF(ICBNEW.EQ.0) THEN C End of code IEND=10 ELSE IF(KODIND.EQ.1) THEN C Initial point of a ray: IF(IABS(ICBNEW).EQ.IY(8)) THEN C Initial point of a ray is situated in the required c.b. IEND=0 ELSE C Initial point of a ray is not situated in the required c.b. IEND=22 END IF ELSE IF(IABS(ICBNEW).EQ.IABS(IY(5))) THEN C Reflection IEND=0 ELSE C Possible transmission: J=ISIGN(1,IY(8)-IABS(IY(5))) IF(IABS(ICBNEW).EQ.IABS(IY(5))+J) THEN C Loop for fictitious parts of blocks: DO 41 I=IABS(IY(5))+J+J,IY(8),J KODIND=KODIND+1 ICBNEW=KODE(KODIND) IF(ICBNEW.EQ.0) THEN C End of code in the fictitious part of block IEND=10 RETURN ELSE IF(ICBNEW.EQ.ISIGN(I,KODE(KODIND-1))) THEN C Transmission from the fictitious part of block IEND=0 ELSE C Termination of the ray computation in the fictitious part C of the block IEND=30 RETURN END IF 41 CONTINUE ELSE C Required complex block is not attainable IEND=22 END IF END IF RETURN C C Transmission-reflection code: 50 CONTINUE KODIND=KODIND+1 I=KODE(KODIND) IF(IABS(I).EQ.1) THEN C Transmission: IF(IY(8).GT.0) THEN C Transmission into material block ICBNEW=ISIGN(IY(8),I) IEND=0 ELSE C Transmission into free space IEND=23 END IF ELSE IF(IABS(I).EQ.2.AND.KODIND.GT.1) THEN C Reflection ICBNEW=ISIGN(IABS(IY(5)),I) IEND=0 ELSE C End of code IEND=10 END IF RETURN END C C======================================================================= Ccode.inc 100666 1750 1750 2055 6425373366 11562 0 ustar klimes klimes C
C INCLUDE 'code.inc' C ------------------------------------------------------------------ INTEGER MKODE PARAMETER (MKODE=128) INTEGER KODTYP,KODE(MKODE) COMMON /COD/ KODTYP,KODE SAVE /COD/ C ------------------------------------------------------------------ C KODTYP..Determines the type of the code, see the input data (2). C KODE... Array containing the code of the elementary wave. C The code is a finite sequence of nonzero integers. C Zero indicates the end of a code. C C Common block /COD/ is included in external procedures COD1, CODE, C WRIT1 of 'code.for', and may be included in any other subroutine. C If MKODE is changed, it must be adjusted in all subroutines which C include common block /COD/. C C Date: 1996, July 8 C Coded by Ludek Klimes C C======================================================================= Ccode1.dat 100666 1750 1750 266 6425373370 11617 0 ustar klimes klimes 'code1.dat: Only refracted wave' / 5 1 1 1 1 1 1 1 1 / (reflection-transmission code, refracted wave) / ======================================================================== coef.for 100666 1750 1750 21701 6425373366 11620 0 ustar klimes klimes C
C Subroutine file 'coef.for' - reflection/transmission coefficients C C Date: 1989, December 8 C Coded by: Ludek Klimes C C....................................................................... C C This file consists of: C COEFSH..Subroutine designed to evaluate SH R/T coefficients C (see C.R.T.5.9.7). C COEFSH C COEF50..Subroutine designed to evaluate P-SV R/T coefficients C (see C.R.T.5.9.7). C COEF50 C C C======================================================================= C C C SUBROUTINE COEFSH(P,VS1,RO1,VS2,RO2,NCODE,RMOD,RPH) C C ****************************************************************** C C The routine COEFSH is designed for the computation of reflection C and transmission coefficients at a plane interface between two C homogeneous solid halfspaces or at a free surface of a homogeneous C solid halfspace. C C I n p u t p a r a m e t e r s C P...Ray parameter C VS1,RO1...Parameters of the first halfspace C VS2,RO2...Parameters of second halfspace. For the free C surface take RO2=0. And arbitrary C value of VS2 C NCODE...Code of the computed coefficient C S1S1...NCODE=1 C S1S2...NCODE=2 C C O u t p u t p a r a m e t e r s C RMOD,RPH...Modul and argument of the coefficient C C N o t e s C 1/ Time factor of incident wave...EXP(-i*OMEGA*T) C 2/ Formulae are taken from Cerveny,Molotkov and Psencik, C Ray Method in Seismology, page 34 C C ****************************************************************** C COMPLEX A,B X= 1.-P*P*VS1*VS1 Y= 1.-P*P*VS2*VS2 C= RO1*VS1*SQRT(ABS(X)) D= RO2*VS2*SQRT(ABS(Y)) A= CMPLX(C,0.) IF(X.LT.0.) A= CMPLX(0.,C) B= CMPLX(D,0.) IF(Y.LT.0.) B= CMPLX(0.,D) GO TO (1,2), NCODE 1 A= (A-B)/(A+B) GO TO 3 2 A= (A+A)/(A+B) 3 RMOD= SQRT(REAL(A)*REAL(A)+AIMAG(A)*AIMAG(A)) RPH= ATAN2(AIMAG(A),REAL(A)) RETURN END C C======================================================================= C C C SUBROUTINE COEF50(P,VP1,VS1,RO1,VP2,VS2,RO2,NCODE,ND,RMOD,RPH) C C ****************************************************************** C C The routine COEF50 is designed to evaluate the reflection and C transmission coefficients at a plane interface between two C homogeneous solid halfspaces or at a free surface of a homogeneous C solid halfspace. C C The kinds of individual coefficients are specified by the C following numbers C a/ Interface between two solid halfspaces C P1P1...1 P1S1...2 P1P2...3 P1S2...4 C S1P1...5 S1S1...6 S1P2...7 S1S2...8 C b/ Free surface (for RO2.LT.0.00001) C PP.....1 PX.....5 PX,PZ...X- and Z- components of the C PS.....2 PZ.....6 coef.of conversion,incident P wave C SP.....3 SX.....7 SX,SZ...X- and Z- components of the C SS.....4 SZ.....8 coef.of conversion,incident S wave C C I n p u t p a r a m e t e r s C P...Ray parameter C VP1,VS1,RO1...Parameters of the first halfspace C VP2,VS2,RO2...Parameters of second halfspace. For the free C surface take RO2.LT.0.000001,eg.RO2=0., and C arbitrary values of VP2 and VS2 C NCODE...Code of the computed coefficient C ND...=0 when the interface is situated at the right-hand C side of the incident ray (X against P) C =1 when the interface is situated at the left-hand C side of the incident ray (X along P) C C O u t p u t p a r a m e t e r s C RMOD,RPH...Modul and argument of the coefficient C C N o t e s C 1/ Positive P...In the direction of propagation C 2/ Positive S...To the left from P C 3/ Positive X...To the right from Z (to the right from P) C 4/ Positive Z...In the direction of P C 5/ Time factor of incident wave...EXP(-i*OMEGA*T) C 6/ Formulae are taken from Cerveny and Ravindra, Theory of Seismic C Head Waves,Pages 63-67. Due to the note 2, the signs at certain C coefficients are opposite (and time factor is changed, L.K.) C (signs of conversion coefficients are opposite to Cerveny, C Molotkov and Psencik, Ray Method in Seismology, page 35) C C ****************************************************************** C COMPLEX B(4),RR,C1,C2,C3,C4,H1,H2,H3,H4,H5,H6,H,HB,HC DIMENSION PRMT(4),D(4),DD(4) PRMT(1)=VP1 PRMT(2)=VS1 PRMT(3)=VP2 PRMT(4)=VS2 IF(RO2.LT.0.000001)GO TO 150 A1=VP1*VS1 A2=VP2*VS2 A3=VP1*RO1 A4=VP2*RO2 A5=VS1*RO1 A6=VS2*RO2 Q=2.*(A6*VS2-A5*VS1) PP=P*P QP=Q*PP X=RO2-QP Y=RO1+QP Z=RO2-RO1-QP G1=A1*A2*PP*Z*Z G2=A2*X*X G3=A1*Y*Y G4=A4*A5 G5=A3*A6 G6=Q*Q*PP DO 21 I=1,4 DD(I)=P*PRMT(I) 21 D(I)=SQRT(ABS(1.-DD(I)*DD(I))) IF(DD(1).LE.1..AND.DD(2).LE.1..AND.DD(3).LE.1..AND.DD(4).LE.1.) 1GO TO 100 C C Complex coefficients DO 22 I=1,4 IF(DD(I).GT.1.)GO TO 23 B(I)=CMPLX(D(I),0.) GO TO 22 23 B(I)= CMPLX(0.,D(I)) 22 CONTINUE C1=B(1)*B(2) C2=B(3)*B(4) C3=B(1)*B(4) C4=B(2)*B(3) H1=CMPLX(G1,0.) H2=G2*C1 H3=G3*C2 H4=G4*C3 H5=G5*C4 H6=G6*C1*C2 H=1./(H1+H2+H3+H4+H5+H6) HB=2.*H HC=HB*P GO TO (1,2,3,4,5,6,7,8),NCODE 1 RR=H*(H2+H4+H6-H1-H3-H5) GO TO 26 2 RR=VP1*B(1)*HC*(Q*Y*C2+A2*X*Z) IF(ND.NE.0)RR=-RR GO TO 26 3 RR=A3*B(1)*HB*(VS2*B(2)*X+VS1*B(4)*Y) GO TO 26 4 RR=-A3*B(1)*HC*(Q*C4-VS1*VP2*Z) IF(ND.NE.0)RR=-RR GO TO 26 5 RR=-VS1*B(2)*HC*(Q*Y*C2+A2*X*Z) IF(ND.NE.0)RR=-RR GO TO 26 6 RR=H*(H2+H5+H6-H1-H3-H4) GO TO 26 7 RR=A5*B(2)*HC*(Q*C3-VP1*VS2*Z) IF(ND.NE.0)RR=-RR GO TO 26 8 RR=A5*B(2)*HB*(VP1*B(3)*Y+VP2*B(1)*X) GO TO 26 C Real coefficients 100 E1=D(1)*D(2) E2=D(3)*D(4) E3=D(1)*D(4) E4=D(2)*D(3) S1=G1 S2=G2*E1 S3=G3*E2 S4=G4*E3 S5=G5*E4 S6=G6*E1*E2 S=1./(S1+S2+S3+S4+S5+S6) SB=2.*S SC=SB*P GO TO (101,102,103,104,105,106,107,108),NCODE 101 R=S*(S2+S4+S6-S1-S3-S5) GO TO 250 102 R=VP1*D(1)*SC*(Q*Y*E2+A2*X*Z) IF(ND.NE.0)R=-R GO TO 250 103 R=A3*D(1)*SB*(VS2*D(2)*X+VS1*D(4)*Y) GO TO 250 104 R=-A3*D(1)*SC*(Q*E4-VS1*VP2*Z) IF(ND.NE.0)R=-R GO TO 250 105 R=-VS1*D(2)*SC*(Q*Y*E2+A2*X*Z) IF(ND.NE.0)R=-R GO TO 250 106 R=S*(S2+S5+S6-S1-S3-S4) GO TO 250 107 R=A5*D(2)*SC*(Q*E3-VP1*VS2*Z) IF(ND.NE.0)R=-R GO TO 250 108 R=A5*D(2)*SB*(VP1*D(3)*Y+VP2*D(1)*X) GO TO 250 C C Earths surface,complex coefficients and coefficients of conversion 150 A1=VS1*P A2=A1*A1 A3=2.*A2 A4=2.*A1 A5=A4+A4 A6=1.-A3 A7=2.*A6 A8=2.*A3*VS1/VP1 A9=A6*A6 DD(1)=P*VP1 DD(2)=P*VS1 DO 151 I=1,2 151 D(I)=SQRT(ABS(1.-DD(I)*DD(I))) IF(DD(1).LE.1..AND.DD(2).LE.1.)GO TO 200 DO 154 I=1,2 IF(DD(I).GT.1.)GO TO 155 B(I)=CMPLX(D(I),0.) GO TO 154 155 B(I)= CMPLX(0.,D(I)) 154 CONTINUE H1=B(1)*B(2) H2=H1*A8 H=1./(A9+H2) GO TO (161,162,163,164,165,166,167,168),NCODE 161 RR=(-A9+H2)*H GO TO 26 162 RR=-A5*B(1)*H*A6 IF(ND.NE.0)RR=-RR GO TO 26 163 RR=A5*B(2)*H*A6*VS1/VP1 IF(ND.NE.0)RR=-RR GO TO 26 164 RR=-(A9-H2)*H GO TO 26 165 RR=-A5*H1*H IF(ND.NE.0)RR=-RR GO TO 26 166 RR=A7*B(1)*H GO TO 26 167 RR=-A7*B(2)*H GO TO 26 168 RR=-A5*VS1*H1*H/VP1 IF(ND.NE.0)RR=-RR 26 Z2=REAL(RR) Z3=AIMAG(RR) IF(Z2.EQ.0..AND.Z3.EQ.0.)GO TO 157 RMOD=SQRT(Z2*Z2+Z3*Z3) RPH=ATAN2(Z3,Z2) RETURN 157 RMOD=0. RPH=0. RETURN C C Earths surface,real coefficients and coefficients of conversion 200 S1=D(1)*D(2) S2=A8*S1 S=1./(A9+S2) GO TO (201,202,203,204,205,206,207,208),NCODE 201 R=(-A9+S2)*S GO TO 250 202 R=-A5*D(1)*S*A6 IF(ND.NE.0)R=-R GO TO 250 203 R=A5*D(2)*S*A6*VS1/VP1 IF(ND.NE.0)R=-R GO TO 250 204 R=(S2-A9)*S GO TO 250 205 R=-A5*S1*S IF(ND.NE.0)R=-R GO TO 250 206 R=A7*D(1)*S GO TO 250 207 R=-A7*D(2)*S GO TO 250 208 R=-A5*VS1*S1*S/VP1 IF(ND.NE.0)R=-R 250 IF(R.LT.0.)GO TO 251 RMOD=R RPH=0. RETURN 251 RMOD=-R RPH=3.14159 RETURN END C C======================================================================= Ccrt.dat 100666 1750 1750 740 6425373370 11411 0 ustar klimes klimes 'Sample main input data crt.dat: Data filenames' 'model.dat' 'dcrt.dat' 'init.dat' 'code.dat' 'rpar.dat' 'writsrf.dat' 'log.out' ------------------------------------------------------------------------ model.dat, dcrt.dat, init.dat, code.dat, rpar.dat and writsrf.dat are the files with the input data. log.out is the output log file containing very brief notes on the program running. ======================================================================== crt.for 100666 1750 1750 26440 6425373366 11501 0 ustar klimes klimes C
C Program CRT for complete ray tracing C C Version: 5.10 C Date: 1997, October 25 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 This file consists of: C CRT... Main program controlling the complete ray tracing. C CRT C LUWARN..Integer external function to remember the logical unit C number of the output file to write the warning messages. C LUWARN C C....................................................................... C C C Description of 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) 'CRT' C The string containing the name of the main input data file for the C complete ray tracing program. The data file 'CRT' will be read in C by the subroutine CRTIN, and is described within the FORTRAN77 C source code file 'crtin.for'. Only the first 80 characters of the C string are significant. C Description of data file CRT C Default: 'CRT'='crt.dat'. C C======================================================================= C C C PROGRAM CRT C C Main program for complete ray tracing. This program reads the input C data and then controls the complete ray tracing of the specified C elementary waves. C C Input data: Main input data set containing the names of other input C files and the name of the output log file is read in by the subroutine C CRTIN of the file 'crtin.for'. Thus, the structure of the main input C data set is described in the file 'crtin.for'. C The name of the main input data file is given by the first actual C argument of the subroutine crtin called in the first executive C statement of the main program. It is blank in the original version. C C Subroutines referenced: EXTERNAL CRTIN,RAY2,INIT2,CODE1,RPAR1,RPAR2,RPAR4 EXTERNAL WRIT1,WRIT2,WRIT4,WRIT5 C MODEL1...File 'model.for' of the package 'model'. C CRTIN,UNIT... File 'crtin.for'. C RAY1,RAY2... File 'ray.for'. C INIT1,INIT2... File 'init.for'. C CODE1... File 'code.for'. C RPAR1,RPAR2,RPAR4... File 'rpar.for'. C WRIT1,WRIT2,WRIT4, WRIT5... File 'writ.for'. C Note that the above subroutines reference many other external C procedures from various subroutine files. These indirectly C referenced procedures are not named here, but are listed in the C particular subroutine files. C C Date: 1997, July 21 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Storage locations: C C Input data: CHARACTER*80 FCRT C FCRT... Name of the main input data file for the complete ray C tracing program. C C Logical unit numbers: INTEGER LUCODE,LURPAR,LUWRIT,LULOG C C LUCODE..The logical unit connected to the file with the CODE data. C LURPAR..The logical unit connected to the file with the RPAR data. C LUWRIT..The logical unit connected to the file with the WRIT data. C LULOG...The logical unit connected to the output LOG file. C C Quantities describing elementary waves and their rays: REAL PAR1,PAR2,YL(6),Y(35),YY(5) INTEGER IWAVE,IWAVE0,IKODE,IRAY,IY(12),IEND,ISHEET,IREC C C IWAVE...Index of the computed elementary wave. C IWAVE0..Index of the already computed elementary wave having the C most numerous common elements with the current elementary C wave. C IKODE...The length of the common part of the codes of the IWAVE-th C and IWAVE0-th elementary waves. C IRAY... Index of the computed ray. C PAR1,PAR2... Ray take-off parameters. C YL... Array containing local quantities at a point of a ray (see C C.R.T.5.5.4). The quantities are listed in the subroutine C file 'ray.for'. C Description of YL C Y... Array containing basic quantities computed along a ray C (see C.R.T.5.2.1). The quantities are listed in the C subroutine file 'ray.for'. C Description of Y C YY... Array containing real auxiliary quantities computed along C a ray (see C.R.T.5.2.2). The quantities are listed in the C subroutine file 'ray.for'. C Description of YY C IY... Array containing integer auxiliary quantities computed C along a ray (see C.R.T.5.2.2). The quantities are listed C in the subroutine file 'ray.for'. C Description of IY C IEND... Reason of the termination of the computation of a ray (see C C.R.T.5.4). C Description of IEND in RAY2 C Description of IEND in INIT2 C ISHEET..Ray-history index. The different ray histories are C consecutively indexed by positive integers 1,2,3,... C According to their appearance during ray tracing. C The ray histories are indexed independently within each C elementary wave. C The ray-history indices are complemented with sign: C Positive - successful ray (crossing reference surface), C negative - unsuccessful ray (terminating before crossing C reference surface). C IREC... Index of the receiver for a two-point ray, determined in C subroutine RPAR4. C C....................................................................... C C Opening data files and reading the input data: C FCRT='crt.dat' WRITE(*,'(A)') ' Enter the name of the main input data file:' READ(*,*) FCRT WRITE(*,'(A)') '+Reading input data. ' CALL CRTIN(FCRT,LUCODE,LURPAR,LUWRIT,LULOG) LULOG=LUWARN(LULOG) WRITE(*,'(A)') '+Computing. ' C C....................................................................... C C Complete ray tracing: C CALL WRIT1(LUWRIT,LULOG,0,0,0) IWAVE=0 IRAY=0 C C Loop over elementary waves 30 CONTINUE C Computation of a single elementary wave: C Reading the input data for the elementary wave CALL CODE1(LUCODE,IWAVE,IWAVE0,IKODE) IF(IWAVE.EQ.0) THEN C All required elementary waves are computed GO TO 90 END IF CALL RPAR1(LURPAR,IWAVE) CALL WRIT1(LUWRIT,LULOG,IWAVE,IWAVE0,IKODE) C Loop over rays 40 CONTINUE C Complete tracing of a single ray: C Determination of the take-off parameters CALL RPAR2(IRAY,PAR1,PAR2) IF(IRAY.EQ.0) THEN C All required rays of the elementary wave are computed GO TO 80 END IF C Initial conditions for the ray CALL INIT2(PAR1,PAR2,YL,Y,YY,IY,IEND,IWAVE0,IKODE) CALL WRIT2(LULOG,IRAY) IF(IEND.EQ.0) THEN C Computation of the ray CALL RAY2(YL,Y,YY,IY,IEND) END IF C The ray is computed CALL RPAR4(IRAY,PAR1,PAR2,YL,Y,YY,IY,IEND,ISHEET,IREC) CALL WRIT4(LULOG,IRAY,YL,Y,YY,IY,IEND,ISHEET,IREC) GO TO 40 80 CONTINUE C The elementary wave is computed CALL WRIT5(LULOG,IWAVE) GO TO 30 90 CONTINUE C C End of computation CALL WRIT5(LULOG,0) STOP END C C======================================================================= C C C INTEGER FUNCTION LUWARN(LU) INTEGER LU C C Function to remember the logical unit number of the output file to C write the warning messages. C C Input: C LU... Positive logical unit number of the output file to write C the warning messages during the first invocation, C performed usually from the main program. C Otherwise zero. C Output: C LUWARN..Logical unit number of the output file to write the C warning messages. C For consistency, it is recommended that the warning C message starts with string 'Warning' at the begining of C the first written line. Numbered warnings should be C listed in the list of errors. C C Date: 1997, July 21 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C INTEGER LUSTOR SAVE LUSTOR C IF(LU.GT.0) THEN LUSTOR=LU END IF LUWARN=LUSTOR RETURN END C C======================================================================= C INCLUDE 'model.for' C model.for INCLUDE 'metric.for' C metric.for INCLUDE 'srfc.for' C srfc.for INCLUDE 'parm.for' C parm.for INCLUDE 'val.for' C val.for INCLUDE 'fit.for' C fit.for INCLUDE 'means.for' C means.for INCLUDE 'hpcg.for' C hpcg.for INCLUDE 'crtin.for' C crtin.for INCLUDE 'code.for' C code.for INCLUDE 'ray.for' C ray.for INCLUDE 'raycb.for' C raycb.for INCLUDE 'trans.for' C trans.for INCLUDE 'coef.for' C coef.for INCLUDE 'init.for' C init.for INCLUDE 'rpar.for' C rpar.for INCLUDE 'rp2d.for' C rp2d.for INCLUDE 'rp3d.for' C rp3d.for INCLUDE 'writ.for' C writ.for C C Screen output subroutines: C Include just one of the following files 'scro*.for': C (a) No report on the progress of calculation: * INCLUDE 'scronul.for' C scronul.for C (b) Very brief text screen output (indices of traced rays): INCLUDE 'scronum.for' C scronum.for C (c) More informative both text and graphical screen output: * INCLUDE 'scropc.for' C scropc.for C Note that 'scropc.for' must be supplemented with CalComp graphics C subroutines PLOTS, PLOT, and NEWPEN designed for the particular C operating system and compiler. C Required CalComp subroutines C To disable screen graphics: * INCLUDE 'plotnul.for' C plotnul.for C C======================================================================= Ccrt.htm 100666 1750 1750 72443 6425373366 11507 0 ustar klimes klimes
d a t a |
* |
m a i n |
l o g |
M O D E L |
C R T _ R |
C R T _ S |
C R T _ I |
C R T _ T |
L I N |
P T S |
F T T |
G R E E N |
S O U R C E |
R F |
G S E |
S E P |
M G R D |
D A T A |
P S |
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
CRT | in | in | out | in | out | out | out | out |
in in | ||||||||||
RPPLOT | in | in | in | in | in | out | |||||||||||||
MTT | in | in | in | in | in | out | |||||||||||||
CRT2P | in |
in out |
in out |
in out | |||||||||||||||
CRTRAY | in | in | in | out |
in in | ||||||||||||||
CRTPTS | in | in | in |
in in out | out | ||||||||||||||
GREEN | in | in | in |
in in | out | ||||||||||||||
GREENSS | in | in | in | in | out |
in out | |||||||||||||
SS | in | in | out | in | out | out | |||||||||||||
SP | in | in | in | in | out | ||||||||||||||
INV1TT | in | in | out | in | in | in | out |
C Program CRT2D3D transforming 2-D system of rays to 3-D system of rays C to be processed by program MTT which present version works only in 3-D C C Version: 5.10 C Date: 1997, October 21 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 Description of data files: C C Main input data read from external interactive device (*): C The data consist of character strings, read by list directed (free C format) input. The strings have thus to be enclosed in C apostrophes. The interactive * external unit may be redirected to C the file containing the data. C (1) 'CRT-R-2D','CRT-I-2D','CRT-T-2D','CRT-R-3D','CRT-I-3D','CRT-T-3D', C DX1,DX2,DX3,/ C 'CRT-R-2D'... Input file CRT-R with the quantities stored along C rays (see C.R.T.5.5.1) resulting from 2-D ray tracing. C 'CRT-I-2D'... Input file CRT-I with the quantities at the initial C points of rays, corresponding to file CRT-R-2D (see C C.R.T.6.1). C 'CRT-T-2D'... Input file CRT-T with the homogeneous triangles in C the ray-parameter domain, corresponding to file CRT-R-2D. C 'CRT-R-3D'... Output file CRT-R containing 3-D sytem of rays C composed of two 2-D system of rays shifted by vectors C -(DX1,DX2,DX3) and +(DX1,DX2,DX3). C 'CRT-I-3D'... Output file CRT-I with the quantities at the initial C points, corresponding to file CRT-R-3D (see C.R.T.6.1). C 'CRT-T-3D'... Output file CRT-T with the homogeneous triangles in C the ray-parameter domain, corresponding to file CRT-R-3D. C DX1,DX2,DX3... Translation vector perpendicular to the 2-D system C of rays. C Default: 'CRT-R-2D'='r01.out', 'CRT-I-2D'='r01i.out', C 'CRT-T-2D'='t01.out', 'CRT-R-3D'='r01-3d.out', C 'CRT-I-3D'='r01i-3d.out', 'CRT-T-3D'='t01-3d.out', C DX1=0., DX2=0., DX3=0. C C Unformatted files CRT-R: C See the description within source code file 'writ.for'. C Description of files CRT-R C C Unformatted files CRT-I: C See the description within source code file 'writ.for'. C Description of files CRT-I C C Formatted files CRT-T: C See the description within source code file 'writ.for'. C Description of files CRT-T C C----------------------------------------------------------------------- C C Memory management: INCLUDE 'ram.inc' C ram.inc INTEGER IRAM(MRAM) EQUIVALENCE (IRAM,RAM) C C Common block /POINTC/ to store the results of complete ray tracing: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C Subroutines and external functions required: EXTERNAL AP00 C AP00... File 'ap.for'. C C----------------------------------------------------------------------- C C Auxiliary storage locations: INTEGER LU1,LU2,LU3,LU4,I,J,I1,I2,I3,I100,N100,NRAM PARAMETER (LU1=1,LU2=2,LU3=3,LU4=4) CHARACTER*80 FILE1,FILE2,FILE3,FILE4,FILE5,FILE6 REAL DX1,DX2,DX3,X1,X2,X3 C C Output format: INTEGER IFORM CHARACTER*10 FORMAT DATA IFORM/99999/,FORMAT/'(I6,I6,I6)'/ C C C....................................................................... C C Opening input and output files: FILE1='r01.out' FILE2='r01i.out' FILE3='t01.out' FILE4='r01-3d.out' FILE5='r01i-3d.out' FILE6='t01-3d.out' DX1=0. DX2=0. DX3=0. WRITE(*,'(2A)') ' Enter 6 filenames and 3 reals: ' READ(*,*) FILE1,FILE2,FILE3,FILE4,FILE5,FILE6,DX1,DX2,DX3 C C Triangles: WRITE(*,'(2A)') '+Writing triangles ' OPEN(LU1,FILE=FILE3,STATUS='OLD') OPEN(LU2,FILE=FILE6) N100=0 C C Loop for the triangles 10 CONTINUE C Reading the interval READ(LU1,*,END=20) I1,I2,I3 IF(I3.NE.0) THEN C CRT2D3D-01 C PAUSE 'Error CRT2D3D-01: Input data are not 2-D' STOP END IF N100=MAX0(I1,I2,N100) C Setting output format IF(2*I1.GT.IFORM.OR.2*I2.GT.IFORM) THEN IFORM1=IFORM1*10+9 FORMAT(3:3)=CHAR(ICHAR(FORMAT(3:3))+1) FORMAT(6:6)=FORMAT(3:3) FORMAT(9:9)=FORMAT(3:3) END IF C Writing the triangles WRITE(LU2,FORMAT) 2*I1-1,2*I1,2*I2-1 WRITE(LU2,FORMAT) 2*I1,2*I2-1,2*I2 GO TO 10 C 20 CONTINUE CLOSE(LU1) CLOSE(LU2) C C Writing rays: WRITE(*,'(2A)') '+ 0% of rays rewritten ' OPEN(LU1,FILE=FILE1,FORM='UNFORMATTED',STATUS='OLD') OPEN(LU2,FILE=FILE2,FORM='UNFORMATTED',STATUS='OLD') OPEN(LU3,FILE=FILE4,FORM='UNFORMATTED') OPEN(LU4,FILE=FILE5,FORM='UNFORMATTED') I100=0 C C Loop for the points of rays NRAM=0 50 CONTINUE C Reading the results of the complete ray tracing CALL AP00(0,LU1,LU2) IF(IPT.LE.1.AND.NRAM.GT.0) THEN C New ray - recording the duplication of the last ray J=0 51 CONTINUE WRITE(LU3) (IRAM(I),I=J+1,J+5),(RAM(I),I=J+6,J+12+IRAM(J+3)) J=J+12+IRAM(J+3) IF(J.LT.NRAM) GO TO 51 NRAM=0 END IF IF(IWAVE.LT.1) THEN C End of rays GO TO 60 END IF IF(IPT.LE.1)THEN C New ray - recording the initial points X1=YI(3)-DX1 X2=YI(4)-DX2 X3=YI(5)-DX3 WRITE(LU4) -IWAVE,2*IRAY-1,ICB1I,IEND,ISHEET,IREC,YLI, * YI(1),YI(2),X1,X2,X3,(YI(I),I=6,MYI) X1=YI(3)+DX1 X2=YI(4)+DX2 X3=YI(5)+DX3 WRITE(LU4) -IWAVE,2*IRAY ,ICB1I,IEND,ISHEET,IREC,YLI, * YI(1),YI(2),X1,X2,X3,(YI(I),I=6,MYI) END IF X1=Y(3)-DX1 X2=Y(4)-DX2 X3=Y(5)-DX3 WRITE(LU3) IWAVE,2*IRAY-1,NY,ICB1,ISRF,X,YL,Y(1),Y(2),X1,X2,X3, * (Y(I),I=6,NY) IF(NRAM+12+NY.GT.MRAM) THEN C CRT2D3D-02 C PAUSE 'Error CRT2D3D-02: Too small array RAM to store a ray' STOP C Dimension MRAM of array RAM in include file C ram.inc C should probably be increased to accommodate a long ray. END IF IRAM(NRAM+1)=IWAVE IRAM(NRAM+2)=2*IRAY IRAM(NRAM+3)=NY IRAM(NRAM+4)=ICB1 IRAM(NRAM+5)=ISRF RAM(NRAM+6)=X DO 56 I=1,6 RAM(NRAM+6+I)=YL(I) 56 CONTINUE RAM(NRAM+13)=Y(1) RAM(NRAM+14)=Y(2) RAM(NRAM+15)=Y(3)+DX1 RAM(NRAM+16)=Y(4)+DX2 RAM(NRAM+17)=Y(5)+DX3 DO 57 I=6,NY RAM(NRAM+12+I)=Y(I) 57 CONTINUE NRAM=NRAM+12+NY IF(100*IRAY.GE.I100*N100) THEN WRITE(*,'(A,I3)') '+',I100 I100=I100+1 END IF GO TO 50 C 60 CONTINUE CLOSE(LU1) CLOSE(LU2) CLOSE(LU3) CLOSE(LU4) WRITE(*,'(A,I3)') '+',100 C STOP END C C======================================================================= C INCLUDE 'ap.for' C ap.for C C======================================================================= Ccrt2p.for 100666 1750 1750 10046 6425373367 11737 0 ustar klimes klimes C
C Program CRT2P collecting 2-point rays from the unformatted output of C program CRT. C C Version: 5.10 C Date: 1997, September 27 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 Description of data files: C C Main input data read from external interactive device (*): C The data consist of character strings, read by list directed (free C format) input. The strings have thus to be enclosed in C apostrophes. The interactive * external unit may be redirected to C the file containing the data. C (1) 'RAYALL','INIALL','RAY2P','INI2P',/ C 'RAYALL'... Input file CRT-R with the quantities stored along rays C (see C.R.T.5.5.1), or input file CRT-S with the quantities C stored at the specified surfaces (see C.R.T.5.5.2). C 'INIALL'... Input file CRT-I with the quantities at the initial C points of rays, corresponding to file RAYALL (see C C.R.T.6.1). C 'RAY2P'... Output file CRT-R or CRT-S, with the quantities C corresponding to the 2-point rays only. C 'INI2P'... Output file CRT-I with the quantities at the initial C points of 2-point rays, corresponding to file RAY2P (see C C.R.T.6.1). C Default: 'RAYALL'='r01.out', 'INIALL'='r01i.out', C 'RAY2P'='ray2p.out', 'INI2P'='ini2p.out'. C C Unformatted files RAYALL and RAY2P: C See the description within source code file 'writ.for'. C Description of files CRT-R C Description of files CRT-S C C Unformatted files INIALL and INI2P: C See the description within source code file 'writ.for'. C Description of files CRT-I C C----------------------------------------------------------------------- C C Common block /POINTC/ to store the results of complete ray tracing: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C Subroutines and external functions required: EXTERNAL AP00 C AP00... File 'ap.for'. C C----------------------------------------------------------------------- C C Auxiliary storage locations: INTEGER LU1,LU2,LU3,LU4,I PARAMETER (LU1=1,LU2=2,LU3=3,LU4=4) CHARACTER*80 FILE1,FILE2,FILE3,FILE4 C C....................................................................... C C Opening input and output files: FILE1='r01.out' FILE2='r01i.out' FILE3='ray2p.out' FILE4='ini2p.out' WRITE(*,'(2A)') * ' Enter 4 filenames (r01.out, r01i.out, ray2p.out, ini2p.out): ' READ(*,*) FILE1,FILE2,FILE3,FILE4 OPEN(LU1,FILE=FILE1,FORM='UNFORMATTED',STATUS='OLD') OPEN(LU2,FILE=FILE2,FORM='UNFORMATTED',STATUS='OLD') OPEN(LU3,FILE=FILE3,FORM='UNFORMATTED') OPEN(LU4,FILE=FILE4,FORM='UNFORMATTED') C C Loop for the points of rays 10 CONTINUE C Reading the results of the complete ray tracing CALL AP00(0,LU1,LU2) IF(IWAVE.LT.1)THEN C End of rays GO TO 80 END IF IF (IREC.GT.0) THEN C Two-point ray: WRITE(LU3) IWAVE,IRAY,NY,ICB1,ISRF,X,YL,(Y(I),I=1,NY) IF(IPT.LE.1)THEN C New ray - recording the initial point WRITE(LU4) -IWAVE,IRAY,ICB1I,IEND,ISHEET,IREC,YLI,YI END IF END IF GO TO 10 C 80 CONTINUE CLOSE(LU1) CLOSE(LU2) CLOSE(LU3) CLOSE(LU4) STOP END C C======================================================================= C INCLUDE 'ap.for' C ap.for C C======================================================================= Ccrtdoc.htm 100666 1750 1750 124162 6425373366 12211 0 ustar klimes klimes
Complete ray tracing subroutine package CRT (general description)
Version 5.10 Date: 1997, October 26 Authors: Petr Bulant Department of Geophysics, Charles University Prague Ke Karlovu 3 121 16 Praha 2, Czech Republic E-mail: bulant@seis.karlov.mff.cuni.cz Vlastislav Cerveny Department of Geophysics, Charles University Prague Ke Karlovu 3 121 16 Praha 2, Czech Republic E-mail: vcerveny@seis.karlov.mff.cuni.cz 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 Ivan Psencik Geophysical Institute, Acad. Sci. Czech Rep. Bocni II, 1401 141 31 Praha 4, Czech Republic E-mail: ip@ig.cas.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: Cerveny V., Klimes L. and Psencik I. (1988): Complete seismic-ray tracing in three-dimensional structures. In: Seismological Algorithms, ed. Doornbos D.J., Academic Press, New York. The above paper contains detailed description of the algorithm of complete ray tracing and is frequently referred throughout the code of complete ray tracing. The references like (C.R.T.5.4) or (5.4) are related to the paper. The detailed description of the input data, subroutine and function parameters, and other specifications not contained in the paper, is included within the individual source code files. Bulant, P. (1996): Two-point ray tracing in 3-D. PAGEOPH, in press. Bulant, P. (1996): Two-point ray tracing and controlled initial-value ray tracing in 3-D heterogeneous block structures. In: Seismic Waves in Complex 3-D Structures, Report 4, pp. 61-75, Dep. Geophys., Charles Univ., Prague. These references are related to the two-parametric shooting algorithm for 3-D two-point ray tracing coded in file 'RP3D.FOR'. The code of the complete ray tracing subroutine package CRT is build up on the basis of the model specification subroutine package MODEL. Thus this general description of C.R.T. should be understood as a continuation of the general description 'modeldoc.htm' of the seismic model specification subroutines. Attention: subroutine SCRO5 of 'scropc.for' interactively asks external unit * to continue. This should be taken into account if linking 'crt.for' and wishing to redirect the * unit into a file. ...................................................................... The Complete Ray Tracing consists of package MODEL and of the following FORTRAN77 source code and demo files: (A) Documentation: 'crt.htm'... Main HTML file containing basic description and links the files of this package. 'crtdoc.htm'... This file containing a brief overview of the CRT package. The detailed description of input data, procedures, and other important topics is included within the individual FORTRAN77 source code files. 'crterr.htm'... HTML file containing links to error descriptions. (B) Basic complete ray tracing program and subroutines: These files together with the forward modelling model specification routines of the files 'model.for', 'metric.for', 'srfc.for', 'parm.for', 'val.for', 'fit.for' form a consistent basic version of the complete ray tracing program. 'crt.for'... Main program. It reads the input data and then controls the complete ray tracing of the specified elementary waves. 'crtin.for'... Subroutines designed to open the data files for complete ray tracing and to read the input data sets CRT, MODEL, DCRT and INIT. Called e.g. by the main program 'crt.for'. 'code.for'... Subroutine file devoted to the codes for elementary waves. Contains the general description of the codes for elementary waves and subroutines designed to read the input data for the codes of elementary waves and to transform the used numerical code of the elementary wave under consideration into instructions specifying the behaviour of the wave at the initial points of rays and at all points of incidence of the rays at interfaces (see C.R.T.4). 'code.inc'... Include file with COMMON block for 'code.for'. 'ray.for'... Contains the subroutine designed to read the input data for complete ray tracing and to store them in the memory (see C.R.T.5.6), the list of the quantities computed along rays (see C.R.T.5.2), and the subroutine designed to continue the complete ray tracing of a ray from the given point (see C.R.T.5.7). 'dcrt.inc'... Include file with COMMON block with data controlling ray tracing. The data are read by 'ray.for' and are used by various ray tracing routines. 'raycb.for'... Subroutines for complete ray tracing within one complex block (see C.R.T.5.8). 'raycb.inc'... Include file with COMMON block for 'raycb.for'. 'trans.for'... Subroutine transforming the computed quantities across a curved interface (see C.R.T.5.9), and subroutine replacing the amplitudes by ones involving the appropriate conversion coefficients (see C.R.T.5.5.4). 'coef.for'... Subroutines computing the reflection/transmission coefficients (see C.R.T.5.9.7). 'init.for'... Subroutines designed to read the input data for the initial surface, and to define the initial values of the quantities for complete tracing of a ray with given take-off parameters (see C.R.T.6). 'initd.inc'... Include file with COMMON blocks for 'init.for', containing input data and related quantities. 'initc.inc'... Include file with COMMON block for 'init.for' and other routines, containing the quantities at the initial point of the ray being currently traced. 'rpar.for'... Subroutines controlling the take-off parameters of the rays. A user may introduce his own procedure of selection of the take-off parameters and his own two-point ray tracing algorithm by means of a modification of this subroutine file, or subsequently referred files 'rp2d.for' and 'rp3d.for' controlling the shooting algorithms. 'rpard.inc'... Include file with COMMON block for 'rpar.for', containing input data and related quantities. 'rparc.inc'... Include file with COMMON blocks for 'rpar.for' to record the ray histories and other related quantities. 'rp2d.for'... Subroutines controlling the one-parametric shooting algorithm determining the normalized take-off parameter of rays for 2-D two-point ray tracing. 'rp2d.inc'... Include file with COMMON block for 'rp2d.for'. 'rp3d.for'... Subroutines controlling the two-parametric shooting algorithm determining the normalized take-off parameters of rays for 3-D two-point ray tracing. 'rp3dnul.for'... Void subroutines replacing 'rp3d.for' to save RAM if only 2-D ray tracing is performed. Not very interesting. 'writ.for'... Subroutines creating the output of complete ray tracing (see C.R.T.5.5). 'writ.inc'... Include file with COMMON blocks for 'writ.for'. 'scronum.for'... Basic version of the subroutine file 'scro.for', writing the index of ray and the index of elementary wave to the screen. It uses the '+' ASA carriage control character in the first column to avoid line feed. (C) The following subroutine files may be used to modify the basic version of the complete ray tracing program by means of additional screen output routines: 'scronul.for'... Dummy version of the subroutine file 'scro.for' containing screen output subroutines called by the subroutines of the package 'writ.for'. 'scropc.for'... Version of the subroutine file 'scro.for' for the IBM-compatible personal computers. It should also work on the VAX computers. The screen output consists of a simple graphic output (see the subroutine files 'plot*.for' below) and of writing the brief messages on the status of the currently computed ray to the console. This output controls the console by means of the ANSI escape sequences supported by MS-DOS ANSI.SYS driver on IBM-compatible personal computers. This console output is just an example, the subroutines SCRO1, SCRO2, SCRO3, SCRO4 and SCRO5 have to be modified by a user for the particular computer system. If no screen output is required, the executable statements of the subroutines SCRO1, SCRO2, SCRO3, SCRO4 and SCRO5 may simply be deleted (see 'scronul.for' above). Graphic output is accomplished by means of invocation of 'CalComp' subroutines PLOTS, PLOT, and NEWPEN. They may be already available on some computers for some FORTRAN77 compilers (e.g., PLOTS, PLOT, and NEWPEN are included in the Lahey FORTRAN77 compilers for PC's). Otherwise, 'scropc.for' may be linked with 'plotnul.for' to disable plotting, or with user's own interface routines to his particular graphic system (see files 'plot*.for' and 'calcomp.for'). 'scropc.inc'... Include file with COMMON block for 'scropc.for'. 'plotnul.for'... Dummy version of the subroutine file 'plot*.for' containing the plot subroutines called by the subroutines of the package 'scropc.for', see also the section graphics of this guide. 'calcomp.cfg'... Configuration file to the 'calcomp.for' routines, disabling the interactive communication and other features of 'calcomp.for' not required by the 'scropc.for' routines. The 'calcomp.cfg' configuration file is active just if located in the current directory. Otherwise, the 'calcomp.for' routines run in an interactive way and may create another 'calcomp.cfg' configuration file. Refer to the MODEL package. (D) Application routines and programs facilitating the processing of the results of complete ray tracing: When using the complete ray tracing program composed of the subroutine files listed above, we determine and store various quantities along the ray and at the points of intersection of the ray with some selected surfaces. The following sets of routines may be utilized when processing the results of the complete ray tracing, including a kinematic inversion: 'ap.for'... Applications and processing of the results of complete ray tracing. Subroutines designed to read from the files the quantities describing the points of rays, and to evaluate many other quantities used in seismology and discussed in the chapter C.R.T.7. These subroutines may be included in user's application programs following the complete ray tracing program. Individual subroutines correspond to the individual sections of the chapter C.R.T.7, and may call many subroutines of the above files composing the complete ray tracing program. 'apvar.for'... Subroutines designed to evaluate the variations of the travel time with respect to the model coefficients. 'pointc.inc'... Include file with COMMON block /POINTC/ to store the quantities calculated at a point of a ray, used by 'ap.for' and other routines processing the results of the 'crt.for' program. 'crtout.for'... Subroutines to facilitate conversion of the unformatted output of program CRT into formatted files. 'ttsort.for'... Subroutine to sort the quantities according to the receivers, and at each receiver according to the increasing travel time. 'rpplot.for': Plotting ray parameters. 'crt2d3d.for'... Program to transform 2-D system of rays to 3-D system of rays to be processed by program MTT, which present version works only in 3-D. 'mtt.for': Interpolation within ray cells. 'mttgrd.for': Converting multivalued travel times produced by program MTT into several singlevalued grids corresponding to individual ray histories. 'crt2p.for'... Program to single out two-point rays in the unformatted output program CRT. Simple illustrative example how to use 'ap.for'. 'crtpts.for'... Program converting the unformatted output of program CRT into formatted file with endpoints of rays. 'crtray.for'... Program converting the unformatted output of program CRT into formatted files with rays suitable for plotting. 'green.for'... Program to convert the unformatted output of program CRT into a formatted file containing the ray-theory elastodynamic Green function. 'greenss.for'... Program to read a formatted file containing the ray-theory elastodynamic Green function and to generate ray-theory time-domain synthetic seismograms (without attenuation) or frequency-domain response functions (including causal Futterman's attenuation). 'ss.for'(Synthetic Seismograms)... Program to read or generate and filter the source time function. It may store the filtered source time function and its Hilbert transform in the GSE data exchange format, or read the frequency-domain response function and generate synthetic seismograms in the GSE data exchange format. 'sp.for'(Seismogram Plotting)... Program to plot seismograms previously stored in the GSE data exchange format. 'inv1tt.for'... Program designed to evaluate the derivatives of the travel time with respect to the model coefficients. (E) Demo files: 'guide.dat'... Some comments to the sample input data files '*.dat'. 'guide.dat' itself is not a data file. 'crt.dat'... Sample main input data for the CRT program. This data file refers, among others, sample data file 'model.dat' of the MODEL specification package, which has therefore to be located in the current directory. 'dcrt.dat'... Additional input data file for the CRT program, with the numerical parameters for the complete ray tracing. 'init.dat'... Additional input data file for the CRT program, specifying the initial conditions for rays (referring 'len-src.dat'). 'len-src.dat'... Additional input data file for the CRT program, specifying the position of the point source. 'code.dat'... Additional input data file for the CRT program, specifying the codes of elementary waves. 'code1.dat'... Data specifying only the refracted wave. 'rpar.dat'... Additional input data file for the CRT program, specifying the take-off parameters of the computed rays. 'writ.dat'... Additional input data file for the CRT program, with names of the output files. Whole two-point rays are stored in files corresponding to individual elementary waves and the points of intersection with given surfaces are stored in files corresponding to individual surfaces. 'writsrf.dat'... Alternative data file specifying the names of the output files. No whole rays are stored. The points of intersection with given surfaces are stored in files corresponding to individual surfaces. 'writall.dat'... Alternative data file specifying the names of the output files. All whole rays are stored, not only two-point two-point rays. 'source.dat'... Sample main input data for the GREENSS program to specify the point source (moment-tensor or single-force seismic source). 'srpcrt.bat'... MS-DOS batch file to generate coordinates of the source and receiver points for given configuration parameters, perform two-point ray tracing, and convert unformatted output into a simple formatted file. It runs programs SRP, CRT and CRTPTS. 'srpcrt.bat'... Unix script to generate coordinates of the source and receiver points for given configuration parameters, perform two-point ray tracing, and convert unformatted output into a simple formatted file. It runs programs 'srp', 'crt' and 'crtpts'. 'fcrt.bat'... MS-DOS batch file for Lahey Fortran 77 compiler driven by means of predefined batch file 'f.bat'. 'fcrt'..Unix script to compile the CRT package by means of predefined script 'f' compiling and linking a single Fortran 77 source code file. (F) Subdirectories with data files related to particular models: 'len'...Model with a lenticular inclusion. 'prem'..PREM (Preliminary Reference Earth Model) specified in geographical spherical coordinates. Input data for the complete ray tracing in spherical coordinates. 'elf1'..Homogeneous layers separated by dipping plane interfaces (model MI). 'u2d'...2-D model UNCONFORMITY (Cormier and Mellen 1984). ...................................................................... Compilation and linking: All Fortran 77 source code and include files of the CRT package are assumed to be located in a single directory together with all source code and include files of the MODEL package when being compiled and linked. The files with main programs contain, at their ends, Fortran 90 INCLUDE command for all subroutine files required. In this way, each program may simply be compiled and linked as a single file. All filenames are assumed to be expressed in lowercase (since version 5.00) which should be more convenient than uppercase on Unix systems. Fortran 77 source code files have extension '.for'. The corresponding files with specifications of the COMMON blocks have extension '.inc' and are included in the Fortran 77 source code by means of Fortran 90 INCLUDE command. If using 'scropc.for' and linking with a compiler's calcomp library (e.g. Lahey's F77L3 'GRAPH3.LIB' on a PC), do not forget to adjust the CalComp plotting area in 'scropc.for'. ...................................................................... Running the executable programs: MS-DOS example: If the corresponding executables '*.EXE' have been prepared, CRT.EXE program may be run with demo data, e.g., by entering commands: ECHO 'crt.dat' / >crt.con ECHO >>crt.con ECHO >>crt.con ECHO >>crt.con CRTcrterr.htm 100666 1750 1750 16212 6425373366 12210 0 ustar klimes klimes CRT: error messages Package CRT: List of error messages
crtin.for 100666 1750 1750 33003 6425373366 12021 0 ustar klimes klimes C
- 101
- 102
- 2** (package MODEL)
- 3** (package MODEL)
- 401
- 551
- 552
- 553
- 554
- 556
- 557
- 558
- 559
- 561
- 562
- 563
- 564
- 570
- 58* (package MODEL)
- 591
- 601
- 602
- 611
- 612
- 613
- 614
- 615
- 617
- 618
- 619
- 640
- 641
- 642
- 643
- 644
- 645
- 647
- 648
- 651
- 652
- 659
- 701
- 702
- 703
- 704
- 705
- 706
- 715
- 729
- CALCOPS-** (package FORMS)
- CRT2D3D-01
- CRT2D3D-02
- CRTOUT-01
- CRTOUT-02
- CRTOUT-03
- CRTOUT-04
- CRTOUT-05
- CRTOUT-06
- GREENSS-01
- GREENSS-02
- GREENSS-51
- GSE-** (package FORMS)
- INV1TT-01
- INV1TT-02
- INV1TT-03
- INV1TT-04
- MTT-01
- MTT-02
- MTT-03
- MTT-04
- MTT-05
- MTT-06
- MTT-07
- MTT-08
- MTT-09
- MTT-10
- MTT-11
- MTT-12
- MTT-13
- MTT-14
- MTT-15
- MTT-16
- MTT-17
- MTT-18
- MTT-19
- MTT-20
- MTT-21
- MTT-22
- MTT-23
- MTTGRD-01
- MTTGRD-02
- MTTGRD-03
- RP3D-001
- RP3D-002
- RP3D-003
- RP3D-004
- RP3D-005
- RP3D-006
- RP3D-007
- RP3D-008
- RP3D-009
- RP3D-010
- RP3D-011
- RP3D-012
- RP3D-013
- RP3D-014
- RP3D-015
- RP3D-016
- RP3D-017
- RP3D-018
- RP3D-019
- RP3D-020
- RP3D-021
- RP3D-022
- RP3D-023
- RP3D-024
- RP3D-025
- RP3D-026
- RP3D-027
- RP3D-028
- RP3D-029
- RP3D-030
- RP3D-646
- RP3D-999
- RPPLOT-01
- RPPLOT-02
- RPPLOT-03
- SEP-** (package FORMS)
- SS-01
- SS-02
- SS-03
- SS-04
- SS-05
- SS-06
- SS-07
C File 'crtin.for' for reading the input data for complete ray tracing C C Date: 1997, September 25 C Coded by Ludek Klimes C C....................................................................... C C This file consists of: C CRTIN...Subroutine designed to open the data files for complete C ray tracing and to read the input data sets CRT, MODEL, C DCRT and INIT. C CRTIN C UNIT... Subroutine designed to control connecting and C disconnecting the data files to logical units, and to C determine the logical units from which the given data sets C are to be read. Called e.g. by the subroutine CRTIN. C UNIT C C....................................................................... C C C Description of data files: C C Input data - main data set CRT: C This main data file contains the names of other input files and C the name of the output log file. It may or may not contain other C input data. The names of the output files with the computed C quantities (C.R.T.5.5) are specified in the subroutine file C 'writ.for'. C The data are read in by the list directed input (free format). In C the list of input data below, each numbered paragraph indicates C the beginning of a new input operation (new READ statement). All C input variables are of the type CHARACTER. Only the first 80 C characters of the strings are significant. C (1) TEXT C The string describing the input data. C (2) FILE(2)...data set MODEL C The string containing the name of the file with the input data for C the model. The data will be read in by the subroutine MODEL1. C If FILE(2) is blank, data set MODEL is appended to this file. C Description of data MODEL C It is recommended to define only surfaces covering structural C interfaces (MODEL SURFACES) in data set MODEL, and to define C AUXILIARY SURFACES in data set DCRT. C (3) FILE(3)...data set DCRT C The string containing the name of the file with the input data for C the complete ray tracing. The data will be read in by the C subroutine RAY1. C If FILE(3) is blank, data set DCRT is appended to this file. C Description of data set DCRT C (4) FILE(4)...data set INIT C The string containing the name of the file with the input data C specifying the initial conditions for rays. The data will be read C in by the subroutine INIT1. C If FILE(4) is blank, data set INIT is appended to this file. C Description of data set INIT C (5) FILE(5)...data set CODE C The string containing the name of the file with the codes of C elementary waves. The data will be read in by the subroutine C CODE1. C If FILE(4) is blank, data set CODE is appended to this file. C It is recommended to append at most one of sets CODE, RPAR, WRIT. C Description of data set CODE C (6) FILE(5)...data set RPAR C The string containing the name of the file with the data C specifying the take-off parameters of the required rays. The data C will be read in by the subroutine RPAR1. C If FILE(5) is blank, data set CODE is appended to this file. C It is recommended to append at most one of sets CODE, RPAR, WRIT. C Description of data set RPAR C (7) FILE(6)...data set WRIT C The string containing the name of the file specifying the names of C the output files with the computed quantities. These data will be C read by the subroutine WRIT1. C If FILE(6) is blank, data set WRIT is appended to this file. C It is recommended to append at most one of sets CODE, RPAR, WRIT. C Description of data set WRIT C (8) FILE(6)...data set LOG C The string containing the name of the output log file. The data C will be written by the subroutines WRIT1, WRIT2, WRIT4 and WRIT5. C The filenames FILE(1) to FILE(8) need not be mutually different, C several data sets may be read from (or written to) the same data file. C Each data file is closed when read over, and its logical unit number C may be connected to another file to be opened. When more than one C elementary wave is computed, it is not recommended to write the LOG C output data set to the file containing the CODE, RPAR or WRIT data C set. C Example of data CRT all data sets separated C Example of data CRT with DCRT and INIT C C======================================================================= C C C SUBROUTINE CRTIN(FILE1,LUCODE,LURPAR,LUWRIT,LULOG) CHARACTER*(*) FILE1 INTEGER LUCODE,LURPAR,LUWRIT,LULOG C C Subroutine CRTIN is designed to open the data files for complete ray C tracing and to read the input data sets CRT, MODEL, DCRT and INIT. C C Input: C FILE1...The name of the main input data file CRT. The file is C opened with the logical unit number LU(1)=5 defined in C this subroutine. The name may be blank to use C preconnected input device. Note that also logical units C LU(2)=4, LU(3)=3 and LU(4)=2 may be used to connect other C input data files always having non-blank filenames. C C Output: C LUCODE..The logical unit connected to the file with the CODE data. C LURPAR..The logical unit connected to the file with the RPAR data. C LUWRIT..The logical unit connected to the file with the WRIT data. C LULOG...The logical unit connected to the output LOG file. C C Subroutines and external functions required: EXTERNAL MODEL1,RAY1,INIT1,UNIT C MODEL1..File 'model.for' of the package 'model'. C RAY1... File 'ray.for'. C INIT1...File 'init.for'. C UNIT... This file. C Note that the above subroutines reference many other external C procedures from various subroutine files. These indirectly C referenced procedures are not named here, but are listed in the C particular subroutine files. C C Date: 1997, September 6 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Local storage locations: C C The name of the data: CHARACTER*80 TEXTC C TEXTC...String of 80 characters containing input data (1). C C Auxiliary storage locations: INTEGER I C I... Auxiliary loop variable C C Quantities describing data files and logical units: INTEGER NFILE,IU,NU PARAMETER (NFILE=8) CHARACTER*80 FILE(NFILE) PARAMETER (NU=4) INTEGER LU(NU),KU(NU) DATA LU/5,4,3,2/ C NFILE, FILE, IU, NU, LU, KU... For the description of these C quantities see the subroutine unit below. C C....................................................................... C C The name of the main input file. This file contains the names of C other input files FILE(1)=FILE1 IF(NU.LT.4) THEN C 102 PAUSE 'Error 102 in CRTIN: Less than 4 logical units' STOP C Four logical units must be available to read the input data and C to write the output log file. END IF C C (1) Main data file - contains the names of other input files CALL UNIT(1,NFILE,FILE,IU,NU,LU,KU,'OLD') READ(LU(IU),*) TEXTC DO 10 I=2,NFILE READ(LU(IU),*) FILE(I) 10 CONTINUE C C (2) Data for model CALL UNIT(2,NFILE,FILE,IU,NU,LU,KU,'OLD') CALL MODEL1(LU(IU)) C C (3) Data for complete ray tracing CALL UNIT(3,NFILE,FILE,IU,NU,LU,KU,'OLD') CALL RAY1(LU(IU)) C C (4) Data for initial points of rays CALL UNIT(4,NFILE,FILE,IU,NU,LU,KU,'OLD') CALL INIT1(LU(IU)) C C (5) File containing the codes of elementary waves CALL UNIT(5,NFILE,FILE,IU,NU,LU,KU,'OLD') C The data file for the subroutine CODE1 remains open LUCODE=LU(IU) IU=0 C C (6) File controlling the take-off parameters of rays CALL UNIT(6,NFILE,FILE,IU,NU,LU,KU,'OLD') C The data file for the subroutine RPAR1 remains open LURPAR=LU(IU) IU=0 C C (7) File specifying the names of files with the computed C quantities CALL UNIT(7,NFILE,FILE,IU,NU,LU,KU,'OLD') C The data file for the subroutine WRIT1 remains open LUWRIT=LU(IU) IU=0 C C (8) The output LOG file CALL UNIT(8,NFILE,FILE,IU,NU,LU,KU,'UNKNOWN') C The output file for the subroutines WRIT1, WRIT2, WRIT4 and WRIT5 C remains open LULOG=LU(IU) C RETURN END C C======================================================================= C C C SUBROUTINE UNIT(IFILE,NFILE,FILE,IU,NU,LU,KU,STATUS) INTEGER IFILE,NFILE,IU,NU,LU(NU),KU(NU) CHARACTER*(*) FILE(NFILE),STATUS C C Subroutine UNIT is designed to control connecting and disconnecting C the data files to logical units, and to determine the logical units C from which the given data sets are to be read. C C Input: C IFILE...Index of the data set to be read in. The data sets are C indexed by integers from 1 to NFILE. C NFILE...The total number of data sets. C FILE... Character array containing the names of the files C containing individual data sets. Different data sets may C be stored in the same file. If IFILE=1, only FILE(1) has C to be defined. C IU... Index of the logical unit connected to the file containing C the last read data set (i.e. the last data set was read C from the logical unit LU(IU) connected to the file C FILE(KU(IU)). Zero if no data are read in, or if there is C no data file to close. Need not be defined if IFILE=1. C NU... The maximum number of available logical units. C LU... Array containing reference numbers of logical units. C KU... Auxiliary array of the dimension at least NU. C Its elements KU(1) to KU(NU) must not be modified between C two invocations of this subroutine. Its values need not C be defined if IFILE=1. C KU(I)...Zero if the logical unit LU(I) is closed, C otherwise the sequential number of the next data set to C be read from this unit. C C Output: C IU... Index of the logical unit connected to file with the data C set to be read in (i.e. the next data set will be read C from the logical unit LU(IU) connected to the file C FILE(IFILE)). Zero if no logical unit is available. C KU... Updated input values. C C Date: 1997, September 6 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Auxiliary storage locations: INTEGER IERR,JU,I C IF(IFILE.EQ.1) THEN C No logical units are connected when opening the first data file DO 10 JU=1,NU KU(JU)=0 10 CONTINUE ELSE C Updating indices of next data sets to be read from open files: DO 13 JU=1,NU IF(0.LT.KU(JU).AND.KU(JU).LT.IFILE) THEN C The data set from the file connected to the logical unit C LU(JU) has been read. Determining the next data set C contained in the file: DO 11 I=IFILE,NFILE IF(FILE(KU(JU)).EQ.FILE(I).OR. * (KU(JU).EQ.1.AND.FILE(I).EQ.' ')) THEN C The I-th data set will also be read from the last file C connected to the logical unit LU(JU) KU(JU)=I GO TO 12 END IF 11 CONTINUE C No other data set will be read from the last file. The file C may be closed and the logical unit LU(IU) disconnected 12 CONTINUE END IF 13 CONTINUE C Closing the data file: IF(IU.GT.0) THEN C There is a file submitted to be closed IF(0.LT.KU(IU).AND.KU(IU).LT.IFILE) THEN C No other data set will be read from this file. The file C may be closed and the logical unit LU(IU) disconnected CLOSE(LU(IU)) KU(IU)=0 END IF END IF END IF C C Opening new data file: IF(IFILE.GT.0) THEN DO 21 JU=1,NU IF(KU(JU).EQ.IFILE) THEN C The data file is already open IU=JU RETURN END IF 21 CONTINUE C The data file has to be opened DO 22 JU=1,NU IF(KU(JU).EQ.0) THEN C The logical unit LU(JU) may be connected to the data file IU=JU KU(IU)=IFILE IF(FILE(IFILE).EQ.' ') THEN OPEN(LU(IU),FILE=' ',STATUS='OLD',IOSTAT=IERR,ERR=90) ELSE OPEN(LU(IU),FILE=FILE(IFILE) * ,STATUS=STATUS,IOSTAT=IERR,ERR=90) END IF RETURN END IF 22 CONTINUE C No logical unit available IU=0 END IF RETURN C 90 CONTINUE C 101 WRITE(*,'('' STATUS'',I5,'': '',A)') IERR,FILE(IFILE) PAUSE 'Error 101 in UNIT: Open file error' STOP C Error encountered during execution of the OPEN statement. END C C====================================================================== Ccrtout.for 100666 1750 1750 42554 6425373367 12236 0 ustar klimes klimes CSUBROUTINE CRTOUT * (LU1,LU2,KALL,KREC,INI,NQ,MPTS,NPTS,OUT,OUTMIN,OUTMAX) C INTEGER LU1,LU2,KALL,KREC,INI,NQ,MPTS,NPTS REAL OUT(NQ,MPTS),OUTMIN(NQ),OUTMAX(NQ) C C Subroutine designed to prepare some output quantities of the CRT C program for printing. C C Input: C LU1,LU2... Logical unit numbers corresponding to files with ray C points and ray initial points. C KALL... KALL.LE.0: only two-point rays are considered, C KALL.GE.1: all rays are considered. C KREC... 0: No Taylor expansion of travel time. C 1: Linear Taylor expansion of travel time to the receiver. C 2: Quadratic Taylor expansion of travel time and linear C Taylor expansion of slowness vector to the receiver. C INI... INI.LE.0: initial points of rays are not considered, C INI.GE.1: initial points of rays are considered. C NQ... Number of reals in each output line. C MPTS... Maximum total number of ray points. C NPTS... Number of ray points already stored in array OUT. C OUT... Quantities at ray points already stored in the memory C during previous invocations. C OUTMIN,OUTMAX... Minimum and maximum values of corresponding C quantities stored in array OUT. C C Output: C NPTS... Number of ray points stored in array OUT. C Input value increased by 1 or 2 (if also the initial C point of a ray has been stored). C OUT... For each ray point, the first NQ quantities of the C following ones: C 1. X1-coordinate. C 2. X2-coordinate. C 3. X3-coordinate. C 4. Travel time. C 5. P1 slowness-vector component. C 6. P2 slowness-vector component. C 7. P3 slowness-vector component. C 8. Real part of ray amplitude, normalized to 1 at an C initial surface or along on a unit sphere around a C point source, corresponding to P- or S1-polarization at C the initial point of the ray. C 9. Imaginary part of ray amplitude corresponding to P- or C S1-polarization at the initial point of the ray. C 10. Real part of ray amplitude corresponding to C S2-polarization at the initial point of the ray. C 11. Imaginary part of ray amplitude corresponding C S2-polarization at the initial point of the ray. C OUTMIN,OUTMAX... Minimum and maximum values of corresponding C quantities stored in array OUT. C C Common block /POINTC/ to store the results of complete ray tracing: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C Subroutines and external functions required: EXTERNAL AP00 C AP00... File 'ap.for'. C C Date: 1997, October 25 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Local storage locations: REAL GIANT PARAMETER (GIANT=1.E20) INTEGER IQ REAL QDETI,QDET,VI,V,RHOI,RHO,AUX REAL HI(18),H(18),HUI(9),RM(6),RN(6),R(3),P(3) C C....................................................................... C IF(NPTS.EQ.0) THEN DO 10 IQ=1,NQ OUTMIN(IQ)= GIANT OUTMAX(IQ)=-GIANT 10 CONTINUE END IF C 20 CONTINUE C Reading the results of the complete ray tracing CALL AP00(0,LU1,LU2) IF(IWAVE.LT.1)THEN C End of rays RETURN ELSE IF (KALL.GT.0.OR.IREC.GT.0) THEN C .............................................................. C Initial point of the ray: IF(INI.GT.0.AND.IPT.LE.1)THEN C New ray - recording the initial point IF(NPTS.GE.MPTS) THEN C CRTOUT-01 PAUSE * 'Error CRTOUT-01: Too many ray points to fit in memory' STOP END IF NPTS=NPTS+1 C C Coordinates: DO 31 IQ=1,MIN0(NQ,3) OUT(IQ,NPTS)=YI(2+IQ) 31 CONTINUE C Travel time: DO 32 IQ=4,MIN0(NQ,4) OUT(IQ,NPTS)=YI(1) 32 CONTINUE C Slowness vector: DO 33 IQ=5,MIN0(NQ,7) OUT(IQ,NPTS)=YI(1+IQ) 33 CONTINUE C Amplitudes: DO 34 IQ=8,NQ OUT(IQ,NPTS)=0. 34 CONTINUE DO 35 IQ=8,MIN0(NQ,NY-20),6 OUT(IQ,NPTS)=1. 35 CONTINUE C DO 39 IQ=1,NQ OUTMIN(IQ)=AMIN1(OUTMIN(IQ),OUT(IQ,NPTS)) OUTMAX(IQ)=AMAX1(OUTMAX(IQ),OUT(IQ,NPTS)) 39 CONTINUE END IF C .............................................................. C Other than initial ray point: IF(NPTS.GE.MPTS) THEN C CRTOUT-02 PAUSE'Error CRTOUT-02: Too many ray points to fit in memory' STOP END IF NPTS=NPTS+1 C C Coordinates: R(1)=Y(3) R(2)=Y(4) R(3)=Y(5) IF(KREC.GE.1) THEN CALL REC(IREC,R(1),R(2),R(3)) END IF DO 41 IQ=1,MIN0(NQ,3) OUT(IQ,NPTS)=R(IQ) 41 CONTINUE C Travel time: DO 42 IQ=4,MIN0(NQ,4) OUT(IQ,NPTS)=Y(1) IF(KREC.GE.1) THEN C Linear Taylor expansion of travel time: R(1)=R(1)-Y(3) R(2)=R(2)-Y(4) R(3)=R(3)-Y(5) OUT(IQ,NPTS)=OUT(IQ,NPTS)+Y(6)*R(1)+Y(7)*R(2)+Y(8)*R(3) IF(KREC.GE.2) THEN C Quadratic Taylor expansion of travel time: CALL AP03(0,HI,H,HUI) CALL AP08(0,H,HUI,RM,RN) P(1)=RN(1)*R(1)+RN(2)*R(2)+RN(4)*R(3) P(2)=RN(2)*R(1)+RN(3)*R(2)+RN(5)*R(3) P(3)=RN(4)*R(1)+RN(5)*R(2)+RN(6)*R(3) OUT(IQ,NPTS)=OUT(IQ,NPTS) * +0.5*(P(1)*R(1)+P(2)*R(2)+P(3)*R(3)) END IF END IF 42 CONTINUE C Slowness vector: DO 43 IQ=5,MIN0(NQ,7) OUT(IQ,NPTS)=Y(1+IQ) IF(KREC.GE.2) THEN C Linear Taylor expansion of slowness vector: IF(KREC.LT.2) THEN OUT(IQ,NPTS)=Y(1+IQ) ELSE OUT(IQ,NPTS)=Y(1+IQ)+P(IQ-4) END IF END IF 43 CONTINUE C Amplitudes: IF(NQ.GT.7) THEN C wrong! AUX=SQRT( YLI(1)**3*YLI(3)*ABS(YI(14)*YI(19)-YI(15)*YI(18))/ C old AUX=SQRT( YLI(1)**3*YLI(3)/ C old* (YL(1) *YL(3) *ABS( Y(20)*Y(25) - Y(21)*Y(24)))) CALL AP07(QDETI,QDET,VI,V,RHOI,RHO,IQ) AUX=SQRT(QDETI*VI*RHOI/(QDET*V*RHO)) DO 44 IQ=8,MIN0(NQ,NY-20) OUT(IQ,NPTS)=Y(20+IQ)*AUX 44 CONTINUE DO 45 IQ=NY-19,NQ OUT(IQ,NPTS)=0. 45 CONTINUE END IF C DO 49 IQ=1,NQ OUTMIN(IQ)=AMIN1(OUTMIN(IQ),OUT(IQ,NPTS)) OUTMAX(IQ)=AMAX1(OUTMAX(IQ),OUT(IQ,NPTS)) 49 CONTINUE C .............................................................. RETURN END IF GO TO 20 C END C C======================================================================= C C C SUBROUTINE TXT1(LU,SRCFIL,RECFIL) C C Subroutine designed to read the source and receiver names and prepare C them for entry TXT2. C C ENTRY TXT2(KALL,KTT,IWAVE,IRAY,IREC,LENTXT,TXT) C C Entry designed to generate the string describing the ray or its C endpoint. C C ENTRY REC(IREC,R1,R2,R3) C C ENTRY SRC(IREC,R1,R2,R3) C INTEGER LU,KALL,KTT,IWAVE,IRAY,IREC,LENTXT CHARACTER*(*) SRCFIL,RECFIL,TXT REAL R1,R2,R3 C C Input: C KALL... IABS(KALL)=0: only source (if the source file has been C submitted) and receiver (for two-point rays) information C is contained within the output string. C IABS(KALL)=1: in addition, the string is prefixed with C the index of the ray. C IABS(KALL)=2: in addition, the string is prefixed also C with the index of the elementary wave. C KTT... 0: creates a single string. C 1: separates the string into 2 strings: the source and C receiver parts. This option is intended to generate C files with synthetic travel times. C IWAVE...Index of the elementary wave. C IRAY... Index of the ray within the elementary wave. C IREC... Index of the receiver for a two-point ray, determined in C subroutine RPAR4. C C Output: C LENTXT..Length of the string, including also apostrophes. C TXT... The string, beginning and terminating with apostrophes. C If KTT=1, the string is separated by C apostrophe,blank,apostrophe into the source and receiver C parts. C Examples: KTT IREC REC C --------- KALL SRC C ' ' 0 0 0 n C 'REC 13' 0 0 + n n C 'recnam' 0 0 + n y C 'srcnam' 0 0 0 y C 'srcnam, REC 13' 0 0 + y n C 'srcnam TO recnam' 0 0 + y y C 'RAY 112' 0 1 0 n C 'RAY 112, REC 13' 0 1 + n n C 'RAY 112 TO recnam' 0 1 + n y C 'RAY 112 FROM srcnam' 0 1 0 y C 'RAY 112 FROM srcnam, REC 13' 0 1 + y n C 'RAY 112 FROM srcnam to recnam' 0 1 + y y C 'WAVE 1, RAY 112' 0 2 0 n C 'WAVE 1, RAY 112, REC 13' 0 2 + n n C 'WAVE 1, RAY 112 TO recnam' 0 2 + n y C 'WAVE 1, RAY 112 FROM srcnam' 0 2 0 y C 'WAVE 1, RAY 112 FROM srcnam, rec 13' 0 2 + y n C 'WAVE 1, RAY 112 FROM srcnam TO recnam' 0 2 + y y C ' ' ' ' 1 0 0 n C ' ' 'REC 13' 1 0 + n n C ' ' 'recnam' 1 0 + n y C 'srcnam' ' ' 1 0 0 y C 'srcnam' 'REC 13' 1 0 + y n C 'srcnam' 'recnam' 1 0 + y y C 'RAY 112' ' ' 1 1 0 n C 'RAY 112' 'REC 13' 1 1 + n n C 'RAY 112' 'recnam' 1 1 + n y C 'RAY 112 FROM srcnam' ' ' 1 1 0 y C 'RAY 112 FROM srcnam' 'REC 13' 1 1 + y n C 'RAY 112 FROM srcnam' 'recnam' 1 1 + y y C 'WAVE 1, RAY 112' ' ' 1 2 0 n C 'WAVE 1, RAY 112' 'REC 13' 1 2 + n n C 'WAVE 1, RAY 112' 'recnam' 1 2 + n y C 'WAVE 1, RAY 112 FROM srcnam' ' ' 1 2 0 y C 'WAVE 1, RAY 112 FROM srcnam' 'REC 13' 1 2 + y n C 'WAVE 1, RAY 112 FROM srcnam' 'recnam' 1 2 + y y C C Subroutines and external functions required: INTEGER LENGTH EXTERNAL LENGTH C LENGTH..File 'length.for'. C C Date: 1996, August 30 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C INTEGER MPTS,NSRC,NREC,LENSRC,LENREC PARAMETER (MPTS=1000) CHARACTER*8 POINTS(MPTS) REAL UNDEF,COOR1(MPTS),COOR2(MPTS),COOR3(MPTS) PARAMETER (UNDEF=-999999.) SAVE NSRC,NREC,LENSRC,LENREC,POINTS,COOR1,COOR2,COOR3 C INTEGER I,ISRC C C----------------------------------------------------------------------- C NSRC=0 LENSRC=0 IF(SRCFIL.NE.' ') THEN OPEN(LU,FILE=SRCFIL,STATUS='OLD') READ(LU,*) (POINTS(1),I=1,20) 11 CONTINUE IF(NSRC.GE.MPTS) THEN C CRTOUT-03 PAUSE * 'Error CRTOUT-03: Too many source names to fit in memory' STOP END IF NSRC=NSRC+1 POINTS(NSRC)='$' COOR1(NSRC)=UNDEF COOR2(NSRC)=UNDEF COOR3(NSRC)=UNDEF READ(LU,*,END=12) * POINTS(NSRC),COOR1(NSRC),COOR2(NSRC),COOR3(NSRC) IF(POINTS(NSRC).EQ.'$') THEN GO TO 12 END IF LENSRC=MAX0(LENGTH(POINTS(NSRC)),LENSRC) GO TO 11 12 CONTINUE NSRC=NSRC-1 CLOSE(LU) END IF C NREC=NSRC LENREC=0 IF(RECFIL.NE.' ') THEN OPEN(LU,FILE=RECFIL,STATUS='OLD') READ(LU,*) (POINTS(NREC+1),I=1,20) 21 CONTINUE IF(NREC.GE.MPTS) THEN C CRTOUT-04 PAUSE * 'Error CRTOUT-04: Too many receiver names to fit in memory' STOP END IF NREC=NREC+1 POINTS(NREC)='$' COOR1(NREC)=UNDEF COOR2(NREC)=UNDEF COOR3(NREC)=UNDEF READ(LU,*) POINTS(NREC),COOR1(NREC),COOR2(NREC),COOR3(NREC) IF(POINTS(NREC).EQ.'$') THEN NREC=NREC-1 GO TO 22 END IF LENREC=MAX0(LENGTH(POINTS(NREC)),LENREC) GO TO 21 22 CONTINUE CLOSE(LU) END IF C RETURN C C----------------------------------------------------------------------- C ENTRY REC(IREC,R1,R2,R3) C IF(LENREC.GT.0.AND.IREC.GT.0.AND.IREC.LE.NREC-NSRC) THEN IF(COOR1(NSRC+IREC).NE.UNDEF) R1=COOR1(NSRC+IREC) IF(COOR2(NSRC+IREC).NE.UNDEF) R2=COOR2(NSRC+IREC) IF(COOR3(NSRC+IREC).NE.UNDEF) R3=COOR3(NSRC+IREC) END IF C RETURN C C----------------------------------------------------------------------- C ENTRY SRC(IREC,R1,R2,R3) C IF(LENSRC.GT.0.AND.IREC.GT.0.AND.IREC.LE.NSRC) THEN IF(COOR1(IREC).NE.UNDEF) R1=COOR1(IREC) IF(COOR2(IREC).NE.UNDEF) R2=COOR2(IREC) IF(COOR3(IREC).NE.UNDEF) R3=COOR3(IREC) END IF C RETURN C C----------------------------------------------------------------------- C ENTRY TXT2(KALL,KTT,IWAVE,IRAY,IREC,LENTXT,TXT) C C The name of the first point in the source file is selected: C ------ ISRC=1 C ------ C C Initial apostrophe: LENTXT=1 TXT='''' C C Index of the elementary wave: IF(IABS(KALL).GE.2) THEN TXT(LENTXT+1:LENTXT+10)='WAVE0000, ' WRITE(TXT(LENTXT+5:LENTXT+8),'(I4)') IWAVE LENTXT=LENTXT+10 END IF C C Index of the ray: IF(IABS(KALL).GE.1) THEN TXT(LENTXT+1:LENTXT+8)='RAY00000' WRITE(TXT(LENTXT+4:LENTXT+8),'(I5)') IRAY LENTXT=LENTXT+8 END IF C C Name of the source: IF(LENSRC.GT.0) THEN IF(ISRC.GT.0) THEN IF(ISRC.GT.NSRC) THEN C CRTOUT-05 PAUSE * 'Error CRTOUT-05: Source index exceeding number of sources' STOP END IF C Separator: IF(KALL.NE.0) THEN TXT(LENTXT+1:LENTXT+6)=' FROM ' LENTXT=LENTXT+6 END IF C Name: TXT(LENTXT+1:LENTXT+LENSRC)=POINTS(ISRC)(1:LENSRC) LENTXT=LENTXT+LENSRC END IF END IF C C Separation of source and receiver strings: IF(KTT.NE.0) THEN IF(LENTXT.LE.1) THEN LENTXT=2 END IF TXT(LENTXT+1:LENTXT+3)=''' ''' LENTXT=LENTXT+3 END IF C C Name of the receiver: IF(LENREC.GT.0) THEN C Separator: IF(KTT.EQ.0.AND.LENTXT.GT.1) THEN IF(IREC.GT.0) THEN TXT(LENTXT+1:LENTXT+4)=' TO ' END IF LENTXT=LENTXT+4 END IF C Name: IF(IREC.GT.0) THEN IF(IREC.GT.NREC-NSRC) THEN C CRTOUT-06 PAUSE * 'Error CRTOUT-06: Receiver index exceeding number of receivers' STOP END IF TXT(LENTXT+1:LENTXT+LENREC)=POINTS(NSRC+IREC)(1:LENREC) END IF LENTXT=LENTXT+LENREC END IF C C Index of the receiver: IF(LENREC.EQ.0) THEN C Separator: IF(KTT.EQ.0.AND.LENTXT.GT.1) THEN IF(IREC.GT.0) THEN TXT(LENTXT+1:LENTXT+2)=', ' END IF LENTXT=LENTXT+2 END IF C Index: IF(IREC.GT.0) THEN TXT(LENTXT+1:LENTXT+8)='REC00000' WRITE(TXT(LENTXT+4:LENTXT+8),'(I5)') IREC END IF LENTXT=LENTXT+8 END IF C C Terminating apostrophe: LENTXT=LENTXT+1 TXT(LENTXT:LENTXT)='''' C RETURN END C C======================================================================= Ccrtpts.for 100666 1750 1750 31370 6425373370 12221 0 ustar klimes klimes CC Program CRTPTS converting the unformatted output of program CRT into a C formatted file containing coordinates, travel times, slowness vectors, C and amplitudes at the endpoints of (usually two-point) rays. C C Version: 5.10 C Date: 1997, July 21 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 This simple conversion program may serve as an example how to read and C process output files of the complete ray tracing program 'CRT'. C Reading the output files is completed by a simple invocation of C subroutine AP00 of file 'ap.for', called by means of subroutine CRTOUT C of file 'crtout.for'. C C The structure of the output file with rays is an extension of the C general file form 'points' described in 'formsdoc.htm' and designed to C store 3-D points. C C....................................................................... C C C Description of data files: C C Main input data read from external interactive device (*): C The data consist of character strings and integers, read by list C directed (free format) input. The strings have thus to be C enclosed in apostrophes. The interactive * external unit may be C redirected to the file containing the data. C (1) 'REC','SRC','POINTS','INITIALPOINTS','PTS',NQ,KALL,ISRC,KTT C 'REC'...If non-blank, the name of the file with the names of the C receiver points. The names are then used within the C strings describing the points of two-point rays. C Otherwise, the two-point rays are denoted by the receiver C index. C Description of file REC C 'SRC'...If non-blank, the name of the file with the name of the C source point. The name is then used within the strings C describing the rays. C Description of file SRC C 'POINTS'... File with the quantities stored at the points of C intersections of rays with a specified surface (see C C.R.T.5.5.2). C 'INITIALPOINTS'... File with the quantities at the initial points C of rays, corresponding to file POINTS (see C.R.T.6.1). C 'PTS'.. Name of the output formatted file with ray points. C Description of file PTS C NQ... Number of reals in each output line. C If NQ exceeds parameter MQ (see the code below), it is set C to MQ. C The output reals represent: C 1. X1-coordinate. C 2. X2-coordinate. C 3. X3-coordinate. C 4. Travel time. C 5. P1 slowness-vector component. C 6. P2 slowness-vector component. C 7. P3 slowness-vector component. C 8. Real part of ray amplitude, normalized to 1 at an C initial surface or along on a unit sphere around a C point source, corresponding to P- or S1-polarization at C the initial point of the ray. C 9. Imaginary part of ray amplitude corresponding to P- or C S1-polarization at the initial point of the ray. C Printed only if greater than 0.000001 in abs value. C 10. Real part of ray amplitude corresponding to C S2-polarization at the initial point of the ray. C Printed only if greater than 0.000001 in abs value. C 11. Imaginary part of ray amplitude corresponding C S2-polarization at the initial point of the ray. C Printed only if greater than 0.000001 in abs value. C KALL... KALL.LE.0: only two-point rays are considered. C KALL.GE.1: all rays are considered. C Absolute value specifies the form of the strings C describing individual points. Here are some examples: C ABS(KALL)=0: 'REC 13' C 'recnam' C 'srcnam TO recnam' C ABS(KALL)=1: 'RAY 112' C 'RAY 112, REC 13' C 'RAY 112 TO recnam' C 'RAY 112 FROM srcnam' C 'RAY 112 FROM srcnam TO recnam' C ABS(KALL)=2: 'WAVE 1, RAY 112' C 'WAVE 1, RAY 112, REC 13' C 'WAVE 1, RAY 112 TO recnam' C 'WAVE 1, RAY 112 FROM srcnam' C 'WAVE 1, RAY 112 FROM srcnam TO recnam' C Values KALL=0 and KALL=1 specify the briefest strings. C ISRC.. -1: Initial points of rays are written to the output file C instead of ray points situated on the storing surface. C 0: Ray points situated on the storing surface are written C to the output file. C 1: If the receiver file is specified, the coordinates C of ray endpoints are replaced by receiver coordinates C and the travel time is linearly interpolated to the C receivers. C 2: If the receiver file is specified, the coordinates C of ray endpoints are replaced by receiver coordinates C and the travel time is quadraticly interpolated to the C receivers. C KTT... 0: Creates a single string. C 1: Separates the string into 2 strings: the source and C receiver parts. This option is intended to generate C files with synthetic travel times. C Default: 'REC'=' ', 'SRC'=' ', 'POINTS'='s01.out', C 'INITIALPOINTS'='s01i.out', 'PTS'='pts.out', C NQ=11, KALL=0, ISRC=0, KTT=0. C C Input unformatted file POINTS: C See the description within source code file 'writ.for'. C Description of file POINTS C C Input unformatted file INITIALPOINTS: C See the description within source code file 'writ.for'. C Description of file INITIALPOINTS C C C Output formatted file PTS: C (1) / (a slash). C (2) For each ray endpoint (or initial point) (2.1): C (2.2.1) 'RAYTXT',(OUT(I),I=1,NQ),/ C 'RAYTXT'... One or two strings in apostrophes describing the ray. C See the description of input parameters KALL and KTT. C One string: output format PTS. C Two strings: output format FTT. C (OUT(I),I=1,NQ)... Output quantities at the ray point, see the C description of input parameter NQ. C /... An obligatory slash after at the end of line, in place C where the slowness vector components could be written. C For default NQ=11 and P-wave at the source one of: C (2.1) 'RAYTXT',X1,X2,X3,TT,P1,P2,P3,AR,AI,/ C (2.1) 'RAYTXT',X1,X2,X3,TT,P1,P2,P3,AR,/ C X1,X2,X3... Coordinates of the point of the ray. C TT... Arrival time at the point. C P1,P2,P3... Slowness vector. C AR... Real part of the complex-valued amplitude, normalized to C 1 on a unit sphere. C AI... Imaginary part of the amplitude if it is greater than C 0.000001. C /... An obligatory slash after at the end of line. C (3) / (a slash). C Description of format PTS C Description of format FTT C C----------------------------------------------------------------------- C C Common block /POINTC/ to store the results of complete ray tracing: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C Subroutines and external functions required: EXTERNAL CRTOUT,TXT1,TXT2,TTSORT,FORM2 C CRTOUT,TXT1,TXT2... File 'crtout.for'. C AP00... File 'ap.for' (called by CRTOUT). C LENGTH..File 'length.for' (called by CRTOUT). C TTSORT..File 'ttsort.for'. C INDEXX..File 'indexx.for' (called by TTSORT). C FORM2...File 'forms.for'. C FORM1...File 'forms.for' (called by FORM2). C C----------------------------------------------------------------------- C C Common block /RAMC/: INCLUDE 'ram.inc' C ram.inc C C Allocation of working arrays: INTEGER MPTS,MOUT PARAMETER (MPTS=MRAM/8,MOUT=MRAM-4*MPTS) INTEGER IRECS(MPTS),IWAVES(MPTS),IRAYS(MPTS),INDX(MPTS) REAL OUT(MOUT) EQUIVALENCE (IRECS ,RAM ) EQUIVALENCE (IWAVES,RAM( MPTS+1)) EQUIVALENCE (IRAYS ,RAM(2*MPTS+1)) EQUIVALENCE (INDX ,RAM(3*MPTS+1)) EQUIVALENCE (OUT ,RAM(4*MPTS+1)) REAL RECS(MPTS) EQUIVALENCE (IRECS,RECS) C C----------------------------------------------------------------------- C C Auxiliary storage locations: INTEGER LU1,LU2,LU3,MQ PARAMETER (LU1=1,LU2=2,LU3=3) PARAMETER (MQ=11) C 1:X1, 2:X2, 3:X3, 4:TT, 5:P1, 6:P2, 7:P3, 8:AR1, 9:AI1, C 10:AR2, 11:AI2 CHARACTER*80 FILREC,FILSRC,FILE1,FILE2,FILE3 CHARACTER*(4+8*MQ) FORMAT CHARACTER*80 RAYTXT INTEGER NQ,KALL,ISRC,INI,KTT INTEGER MPTS1,NPTS,LENTXT,IQ,II,I,J REAL OUTMIN(MQ),OUTMAX(MQ) C C....................................................................... C C Opening input and output files: FILREC=' ' FILSRC=' ' FILE1='s01.out' FILE2='s01i.out' FILE3='pts.out' C Number of output quantities: NQ =MQ C Switch between all rays and only two-point rays: KALL=0 ISRC=0 KTT =0 WRITE(*,'(2A)') * ' Enter 5 filenames (REC,SRC,S01,S01I,PTS),', * ' and 4 integers (NQ,KALL,ISRC,KTT): ' READ(*,*) FILREC,FILSRC,FILE1,FILE2,FILE3,NQ,KALL,ISRC,KTT NQ=MIN0(NQ,MQ) MPTS1=MIN0(MPTS,MOUT/NQ) INI =MAX0(0,MIN0(-ISRC,1)) CALL TXT1(LU3,FILSRC,FILREC) FORMAT(1:1)='(' OPEN(LU1,FILE=FILE1,FORM='UNFORMATTED',STATUS='OLD') OPEN(LU2,FILE=FILE2,FORM='UNFORMATTED',STATUS='OLD') OPEN(LU3,FILE=FILE3) WRITE(LU3,'(A)') '/' C C....................................................................... C C Loop for the points of rays: NPTS=0 10 CONTINUE C Reading the results of the complete ray tracing CALL CRTOUT * (LU1,LU2,KALL,ISRC,INI,NQ,MPTS1,NPTS,OUT,OUTMIN,OUTMAX) IF(IWAVE.LT.1)THEN C End of rays GO TO 60 END IF NPTS=NPTS-INI IF(INI.EQ.0.AND.IPT.GT.1)THEN NPTS=NPTS-1 DO 11 IQ=NQ*NPTS+1,NQ*NPTS+NQ OUT(IQ-NQ)=OUT(IQ) 11 CONTINUE END IF IRECS(NPTS)=IREC IWAVES(NPTS)=IWAVE IRAYS(NPTS)=IRAY GO TO 10 60 CONTINUE C C....................................................................... C C Sorting two-point rays: IF(KALL.LE.0) THEN CALL TTSORT(NQ,NPTS,4,OUT,IRECS,RECS,INDX) ELSE DO 71 I=1,NPTS INDX(I)=I 71 CONTINUE END IF C C....................................................................... C C Writing ray points: C C Text describing the point: IF(ISRC.LT.0) THEN LENTXT=9 RAYTXT(1:LENTXT)='''000-000''' WRITE(RAYTXT(2:4),'(I3.3)') -ISRC END IF C C Writing: FORMAT(1:4)='(2A,' CALL FORM2(NQ,OUTMIN,OUTMAX,FORMAT(5:4+8*NQ)) DO 89 I=1,NPTS J=INDX(I) C C Text describing the point: IF(ISRC.LT.0) THEN WRITE(RAYTXT(LENTXT-3:LENTXT-1),'(I3.3)') IRECS(J) ELSE CALL TXT2(KALL,KTT,IWAVES(J),IRAYS(J),IRECS(J),LENTXT,RAYTXT) END IF C J=NQ*(J-1) DO 81 IQ=NQ,1,-1 IF(ABS(OUT(IQ+J)).GE.0.000001) THEN GO TO 82 END IF 81 CONTINUE 82 CONTINUE WRITE(LU3,FORMAT) * RAYTXT(1:LENTXT),(' ',OUT(II),II=1+J,IQ+J),' /' 89 CONTINUE C WRITE(LU3,'(A)') '/' CLOSE(LU3) CLOSE(LU2) CLOSE(LU1) STOP END C C======================================================================= C INCLUDE 'ap.for' C ap.for INCLUDE 'crtout.for' C crtout.for INCLUDE 'ttsort.for' C ttsort.for INCLUDE 'forms.for' C forms.for INCLUDE 'length.for' C length.for INCLUDE 'indexx.for' C indexx.for C C======================================================================= Ccrtray.for 100666 1750 1750 22657 6425373370 12216 0 ustar klimes klimes CC Program CRTRAY converting the unformatted output of program CRT into C formatted files with rays suitable for plotting. C C Version: 5.10 C Date: 1996, September 26 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 This simple conversion program may serve as an example how to read and C process output files of the complete ray tracing program CRT. C Reading the output files is completed by a simple invocation of C subroutine AP00 of file 'ap.for', called by means of subroutine CRTOUT C of file 'crtout.for'. C C The structure of the output file with rays is an extension of the C general file form 'Lines' described in 'formsdoc.htm' and designed to C store 3-D curves, e.g., for the purposes of plotting. C C....................................................................... C C C Description of data files: C C Main input data read from external interactive device (*): C The data consist of character strings and integers, read by list C directed (free format) input. The strings have thus to be C enclosed in apostrophes. The interactive * external unit may be C redirected to the file containing the data. C (1) 'REC','SRC','RAYPOINTS','INITIALPOINTS','RAYS',NQ,KALL C 'REC'...If non-blank, the name of the file with the names of the C receiver points. The names are then used within the C strings describing the two-point rays. Otherwise, the C two-point rays are denoted by the receiver index. C Description of file REC C 'SRC'...If non-blank, the name of the file with the name of the C source point. The name is then used within the strings C describing the rays. C Description of file SRC C 'RAYPOINTS'... File with the quantities stored along rays (see C C.R.T.5.5.1). C 'INITIALPOINTS'... File with the quantities at the initial points C of rays, corresponding to file 'RAYPOINTS' (see C C.R.T.6.1). C 'RAYS'..Name of the output formatted file with rays. This file is C designed, for instance, as input file for plotting rays. C Description of file RAYS C NQ... Number of reals in each output line. C If NQ exceeds parameter MQ (see the code below), it is set C to MQ. C The output reals represent: C 1. X1-coordinate. C 2. X2-coordinate. C 3. X3-coordinate. C 4. Travel time. C 5. P1 slowness-vector component. C 6. P2 slowness-vector component. C 7. P3 slowness-vector component. C 8. Real part of ray amplitude, normalized to 1 at an C initial surface or along on a unit sphere around a C point source, corresponding to P- or S1-polarization at C the initial point of the ray. C 9. Imaginary part of ray amplitude corresponding to P- or C S1-polarization at the initial point of the ray. C Printed only if greater than 0.000001 in abs value. C 10. Real part of ray amplitude corresponding to C S2-polarization at the initial point of the ray. C Printed only if greater than 0.000001 in abs value. C 11. Imaginary part of ray amplitude corresponding C S2-polarization at the initial point of the ray. C Printed only if greater than 0.000001 in abs value. C KALL... KALL.LE.0: only two-point rays are considered, C KALL.GE.1: all rays are considered. C Absolute value specifies the form of the strings C describing individual points. Here are some examples: C ABS(KALL)=0: 'rec 13' C 'recnam' C 'srcnam TO recnam' C ABS(KALL)=1: 'RAY 112' C 'RAY 112, REC 13' C 'RAY 112 TO recnam' C 'RAY 112 FROM srcnam' C 'RAY 112 FROM srcnam TO recnam' C ABS(KALL)=2: 'WAVE 1, RAY 112' C 'WAVE 1, RAY 112, REC 13' C 'WAVE 1, RAY 112 TO recnam' C 'WAVE 1, RAY 112 FROM srcnam' C 'WAVE 1, RAY 112 FROM srcnam TO recnam' C Values KALL=0 and KALL=1 specify the briefest strings. C Default: 'REC'=' ', 'SRC'=' ', 'RAYPOINTS'='r01.out', C 'INITIALPOINTS'='r01i.out', 'RAYS'='rays.out', NQ=4, KALL=0. C C Input unformatted file RAYPOINTS: C See the description within source code file 'writ.for'. C Description of file RAYPOINTS C C Input unformatted file INITIALPOINTS: C See the description within source code file 'writ.for'. C Description of file INITIALPOINTS C C C Output formatted file RAYS (format LIN): C (1) / (a slash). C (2) For each ray (2.1), (2.2), and (2.3): C (2.1) 'RAYTXT',/ C 'RAYTXT'... String in apostrophes describing the ray. See the C description of input parameter KALL. C /... An obligatory slash after the string, in place of the C coordinates of the reference point. C (2.2) For each point of the ray (2.1.1): C (2.2.1) (OUT(I),I=1,NQ),/ C (OUT(I),I=1,NQ)... Output quantities at the ray point, see the C description of input parameter NQ. C /... An obligatory slash after at the end of line, in place C where the slowness vector components could be written. C For default NQ=4: 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 (2.3) / (a slash). C (3) / (a slash). C Description of format LIN C C----------------------------------------------------------------------- C C Common block /POINTC/ to store the results of complete ray tracing: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C Subroutines and external functions required: EXTERNAL CRTOUT,FORM2 C CRTOUT..File 'crtout.for'. C AP00... File 'ap.for' (called by CRTOUT). C FORM2...File 'forms.for'. C FORM1...File 'forms.for' (called by FORM2). C C----------------------------------------------------------------------- C C Auxiliary storage locations: INTEGER LU1,LU2,LU3,MQ,MPTS,MOUT PARAMETER (LU1=1,LU2=2,LU3=3) PARAMETER (MQ=11,MPTS=2,MOUT=MQ*MPTS) C 1:X1, 2:X2, 3:X3, 4:TT C Optional: 5:P1, 6:P2, 7:P3, 8:AR1, 9:AI1, 10:AR2, 11:AI2 CHARACTER*80 FILE1,FILE2,FILE3,FILSRC,FILREC CHARACTER*(2+8*MQ) FORMAT CHARACTER*80 RAYTXT INTEGER NQ,KALL,NPTS,LENTXT,IQ REAL OUT(MOUT),OUTMIN(MQ),OUTMAX(MQ) C C....................................................................... C C Opening input and output files: FILREC=' ' FILSRC=' ' FILE1='r01.out' FILE2='r01i.out' FILE3='rays.out' C Number of output quantities: NQ =4 C Switch between all rays and only two-point rays: KALL=0 WRITE(*,'(2A)') * ' Enter 5 filenames (REC,SRC,R01,R01I,RAYS),', * ' and 2 integers (NQ,KALL): ' READ(*,*) FILREC,FILSRC,FILE1,FILE2,FILE3,NQ,KALL NQ=MIN0(NQ,MQ) CALL TXT1(LU3,FILSRC,FILREC) OPEN(LU1,FILE=FILE1,FORM='UNFORMATTED',STATUS='OLD') OPEN(LU2,FILE=FILE2,FORM='UNFORMATTED',STATUS='OLD') OPEN(LU3,FILE=FILE3) C C....................................................................... C C Loop for the points of rays 10 CONTINUE C Reading the results of the complete ray tracing NPTS=0 CALL CRTOUT(LU1,LU2,KALL,0,1,MQ,MPTS,NPTS,OUT,OUTMIN,OUTMAX) IF(IWAVE.LT.1)THEN C End of rays GO TO 80 END IF C Writing the results of the complete ray tracing FORMAT(1:1)='(' CALL FORM2(NQ,OUTMIN,OUTMAX,FORMAT(2:2+8*NQ)) IF(IPT.LE.1)THEN C New ray - recording the initial point CALL TXT2(KALL,0,IWAVE,IRAY,IREC,LENTXT,RAYTXT) WRITE(LU3,'(A)') '/' WRITE(LU3,'(2A)') RAYTXT(1:LENTXT),' /' WRITE(LU3,FORMAT) OUT(1),(' ',OUT(IQ),IQ=2,NQ),' /' END IF WRITE(LU3,FORMAT) OUT(1+MQ*(NPTS-1)), * (' ',OUT(IQ),IQ=2+MQ*(NPTS-1),MQ*(NPTS-1)+NQ),' /' GO TO 10 C 80 CONTINUE WRITE(LU3,'(A)') '/' WRITE(LU3,'(A)') '/' CLOSE(LU3) CLOSE(LU2) CLOSE(LU1) STOP END C C======================================================================= C INCLUDE 'ap.for' C ap.for INCLUDE 'crtout.for' C crtout.for INCLUDE 'forms.for' C forms.for INCLUDE 'length.for' C length.for C C======================================================================= Cdcrt.dat 100666 1750 1750 1412 6425373370 11572 0 ustar klimes klimes 'Data file dcrt.dat: Numerical parameters for ray tracing' 0 0 5 0 / (KSTORE, NEXPS, NHLF, MODCRT) 1.0 2.0 0.0001 0.001 0.001 0.001 0.010 / (STORE,STEP,UEB,...) / (computational volume is the whole model) / (no auxiliary surface defined within this data set) / (no end surfaces) 2 / (storing surfaces) / (all points of intersection) / (all points of intersection) ------------------------------------------------------------------------ The general description of the input data specifying the numerical parameters of the ray tracing may be found in file 'ray.for'. ======================================================================== dcrt.inc 100666 1750 1750 4757 6425373366 11617 0 ustar klimes klimes CC INCLUDE 'dcrt.inc' C ------------------------------------------------------------------ INTEGER MEND,MSTOR PARAMETER (MEND=128) PARAMETER (MSTOR=128) INTEGER KSTORE,NEXPS,NHLF,MODCRT REAL STORE,STEP,UEB,UEBPP,UEBPH,UEBHH,UEBDRT,BOUNDR(7) INTEGER NSRFCA,NEND,KEND(MEND),NSTOR,KSTOR(MSTOR) COMMON/DCRT/ KSTORE,NEXPS,NHLF,MODCRT,STORE,STEP,UEB,UEBPP,UEBPH, * UEBHH,UEBDRT,BOUNDR,NSRFCA,NEND,KEND,NSTOR,KSTOR SAVE /DCRT/ C ------------------------------------------------------------------ C KSTORE,NEXPS,NHLF,MODCRT... Input data (2) of 'ray.for'. C STORE,STEP,UEB,UEBPP,UEBPH,UEBHH,UEBDRT... Input data (3) of C 'ray.for'. C BOUNDR..Boundaries X1MIN,X1MAX,X2MIN,X2MAX,X3MIN,X3MAX,TMAX of the C computational volume, see input data (4) of 'ray.for'. C NSRFCA..Number of auxiliary surfaces, see input data (5) of C 'ray.for'. C NEND... Number of end surfaces, see input data (6) of 'ray.for'. C KEND... Contains the indices of end surfaces, see input data (6) C of 'ray.for'. C NSTOR...Number of surfaces for storing computed quantities, see C input data (7) of 'ray.for'. C KSTOR...Contains the indices of surfaces for storing computed C quantities, see input data (7), the input data (8) and C finally, the input data (9) of 'ray.for'. The total of C 3*NSTOR integers. C C Common block /DCRT/ is also included in subroutine files C 'ray.for', 'raycb.for', 'init.for', 'rpar.for', 'writ.for' and C 'scropc.for'. All the input data are read in 'ray.for'. C c C All the input data are stored sequentially in the same order as C they were read. The only exception are locations NEND and NSTOR C which are inserted when reading the input data. The index of the C last allocated numeric unit of array KEND is named MEND. The C index of the last allocated numeric unit of array KSTOR is named C MSTOR. If MEND or MSTOR is changed, it must be adjusted in all C subroutines which include common block /DCRT/. C C Date: 1996, July 8 C Coded by Ludek Klimes C C======================================================================= Celf1/ 40777 1750 1750 0 6425373371 10701 5 ustar klimes klimes elf1/elf1.doc 100666 1750 1750 2465 6425373371 12323 0 ustar klimes klimes Complete Ray Tracing in a simple 3-D 4-layer model MI (ELF1) ------------------------------------------------------------ The calculation is performed for 3 source-receiver lines: (a) 389 sources SSS=001,002,...,389, 162 receivers: SSS=001,002,...,162. Source coordinates: X1=X2=(4.100+SSS*0.025)/SQRT(2), X3=0.000 Receiver coordinates: X1=X3=(4.025+SSS*0.025-RRR*0.025)/SQRT(2), X3=0.000 Output files: 'elf1aSSS.out' The calculation of 63018 two-point rays (162 two-point rays for each of 389 sources) took 41 minutes on a Pentium/133MHz PC. (b) 236 sources SSS=001,002,...,389, 162 receivers: SSS=001,002,...,162. Source coordinates: X1=4.100+SSS*0.025, X2=7.000, X3=0.010 Receiver coordinates: X1=4.025+SSS*0.025-RRR*0.025, X2=7.000, X3=0.010 Output files: 'elf1bSSS.out' The calculation of 38232 two-point rays (162 two-point rays for each of 236 sources) took 25 minutes on a Pentium/133MHz PC. (c) 236 sources SSS=001,002,...,389, 162 receivers: SSS=001,002,...,162. Source coordinates: X2=2.500, X1=4.100+SSS*0.025, X3=0.010 Receiver coordinates: X2=2.500, X1=4.025+SSS*0.025-RRR*0.025, X3=0.010 Output files: 'elf1cSSS.out' The calculation of 38232 two-point rays (162 two-point rays for each of 236 sources) took 25 minutes on a Pentium/133MHz PC. elf1/elf1-cod.dat 100666 1750 1750 223 6425373371 13037 0 ustar klimes klimes 'elf1-cod.dat (P-wave reflected from the bottom of the third layer)' / 1 1 2 2 3 3 4 3 3 2 2 1 / (block-surface code, reflected wave) / elf1/elf1asrp.dat 100666 1750 1750 13420 6425373371 13225 0 ustar klimes klimes 'elf1asrc.out' 'elf1arec.out' / 'SRC' 2*2.899138 0. 2*0.01767767 / / '001' 2*2.828427 0. 2*0.01767767 / '002' 2*2.810749 0. 2*0.01767767 / '003' 2*2.793072 0. 2*0.01767767 / '004' 2*2.775394 0. 2*0.01767767 / '005' 2*2.757716 0. 2*0.01767767 / '006' 2*2.740039 0. 2*0.01767767 / '007' 2*2.722361 0. 2*0.01767767 / '008' 2*2.704683 0. 2*0.01767767 / '009' 2*2.687006 0. 2*0.01767767 / '010' 2*2.669328 0. 2*0.01767767 / '011' 2*2.651650 0. 2*0.01767767 / '012' 2*2.633973 0. 2*0.01767767 / '013' 2*2.616295 0. 2*0.01767767 / '014' 2*2.598617 0. 2*0.01767767 / '015' 2*2.580940 0. 2*0.01767767 / '016' 2*2.563262 0. 2*0.01767767 / '017' 2*2.545584 0. 2*0.01767767 / '018' 2*2.527907 0. 2*0.01767767 / '019' 2*2.510229 0. 2*0.01767767 / '020' 2*2.492551 0. 2*0.01767767 / '021' 2*2.474874 0. 2*0.01767767 / '022' 2*2.457196 0. 2*0.01767767 / '023' 2*2.439518 0. 2*0.01767767 / '024' 2*2.421841 0. 2*0.01767767 / '025' 2*2.404163 0. 2*0.01767767 / '026' 2*2.386485 0. 2*0.01767767 / '027' 2*2.368808 0. 2*0.01767767 / '028' 2*2.351130 0. 2*0.01767767 / '029' 2*2.333452 0. 2*0.01767767 / '030' 2*2.315775 0. 2*0.01767767 / '031' 2*2.298097 0. 2*0.01767767 / '032' 2*2.280419 0. 2*0.01767767 / '033' 2*2.262742 0. 2*0.01767767 / '034' 2*2.245064 0. 2*0.01767767 / '035' 2*2.227386 0. 2*0.01767767 / '036' 2*2.209708 0. 2*0.01767767 / '037' 2*2.192031 0. 2*0.01767767 / '038' 2*2.174353 0. 2*0.01767767 / '039' 2*2.156676 0. 2*0.01767767 / '040' 2*2.138998 0. 2*0.01767767 / '041' 2*2.121320 0. 2*0.01767767 / '042' 2*2.103642 0. 2*0.01767767 / '043' 2*2.085965 0. 2*0.01767767 / '044' 2*2.068287 0. 2*0.01767767 / '045' 2*2.050610 0. 2*0.01767767 / '046' 2*2.032932 0. 2*0.01767767 / '047' 2*2.015254 0. 2*0.01767767 / '048' 2*1.997577 0. 2*0.01767767 / '049' 2*1.979899 0. 2*0.01767767 / '050' 2*1.962221 0. 2*0.01767767 / '051' 2*1.944543 0. 2*0.01767767 / '052' 2*1.926866 0. 2*0.01767767 / '053' 2*1.909188 0. 2*0.01767767 / '054' 2*1.891510 0. 2*0.01767767 / '055' 2*1.873833 0. 2*0.01767767 / '056' 2*1.856155 0. 2*0.01767767 / '057' 2*1.838477 0. 2*0.01767767 / '058' 2*1.820800 0. 2*0.01767767 / '059' 2*1.803122 0. 2*0.01767767 / '060' 2*1.785444 0. 2*0.01767767 / '061' 2*1.767767 0. 2*0.01767767 / '062' 2*1.750089 0. 2*0.01767767 / '063' 2*1.732412 0. 2*0.01767767 / '064' 2*1.714734 0. 2*0.01767767 / '065' 2*1.697056 0. 2*0.01767767 / '066' 2*1.679379 0. 2*0.01767767 / '067' 2*1.661701 0. 2*0.01767767 / '068' 2*1.644023 0. 2*0.01767767 / '069' 2*1.626346 0. 2*0.01767767 / '070' 2*1.608668 0. 2*0.01767767 / '071' 2*1.590990 0. 2*0.01767767 / '072' 2*1.573313 0. 2*0.01767767 / '073' 2*1.555635 0. 2*0.01767767 / '074' 2*1.537957 0. 2*0.01767767 / '075' 2*1.520280 0. 2*0.01767767 / '076' 2*1.502602 0. 2*0.01767767 / '077' 2*1.484924 0. 2*0.01767767 / '078' 2*1.467247 0. 2*0.01767767 / '079' 2*1.449569 0. 2*0.01767767 / '080' 2*1.431891 0. 2*0.01767767 / '081' 2*1.414213 0. 2*0.01767767 / '082' 2*1.396536 0. 2*0.01767767 / '083' 2*1.378858 0. 2*0.01767767 / '084' 2*1.361180 0. 2*0.01767767 / '085' 2*1.343503 0. 2*0.01767767 / '086' 2*1.325825 0. 2*0.01767767 / '087' 2*1.308147 0. 2*0.01767767 / '088' 2*1.290470 0. 2*0.01767767 / '089' 2*1.272792 0. 2*0.01767767 / '090' 2*1.255114 0. 2*0.01767767 / '091' 2*1.237437 0. 2*0.01767767 / '092' 2*1.219759 0. 2*0.01767767 / '093' 2*1.202081 0. 2*0.01767767 / '094' 2*1.184404 0. 2*0.01767767 / '095' 2*1.166726 0. 2*0.01767767 / '096' 2*1.149048 0. 2*0.01767767 / '097' 2*1.131371 0. 2*0.01767767 / '098' 2*1.113693 0. 2*0.01767767 / '099' 2*1.096015 0. 2*0.01767767 / '100' 2*1.078338 0. 2*0.01767767 / '101' 2*1.060660 0. 2*0.01767767 / '102' 2*1.042982 0. 2*0.01767767 / '103' 2*1.025305 0. 2*0.01767767 / '104' 2*1.007627 0. 2*0.01767767 / '105' 2*0.989949 0. 2*0.01767767 / '106' 2*0.972272 0. 2*0.01767767 / '107' 2*0.954594 0. 2*0.01767767 / '108' 2*0.936916 0. 2*0.01767767 / '109' 2*0.919239 0. 2*0.01767767 / '110' 2*0.901561 0. 2*0.01767767 / '111' 2*0.883883 0. 2*0.01767767 / '112' 2*0.866206 0. 2*0.01767767 / '113' 2*0.848528 0. 2*0.01767767 / '114' 2*0.830850 0. 2*0.01767767 / '115' 2*0.813173 0. 2*0.01767767 / '116' 2*0.795495 0. 2*0.01767767 / '117' 2*0.777817 0. 2*0.01767767 / '118' 2*0.760140 0. 2*0.01767767 / '119' 2*0.742462 0. 2*0.01767767 / '120' 2*0.724784 0. 2*0.01767767 / '121' 2*0.707107 0. 2*0.01767767 / '122' 2*0.689429 0. 2*0.01767767 / '123' 2*0.671751 0. 2*0.01767767 / '124' 2*0.654074 0. 2*0.01767767 / '125' 2*0.636396 0. 2*0.01767767 / '126' 2*0.618718 0. 2*0.01767767 / '127' 2*0.601041 0. 2*0.01767767 / '128' 2*0.583363 0. 2*0.01767767 / '129' 2*0.565685 0. 2*0.01767767 / '130' 2*0.548008 0. 2*0.01767767 / '131' 2*0.530330 0. 2*0.01767767 / '132' 2*0.512652 0. 2*0.01767767 / '133' 2*0.494975 0. 2*0.01767767 / '134' 2*0.477297 0. 2*0.01767767 / '135' 2*0.459619 0. 2*0.01767767 / '136' 2*0.441942 0. 2*0.01767767 / '137' 2*0.424264 0. 2*0.01767767 / '138' 2*0.406586 0. 2*0.01767767 / '139' 2*0.388909 0. 2*0.01767767 / '140' 2*0.371231 0. 2*0.01767767 / '141' 2*0.353553 0. 2*0.01767767 / '142' 2*0.335876 0. 2*0.01767767 / '143' 2*0.318198 0. 2*0.01767767 / '144' 2*0.300520 0. 2*0.01767767 / '145' 2*0.282843 0. 2*0.01767767 / '146' 2*0.265165 0. 2*0.01767767 / '147' 2*0.247487 0. 2*0.01767767 / '148' 2*0.229810 0. 2*0.01767767 / '149' 2*0.212132 0. 2*0.01767767 / '150' 2*0.194454 0. 2*0.01767767 / '151' 2*0.176777 0. 2*0.01767767 / '152' 2*0.159099 0. 2*0.01767767 / '153' 2*0.141421 0. 2*0.01767767 / '154' 2*0.123744 0. 2*0.01767767 / '155' 2*0.106066 0. 2*0.01767767 / '156' 2*0.088388 0. 2*0.01767767 / '157' 2*0.070711 0. 2*0.01767767 / '158' 2*0.053033 0. 2*0.01767767 / '159' 2*0.035355 0. 2*0.01767767 / '160' 2*0.017678 0. 2*0.01767767 / '161' 2*0.000000 0. 2*0.01767767 / '162' 2*-.017678 0. 2*0.01767767 / / elf1/elf1acrt.dat 100666 1750 1750 1646 6425373371 13200 0 ustar klimes klimes 'data elf1acrt.dat' 'elf1-mod.dat' ' ' ' ' 'elf1-cod.dat' ' ' 'writsrf.dat' 'elf1-log.out' 'elf1-dcr.dat' 0 0 5 0 / (KSTORE, NEXPS, NHLF, MODCRT) 999. 10. 0.00005 0.00050 0.000 0.000 0.000 / (STORE,STEP,UEB,UEB**) -2 12 -2 12 -1 5 / (Computational volume) / (No auxiliary surface defined within this data set) / (No end surfaces) -1 / (Storing surfaces) / (All points of intersection) / (All points of intersection) 'elf1-ini.dat' -1 3 / (Single initial point, azimuthal equidistant projection) 'elf1asrc.out' / (File with coordinates of the initial point) 'elf1-rpa.dat (azimuthal equidistant projection ray parameters)' -1 -1 -2 -1 0.0005 0.05 / (ISRFR,ISRFX,ISRFY,NREC,XERR,AERR) 'elf1arec.out' / -.200 -.400 0.150 -.050 -.300 -.300 2 2 1 / / elf1/elf1a.bat 100666 1750 1750 22520 6425373371 12477 0 ustar klimes klimes @ECHO OFF REM ==================================================================== REM Ray tracing for different source-receiver configurations (MS-DOS) REM (for all 389 sources remove command GOTO :END below) REM ==================================================================== REM Deleting old recording of the screen output: IF EXIST elf1ascr.out DEL elf1ascr.out REM Measuring time elapsed: ECHO.|TIME >elf1atim.out REM -------------------------------------------------------------------- CALL srpcrt elf1a 001 GOTO :END CALL srpcrt elf1a 002 CALL srpcrt elf1a 003 CALL srpcrt elf1a 004 CALL srpcrt elf1a 005 CALL srpcrt elf1a 006 CALL srpcrt elf1a 007 CALL srpcrt elf1a 008 CALL srpcrt elf1a 009 CALL srpcrt elf1a 010 CALL srpcrt elf1a 011 CALL srpcrt elf1a 012 CALL srpcrt elf1a 013 CALL srpcrt elf1a 014 CALL srpcrt elf1a 015 CALL srpcrt elf1a 016 CALL srpcrt elf1a 017 CALL srpcrt elf1a 018 CALL srpcrt elf1a 019 CALL srpcrt elf1a 020 CALL srpcrt elf1a 021 CALL srpcrt elf1a 022 CALL srpcrt elf1a 023 CALL srpcrt elf1a 024 CALL srpcrt elf1a 025 CALL srpcrt elf1a 026 CALL srpcrt elf1a 027 CALL srpcrt elf1a 028 CALL srpcrt elf1a 029 CALL srpcrt elf1a 030 CALL srpcrt elf1a 031 CALL srpcrt elf1a 032 CALL srpcrt elf1a 033 CALL srpcrt elf1a 034 CALL srpcrt elf1a 035 CALL srpcrt elf1a 036 CALL srpcrt elf1a 037 CALL srpcrt elf1a 038 CALL srpcrt elf1a 039 CALL srpcrt elf1a 040 CALL srpcrt elf1a 041 CALL srpcrt elf1a 042 CALL srpcrt elf1a 043 CALL srpcrt elf1a 044 CALL srpcrt elf1a 045 CALL srpcrt elf1a 046 CALL srpcrt elf1a 047 CALL srpcrt elf1a 048 CALL srpcrt elf1a 049 CALL srpcrt elf1a 050 CALL srpcrt elf1a 051 CALL srpcrt elf1a 052 CALL srpcrt elf1a 053 CALL srpcrt elf1a 054 CALL srpcrt elf1a 055 CALL srpcrt elf1a 056 CALL srpcrt elf1a 057 CALL srpcrt elf1a 058 CALL srpcrt elf1a 059 CALL srpcrt elf1a 060 CALL srpcrt elf1a 061 CALL srpcrt elf1a 062 CALL srpcrt elf1a 063 CALL srpcrt elf1a 064 CALL srpcrt elf1a 065 CALL srpcrt elf1a 066 CALL srpcrt elf1a 067 CALL srpcrt elf1a 068 CALL srpcrt elf1a 069 CALL srpcrt elf1a 070 CALL srpcrt elf1a 071 CALL srpcrt elf1a 072 CALL srpcrt elf1a 073 CALL srpcrt elf1a 074 CALL srpcrt elf1a 075 CALL srpcrt elf1a 076 CALL srpcrt elf1a 077 CALL srpcrt elf1a 078 CALL srpcrt elf1a 079 CALL srpcrt elf1a 080 CALL srpcrt elf1a 081 CALL srpcrt elf1a 082 CALL srpcrt elf1a 083 CALL srpcrt elf1a 084 CALL srpcrt elf1a 085 CALL srpcrt elf1a 086 CALL srpcrt elf1a 087 CALL srpcrt elf1a 088 CALL srpcrt elf1a 089 CALL srpcrt elf1a 090 CALL srpcrt elf1a 091 CALL srpcrt elf1a 092 CALL srpcrt elf1a 093 CALL srpcrt elf1a 094 CALL srpcrt elf1a 095 CALL srpcrt elf1a 096 CALL srpcrt elf1a 097 CALL srpcrt elf1a 098 CALL srpcrt elf1a 099 CALL srpcrt elf1a 100 CALL srpcrt elf1a 101 CALL srpcrt elf1a 102 CALL srpcrt elf1a 103 CALL srpcrt elf1a 104 CALL srpcrt elf1a 105 CALL srpcrt elf1a 106 CALL srpcrt elf1a 107 CALL srpcrt elf1a 108 CALL srpcrt elf1a 109 CALL srpcrt elf1a 110 CALL srpcrt elf1a 111 CALL srpcrt elf1a 112 CALL srpcrt elf1a 113 CALL srpcrt elf1a 114 CALL srpcrt elf1a 115 CALL srpcrt elf1a 116 CALL srpcrt elf1a 117 CALL srpcrt elf1a 118 CALL srpcrt elf1a 119 CALL srpcrt elf1a 120 CALL srpcrt elf1a 121 CALL srpcrt elf1a 122 CALL srpcrt elf1a 123 CALL srpcrt elf1a 124 CALL srpcrt elf1a 125 CALL srpcrt elf1a 126 CALL srpcrt elf1a 127 CALL srpcrt elf1a 128 CALL srpcrt elf1a 129 CALL srpcrt elf1a 130 CALL srpcrt elf1a 131 CALL srpcrt elf1a 132 CALL srpcrt elf1a 133 CALL srpcrt elf1a 134 CALL srpcrt elf1a 135 CALL srpcrt elf1a 136 CALL srpcrt elf1a 137 CALL srpcrt elf1a 138 CALL srpcrt elf1a 139 CALL srpcrt elf1a 140 CALL srpcrt elf1a 141 CALL srpcrt elf1a 142 CALL srpcrt elf1a 143 CALL srpcrt elf1a 144 CALL srpcrt elf1a 145 CALL srpcrt elf1a 146 CALL srpcrt elf1a 147 CALL srpcrt elf1a 148 CALL srpcrt elf1a 149 CALL srpcrt elf1a 150 CALL srpcrt elf1a 151 CALL srpcrt elf1a 152 CALL srpcrt elf1a 153 CALL srpcrt elf1a 154 CALL srpcrt elf1a 155 CALL srpcrt elf1a 156 CALL srpcrt elf1a 157 CALL srpcrt elf1a 158 CALL srpcrt elf1a 159 CALL srpcrt elf1a 160 CALL srpcrt elf1a 161 CALL srpcrt elf1a 162 CALL srpcrt elf1a 163 CALL srpcrt elf1a 164 CALL srpcrt elf1a 165 CALL srpcrt elf1a 166 CALL srpcrt elf1a 167 CALL srpcrt elf1a 168 CALL srpcrt elf1a 169 CALL srpcrt elf1a 170 CALL srpcrt elf1a 171 CALL srpcrt elf1a 172 CALL srpcrt elf1a 173 CALL srpcrt elf1a 174 CALL srpcrt elf1a 175 CALL srpcrt elf1a 176 CALL srpcrt elf1a 177 CALL srpcrt elf1a 178 CALL srpcrt elf1a 179 CALL srpcrt elf1a 180 CALL srpcrt elf1a 181 CALL srpcrt elf1a 182 CALL srpcrt elf1a 183 CALL srpcrt elf1a 184 CALL srpcrt elf1a 185 CALL srpcrt elf1a 186 CALL srpcrt elf1a 187 CALL srpcrt elf1a 188 CALL srpcrt elf1a 189 CALL srpcrt elf1a 190 CALL srpcrt elf1a 191 CALL srpcrt elf1a 192 CALL srpcrt elf1a 193 CALL srpcrt elf1a 194 CALL srpcrt elf1a 195 CALL srpcrt elf1a 196 CALL srpcrt elf1a 197 CALL srpcrt elf1a 198 CALL srpcrt elf1a 199 CALL srpcrt elf1a 200 CALL srpcrt elf1a 201 CALL srpcrt elf1a 202 CALL srpcrt elf1a 203 CALL srpcrt elf1a 204 CALL srpcrt elf1a 205 CALL srpcrt elf1a 206 CALL srpcrt elf1a 207 CALL srpcrt elf1a 208 CALL srpcrt elf1a 209 CALL srpcrt elf1a 210 CALL srpcrt elf1a 211 CALL srpcrt elf1a 212 CALL srpcrt elf1a 213 CALL srpcrt elf1a 214 CALL srpcrt elf1a 215 CALL srpcrt elf1a 216 CALL srpcrt elf1a 217 CALL srpcrt elf1a 218 CALL srpcrt elf1a 219 CALL srpcrt elf1a 220 CALL srpcrt elf1a 221 CALL srpcrt elf1a 222 CALL srpcrt elf1a 223 CALL srpcrt elf1a 224 CALL srpcrt elf1a 225 CALL srpcrt elf1a 226 CALL srpcrt elf1a 227 CALL srpcrt elf1a 228 CALL srpcrt elf1a 229 CALL srpcrt elf1a 230 CALL srpcrt elf1a 231 CALL srpcrt elf1a 232 CALL srpcrt elf1a 233 CALL srpcrt elf1a 234 CALL srpcrt elf1a 235 CALL srpcrt elf1a 236 CALL srpcrt elf1a 237 CALL srpcrt elf1a 238 CALL srpcrt elf1a 239 CALL srpcrt elf1a 240 CALL srpcrt elf1a 241 CALL srpcrt elf1a 242 CALL srpcrt elf1a 243 CALL srpcrt elf1a 244 CALL srpcrt elf1a 245 CALL srpcrt elf1a 246 CALL srpcrt elf1a 247 CALL srpcrt elf1a 248 CALL srpcrt elf1a 249 CALL srpcrt elf1a 250 CALL srpcrt elf1a 251 CALL srpcrt elf1a 252 CALL srpcrt elf1a 253 CALL srpcrt elf1a 254 CALL srpcrt elf1a 255 CALL srpcrt elf1a 256 CALL srpcrt elf1a 257 CALL srpcrt elf1a 258 CALL srpcrt elf1a 259 CALL srpcrt elf1a 260 CALL srpcrt elf1a 261 CALL srpcrt elf1a 262 CALL srpcrt elf1a 263 CALL srpcrt elf1a 264 CALL srpcrt elf1a 265 CALL srpcrt elf1a 266 CALL srpcrt elf1a 267 CALL srpcrt elf1a 268 CALL srpcrt elf1a 269 CALL srpcrt elf1a 270 CALL srpcrt elf1a 271 CALL srpcrt elf1a 272 CALL srpcrt elf1a 273 CALL srpcrt elf1a 274 CALL srpcrt elf1a 275 CALL srpcrt elf1a 276 CALL srpcrt elf1a 277 CALL srpcrt elf1a 278 CALL srpcrt elf1a 279 CALL srpcrt elf1a 280 CALL srpcrt elf1a 281 CALL srpcrt elf1a 282 CALL srpcrt elf1a 283 CALL srpcrt elf1a 284 CALL srpcrt elf1a 285 CALL srpcrt elf1a 286 CALL srpcrt elf1a 287 CALL srpcrt elf1a 288 CALL srpcrt elf1a 289 CALL srpcrt elf1a 290 CALL srpcrt elf1a 291 CALL srpcrt elf1a 292 CALL srpcrt elf1a 293 CALL srpcrt elf1a 294 CALL srpcrt elf1a 295 CALL srpcrt elf1a 296 CALL srpcrt elf1a 297 CALL srpcrt elf1a 298 CALL srpcrt elf1a 299 CALL srpcrt elf1a 300 CALL srpcrt elf1a 301 CALL srpcrt elf1a 302 CALL srpcrt elf1a 303 CALL srpcrt elf1a 304 CALL srpcrt elf1a 305 CALL srpcrt elf1a 306 CALL srpcrt elf1a 307 CALL srpcrt elf1a 308 CALL srpcrt elf1a 309 CALL srpcrt elf1a 310 CALL srpcrt elf1a 311 CALL srpcrt elf1a 312 CALL srpcrt elf1a 313 CALL srpcrt elf1a 314 CALL srpcrt elf1a 315 CALL srpcrt elf1a 316 CALL srpcrt elf1a 317 CALL srpcrt elf1a 318 CALL srpcrt elf1a 319 CALL srpcrt elf1a 320 CALL srpcrt elf1a 321 CALL srpcrt elf1a 322 CALL srpcrt elf1a 323 CALL srpcrt elf1a 324 CALL srpcrt elf1a 325 CALL srpcrt elf1a 326 CALL srpcrt elf1a 327 CALL srpcrt elf1a 328 CALL srpcrt elf1a 329 CALL srpcrt elf1a 330 CALL srpcrt elf1a 331 CALL srpcrt elf1a 332 CALL srpcrt elf1a 333 CALL srpcrt elf1a 334 CALL srpcrt elf1a 335 CALL srpcrt elf1a 336 CALL srpcrt elf1a 337 CALL srpcrt elf1a 338 CALL srpcrt elf1a 339 CALL srpcrt elf1a 340 CALL srpcrt elf1a 341 CALL srpcrt elf1a 342 CALL srpcrt elf1a 343 CALL srpcrt elf1a 344 CALL srpcrt elf1a 345 CALL srpcrt elf1a 346 CALL srpcrt elf1a 347 CALL srpcrt elf1a 348 CALL srpcrt elf1a 349 CALL srpcrt elf1a 350 CALL srpcrt elf1a 351 CALL srpcrt elf1a 352 CALL srpcrt elf1a 353 CALL srpcrt elf1a 354 CALL srpcrt elf1a 355 CALL srpcrt elf1a 356 CALL srpcrt elf1a 357 CALL srpcrt elf1a 358 CALL srpcrt elf1a 359 CALL srpcrt elf1a 360 CALL srpcrt elf1a 361 CALL srpcrt elf1a 362 CALL srpcrt elf1a 363 CALL srpcrt elf1a 364 CALL srpcrt elf1a 365 CALL srpcrt elf1a 366 CALL srpcrt elf1a 367 CALL srpcrt elf1a 368 CALL srpcrt elf1a 369 CALL srpcrt elf1a 370 CALL srpcrt elf1a 371 CALL srpcrt elf1a 372 CALL srpcrt elf1a 373 CALL srpcrt elf1a 374 CALL srpcrt elf1a 375 CALL srpcrt elf1a 376 CALL srpcrt elf1a 377 CALL srpcrt elf1a 378 CALL srpcrt elf1a 379 CALL srpcrt elf1a 380 CALL srpcrt elf1a 381 CALL srpcrt elf1a 382 CALL srpcrt elf1a 383 CALL srpcrt elf1a 384 CALL srpcrt elf1a 385 CALL srpcrt elf1a 386 CALL srpcrt elf1a 387 CALL srpcrt elf1a 388 CALL srpcrt elf1a 389 REM -------------------------------------------------------------------- :END ECHO.|TIME>>elf1atim.out ECHO [1;31melf1atim.out[0m REM -------------------------------------------------------------------- REM The results from RAM disk may be copied ,e.g., to drive C: rem COPY elf1a0??.out C: rem COPY elf1a1??.out C: rem COPY elf1a2??.out C: rem COPY elf1a3??.out C: rem COPY elf1atim.out C: REM -------------------------------------------------------------------- elf1/elf1a 100777 1750 1750 1374 6425373371 11721 0 ustar klimes klimes #!/bin/sh ### ==================================================================== ### Ray tracing for different source-receiver configurations (Unix) ### (for all 389 sources remove command n=1 below) ### ==================================================================== ### Deleting old recording of the screen output: rm elf1ascr.out 2>/dev/null ### -------------------------------------------------------------------- n=389 n=1 j=0 while [ \( $j -lt $n \) -a \( $j -lt 9 \) ] do j=`expr $j + 1` srpcrt elf1a 00$j done while [ \( $j -lt $n \) -a \( $j -lt 99 \) ] do j=`expr $j + 1` srpcrt elf1a 0$j done while [ $j -lt $n ] do j=`expr $j + 1` srpcrt elf1a $j done ### ==================================================================== elf1/elf1bsrp.dat 100666 1750 1750 12447 6425373371 13236 0 ustar klimes klimes 'elf1bsrc.out' 'elf1brec.out' / 'SRC' 4.100 7.000 0.010 0.025 / / '001' 4.000 7.000 0.010 0.025 / '002' 3.975 7.000 0.010 0.025 / '003' 3.950 7.000 0.010 0.025 / '004' 3.925 7.000 0.010 0.025 / '005' 3.900 7.000 0.010 0.025 / '006' 3.875 7.000 0.010 0.025 / '007' 3.850 7.000 0.010 0.025 / '008' 3.825 7.000 0.010 0.025 / '009' 3.800 7.000 0.010 0.025 / '010' 3.775 7.000 0.010 0.025 / '011' 3.750 7.000 0.010 0.025 / '012' 3.725 7.000 0.010 0.025 / '013' 3.700 7.000 0.010 0.025 / '014' 3.675 7.000 0.010 0.025 / '015' 3.650 7.000 0.010 0.025 / '016' 3.625 7.000 0.010 0.025 / '017' 3.600 7.000 0.010 0.025 / '018' 3.575 7.000 0.010 0.025 / '019' 3.550 7.000 0.010 0.025 / '020' 3.525 7.000 0.010 0.025 / '021' 3.500 7.000 0.010 0.025 / '022' 3.475 7.000 0.010 0.025 / '023' 3.450 7.000 0.010 0.025 / '024' 3.425 7.000 0.010 0.025 / '025' 3.400 7.000 0.010 0.025 / '026' 3.375 7.000 0.010 0.025 / '027' 3.350 7.000 0.010 0.025 / '028' 3.325 7.000 0.010 0.025 / '029' 3.300 7.000 0.010 0.025 / '030' 3.275 7.000 0.010 0.025 / '031' 3.250 7.000 0.010 0.025 / '032' 3.225 7.000 0.010 0.025 / '033' 3.200 7.000 0.010 0.025 / '034' 3.175 7.000 0.010 0.025 / '035' 3.150 7.000 0.010 0.025 / '036' 3.125 7.000 0.010 0.025 / '037' 3.100 7.000 0.010 0.025 / '038' 3.075 7.000 0.010 0.025 / '039' 3.050 7.000 0.010 0.025 / '040' 3.025 7.000 0.010 0.025 / '041' 3.000 7.000 0.010 0.025 / '042' 2.975 7.000 0.010 0.025 / '043' 2.950 7.000 0.010 0.025 / '044' 2.925 7.000 0.010 0.025 / '045' 2.900 7.000 0.010 0.025 / '046' 2.875 7.000 0.010 0.025 / '047' 2.850 7.000 0.010 0.025 / '048' 2.825 7.000 0.010 0.025 / '049' 2.800 7.000 0.010 0.025 / '050' 2.775 7.000 0.010 0.025 / '051' 2.750 7.000 0.010 0.025 / '052' 2.725 7.000 0.010 0.025 / '053' 2.700 7.000 0.010 0.025 / '054' 2.675 7.000 0.010 0.025 / '055' 2.650 7.000 0.010 0.025 / '056' 2.625 7.000 0.010 0.025 / '057' 2.600 7.000 0.010 0.025 / '058' 2.575 7.000 0.010 0.025 / '059' 2.550 7.000 0.010 0.025 / '060' 2.525 7.000 0.010 0.025 / '061' 2.500 7.000 0.010 0.025 / '062' 2.475 7.000 0.010 0.025 / '063' 2.450 7.000 0.010 0.025 / '064' 2.425 7.000 0.010 0.025 / '065' 2.400 7.000 0.010 0.025 / '066' 2.375 7.000 0.010 0.025 / '067' 2.350 7.000 0.010 0.025 / '068' 2.325 7.000 0.010 0.025 / '069' 2.300 7.000 0.010 0.025 / '070' 2.275 7.000 0.010 0.025 / '071' 2.250 7.000 0.010 0.025 / '072' 2.225 7.000 0.010 0.025 / '073' 2.200 7.000 0.010 0.025 / '074' 2.175 7.000 0.010 0.025 / '075' 2.150 7.000 0.010 0.025 / '076' 2.125 7.000 0.010 0.025 / '077' 2.100 7.000 0.010 0.025 / '078' 2.075 7.000 0.010 0.025 / '079' 2.050 7.000 0.010 0.025 / '080' 2.025 7.000 0.010 0.025 / '081' 2.000 7.000 0.010 0.025 / '082' 1.975 7.000 0.010 0.025 / '083' 1.950 7.000 0.010 0.025 / '084' 1.925 7.000 0.010 0.025 / '085' 1.900 7.000 0.010 0.025 / '086' 1.875 7.000 0.010 0.025 / '087' 1.850 7.000 0.010 0.025 / '088' 1.825 7.000 0.010 0.025 / '089' 1.800 7.000 0.010 0.025 / '090' 1.775 7.000 0.010 0.025 / '091' 1.750 7.000 0.010 0.025 / '092' 1.725 7.000 0.010 0.025 / '093' 1.700 7.000 0.010 0.025 / '094' 1.675 7.000 0.010 0.025 / '095' 1.650 7.000 0.010 0.025 / '096' 1.625 7.000 0.010 0.025 / '097' 1.600 7.000 0.010 0.025 / '098' 1.575 7.000 0.010 0.025 / '099' 1.550 7.000 0.010 0.025 / '100' 1.525 7.000 0.010 0.025 / '101' 1.500 7.000 0.010 0.025 / '102' 1.475 7.000 0.010 0.025 / '103' 1.450 7.000 0.010 0.025 / '104' 1.425 7.000 0.010 0.025 / '105' 1.400 7.000 0.010 0.025 / '106' 1.375 7.000 0.010 0.025 / '107' 1.350 7.000 0.010 0.025 / '108' 1.325 7.000 0.010 0.025 / '109' 1.300 7.000 0.010 0.025 / '110' 1.275 7.000 0.010 0.025 / '111' 1.250 7.000 0.010 0.025 / '112' 1.225 7.000 0.010 0.025 / '113' 1.200 7.000 0.010 0.025 / '114' 1.175 7.000 0.010 0.025 / '115' 1.150 7.000 0.010 0.025 / '116' 1.125 7.000 0.010 0.025 / '117' 1.100 7.000 0.010 0.025 / '118' 1.075 7.000 0.010 0.025 / '119' 1.050 7.000 0.010 0.025 / '120' 1.025 7.000 0.010 0.025 / '121' 1.000 7.000 0.010 0.025 / '122' 0.975 7.000 0.010 0.025 / '123' 0.950 7.000 0.010 0.025 / '124' 0.925 7.000 0.010 0.025 / '125' 0.900 7.000 0.010 0.025 / '126' 0.875 7.000 0.010 0.025 / '127' 0.850 7.000 0.010 0.025 / '128' 0.825 7.000 0.010 0.025 / '129' 0.800 7.000 0.010 0.025 / '130' 0.775 7.000 0.010 0.025 / '131' 0.750 7.000 0.010 0.025 / '132' 0.725 7.000 0.010 0.025 / '133' 0.700 7.000 0.010 0.025 / '134' 0.675 7.000 0.010 0.025 / '135' 0.650 7.000 0.010 0.025 / '136' 0.625 7.000 0.010 0.025 / '137' 0.600 7.000 0.010 0.025 / '138' 0.575 7.000 0.010 0.025 / '139' 0.550 7.000 0.010 0.025 / '140' 0.525 7.000 0.010 0.025 / '141' 0.500 7.000 0.010 0.025 / '142' 0.475 7.000 0.010 0.025 / '143' 0.450 7.000 0.010 0.025 / '144' 0.425 7.000 0.010 0.025 / '145' 0.400 7.000 0.010 0.025 / '146' 0.375 7.000 0.010 0.025 / '147' 0.350 7.000 0.010 0.025 / '148' 0.325 7.000 0.010 0.025 / '149' 0.300 7.000 0.010 0.025 / '150' 0.275 7.000 0.010 0.025 / '151' 0.250 7.000 0.010 0.025 / '152' 0.225 7.000 0.010 0.025 / '153' 0.200 7.000 0.010 0.025 / '154' 0.175 7.000 0.010 0.025 / '155' 0.150 7.000 0.010 0.025 / '156' 0.125 7.000 0.010 0.025 / '157' 0.100 7.000 0.010 0.025 / '158' 0.075 7.000 0.010 0.025 / '159' 0.050 7.000 0.010 0.025 / '160' 0.025 7.000 0.010 0.025 / '161' 0.000 7.000 0.010 0.025 / '162' -.025 7.000 0.010 0.025 / / elf1/elf1bcrt.dat 100666 1750 1750 1646 6425373371 13201 0 ustar klimes klimes 'data elf1bcrt.dat' 'elf1-mod.dat' ' ' ' ' 'elf1-cod.dat' ' ' 'writsrf.dat' 'elf1-log.out' 'elf1-dcr.dat' 0 0 5 0 / (KSTORE, NEXPS, NHLF, MODCRT) 999. 10. 0.00005 0.00050 0.000 0.000 0.000 / (STORE,STEP,UEB,UEB**) -2 12 -2 12 0.010 5 / (Computational volume) / (No auxiliary surface defined within this data set) / (No end surfaces) 105 / (Storing surfaces) / (All points of intersection) / (All points of intersection) 'elf1-ini.dat' -1 3 / (Single initial point, azimuthal equidistant projection) 'elf1bsrc.out' / (File with coordinates of the initial point) 'elf1-rpa.dat (azimuthal equidistant projection ray parameters)' 105 -1 -2 -1 0.0005 0.05 / (ISRFR,ISRFX,ISRFY,NREC,XERR,AERR) 'elf1brec.out' / -.330 -.100 0.100 -.100 -.330 0.000 2 2 1 / / elf1/elf1b.bat 100666 1750 1750 14016 6425373371 12501 0 ustar klimes klimes @ECHO OFF REM ==================================================================== REM Ray tracing for different source-receiver configurations (MS-DOS) REM (for all 236 sources remove command GOTO :END below) REM ==================================================================== REM Deleting old recording of the screen output: IF EXIST elf1bscr.out DEL elf1bscr.out REM Measuring time elapsed: ECHO.|TIME >elf1btim.out REM -------------------------------------------------------------------- CALL srpcrt elf1b 001 GOTO :END CALL srpcrt elf1b 002 CALL srpcrt elf1b 003 CALL srpcrt elf1b 004 CALL srpcrt elf1b 005 CALL srpcrt elf1b 006 CALL srpcrt elf1b 007 CALL srpcrt elf1b 008 CALL srpcrt elf1b 009 CALL srpcrt elf1b 010 CALL srpcrt elf1b 011 CALL srpcrt elf1b 012 CALL srpcrt elf1b 013 CALL srpcrt elf1b 014 CALL srpcrt elf1b 015 CALL srpcrt elf1b 016 CALL srpcrt elf1b 017 CALL srpcrt elf1b 018 CALL srpcrt elf1b 019 CALL srpcrt elf1b 020 CALL srpcrt elf1b 021 CALL srpcrt elf1b 022 CALL srpcrt elf1b 023 CALL srpcrt elf1b 024 CALL srpcrt elf1b 025 CALL srpcrt elf1b 026 CALL srpcrt elf1b 027 CALL srpcrt elf1b 028 CALL srpcrt elf1b 029 CALL srpcrt elf1b 030 CALL srpcrt elf1b 031 CALL srpcrt elf1b 032 CALL srpcrt elf1b 033 CALL srpcrt elf1b 034 CALL srpcrt elf1b 035 CALL srpcrt elf1b 036 CALL srpcrt elf1b 037 CALL srpcrt elf1b 038 CALL srpcrt elf1b 039 CALL srpcrt elf1b 040 CALL srpcrt elf1b 041 CALL srpcrt elf1b 042 CALL srpcrt elf1b 043 CALL srpcrt elf1b 044 CALL srpcrt elf1b 045 CALL srpcrt elf1b 046 CALL srpcrt elf1b 047 CALL srpcrt elf1b 048 CALL srpcrt elf1b 049 CALL srpcrt elf1b 050 CALL srpcrt elf1b 051 CALL srpcrt elf1b 052 CALL srpcrt elf1b 053 CALL srpcrt elf1b 054 CALL srpcrt elf1b 055 CALL srpcrt elf1b 056 CALL srpcrt elf1b 057 CALL srpcrt elf1b 058 CALL srpcrt elf1b 059 CALL srpcrt elf1b 060 CALL srpcrt elf1b 061 CALL srpcrt elf1b 062 CALL srpcrt elf1b 063 CALL srpcrt elf1b 064 CALL srpcrt elf1b 065 CALL srpcrt elf1b 066 CALL srpcrt elf1b 067 CALL srpcrt elf1b 068 CALL srpcrt elf1b 069 CALL srpcrt elf1b 070 CALL srpcrt elf1b 071 CALL srpcrt elf1b 072 CALL srpcrt elf1b 073 CALL srpcrt elf1b 074 CALL srpcrt elf1b 075 CALL srpcrt elf1b 076 CALL srpcrt elf1b 077 CALL srpcrt elf1b 078 CALL srpcrt elf1b 079 CALL srpcrt elf1b 080 CALL srpcrt elf1b 081 CALL srpcrt elf1b 082 CALL srpcrt elf1b 083 CALL srpcrt elf1b 084 CALL srpcrt elf1b 085 CALL srpcrt elf1b 086 CALL srpcrt elf1b 087 CALL srpcrt elf1b 088 CALL srpcrt elf1b 089 CALL srpcrt elf1b 090 CALL srpcrt elf1b 091 CALL srpcrt elf1b 092 CALL srpcrt elf1b 093 CALL srpcrt elf1b 094 CALL srpcrt elf1b 095 CALL srpcrt elf1b 096 CALL srpcrt elf1b 097 CALL srpcrt elf1b 098 CALL srpcrt elf1b 099 CALL srpcrt elf1b 100 CALL srpcrt elf1b 101 CALL srpcrt elf1b 102 CALL srpcrt elf1b 103 CALL srpcrt elf1b 104 CALL srpcrt elf1b 105 CALL srpcrt elf1b 106 CALL srpcrt elf1b 107 CALL srpcrt elf1b 108 CALL srpcrt elf1b 109 CALL srpcrt elf1b 110 CALL srpcrt elf1b 111 CALL srpcrt elf1b 112 CALL srpcrt elf1b 113 CALL srpcrt elf1b 114 CALL srpcrt elf1b 115 CALL srpcrt elf1b 116 CALL srpcrt elf1b 117 CALL srpcrt elf1b 118 CALL srpcrt elf1b 119 CALL srpcrt elf1b 120 CALL srpcrt elf1b 121 CALL srpcrt elf1b 122 CALL srpcrt elf1b 123 CALL srpcrt elf1b 124 CALL srpcrt elf1b 125 CALL srpcrt elf1b 126 CALL srpcrt elf1b 127 CALL srpcrt elf1b 128 CALL srpcrt elf1b 129 CALL srpcrt elf1b 130 CALL srpcrt elf1b 131 CALL srpcrt elf1b 132 CALL srpcrt elf1b 133 CALL srpcrt elf1b 134 CALL srpcrt elf1b 135 CALL srpcrt elf1b 136 CALL srpcrt elf1b 137 CALL srpcrt elf1b 138 CALL srpcrt elf1b 139 CALL srpcrt elf1b 140 CALL srpcrt elf1b 141 CALL srpcrt elf1b 142 CALL srpcrt elf1b 143 CALL srpcrt elf1b 144 CALL srpcrt elf1b 145 CALL srpcrt elf1b 146 CALL srpcrt elf1b 147 CALL srpcrt elf1b 148 CALL srpcrt elf1b 149 CALL srpcrt elf1b 150 CALL srpcrt elf1b 151 CALL srpcrt elf1b 152 CALL srpcrt elf1b 153 CALL srpcrt elf1b 154 CALL srpcrt elf1b 155 CALL srpcrt elf1b 156 CALL srpcrt elf1b 157 CALL srpcrt elf1b 158 CALL srpcrt elf1b 159 CALL srpcrt elf1b 160 CALL srpcrt elf1b 161 CALL srpcrt elf1b 162 CALL srpcrt elf1b 163 CALL srpcrt elf1b 164 CALL srpcrt elf1b 165 CALL srpcrt elf1b 166 CALL srpcrt elf1b 167 CALL srpcrt elf1b 168 CALL srpcrt elf1b 169 CALL srpcrt elf1b 170 CALL srpcrt elf1b 171 CALL srpcrt elf1b 172 CALL srpcrt elf1b 173 CALL srpcrt elf1b 174 CALL srpcrt elf1b 175 CALL srpcrt elf1b 176 CALL srpcrt elf1b 177 CALL srpcrt elf1b 178 CALL srpcrt elf1b 179 CALL srpcrt elf1b 180 CALL srpcrt elf1b 181 CALL srpcrt elf1b 182 CALL srpcrt elf1b 183 CALL srpcrt elf1b 184 CALL srpcrt elf1b 185 CALL srpcrt elf1b 186 CALL srpcrt elf1b 187 CALL srpcrt elf1b 188 CALL srpcrt elf1b 189 CALL srpcrt elf1b 190 CALL srpcrt elf1b 191 CALL srpcrt elf1b 192 CALL srpcrt elf1b 193 CALL srpcrt elf1b 194 CALL srpcrt elf1b 195 CALL srpcrt elf1b 196 CALL srpcrt elf1b 197 CALL srpcrt elf1b 198 CALL srpcrt elf1b 199 CALL srpcrt elf1b 200 CALL srpcrt elf1b 201 CALL srpcrt elf1b 202 CALL srpcrt elf1b 203 CALL srpcrt elf1b 204 CALL srpcrt elf1b 205 CALL srpcrt elf1b 206 CALL srpcrt elf1b 207 CALL srpcrt elf1b 208 CALL srpcrt elf1b 209 CALL srpcrt elf1b 210 CALL srpcrt elf1b 211 CALL srpcrt elf1b 212 CALL srpcrt elf1b 213 CALL srpcrt elf1b 214 CALL srpcrt elf1b 215 CALL srpcrt elf1b 216 CALL srpcrt elf1b 217 CALL srpcrt elf1b 218 CALL srpcrt elf1b 219 CALL srpcrt elf1b 220 CALL srpcrt elf1b 221 CALL srpcrt elf1b 222 CALL srpcrt elf1b 223 CALL srpcrt elf1b 224 CALL srpcrt elf1b 225 CALL srpcrt elf1b 226 CALL srpcrt elf1b 227 CALL srpcrt elf1b 228 CALL srpcrt elf1b 229 CALL srpcrt elf1b 230 CALL srpcrt elf1b 231 CALL srpcrt elf1b 232 CALL srpcrt elf1b 233 CALL srpcrt elf1b 234 CALL srpcrt elf1b 235 CALL srpcrt elf1b 236 REM -------------------------------------------------------------------- :END ECHO.|TIME>>elf1btim.out ECHO [1;31melf1btim.out[0m REM -------------------------------------------------------------------- REM The results from RAM disk may be copied ,e.g., to drive C: rem COPY elf1b0??.out C: rem COPY elf1b1??.out C: rem COPY elf1b2??.out C: rem COPY elf1btim.out C: REM -------------------------------------------------------------------- elf1/elf1b 100777 1750 1750 1374 6425373371 11722 0 ustar klimes klimes #!/bin/sh ### ==================================================================== ### Ray tracing for different source-receiver configurations (Unix) ### (for all 236 sources remove command n=1 below) ### ==================================================================== ### Deleting old recording of the screen output: rm elf1bscr.out 2>/dev/null ### -------------------------------------------------------------------- n=236 n=1 j=0 while [ \( $j -lt $n \) -a \( $j -lt 9 \) ] do j=`expr $j + 1` srpcrt elf1b 00$j done while [ \( $j -lt $n \) -a \( $j -lt 99 \) ] do j=`expr $j + 1` srpcrt elf1b 0$j done while [ $j -lt $n ] do j=`expr $j + 1` srpcrt elf1b $j done ### ==================================================================== elf1/elf1csrp.dat 100666 1750 1750 14371 6425373371 13235 0 ustar klimes klimes 'elf1csrc.out' 'elf1crec.out' / 'SRC' 2.500 4.100 0.010 0.000 0.025 / / '001' 2.500 4.000 0.010 0.000 0.025 / '002' 2.500 3.975 0.010 0.000 0.025 / '003' 2.500 3.950 0.010 0.000 0.025 / '004' 2.500 3.925 0.010 0.000 0.025 / '005' 2.500 3.900 0.010 0.000 0.025 / '006' 2.500 3.875 0.010 0.000 0.025 / '007' 2.500 3.850 0.010 0.000 0.025 / '008' 2.500 3.825 0.010 0.000 0.025 / '009' 2.500 3.800 0.010 0.000 0.025 / '010' 2.500 3.775 0.010 0.000 0.025 / '011' 2.500 3.750 0.010 0.000 0.025 / '012' 2.500 3.725 0.010 0.000 0.025 / '013' 2.500 3.700 0.010 0.000 0.025 / '014' 2.500 3.675 0.010 0.000 0.025 / '015' 2.500 3.650 0.010 0.000 0.025 / '016' 2.500 3.625 0.010 0.000 0.025 / '017' 2.500 3.600 0.010 0.000 0.025 / '018' 2.500 3.575 0.010 0.000 0.025 / '019' 2.500 3.550 0.010 0.000 0.025 / '020' 2.500 3.525 0.010 0.000 0.025 / '021' 2.500 3.500 0.010 0.000 0.025 / '022' 2.500 3.475 0.010 0.000 0.025 / '023' 2.500 3.450 0.010 0.000 0.025 / '024' 2.500 3.425 0.010 0.000 0.025 / '025' 2.500 3.400 0.010 0.000 0.025 / '026' 2.500 3.375 0.010 0.000 0.025 / '027' 2.500 3.350 0.010 0.000 0.025 / '028' 2.500 3.325 0.010 0.000 0.025 / '029' 2.500 3.300 0.010 0.000 0.025 / '030' 2.500 3.275 0.010 0.000 0.025 / '031' 2.500 3.250 0.010 0.000 0.025 / '032' 2.500 3.225 0.010 0.000 0.025 / '033' 2.500 3.200 0.010 0.000 0.025 / '034' 2.500 3.175 0.010 0.000 0.025 / '035' 2.500 3.150 0.010 0.000 0.025 / '036' 2.500 3.125 0.010 0.000 0.025 / '037' 2.500 3.100 0.010 0.000 0.025 / '038' 2.500 3.075 0.010 0.000 0.025 / '039' 2.500 3.050 0.010 0.000 0.025 / '040' 2.500 3.025 0.010 0.000 0.025 / '041' 2.500 3.000 0.010 0.000 0.025 / '042' 2.500 2.975 0.010 0.000 0.025 / '043' 2.500 2.950 0.010 0.000 0.025 / '044' 2.500 2.925 0.010 0.000 0.025 / '045' 2.500 2.900 0.010 0.000 0.025 / '046' 2.500 2.875 0.010 0.000 0.025 / '047' 2.500 2.850 0.010 0.000 0.025 / '048' 2.500 2.825 0.010 0.000 0.025 / '049' 2.500 2.800 0.010 0.000 0.025 / '050' 2.500 2.775 0.010 0.000 0.025 / '051' 2.500 2.750 0.010 0.000 0.025 / '052' 2.500 2.725 0.010 0.000 0.025 / '053' 2.500 2.700 0.010 0.000 0.025 / '054' 2.500 2.675 0.010 0.000 0.025 / '055' 2.500 2.650 0.010 0.000 0.025 / '056' 2.500 2.625 0.010 0.000 0.025 / '057' 2.500 2.600 0.010 0.000 0.025 / '058' 2.500 2.575 0.010 0.000 0.025 / '059' 2.500 2.550 0.010 0.000 0.025 / '060' 2.500 2.525 0.010 0.000 0.025 / '061' 2.500 2.500 0.010 0.000 0.025 / '062' 2.500 2.475 0.010 0.000 0.025 / '063' 2.500 2.450 0.010 0.000 0.025 / '064' 2.500 2.425 0.010 0.000 0.025 / '065' 2.500 2.400 0.010 0.000 0.025 / '066' 2.500 2.375 0.010 0.000 0.025 / '067' 2.500 2.350 0.010 0.000 0.025 / '068' 2.500 2.325 0.010 0.000 0.025 / '069' 2.500 2.300 0.010 0.000 0.025 / '070' 2.500 2.275 0.010 0.000 0.025 / '071' 2.500 2.250 0.010 0.000 0.025 / '072' 2.500 2.225 0.010 0.000 0.025 / '073' 2.500 2.200 0.010 0.000 0.025 / '074' 2.500 2.175 0.010 0.000 0.025 / '075' 2.500 2.150 0.010 0.000 0.025 / '076' 2.500 2.125 0.010 0.000 0.025 / '077' 2.500 2.100 0.010 0.000 0.025 / '078' 2.500 2.075 0.010 0.000 0.025 / '079' 2.500 2.050 0.010 0.000 0.025 / '080' 2.500 2.025 0.010 0.000 0.025 / '081' 2.500 2.000 0.010 0.000 0.025 / '082' 2.500 1.975 0.010 0.000 0.025 / '083' 2.500 1.950 0.010 0.000 0.025 / '084' 2.500 1.925 0.010 0.000 0.025 / '085' 2.500 1.900 0.010 0.000 0.025 / '086' 2.500 1.875 0.010 0.000 0.025 / '087' 2.500 1.850 0.010 0.000 0.025 / '088' 2.500 1.825 0.010 0.000 0.025 / '089' 2.500 1.800 0.010 0.000 0.025 / '090' 2.500 1.775 0.010 0.000 0.025 / '091' 2.500 1.750 0.010 0.000 0.025 / '092' 2.500 1.725 0.010 0.000 0.025 / '093' 2.500 1.700 0.010 0.000 0.025 / '094' 2.500 1.675 0.010 0.000 0.025 / '095' 2.500 1.650 0.010 0.000 0.025 / '096' 2.500 1.625 0.010 0.000 0.025 / '097' 2.500 1.600 0.010 0.000 0.025 / '098' 2.500 1.575 0.010 0.000 0.025 / '099' 2.500 1.550 0.010 0.000 0.025 / '100' 2.500 1.525 0.010 0.000 0.025 / '101' 2.500 1.500 0.010 0.000 0.025 / '102' 2.500 1.475 0.010 0.000 0.025 / '103' 2.500 1.450 0.010 0.000 0.025 / '104' 2.500 1.425 0.010 0.000 0.025 / '105' 2.500 1.400 0.010 0.000 0.025 / '106' 2.500 1.375 0.010 0.000 0.025 / '107' 2.500 1.350 0.010 0.000 0.025 / '108' 2.500 1.325 0.010 0.000 0.025 / '109' 2.500 1.300 0.010 0.000 0.025 / '110' 2.500 1.275 0.010 0.000 0.025 / '111' 2.500 1.250 0.010 0.000 0.025 / '112' 2.500 1.225 0.010 0.000 0.025 / '113' 2.500 1.200 0.010 0.000 0.025 / '114' 2.500 1.175 0.010 0.000 0.025 / '115' 2.500 1.150 0.010 0.000 0.025 / '116' 2.500 1.125 0.010 0.000 0.025 / '117' 2.500 1.100 0.010 0.000 0.025 / '118' 2.500 1.075 0.010 0.000 0.025 / '119' 2.500 1.050 0.010 0.000 0.025 / '120' 2.500 1.025 0.010 0.000 0.025 / '121' 2.500 1.000 0.010 0.000 0.025 / '122' 2.500 0.975 0.010 0.000 0.025 / '123' 2.500 0.950 0.010 0.000 0.025 / '124' 2.500 0.925 0.010 0.000 0.025 / '125' 2.500 0.900 0.010 0.000 0.025 / '126' 2.500 0.875 0.010 0.000 0.025 / '127' 2.500 0.850 0.010 0.000 0.025 / '128' 2.500 0.825 0.010 0.000 0.025 / '129' 2.500 0.800 0.010 0.000 0.025 / '130' 2.500 0.775 0.010 0.000 0.025 / '131' 2.500 0.750 0.010 0.000 0.025 / '132' 2.500 0.725 0.010 0.000 0.025 / '133' 2.500 0.700 0.010 0.000 0.025 / '134' 2.500 0.675 0.010 0.000 0.025 / '135' 2.500 0.650 0.010 0.000 0.025 / '136' 2.500 0.625 0.010 0.000 0.025 / '137' 2.500 0.600 0.010 0.000 0.025 / '138' 2.500 0.575 0.010 0.000 0.025 / '139' 2.500 0.550 0.010 0.000 0.025 / '140' 2.500 0.525 0.010 0.000 0.025 / '141' 2.500 0.500 0.010 0.000 0.025 / '142' 2.500 0.475 0.010 0.000 0.025 / '143' 2.500 0.450 0.010 0.000 0.025 / '144' 2.500 0.425 0.010 0.000 0.025 / '145' 2.500 0.400 0.010 0.000 0.025 / '146' 2.500 0.375 0.010 0.000 0.025 / '147' 2.500 0.350 0.010 0.000 0.025 / '148' 2.500 0.325 0.010 0.000 0.025 / '149' 2.500 0.300 0.010 0.000 0.025 / '150' 2.500 0.275 0.010 0.000 0.025 / '151' 2.500 0.250 0.010 0.000 0.025 / '152' 2.500 0.225 0.010 0.000 0.025 / '153' 2.500 0.200 0.010 0.000 0.025 / '154' 2.500 0.175 0.010 0.000 0.025 / '155' 2.500 0.150 0.010 0.000 0.025 / '156' 2.500 0.125 0.010 0.000 0.025 / '157' 2.500 0.100 0.010 0.000 0.025 / '158' 2.500 0.075 0.010 0.000 0.025 / '159' 2.500 0.050 0.010 0.000 0.025 / '160' 2.500 0.025 0.010 0.000 0.025 / '161' 2.500 0.000 0.010 0.000 0.025 / '162' 2.500 -.025 0.010 0.000 0.025 / / elf1/elf1ccrt.dat 100666 1750 1750 1646 6425373371 13202 0 ustar klimes klimes 'data elf1ccrt.dat' 'elf1-mod.dat' ' ' ' ' 'elf1-cod.dat' ' ' 'writsrf.dat' 'elf1-log.out' 'elf1-dcr.dat' 0 0 5 0 / (KSTORE, NEXPS, NHLF, MODCRT) 999. 10. 0.00005 0.00050 0.000 0.000 0.000 / (STORE,STEP,UEB,UEB**) -2 12 -2 12 0.010 5 / (Computational volume) / (No auxiliary surface defined within this data set) / (No end surfaces) 105 / (Storing surfaces) / (All points of intersection) / (All points of intersection) 'elf1-ini.dat' -1 3 / (Single initial point, azimuthal equidistant projection) 'elf1csrc.out' / (File with coordinates of the initial point) 'elf1-rpa.dat (azimuthal equidistant projection ray parameters)' 105 -1 -2 -1 0.0005 0.05 / (ISRFR,ISRFX,ISRFY,NREC,XERR,AERR) 'elf1crec.out' / 0.050 -.500 0.050 0.000 0.100 -.500 2 2 1 / / elf1/elf1c.bat 100666 1750 1750 14016 6425373371 12502 0 ustar klimes klimes @ECHO OFF REM ==================================================================== REM Ray tracing for different source-receiver configurations (MS-DOS) REM (for all 236 sources remove command GOTO :END below) REM ==================================================================== REM Deleting old recording of the screen output: IF EXIST elf1cscr.out DEL elf1cscr.out REM Measuring time elapsed: ECHO.|TIME >elf1ctim.out REM -------------------------------------------------------------------- CALL srpcrt elf1c 001 GOTO :END CALL srpcrt elf1c 002 CALL srpcrt elf1c 003 CALL srpcrt elf1c 004 CALL srpcrt elf1c 005 CALL srpcrt elf1c 006 CALL srpcrt elf1c 007 CALL srpcrt elf1c 008 CALL srpcrt elf1c 009 CALL srpcrt elf1c 010 CALL srpcrt elf1c 011 CALL srpcrt elf1c 012 CALL srpcrt elf1c 013 CALL srpcrt elf1c 014 CALL srpcrt elf1c 015 CALL srpcrt elf1c 016 CALL srpcrt elf1c 017 CALL srpcrt elf1c 018 CALL srpcrt elf1c 019 CALL srpcrt elf1c 020 CALL srpcrt elf1c 021 CALL srpcrt elf1c 022 CALL srpcrt elf1c 023 CALL srpcrt elf1c 024 CALL srpcrt elf1c 025 CALL srpcrt elf1c 026 CALL srpcrt elf1c 027 CALL srpcrt elf1c 028 CALL srpcrt elf1c 029 CALL srpcrt elf1c 030 CALL srpcrt elf1c 031 CALL srpcrt elf1c 032 CALL srpcrt elf1c 033 CALL srpcrt elf1c 034 CALL srpcrt elf1c 035 CALL srpcrt elf1c 036 CALL srpcrt elf1c 037 CALL srpcrt elf1c 038 CALL srpcrt elf1c 039 CALL srpcrt elf1c 040 CALL srpcrt elf1c 041 CALL srpcrt elf1c 042 CALL srpcrt elf1c 043 CALL srpcrt elf1c 044 CALL srpcrt elf1c 045 CALL srpcrt elf1c 046 CALL srpcrt elf1c 047 CALL srpcrt elf1c 048 CALL srpcrt elf1c 049 CALL srpcrt elf1c 050 CALL srpcrt elf1c 051 CALL srpcrt elf1c 052 CALL srpcrt elf1c 053 CALL srpcrt elf1c 054 CALL srpcrt elf1c 055 CALL srpcrt elf1c 056 CALL srpcrt elf1c 057 CALL srpcrt elf1c 058 CALL srpcrt elf1c 059 CALL srpcrt elf1c 060 CALL srpcrt elf1c 061 CALL srpcrt elf1c 062 CALL srpcrt elf1c 063 CALL srpcrt elf1c 064 CALL srpcrt elf1c 065 CALL srpcrt elf1c 066 CALL srpcrt elf1c 067 CALL srpcrt elf1c 068 CALL srpcrt elf1c 069 CALL srpcrt elf1c 070 CALL srpcrt elf1c 071 CALL srpcrt elf1c 072 CALL srpcrt elf1c 073 CALL srpcrt elf1c 074 CALL srpcrt elf1c 075 CALL srpcrt elf1c 076 CALL srpcrt elf1c 077 CALL srpcrt elf1c 078 CALL srpcrt elf1c 079 CALL srpcrt elf1c 080 CALL srpcrt elf1c 081 CALL srpcrt elf1c 082 CALL srpcrt elf1c 083 CALL srpcrt elf1c 084 CALL srpcrt elf1c 085 CALL srpcrt elf1c 086 CALL srpcrt elf1c 087 CALL srpcrt elf1c 088 CALL srpcrt elf1c 089 CALL srpcrt elf1c 090 CALL srpcrt elf1c 091 CALL srpcrt elf1c 092 CALL srpcrt elf1c 093 CALL srpcrt elf1c 094 CALL srpcrt elf1c 095 CALL srpcrt elf1c 096 CALL srpcrt elf1c 097 CALL srpcrt elf1c 098 CALL srpcrt elf1c 099 CALL srpcrt elf1c 100 CALL srpcrt elf1c 101 CALL srpcrt elf1c 102 CALL srpcrt elf1c 103 CALL srpcrt elf1c 104 CALL srpcrt elf1c 105 CALL srpcrt elf1c 106 CALL srpcrt elf1c 107 CALL srpcrt elf1c 108 CALL srpcrt elf1c 109 CALL srpcrt elf1c 110 CALL srpcrt elf1c 111 CALL srpcrt elf1c 112 CALL srpcrt elf1c 113 CALL srpcrt elf1c 114 CALL srpcrt elf1c 115 CALL srpcrt elf1c 116 CALL srpcrt elf1c 117 CALL srpcrt elf1c 118 CALL srpcrt elf1c 119 CALL srpcrt elf1c 120 CALL srpcrt elf1c 121 CALL srpcrt elf1c 122 CALL srpcrt elf1c 123 CALL srpcrt elf1c 124 CALL srpcrt elf1c 125 CALL srpcrt elf1c 126 CALL srpcrt elf1c 127 CALL srpcrt elf1c 128 CALL srpcrt elf1c 129 CALL srpcrt elf1c 130 CALL srpcrt elf1c 131 CALL srpcrt elf1c 132 CALL srpcrt elf1c 133 CALL srpcrt elf1c 134 CALL srpcrt elf1c 135 CALL srpcrt elf1c 136 CALL srpcrt elf1c 137 CALL srpcrt elf1c 138 CALL srpcrt elf1c 139 CALL srpcrt elf1c 140 CALL srpcrt elf1c 141 CALL srpcrt elf1c 142 CALL srpcrt elf1c 143 CALL srpcrt elf1c 144 CALL srpcrt elf1c 145 CALL srpcrt elf1c 146 CALL srpcrt elf1c 147 CALL srpcrt elf1c 148 CALL srpcrt elf1c 149 CALL srpcrt elf1c 150 CALL srpcrt elf1c 151 CALL srpcrt elf1c 152 CALL srpcrt elf1c 153 CALL srpcrt elf1c 154 CALL srpcrt elf1c 155 CALL srpcrt elf1c 156 CALL srpcrt elf1c 157 CALL srpcrt elf1c 158 CALL srpcrt elf1c 159 CALL srpcrt elf1c 160 CALL srpcrt elf1c 161 CALL srpcrt elf1c 162 CALL srpcrt elf1c 163 CALL srpcrt elf1c 164 CALL srpcrt elf1c 165 CALL srpcrt elf1c 166 CALL srpcrt elf1c 167 CALL srpcrt elf1c 168 CALL srpcrt elf1c 169 CALL srpcrt elf1c 170 CALL srpcrt elf1c 171 CALL srpcrt elf1c 172 CALL srpcrt elf1c 173 CALL srpcrt elf1c 174 CALL srpcrt elf1c 175 CALL srpcrt elf1c 176 CALL srpcrt elf1c 177 CALL srpcrt elf1c 178 CALL srpcrt elf1c 179 CALL srpcrt elf1c 180 CALL srpcrt elf1c 181 CALL srpcrt elf1c 182 CALL srpcrt elf1c 183 CALL srpcrt elf1c 184 CALL srpcrt elf1c 185 CALL srpcrt elf1c 186 CALL srpcrt elf1c 187 CALL srpcrt elf1c 188 CALL srpcrt elf1c 189 CALL srpcrt elf1c 190 CALL srpcrt elf1c 191 CALL srpcrt elf1c 192 CALL srpcrt elf1c 193 CALL srpcrt elf1c 194 CALL srpcrt elf1c 195 CALL srpcrt elf1c 196 CALL srpcrt elf1c 197 CALL srpcrt elf1c 198 CALL srpcrt elf1c 199 CALL srpcrt elf1c 200 CALL srpcrt elf1c 201 CALL srpcrt elf1c 202 CALL srpcrt elf1c 203 CALL srpcrt elf1c 204 CALL srpcrt elf1c 205 CALL srpcrt elf1c 206 CALL srpcrt elf1c 207 CALL srpcrt elf1c 208 CALL srpcrt elf1c 209 CALL srpcrt elf1c 210 CALL srpcrt elf1c 211 CALL srpcrt elf1c 212 CALL srpcrt elf1c 213 CALL srpcrt elf1c 214 CALL srpcrt elf1c 215 CALL srpcrt elf1c 216 CALL srpcrt elf1c 217 CALL srpcrt elf1c 218 CALL srpcrt elf1c 219 CALL srpcrt elf1c 220 CALL srpcrt elf1c 221 CALL srpcrt elf1c 222 CALL srpcrt elf1c 223 CALL srpcrt elf1c 224 CALL srpcrt elf1c 225 CALL srpcrt elf1c 226 CALL srpcrt elf1c 227 CALL srpcrt elf1c 228 CALL srpcrt elf1c 229 CALL srpcrt elf1c 230 CALL srpcrt elf1c 231 CALL srpcrt elf1c 232 CALL srpcrt elf1c 233 CALL srpcrt elf1c 234 CALL srpcrt elf1c 235 CALL srpcrt elf1c 236 REM -------------------------------------------------------------------- :END ECHO.|TIME>>elf1ctim.out ECHO [1;31melf1ctim.out[0m REM -------------------------------------------------------------------- REM The results from RAM disk may be copied ,e.g., to drive C: rem COPY elf1c0??.out C: rem COPY elf1c1??.out C: rem COPY elf1c2??.out C: rem COPY elf1ctim.out C: REM -------------------------------------------------------------------- elf1/elf1c 100777 1750 1750 1374 6425373371 11723 0 ustar klimes klimes #!/bin/sh ### ==================================================================== ### Ray tracing for different source-receiver configurations (Unix) ### (for all 236 sources remove command n=1 below) ### ==================================================================== ### Deleting old recording of the screen output: rm elf1cscr.out 2>/dev/null ### -------------------------------------------------------------------- n=236 n=1 j=0 while [ \( $j -lt $n \) -a \( $j -lt 9 \) ] do j=`expr $j + 1` srpcrt elf1c 00$j done while [ \( $j -lt $n \) -a \( $j -lt 99 \) ] do j=`expr $j + 1` srpcrt elf1c 0$j done while [ $j -lt $n ] do j=`expr $j + 1` srpcrt elf1c $j done ### ==================================================================== elf1/ramon.bat 100666 1750 1750 2400 6425373371 12576 0 ustar klimes klimes @ECHO OFF REM ==================================================================== REM MS-DOS batch file to speed up repeated loading of programs compiled REM with Lahey Fortran, running in the RAM disk. This batch file has REM been used when running bath files ELF1A.BAT, ELF1B.BAT, ELF1C.BAT. REM -------------------------------------------------------------------- REM Usage: REM RAMON REM programs REM RAMOFF REM ==================================================================== REM Copying files necessary to run the Lahey-compiled programs: IF NOT EXIST COMMAND.COM COPY C:\DOS\COMMAND.COM IF NOT EXIST TNT.EXE COPY C:\F77L3\TNT.EXE IF NOT EXIST F77L3.EER COPY C:\F77L3\F77L3.EER REM REM Copying some CRT programs and files (example): IF NOT EXIST SRP.EXE COPY C:SRP.EXE IF NOT EXIST CRT.EXE COPY C:CRT.EXE IF NOT EXIST CRTPTS.EXE COPY C:CRTPTS.EXE IF NOT EXIST SRPCRT.BAT COPY C:SRPCRT.BAT IF NOT EXIST WRITSRF.DAT COPY C:WRITSRF.DAT REM -------------------------------------------------------------------- REM Batch file to restore system setting changed for RAMdisk: PATH >RAMOFF.BAT APPEND >>RAMOFF.BAT REM REM Disabling searching of hard disk drives: PATH ; APPEND ; REM ==================================================================== fcrt 100777 1750 1750 623 6425373370 11013 0 ustar klimes klimes #!/bin/sh ### ==================================================================== ### Unix script to compile package CRT by means of predefined script f ### ==================================================================== f crt f rpplot f crt2d3d f mtt f mttgrd f crt2p f crtray f crtpts f green f greenss f ss f sp f inv1tt ### ==================================================================== fcrt.bat 100666 1750 1750 1004 6425373370 11567 0 ustar klimes klimes @ECHO OFF REM ==================================================================== REM MS-DOS batch to compile CRT package using a Fortran 77 compiler REM driven by means of predefined batch file F.BAT REM ==================================================================== CALL F crt CALL F rpplot CALL F crt2d3d CALL F mtt CALL F mttgrd CALL F crt2p CALL F crtray CALL F crtpts CALL F green CALL F greenss CALL F ss CALL F sp CALL F inv1tt REM ==================================================================== green.for 100666 1750 1750 25347 6425373370 12011 0 ustar klimes klimes CC Program GREEN converting the unformatted output of program CRT into a C formatted file containing the ray-theory elastodynamic Green function. C C Version: 5.10 C Date: 1997, September 27 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 Description of data files: C C Main input data read from external interactive device (*): C The data consist of character strings read by list directed (free C format) input. The strings have thus to be enclosed in C apostrophes. The interactive * external unit may be redirected to C the file containing the data. C (1) 'REC','SRC','CRT-S','CRT-I','GREEN' C 'REC'...If non-blank, the name of the file with the names of the C receiver points. The names are then used within the C strings describing the points of two-point rays. C Otherwise, the two-point rays are denoted by the receiver C index. C Description of file REC C 'SRC'...If non-blank, the name of the file with the name of the C source point. The name is then used within the strings C describing the rays. C Description of file SRC C 'CRT-S'... File with the quantities stored at the points of C intersections of rays with the specified reference surface C (see C.R.T.5.5.2). Only two-point rays incident to the C vicinities of the receivers situated at the reference C surface are considered. The output elementary Green C functions are then evaluated at the receivers. C Description of file CRT-S C 'CRT-I'... File with the quantities at the initial points of rays, C corresponding to file 'CRT-S' (see C.R.T.6.1). C Description of file CRT-I C 'GREEN'... Name of the output formatted file with the Green C tensor. C Description of file GREEN C Default: 'REC'=' ', 'SRC'=' ', 'CRT-S'='s01.out', 'CRT-I'='s01i.out', C 'GREEN'='green.out'. C C Input formatted files 'REC' and 'SRC', if specified, must correspond C to the receiver and source files used during Complete Ray Tracing. C C Input unformatted file 'CRT-S': C See the description within source code file 'writ.for'. C Description of file CRT-S C C Input unformatted file 'CRT-I': C See the description within source code file 'writ.for'. C Description of file CRT-I C C C Output formatted file 'GREEN': C (1) / (a slash). C (2) For each two-point ray (2.1): C (2.1) 'R','S',(GREEN(I),I=1,32),/ C 'R'... String in apostrophes describing the receiver. C 'S'... String in apostrophes describing the source. C GREEN(1)... Travel time between receiver and source. C GREEN(2)... Imaginary part of the complex-valued travel time C between receiver and source due to attenuation. C GREEN(3:8)... Coordinates of the receiver and coordinates of the C source. C GREEN(9:14)... Derivatives of the travel time with respect to the C coordinates of the receiver and coordinates of the source. C GREEN(15:32)... 1000000 times enlarged amplitude of the Green C function: contravariant components of the complex-valued C 3*3 matrix Gij in model coordinates, where the first C subscript corresponds to the receiver and the second C subscript corresponds to the source. The components are C ordered as C Re(G11),Im(G11),Re(G21),Im(G21),Re(G31),Im(G31), C Re(G12),Im(G12),Re(G22),Im(G22),Re(G32),Im(G32), C Re(G13),Im(G13),Re(G23),Im(G23),Re(G33),Im(G33). C /... An obligatory slash after at the end of line, in place C where the slowness vector components could be written. C (3) / (a slash). C File form GREEN is, to some extent, an extension of file form C Travel Times. C C----------------------------------------------------------------------- C C Common block /POINTC/ to store the results of complete ray tracing: INCLUDE 'pointc.inc' C pointc.inc C None of the storage locations of the common block are altered. C C Subroutines and external functions required: EXTERNAL AP00,AP21,TXT1,TXT2,REC,SRC,TTSORT,FORM2 C AP00,AP21... File 'ap.for'. C AP03,AP03A... File 'ap.for' (called by AP21,AP03). C TXT1,TXT2,REC,SRC... File 'crtout.for'. C LENGTH..File 'length.for' (called by TXT2). C TTSORT..File 'ttsort.for'. C INDEXX..File 'indexx.for' (called by TTSORT). C FORM2...File 'forms.for'. C FORM1...File 'forms.for' (called by FORM2). C C----------------------------------------------------------------------- C C Common block /RAMC/: INCLUDE 'ram.inc' C ram.inc C C Allocation of working arrays: INTEGER MPTS PARAMETER (MPTS=MRAM/34) INTEGER IRECS(MPTS),INDX(MPTS) REAL RECS(MPTS),GREEN(32,MPTS) EQUIVALENCE (IRECS,RAM ) EQUIVALENCE (RECS ,RAM ) EQUIVALENCE (INDX ,RAM( MPTS+1)) EQUIVALENCE (GREEN,RAM(2*MPTS+1)) C C----------------------------------------------------------------------- C C Auxiliary storage locations: INTEGER LU1,LU2,LU3,NPTS PARAMETER (LU1=1,LU2=2,LU3=3) C MPTS... maximum number of two-point rays. C Note: MPTS=1 indicates no sorting according to receivers. CHARACTER*80 FILREC,FILSRC,FILE1,FILE2,FILE3 CHARACTER*260 FORMAT CHARACTER*80 RAYTXT INTEGER LENTXT,I,J,K,L REAL COOR(3) C C....................................................................... C C Opening input and output files: FILREC=' ' FILSRC=' ' FILE1='s01.out' FILE2='s01i.out' FILE3='green.out' WRITE(*,'(A)') ' Enter 5 filenames (REC,SRC,S01,S01I,GREEN): ' READ(*,*) FILREC,FILSRC,FILE1,FILE2,FILE3 C CALL TXT1(LU1,FILSRC,FILREC) OPEN(LU1,FILE=FILE1,FORM='UNFORMATTED',STATUS='OLD') OPEN(LU2,FILE=FILE2,FORM='UNFORMATTED',STATUS='OLD') OPEN(LU3,FILE=FILE3) WRITE(LU3,'(A)') '/' C C....................................................................... C C Loop for the points of rays: NPTS=0 10 CONTINUE C Reading the results of the complete ray tracing CALL AP00(0,LU1,LU2) IF(IWAVE.LT.1)THEN C End of rays GO TO 60 ELSE IF (IREC.GT.0) THEN NPTS=NPTS+1 CALL AP21(GREEN(1,NPTS)) IRECS(NPTS)=IREC C C Linear Taylor expansion of travel time: C Receiver: IF(FILREC.NE.' ') THEN C Receiver: COOR(1)=GREEN(3,NPTS) COOR(2)=GREEN(4,NPTS) COOR(3)=GREEN(5,NPTS) CALL REC(IREC,COOR(1),COOR(2),COOR(3)) GREEN(1,NPTS)=GREEN(1,NPTS) * +(COOR(1)-GREEN(3,NPTS))*GREEN( 9,NPTS) * +(COOR(2)-GREEN(4,NPTS))*GREEN(10,NPTS) * +(COOR(3)-GREEN(5,NPTS))*GREEN(11,NPTS) GREEN(3,NPTS)=COOR(1) GREEN(4,NPTS)=COOR(2) GREEN(5,NPTS)=COOR(3) END IF IF(FILSRC.NE.' ') THEN C Source: COOR(1)=GREEN(6,NPTS) COOR(2)=GREEN(7,NPTS) COOR(3)=GREEN(8,NPTS) CALL SRC(1,COOR(1),COOR(2),COOR(3)) GREEN(1,NPTS)=GREEN(1,NPTS) * +(COOR(1)-GREEN(6,NPTS))*GREEN(12,NPTS) * +(COOR(2)-GREEN(7,NPTS))*GREEN(13,NPTS) * +(COOR(3)-GREEN(8,NPTS))*GREEN(14,NPTS) GREEN(6,NPTS)=COOR(1) GREEN(7,NPTS)=COOR(2) GREEN(8,NPTS)=COOR(3) END IF C C Storing or writing: DO 20 I=15,32 GREEN(I,NPTS)=1000000.*GREEN(I,NPTS) 20 CONTINUE IF(MPTS.EQ.1) THEN C Text strings: CALL TXT2(0,1,IWAVE,IRAY,IREC,LENTXT,RAYTXT) L=INDEX(RAYTXT(1:LENTXT),'''') L=INDEX(RAYTXT(L+1:LENTXT),'''')+L IF(FILREC.EQ.' ') THEN C Shortening the receiver string part from 8 to 6 characters LENTXT=LENTXT-2 DO 21 I=L+4,LENTXT RAYTXT(I:I)=RAYTXT(I+2:I+2) 21 CONTINUE END IF C C Writing: FORMAT(1:4)='(4A,' CALL FORM2(32,GREEN,GREEN,FORMAT(5:260)) WRITE(LU3,FORMAT) RAYTXT(L+2:LENTXT), * ' ',RAYTXT(1:L),(' ',GREEN(I,1),I=1,32),' /' NPTS=0 END IF END IF GO TO 10 60 CONTINUE C C....................................................................... C C Sorting and writing two-point rays: IF(MPTS.GT.1) THEN CALL TTSORT(32,NPTS,1,GREEN,IRECS,RECS,INDX) DO 80 K=1,NPTS J=INDX(K) C C Text strings: CALL TXT2(0,1,1,1,IRECS(J),LENTXT,RAYTXT) L=INDEX(RAYTXT(1:LENTXT),'''') L=INDEX(RAYTXT(L+1:LENTXT),'''')+L IF(FILREC.EQ.' ') THEN C Shortening the receiver string part from 8 to 6 characters LENTXT=LENTXT-2 DO 71 I=L+4,LENTXT RAYTXT(I:I)=RAYTXT(I+2:I+2) 71 CONTINUE END IF C C Writing: FORMAT(1:4)='(4A,' CALL FORM2(32,GREEN(1,J),GREEN(1,J),FORMAT(5:260)) WRITE(LU3,FORMAT) RAYTXT(L+2:LENTXT), * ' ',RAYTXT(1:L),(' ',GREEN(I,J),I=1,32),' /' 80 CONTINUE END IF C C....................................................................... C WRITE(LU3,'(A)') '/' CLOSE(LU3) CLOSE(LU2) CLOSE(LU1) STOP END C C======================================================================= C INCLUDE 'ap.for' C ap.for INCLUDE 'crtout.for' C crtout.for INCLUDE 'ttsort.for' C ttsort.for INCLUDE 'forms.for' C forms.for INCLUDE 'length.for' C length.for INCLUDE 'indexx.for' C indexx.for C C======================================================================= Cgreenss.for 100666 1750 1750 61122 6425373370 12346 0 ustar klimes klimes CC Program GREENSS to read a formatted file containing the ray-theory C elastodynamic Green function and to generate ray-theory time-domain C synthetic seismograms (without attenuation) or frequency-domain C response functions (including causal Futterman's attenuation). C C Version: 5.10 C Date: 1997, September 26 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 Description of data files: C C Main input data read from external interactive device (*): C The data consist of character strings read by list directed (free C format) input. The strings have thus to be enclosed in C apostrophes. The interactive * external unit may be redirected to C the file containing the data. C (1) 'GREEN','SOURCE','FRDAT','SIGNAL','SS',KOMP C 'GREEN'... Name of the input formatted file with the Green tensor. C Description of file GREEN C 'SOURCE'... Name of the input formatted file containing the C complex-valued seismic force or moment. C Description of file SOURCE C 'FRDAT'... Name of the input formatted file containing the C specification of the frequency domain for the calculation C of response functions. C If blank, the time-domain synthetic seismograms are C generated instead of frequency-domain response functions, C see 'SIGNAL'. C Description of file FRDAT C 'SIGNAL'... Name of the input file in the GSE format containing C the source time function and its Hilbert transform (for C seismic force), or their derivatives (for seismic moment). C To be submitted if 'SIGNAL'=' ', otherwise has no meaning. C (One of filenames 'FRDAT' and 'SIGNAL' must be nonblank.) C Description of GSE C 'RF'... Name of the output file in the GSE format containing the C ray-theory seismograms or the frequency-domain Response C Function. C Description of file RF C KOMP... KOMP=0: All 3 components of the synthetic seismograms are C stored in the output GSE file. C KOMP=1: The 1st component of the synthetic seismograms is C stored in the output GSE file. C KOMP=2: The 2nd component of the synthetic seismograms is C stored in the output GSE file. C KOMP=3: The 3rd component of the synthetic seismograms is C stored in the output GSE file. C Default: 'GREEN'='green.out', 'SOURCE'='source.dat', C 'FRDAT'='fr.dat', 'SIGNAL'='source.gse', 'RF'='rf.out'. C Note: File 'SIGNAL'='source.gse' need not exist (i.e. is C not read) if 'SOURCE' is not blank. C C C Input formatted file GREEN: C (1) / (a slash). C (2) For each two-point ray (2.1): C (2.1) 'R','S',(GREEN(I),I=1,32),/ C 'R'... String in apostrophes identifying the receiver. Only C the first 6 characters are written to the output GSE C file. The strings corresponding to different receivers C thus should, if possible, differ in the first 6 C characters. If this is not the case, at least in the C first 12 characters. All lines corresponding to the same C receiver must be consecutive. C 'S'... String in apostrophes describing the source. Not taken C into account. C GREEN(1)... Travel time between receiver and source. C GREEN(2)... Imaginary part of the complex-valued travel time C between receiver and source due to attenuation. C GREEN(3:8)... Coordinates of the receiver and coordinates of the C source. C GREEN(9:14)... Derivatives of the travel time with respect to the C coordinates of the receiver and coordinates of the source. C GREEN(15:32)... 1000000 times enlarged amplitude of the Green C function: contravariant components of the complex-valued C 3*3 matrix Gij in model coordinates, where the first C subscript corresponds to the receiver and the second C subscript corresponds to the source. The components are C ordered as C Re(G11),Im(G11),Re(G21),Im(G21),Re(G31),Im(G31), C Re(G12),Im(G12),Re(G22),Im(G22),Re(G32),Im(G32), C Re(G13),Im(G13),Re(G23),Im(G23),Re(G33),Im(G33). C /... An obligatory slash after at the end of line, in place C where the slowness vector components could be written. C (3) / (a slash). C C C Input formatted file SOURCE: C (1) SFR1,SFI1,SFR2,SFI2,SFR3,SFI3,/ C Components of the complex-valued vectorial seismic force. The C seismic force is assumed to be the product of this vector and the C source time function submitted in file 'SIGNAL'. C Note: The 'unit' radiation pattern corresponds to C SF = 4 pi rho v**2 C (2) SMR11,SMI11,SMR12,SMI12,SMR13,SMI13, C SMR21,SMI21,SMR22,SMI22,SMR23,SMI23, C SMR31,SMI31,SMR32,SMI32,SMR33,SMI33,/ C Components of the transposed complex-valued 3*3 seismic-moment C tensor. The tensor is transposed in order not to look transposed C in the input data. The time derivative of the seismic moment is C assumed to be the product of this vector and the time function C submitted in file 'SIGNAL'. C Note: The 'unit' radiation pattern corresponds to C SM = 4 pi rho v**3 C Example of data file SOURCE C C C Input formatted file FRDAT: C (1) NPTS,FMIN,FMAX,TD,TINT,TIMUL,FREF,/ C NPTS... Number of time steps for the fast Fourier transform. C Will be used to convert the time step to the frequency C step. C NPTS=0: Frequency step is specified instead of time step. C FMIN,FMAX... Response functions are calculated for frequencies C from FMIN to FMAX. FMIN and FMAX are rounded to the C nearest multiples of the time step. C TD... NPTS=0: Frequency step. C Otherwise: Time step. Frequency step=1/(NPTS*TD). C TINT... Maximum time interval. The contribution of the ray to C the seismogram is taken into account only if the travel C time does not exceed TMIN+TINT, where TMIN is the minimum C travel time over the preceding rays arriving at the ' C receiver. Useful to remove alias in the time domain. C TINT=0: Infinite time interval. C TIMUL...Multiplication factor for the imaginary part TI of the C travel time. It may be used to globally decrease or C increase attenuation in the whole model. C FREF... Reference frequency for the Futterman's (1962) C quasi-causal attenuation. The travel times TR and TI C describing the Green function are assumed to correspond C to this frequency. Frequency-dependent travel times are C then given by C Re TT(F)=TR-TI*ln(F/FREF)*2/pi, C Im TT(F)=TI. C FREF=0: Noncausal attenuation, just for test purposes, C Re TT(F)=TR, C Im TT(F)=TI. C Defaults: NPTS=0, FMIN=0, FMAX=1/(NPTS*TD) if NPTS.NE.0, TINT=0, C TIMUL=1, FREF=(FMIN+FMAX)/2. C C C Output formatted file RF: C If 'FRDAT'=' ': Ray-theory time-domain synthetic seismograms (without C attenuation) in the GSE format. The may be, e.g., plotted by C program 'sp.for'. C Program 'greenss.for' stores in the comment lines of the waveform C identification section the hypocentral coordinates identified by C strings 'XS1 ', 'XS2 ' and 'XS3 '. C Description of the GSE format C Otherwise: Ray-theory frequency-domain response functions (including C causal Futterman's attenuation), saved in the format 'RF' C described in 'ss.for'. C Description of file RF C Program 'greenss.for' is prepared to generate the response C functions also in the GSE format in future versions. In such a C case program 'greenss.for' would store in the comment lines of the C waveform identification section the hypocentral coordinates C identified by strings 'XS1 ', 'XS2 ' and 'XS3 ', and times of the C first and last considered arrivals to each receiver, identified by C 'TMIN' and 'TMAX'. C Description of the GSE format C C----------------------------------------------------------------------- C C Subroutines and external functions required: EXTERNAL WGSE1,WGSE2,WGSE3,RGSE2 C WGSE1,WGSE2,WGSE3,RGSE2... File 'gse.for'. C C----------------------------------------------------------------------- C C Common block /RAMC/: INCLUDE 'ram.inc' C ram.inc C C Allocation of working arrays: INTEGER MSEIS PARAMETER (MSEIS=MRAM/6) REAL SEIS1(MSEIS),SEIS2(MSEIS),SEIS3(MSEIS) REAL SEIS4(MSEIS),SEIS5(MSEIS),SEIS6(MSEIS) EQUIVALENCE (SEIS1,RAM ) EQUIVALENCE (SEIS2,RAM( MSEIS+1)) EQUIVALENCE (SEIS3,RAM(2*MSEIS+1)) EQUIVALENCE (SEIS4,RAM(3*MSEIS+1)) EQUIVALENCE (SEIS5,RAM(4*MSEIS+1)) EQUIVALENCE (SEIS6,RAM(5*MSEIS+1)) C C----------------------------------------------------------------------- C C Input and output files: INTEGER LU1,LU2 PARAMETER (LU1=1,LU2=2) CHARACTER*80 FILE1,FILE2,FILE3,FILE4,FILE5,LINE CHARACTER*1 TEXT C Undefined value: REAL UNDEF PARAMETER (UNDEF=-999999.) C Seismic force: REAL SFR1,SFI1,SFR2,SFI2,SFR3,SFI3 C Seismic moment: REAL SMR11,SMI11,SMR12,SMI12,SMR13,SMI13 REAL SMR21,SMI21,SMR22,SMI22,SMR23,SMI23 REAL SMR31,SMI31,SMR32,SMI32,SMR33,SMI33 C Green function: CHARACTER*12 TXTOLD,TXTREC,TXTSRC REAL GREEN(32) C Data for the frequency band: INTEGER NPTS,NF REAL FMIN,FMAX,TD,TINT,TIMUL,FREF,FSTEP C Seismograms: LOGICAL LGSE,LWRITE INTEGER NSEIS,NSEIS4,NSEIS5 REAL TSTAR0,TSTEP0,TSTARH,TSTART,TSTEP C Force at the source and displacement at the receiver: REAL FR1,FI1,FR2,FI2,FR3,FI3,AR1,AI1,AR2,AI2,AR3,AI3 C Temporary storage locations: CHARACTER*1 STAT,CHAN INTEGER I01,I02,I03,I04,I05,I06,I07,I08,I09,I10,I11,I12 INTEGER KOMP,ISHIFT,I REAL AMAX,AR,AI,TR,TI,F,OMEGA REAL XR1,XR2,XR3,XS1,XS2,XS3,TSHIFT,W0,W1 C Source coordinates transferred through the GSE file: INTEGER MCOM,NCOM PARAMETER (MCOM=5) CHARACTER*4 TCOM(MCOM) REAL VCOM(MCOM) DATA TCOM/'XS1 ','XS2 ','XS3 ','TMIN','TMAX'/ C C....................................................................... C C Format of the output response function (.TRUE.'GSE', .FALSE.'RF'): LGSE=.FALSE. C C Names of input and output files: FILE1='green.out' FILE2='source.dat' FILE3='fr.dat' FILE4='source.gse' FILE5='rf.gse' KOMP=0 WRITE(*,'(A)') * ' Enter green.out,source.dat,fr.dat,source.gse,rf.gse,KOMP: ' READ(*,*) FILE1,FILE2,FILE3,FILE4,FILE5,KOMP C C Reading seismic force or seismic moment: OPEN(LU2,FILE=FILE2,STATUS='OLD') SFR1=0. SFI1=0. SFR2=0. SFI2=0. SFR3=0. SFI3=0. READ(LU2,*) SFR1,SFI1,SFR2,SFI2,SFR3,SFI3 SMR11=0. SMI11=0. SMR12=0. SMI12=0. SMR22=0. SMI22=0. SMR13=0. SMI13=0. SMR23=0. SMI23=0. SMR33=0. SMI33=0. READ(LU2,*) SMR11,SMI11,SMR12,SMI12,SMR13,SMI13, * SMR21,SMI21,SMR22,SMI22,SMR23,SMI23, * SMR31,SMI31,SMR32,SMI32,SMR33,SMI33 CLOSE(LU2) C C Reading the data for the frequency domain: IF(FILE3.NE.' ') THEN OPEN(LU2,FILE=FILE3,STATUS='OLD') NPTS=0 FMIN=0. FMAX=UNDEF TINT=0. TIMUL=1. FREF=UNDEF READ(LU2,*) NPTS,FMIN,FMAX,TD,TINT,TIMUL,FREF IF(FMAX.EQ.UNDEF) THEN FMAX=1/TD END IF IF(FREF.EQ.UNDEF) THEN FREF=(FMIN+FMAX)/2. END IF CLOSE(LU2) IF(NPTS.EQ.0) THEN FSTEP=TD ELSE FSTEP=1./(FLOAT(NPTS)*TD) END IF FMIN=FSTEP*INT(FMIN/FSTEP+.5) NF= INT((FMAX-FMIN)/FSTEP+.5)+1 C Parameters for the response functions: FMIN,FSTEP,NF,TIMUL,FREF. NCOM=MCOM ELSE NCOM=3 C C Reading the source time function and its Hilbert transform: IF(FILE4.NE.' ') THEN OPEN(LU2,FILE=FILE4,STATUS='OLD') CALL RGSE2(LU2,STAT,CHAN, * I,XS1,XS2,XS3,TSTAR0,TSTEP0,NSEIS4,MSEIS,SEIS4) CALL RGSE2(LU2,STAT,CHAN, * I,XS1,XS2,XS3,TSTARH,TSTEP ,NSEIS5,MSEIS,SEIS5) CLOSE(LU2) IF(TSTEP0.NE.TSTEP) THEN C GREENSS-01 PAUSE 'Error GREENSS-01: Different time steps.' STOP END IF ELSE C GREENSS-02 PAUSE * 'Error GREENSS-02: One of files FRDAT or SIGNAL must be given' STOP END IF C END IF C C....................................................................... C OPEN(LU1,FILE=FILE1,STATUS='OLD') READ(LU1,*) (TEXT,I=1,20) OPEN(LU2,FILE=FILE5) IF(NCOM.NE.MCOM) THEN CALL WGSE1(LU2,' ') ELSE IF(LGSE) THEN CALL WGSE1(LU2,' ') ELSE LWRITE=.TRUE. END IF END IF C C Loop over rays: TXTREC='$' 30 CONTINUE TXTOLD=TXTREC TXTREC='$' XR1=GREEN(3) XR2=GREEN(4) XR3=GREEN(5) VCOM(1)=GREEN(6) VCOM(2)=GREEN(7) VCOM(3)=GREEN(8) C Preparing source coordinates for output in the GSE file: CALL WGSE2D() DO 31 I=1,NCOM CALL WSEPR(LINE,TCOM(I),VCOM(I)) CALL WGSE2C(LINE) 31 CONTINUE C READ(LU1,*) TXTREC,TXTSRC,GREEN IF(TXTOLD.NE.'$'.AND.TXTREC.NE.TXTOLD) THEN C Writing the previous seismogram: C -------------------------------- IF(NCOM.NE.MCOM) THEN IF(KOMP.LE.0.OR.KOMP.EQ.1) THEN CALL WGSE2(LU2,TXTOLD,' ',1,XR1,XR2,XR3, * TSTART,TSTEP,MIN0(MSEIS,NSEIS),SEIS1) END IF IF(KOMP.LE.0.OR.KOMP.EQ.2) THEN CALL WGSE2(LU2,TXTOLD,' ',2,XR1,XR2,XR3, * TSTART,TSTEP,MIN0(MSEIS,NSEIS),SEIS2) END IF IF(KOMP.LE.0.OR.KOMP.EQ.3) THEN CALL WGSE2(LU2,TXTOLD,' ',3,XR1,XR2,XR3, * TSTART,TSTEP,MIN0(MSEIS,NSEIS),SEIS3) END IF IF(NSEIS.GT.MSEIS) THEN C GREENSS-51 WRITE(*,'(A,I12,2A)') * ' Warning GREENSS-51:',NSEIS, * ' non-zero samples at receiver ',TXTOLD PAUSE END IF ELSE IF(LGSE) THEN IF(KOMP.LE.0.OR.KOMP.EQ.1) THEN CALL WGSE2(LU2,TXTOLD,' ', 1,XR1,XR2,XR3, * FMIN,FSTEP,NF,SEIS1) CALL WGSE2(LU2,TXTOLD,' ',11,XR1,XR2,XR3, * FMIN,FSTEP,NF,SEIS4) END IF IF(KOMP.LE.0.OR.KOMP.EQ.1) THEN CALL WGSE2(LU2,TXTOLD,' ', 2,XR1,XR2,XR3, * FMIN,FSTEP,NF,SEIS2) CALL WGSE2(LU2,TXTOLD,' ',12,XR1,XR2,XR3, * FMIN,FSTEP,NF,SEIS5) END IF IF(KOMP.LE.0.OR.KOMP.EQ.1) THEN CALL WGSE2(LU2,TXTOLD,' ', 3,XR1,XR2,XR3, * FMIN,FSTEP,NF,SEIS3) CALL WGSE2(LU2,TXTOLD,' ',13,XR1,XR2,XR3, * FMIN,FSTEP,NF,SEIS6) END IF ELSE IF(LWRITE)THEN WRITE(LU2,'(A)') '/' WRITE(LU2,'(3(F7.3,1X),A)') VCOM(1),VCOM(2),VCOM(3),'/' WRITE(LU2,'(2(E11.5,1X),I8,1X,A)') FMIN,FSTEP,NF,'/' LWRITE=.FALSE. END IF AMAX=0. DO 32 I=1,NF AMAX=AMAX1(ABS(SEIS1(I)),ABS(SEIS2(I)),ABS(SEIS3(I)), * ABS(SEIS4(I)),ABS(SEIS5(I)),ABS(SEIS6(I)), * AMAX) 32 CONTINUE WRITE(LU2,'(3(F7.3,1X),3(E11.5,1X),A)') * XR1,XR2,XR3,VCOM(4),VCOM(5),AMAX,'/' IF(VCOM(4).LE.VCOM(5)) THEN DO 33 I=1,NF,2 I01=IFIX(99999.1*SEIS1(I)/AMAX) I02=IFIX(99999.1*SEIS4(I)/AMAX) I03=IFIX(99999.1*SEIS2(I)/AMAX) I04=IFIX(99999.1*SEIS5(I)/AMAX) I05=IFIX(99999.1*SEIS3(I)/AMAX) I06=IFIX(99999.1*SEIS6(I)/AMAX) IF(I.LT.NF) THEN I07=IFIX(99999.1*SEIS1(I+1)/AMAX) I08=IFIX(99999.1*SEIS4(I+1)/AMAX) I09=IFIX(99999.1*SEIS2(I+1)/AMAX) I10=IFIX(99999.1*SEIS5(I+1)/AMAX) I11=IFIX(99999.1*SEIS3(I+1)/AMAX) I12=IFIX(99999.1*SEIS6(I+1)/AMAX) WRITE(LU2,'(12I6)') I01,I02,I03,I04,I05,I06, * I07,I08,I09,I10,I11,I12 ELSE WRITE(LU2,'(12I6)') I01,I02,I03,I04,I05,I06 END IF 33 CONTINUE END IF END IF END IF END IF IF(TXTREC.EQ.'$') THEN C No more two-point rays: C ----------------------- GO TO 80 END IF IF(TXTREC.NE.TXTOLD) THEN C New receiver: C ------------- DO 41 I=1,MSEIS SEIS1(I)=0. SEIS2(I)=0. SEIS3(I)=0. 41 CONTINUE IF(NCOM.NE.MCOM) THEN ISHIFT=INT(GREEN(1)/TSTEP) TSTART=TSTAR0+FLOAT(ISHIFT)*TSTEP NSEIS=0 ELSE VCOM(4)= 999999. VCOM(5)=-999999. DO 42 I=1,MSEIS SEIS4(I)=0. SEIS5(I)=0. SEIS6(I)=0. 42 CONTINUE END IF END IF DO 43 I=15,32 GREEN(I)=GREEN(I)/1000000. 43 CONTINUE C C Adding the contribution from a new two-point ray: C ------------------------------------------------- C C Complex-valued amplitude corresponding to the given source: FR1=SFR1-SMR11*GREEN(12)-SMR12*GREEN(13)-SMR13*GREEN(14) FI1=SFI1-SMI11*GREEN(12)-SMI12*GREEN(13)-SMI13*GREEN(14) FR2=SFR2-SMR21*GREEN(12)-SMR22*GREEN(13)-SMR23*GREEN(14) FI2=SFI2-SMI21*GREEN(12)-SMI22*GREEN(13)-SMI23*GREEN(14) FR3=SFR3-SMR31*GREEN(12)-SMR32*GREEN(13)-SMR33*GREEN(14) FI3=SFI3-SMI31*GREEN(12)-SMI32*GREEN(13)-SMI33*GREEN(14) AR1=GREEN(15)*FR1+GREEN(21)*FR2+GREEN(27)*FR3 * -GREEN(16)*FI1-GREEN(22)*FI2-GREEN(28)*FI3 AR2=GREEN(17)*FR1+GREEN(23)*FR2+GREEN(29)*FR3 * -GREEN(18)*FI1-GREEN(24)*FI2-GREEN(30)*FI3 AR3=GREEN(19)*FR1+GREEN(25)*FR2+GREEN(31)*FR3 * -GREEN(20)*FI1-GREEN(26)*FI2-GREEN(32)*FI3 AI1=GREEN(15)*FI1+GREEN(21)*FI2+GREEN(27)*FI3 * +GREEN(16)*FR1+GREEN(22)*FR2+GREEN(28)*FR3 AI2=GREEN(17)*FI1+GREEN(23)*FI2+GREEN(29)*FI3 * +GREEN(18)*FR1+GREEN(24)*FR2+GREEN(30)*FR3 AI3=GREEN(19)*FI1+GREEN(25)*FI2+GREEN(31)*FI3 * +GREEN(20)*FR1+GREEN(26)*FR2+GREEN(32)*FR3 C C Time domain or frequency domain: IF(NCOM.NE.MCOM) THEN C C Adding the multiple of the source time function: TSHIFT=(TSTAR0+GREEN(1)-TSTART)/TSTEP ISHIFT=INT(TSHIFT) W1=TSHIFT-FLOAT(ISHIFT) W0=1.-W1 C W0,W1 are the weights of shifts ISHIFT,ISHIFT+1 IF(ISHIFT.LT.0) THEN C Shifting the start time to the new position: TSTART=TSTART+FLOAT(ISHIFT)*TSTEP NSEIS=NSEIS-ISHIFT DO 51 I=MAX0(MSEIS,NSEIS),-ISHIFT+1,-1 SEIS1(I)=SEIS1(I+ISHIFT) SEIS2(I)=SEIS2(I+ISHIFT) SEIS3(I)=SEIS3(I+ISHIFT) 51 CONTINUE DO 52 I=MAX0(MSEIS,-ISHIFT),1,-1 SEIS1(I)=0. SEIS2(I)=0. SEIS3(I)=0. 52 CONTINUE ISHIFT=0 END IF NSEIS=MAX0(NSEIS,NSEIS4+ISHIFT) DO 53 I=1,MIN(NSEIS4,MSEIS-ISHIFT) SEIS1(I+ISHIFT)=SEIS1(I+ISHIFT)+W0*AR1*SEIS4(I) SEIS2(I+ISHIFT)=SEIS2(I+ISHIFT)+W0*AR2*SEIS4(I) SEIS3(I+ISHIFT)=SEIS3(I+ISHIFT)+W0*AR3*SEIS4(I) 53 CONTINUE ISHIFT=ISHIFT+1 NSEIS=MAX0(NSEIS,NSEIS4+ISHIFT) DO 54 I=1,MIN(NSEIS4,MSEIS-ISHIFT) SEIS1(I+ISHIFT)=SEIS1(I+ISHIFT)+W1*AR1*SEIS4(I) SEIS2(I+ISHIFT)=SEIS2(I+ISHIFT)+W1*AR2*SEIS4(I) SEIS3(I+ISHIFT)=SEIS3(I+ISHIFT)+W1*AR3*SEIS4(I) 54 CONTINUE C C Adding the multiple of the Hilbert transform: TSHIFT=(TSTARH+GREEN(1)-TSTART)/TSTEP ISHIFT=INT(TSHIFT) W1=TSHIFT-FLOAT(ISHIFT) W0=1.-W1 C W0,W1 are the weights of shifts ISHIFT,ISHIFT+1 IF(ISHIFT.LT.0) THEN C Shifting the start time to the new position: TSTART=TSTART+FLOAT(ISHIFT)*TSTEP NSEIS=NSEIS-ISHIFT DO 61 I=MIN0(MSEIS,NSEIS),-ISHIFT+1,-1 SEIS1(I)=SEIS1(I+ISHIFT) SEIS2(I)=SEIS2(I+ISHIFT) SEIS3(I)=SEIS3(I+ISHIFT) 61 CONTINUE DO 62 I=MIN0(MSEIS,-ISHIFT),1,-1 SEIS1(I)=0. SEIS2(I)=0. SEIS3(I)=0. 62 CONTINUE ISHIFT=0 END IF NSEIS=MAX0(NSEIS,NSEIS5+ISHIFT) DO 63 I=1,MIN(NSEIS5,MSEIS-ISHIFT) SEIS1(I+ISHIFT)=SEIS1(I+ISHIFT)-W0*AI1*SEIS5(I) SEIS2(I+ISHIFT)=SEIS2(I+ISHIFT)-W0*AI2*SEIS5(I) SEIS3(I+ISHIFT)=SEIS3(I+ISHIFT)-W0*AI3*SEIS5(I) 63 CONTINUE ISHIFT=ISHIFT+1 NSEIS=MAX0(NSEIS,NSEIS5+ISHIFT) DO 64 I=1,MIN(NSEIS5,MSEIS-ISHIFT) SEIS1(I+ISHIFT)=SEIS1(I+ISHIFT)-W1*AI1*SEIS5(I) SEIS2(I+ISHIFT)=SEIS2(I+ISHIFT)-W1*AI2*SEIS5(I) SEIS3(I+ISHIFT)=SEIS3(I+ISHIFT)-W1*AI3*SEIS5(I) 64 CONTINUE ELSE C C Response functions: VCOM(4)=AMIN1(GREEN(1),VCOM(4)) IF(TINT.EQ.0..OR.GREEN(1).LE.VCOM(4)+TINT) THEN VCOM(5)=AMAX1(GREEN(1),VCOM(5)) DO 69 I=1,NF F=FMIN+FSTEP*FLOAT(I-1) OMEGA=6.2831853*F TI=GREEN(2)*TIMUL IF(FREF.EQ.0.) THEN TR=GREEN(1) ELSE TR=GREEN(1)-TI*ALOG(F/FREF)/1.5707963 END IF TI= EXP(-OMEGA*TI) AR=TI*COS(OMEGA*TR) AI=TI*SIN(OMEGA*TR) SEIS1(I)=SEIS1(I)+AR1*AR-AI1*AI SEIS2(I)=SEIS2(I)+AR2*AR-AI2*AI SEIS3(I)=SEIS3(I)+AR3*AR-AI3*AI SEIS4(I)=SEIS4(I)+AI1*AR+AR1*AI SEIS5(I)=SEIS5(I)+AI2*AR+AR2*AI SEIS6(I)=SEIS6(I)+AI3*AR+AR3*AI 69 CONTINUE END IF END IF GO TO 30 C 80 CONTINUE IF(NCOM.NE.MCOM) THEN CALL WGSE3(LU2) ELSE IF(LGSE)THEN CALL WGSE3(LU2) ELSE WRITE(LU2,'(A)') '/' END IF END IF CLOSE(LU2) CLOSE(LU1) STOP END C C======================================================================= C INCLUDE 'sep.for' C sep.for INCLUDE 'gse.for' C gse.for INCLUDE 'length.for' C length.for C C======================================================================= Cguide.dat 100666 1750 1750 4375 6425373370 11746 0 ustar klimes klimes Files *.dat: Sample input data for the complete ray tracing program By Vlastislav Cerveny, Ludek Klimes, Ivan Psencik Date: 1997, October 26 The sample 3-D model consists of two layers and of the lenticular inclusion with edges, situated in the upper layer, see the schematic Figure 5 in V.Cerveny, L.Klimes, I.Psencik: Complete Seismic-Ray Tracing in 3-D Structures (In: D.Doornbos, ed.: Seismological Algorithms, Academic Press 1988). The files *.dat listed below contain the sample input data for the complete ray tracing program. The input data consist of the 7 data sets (1) to (7) listed in file 'crtdoc.htm' (corresponding to lines (2) to (8) of input data for 'crtin.for'). Note that several data sets may be located in a single file. crt.dat... File containing the sample data set: (1) CRT model.dat... File containing the sample data set: (2) MODEL dcrt.dat... File containing the sample data set: (3) DCRT init.dat... File containing the sample data set: (4) INIT len-src.dat... File containing the source coordinates. Referred from INIT. code.dat... File containing the sample data set: (5) CODE rpar.dat... File containing the sample data set: (6) RPAR writsrf.dat... File containing the sample data set: (7) WRIT These demo data correspond to a very simple initial-value ray tracing of rays shot in a single vertical plane from the point source. For the two-point ray tracing in this model refer to data located in subdirectory 'len'. Remarks within the input data files: The comments in brackets situated at the ends of lines, after the input items, are not the part of the input data. They are just remarks placed so as to be skipped when reading the input data. The last input line of a data file is usually followed by (a) Empty line, line '====' and empty line, or by (b) Empty line, line '----', empty line, text describing the input data, empty line, line '====' and empty line. ======================================================================== init.dat 100666 1750 1750 733 6425373370 11566 0 ustar klimes klimes 'Data file init.dat: Initial conditions for rays' -1 2 / (Single initial point, geographic-like sph.coor.) 'len-src.dat' / (File with coordinates of the initial point) ------------------------------------------------------------------------ The general description of the input data specifying the initial conditions for the computed rays may be found in file 'init.for'. ======================================================================== init.for 100666 1750 1750 163737 6425373366 11707 0 ustar klimes klimes CC Subroutine file 'init.for' to read the input data for the initial C surface, and to define initial values for complete ray tracing. C C Date: 1997, October 26 C Coded by Ludek Klimes C C....................................................................... C C This file consists of the following subroutines: C INIT1...Interface subroutine to INIS1 reading the input data for C the four functions specifying the initial conditions for C the computed rays. C INIT1 C INIT2...Subroutine evaluating, for given ray take-off parameters, C the values of the computed quantities at the initial point C of the ray, and storing the important quantities at the C initial point of the ray in the common block /INITC/. C INIT2 C INIS1...Sample subroutine designed to read the input data for the C initial points of rays. A two-parametric system of rays C of each elementary wave is assumed. A ray of the C elementary wave is specified by its two take-off C parameters. The computed rays may start from a single C initial point common to all rays, from a curve along which C an initial travel time is defined, from an initial surface C along which an initial travel time is defined, etc. C INIS1 C INIS2...Sample subroutine returning the functional values and C their first and second derivatives, of the functions C describing the initial surface. C INIS2 C SQRT3...Subroutine evaluating the square root of the given C real-valued positive-semidefinite symmetric 3*3 matrix. C SQRT3 C SPHERE..Subroutine transforming spherical coordinates PAR1, PAR2 C into the Cartesian coordinates of the corresponding point C on the unit sphere. It also evaluates the first and C second derivatives of the Cartesian coordinates with C respect to PAR1 and PAR2. C SPHERE C Subroutines INIS1 and INIS2, defining the common initial point, C initial curve or initial surface, call subroutines VAL1 and VAL2 which C must be appended. In addition, subroutines CURVN1 (or its alternative C CURVB1), CURV2D (or its alternative CURVBD), SURFB1, SURFBD, VAL3B1, C VAL3BD, VGEN, TERMS, SNHCSH, TRIDEC, TRISOL, DSPLNZ, INTRVL from the C subroutine package 'FITPACK' by Alan Kaylor Cline, Department of C Computer Sciences, University of Texas at Austin, are used. In the C complete ray tracing, subroutines INIS1 and INIS2 may be replaced by C any user-defined package containing subroutines INIS1 and INIS2 with C the same number, type and meaning of their parameters as in this C file. C C....................................................................... C C Description of data files: C C Input data INIT for the initial points of rays: C The data are read in by the list directed input (free format). In C the list of input data below, each numbered paragraph indicates C the beginning of a new input operation (new READ statement). If C the first letter of the symbolic name of the input variable is C I-N, the corresponding value in input data must be of the type C INTEGER. Otherwise (except TEXTI), the input parameter is of the C type real. C (1) TEXTI C String describing the data. Only the first 80 characters of the C string are significant. C C (2) INIDIM,INIPAR,ADVANC,/ C Quantities defining the kind of initial conditions (the kind of C the source). C INIDIM..Determines the dimensionality of the source: C -1...Single initial point (point source), its coordinates C are read from a separate file. C 0...Single initial point (point source), C 1...Initial curve (line source), C 2...Initial surface. C INIPAR..Determines the parametrization of rays: C For INIDIM.LE.0: C INIPAR.LT.0: The same as for IABS(INIPAR), but with C the unit vector (T1,T2,T3) tangent to the ray C changed to (T1,-T2,-T3). C INIPAR.EQ.1: Ray parameters are polar-like spherical C coordinates (colatitude,longitude) connected with the C local Cartesian coordinate system which basis vectors C are given by the square root of the metric tensor at C the initial point. C Equator plane coincides with the local (X1,X2)-plane. C Zero longitude is determined by the positive local X1 C half-axis. Longitude PI/2 then corresponds to the C positive local X2 half-axis. The zero colatitude C corresponds to the positive local X3 half-axis. C If SIN(colatitude).LT.0, the ray is reported out of C the ray-parameter domain: IEND=71 in subroutine INIT2. C INIPAR.EQ.2: Ray parameters are geographic-like C spherical coordinates (longitude,latitude) connected C with the local Cartesian coordinate system which basis C vectors are given by the square root of the metric C tensor at the initial point. C Equator plane coincides with the local (X1,X2)-plane. C Zero longitude is determined by the positive local X1 C half-axis. Longitude PI/2 then corresponds to the C positive local X2 half-axis. The latitude is positive C in the direction given by the positive X3 half-axis. C If COS(latitude).LT.0, the ray is reported out of C the ray-parameter domain: IEND=71 in subroutine INIT2. C INIPAR.EQ.3: Azimuthal equidistant projection of a unit C sphere is parametrized by 2 Cartesian coordinates C centred at the projection point. This option is C suitable especially for reflection seismic studies. C The unit vector tangent to the ray, expressed in the C local Cartesian coordinate system which basis vectors C are given by the square root of the metric tensor at C the initial point, is given by C T1=PAR1*SIN(R)/R C T2=PAR2*SIN(R)/R C T3= COS(R) C with R=SQRT(PAR1*PAR1+PAR2*PAR2). C If R.GT.2*PI, the ray is reported out of the C ray-parameter domain: IEND=71 in subroutine INIT2. C For INIDIM=1: C INIPAR must be 1 or 2. The INIPAR-th ray parameter is C identical with the parameter parametrizing the initial C curve. The other ray parameter is the angle between the C ray take-off plane and the normal to the interpolated C surface. The ray take-off plane is given by the tangent C to the initial line and by the slowness vector. C For INIPAR=1, the initial line is the line PAR2=0 at the C interpolated surface and is parametrized by PAR1. C For INIPAR=2, the initial line is the line PAR1=0 at the C interpolated surface and is parametrized by PAR2. C For INIDIM=2: C Ray parameters are identical with two parameters C parametrizing the initial surface. C INIPAR.LE.0: Initial surface is described in terms of C functions specifying the dependence of general C coordinates (X1,X2,X3) on two parameters of the C initial surface. C INIPAR.EQ.1: Initial surface is specified in the C polar-like spherical coordinates (colatitude, C longitude, radius) connected with the local Cartesian C coordinate system which basis vectors are given by the C square root of the metric tensor at the given point. C Colatitude and longitude are the parameters, and the C initial surface is determined by a function specifying C the dependence of the radius on these parameters C (colatitude and longitude). C INIPAR.GE.2: Initial surface is specified in the C geographic-like spherical coordinates (longitude, C latitude, radius) connected with the local Cartesian C coordinate system which basis vectors are given by the C square root of the metric tensor at the given point. C Longitude and latitude are the parameters, and the C initial surface is determined by a function specifying C the dependence of the radius on these parameters C (longitude and latitude). C ADVANC..Initial point of the ray is shifted by distance ADVANC C perpendicularly to the initial surface or line, C or tangentially to the ray for the single initial point. C All initial and other quantities (except for the metric C tensor) are then evaluated at the shifted initial point. C Finally, the initial travel time is linearly updated C using the initial slowness vector. This option may be C useful if the source is situated close to a structural C interface. C Default: C INIDIM=-1, INIPAR=2, ADVANC=0. C (3) Data describing the initial point, curve or surface. C For INIDIM=-1: C (3A) 'SRC' C 'SRC'... Name of the input file containing the C coordinates of a single initial point and the initial C value of the travel time. C Description of file SRC C For INIDIM=0: C (3A) X1INI,X2INI,X3INI,TTINI C X1INI,X2INI,X3INI... Coordinates of a single initial C point. C TTINI... Initial value of the travel time. C For INIDIM=1: C (3B) Input data for NFUNC=4 functions X1(.,.),X2(.,.), C X3(.,.), TT(.,.) of two variables. The INIPAR-th one of C the 2 variables being simultaneously the ray parameter). C For INIDIM=2, INIPAR.LE.0: C (3B) Input data for NFUNC=4 functions X1(.,.),X2(.,.), C X3(.,.), TT(.,.) of two variables (two initial surface C parameters, being simultaneously the ray parameters). C For INIDIM=2, INIPAR.GE.1: the following two data sets (3A), (3B): C (3A) X1INI,X2INI,X3INI... Coordinates of a given point, C see the description of the input data (1). C (3B) Input data for NFUNC=2 functions R(.,.),TT(.,.) of C two variables (two initial surface parameters, being C simultaneously the ray parameters). C R(.,.) describes the radius, see input data (1), C TT(.,.) is the initial travel time. C Default: 'SRC'='src.dat', TTINI=0. C The structure of the input data (3B) is given by the subroutine VAL1 C and is described below. C Example of data set INIT C C Above mentioned input data (3B) for the initial curve or for the C initial surface are read in by the subroutine VAL1 and have the C following structure: C These input data define at least NFUNC individual functions C describing the initial conditions. They are read in by subroutine C VAL1 called by INIS1. The number MFUNC of all functions specified C in the input data may be greater or equal to NFUNC. The data are C read in by the list directed input (free format). C (1) MFUNC C The number of all input functions. It must be greater or equal to C the number NFUNC of the functions required to describe the C coordinates and travel time along the initial curve or surface. C The functions indexed 1 to NFUNC must be the functions describing C the coordinates and travel time along the initial curve or C surface. C (2) NFUNC-times (i.e. once for each function) input data (2A)+(2B): C (2A) TEXTF,IFUNC C Identification of the function. C TEXTF...Any string. Its first 3 characters must differ from 'END'. C IFUNC...Index of the function: C 1 to 3... coordinates and 4... travel time, or C 1... radius and 2... travel time. Amplitude and/or other C quantities may follow. C (2B) 'Input data for one function', see below. C Input data for one function C (3) TEXTE,AUX C End of data. C TEXTE...String, the first 3 characters of which must be upper-case C 'END'. C AUX... Any number or a slash. C Remark: C If the initial surface coincides with a structural interface C (e.g., exploding-reflector initial conditions), it is reasonable C to slightly shift the initial surface from the structural C interface into the complex block into which the wave propagates. C Otherwise, because of rounding errors, there is a danger that some C parts of the initial surface are situated at the opposite side C of the interface. C C C Input data for one function: C The data are read in by the list directed input (free format). In C the list of input data below, each numbered paragraph indicates C the beginning of a new input operation (new READ statement). If C the first letter of the symbolic name of the input variable is C I-N, the corresponding value in input data must be of the type C INTEGER. Otherwise, the input parameter is of the type REAL. C (1) IVAR1,IVAR2,0,SIGMA C The form of the function. C IVAR1,IVAR2... Denote the form of the function. The function must C be of the form C F(G1,G2) = W(A1,A2)-B1-B2 . C G1, G2 are the ray parameters. Each of A1, A2, B1, B2 must C be either: (a) one of ray parameters G1, G2, or (b) must C be left out. At most 2 of parameters A1-B2 may be of kind C (a). Note that IVAR1 controls the type of A1 and B1, C IVAR2 controls the type of A2 and B2. C For IVAR1.EQ.0: A1, B1 are empty (left out), C for IVAR1.EQ.1: A1=G1, B1 is empty, C for IVAR1.EQ.2: A1=G2, B1 is empty, C for IVAR1.EQ.-1: B1=G1, A1 is empty, C for IVAR1.EQ.-2: B1=G2, A1 is empty, C the meaning of the parameter IVAR2 is similar. C Examples: C IVAR1: IVAR2: the form of the function: C 1 2 F(G1,G2)=W(G1,G2) C 2 1 F(G1,G2)=W(G2,G1) C 1 0 F(G1,G2)=W(G1) C 1 -2 F(G1,G2)=W(G1)-G2 C Function W is interpolated by means of splines under C tension. C SIGMA...Is the tension factor (its sign is ignored). This value C indicates the curviness desired. If ABS(SIGMA) is nearly C zero (e.g. 0.001), the resulting surface is approximately C the tensor product of cubic splines. If ABS(SIGMA) is C large (e.g. 50.), the resulting surface is approximately C tri-linear. If SIGMA equals zero, tensor products of C cubic splines result. A recommended value for SIGMA is C approximately 1. In absolute value. C (2) NX(1),...,NX(NVAR) C The numbers of grid coordinates for the interpolation. C This input is performed if at least one of IVAR1, IVAR2 is C positive. C Each of NX(1),...,NX(NVAR) corresponds to one positive value of C IVAR1, IVAR2 and specifies the number of grid coordinates C corresponding to that independent variable of function W, see (1). C The sign of NX(1),...,NX(NVAR) is ignored. NVAR (.LE.2) is the C number of positive values of the above quantities IVAR1, IVAR2, C i.e. the number of independent variables of function W, see (1). C (3) X1(1),...,X1(NX(1)) C The grid coordinates corresponding to the first independent C variable of function W, see (1). C This input is performed if NX(1) is specified, see (2), and is not C zero. The grid coordinates may be specified in any order. C (4) X2(1),...,X2(NX(2)) C The grid coordinates corresponding to the second independent C variable of function W, see (1). C This input is performed if NX(2) is specified, see (2), and is not C zero. The grid coordinates may be specified in any order. C (5) (((W(I,J),I=1,MAX(NX(1),1)),J=1,MAX(NX(2),1)) C The values of function W at grid points. Function value W(I,J) C corresponds to point (X1(I),X2(J)). C C C Input file SRC containing the coordinates of the initial point: C This file is used only if INIDIM=-1, see the input data (2) above. C (1) Several strings terminated by / (a slash). C The simplest way is to submit just the /. C (2) 'NAME',X1INI,X2INI,X3INI,TTINI,/ C 'NAME'... String reserved for the name of the initial point. C No meaning here, anything in apostrophes may be submitted. C X1INI,X2INI,X3INI... Coordinates of a single initial point. C TTINI... Initial value of the travel time. C Default: TTINI=0. C Example of data set SRC C C....................................................................... C C Storage in the memory: C The input data INIT (2) and (3A) are stored in the common block C /INISC/. The important quantities at the initial point of the ray C (see C.R.T.6.1) are stored in the common block /INITC/. These C common blocks are defined in the include file 'initd.inc'. C initd.inc C C======================================================================= C C C SUBROUTINE INIT1(LUN) INTEGER LUN C C Subroutine INIT1 calls the subroutine INIS1 to read the input data for C the initial points of rays. C C Input: C LUN... Logical unit number of the external input device C containing the input data. C The input parameter is not altered. C C No output. C C Common block /INITC/: INCLUDE 'initc.inc' C initc.inc C None of the storage locations of the common block, except ICB1I, are C altered. ICB1I is set to zero. C C Subroutines and external functions required: EXTERNAL INIS1 C INIS1... This file. C C Date: 1993, December 18 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Auxiliary storage locations: INTEGER NFUNC PARAMETER (NFUNC=4) C CALL INIS1(LUN,NFUNC) ICB1I=0 RETURN END C C======================================================================= C C C SUBROUTINE INIT2(PAR1,PAR2,YL,Y,YY,IY,IEND,IWAVE0,IKODE) REAL PAR1,PAR2,YL(6),Y(35),YY(5) INTEGER IY(12),IEND,IWAVE0,IKODE C C Subroutine INIT2 evaluates, for given ray take-off parameters, the C values of the computed quantities at the initial point of the ray, and C stores the important quantities at the initial point of the ray in the C common block /INITC/. C C Input: C PAR1,PAR2... Ray take-off parameters. C YL,Y,YY,IY... Arrays of dimensions at least 6, 35, 5, 12, C respectively. C IWAVE0..Index of the already computed elementary wave having the C most numerous common elements with the current elementary C wave. Need not be defined if IKODE=0. C IKODE...The length of the common part of the codes of the IWAVE-th C and IWAVE0-th elementary waves. C The input parameters PAR1, PAR2 are not altered. C C Output. C YL... Array containing local quantities at the initial point of C the ray (see C.R.T.5.5.4). The quantities are listed in C the subroutine file 'ray.for'. C Y... Array containing basic quantities computed along the ray C at the initial point of the ray (see C.R.T.5.2.1). The C quantities are listed in the subroutine file 'ray.for'. C YY... Array containing real auxiliary quantities computed along C the ray at the initial point of the ray (see C.R.T.5.2.2). C The quantities are listed in the subroutine file C 'ray.for'. C IY... Array containing integer auxiliary quantities computed C along the ray at the initial point of the ray (see C C.R.T.5.2.2). The quantities are listed in the subroutine C file 'ray.for'. C IEND... Information on the initial point of the ray: C IEND C 0... Computation of the ray may follow. C 71... There is no ray corresponding to the given ray C parameters. E.g., the given parameters do not belong to C the domain of the initial surface. C 72... Initial point of the ray is not situated in the C required complex block. C 73... Initial point of the ray is not situated in the C computational volume. C 74... Ray of the generated wave is not real-valued. C C Common block /DCRT/ (see subroutine file 'ray.for'): INCLUDE 'dcrt.inc' C dcrt.inc C None of the storage locations of the common block are altered. C C Common block /INISC/: INCLUDE 'initd.inc' C initd.inc C None of the storage locations of the common block are altered. C C Common block /INITC/: INCLUDE 'initc.inc' C initc.inc C All the storage locations of the common block are defined in this C subroutine. ICB1I must be zero before the first invocation of this C subroutine, other storage locations may be undefined. C C Subroutines and external functions required: EXTERNAL NSRFC,BLOCK,VELOC,KOOR,METRIC,PARM2,SMVPRD,CODE,INIS2 INTEGER NSRFC,KOOR C NSRFC,BLOCK,VELOC... File 'model.for' of the package 'MODEL'. C KOOR,METRIC... File 'metric.for' of the package 'MODEL'. C PARM2... File 'parm.for' of the package 'MODEL'. C SMVPRD... File 'means.for' of the package 'MODEL'. C CODE... File 'code.for'. C INIS2... This file. C C Date: 1996, September 30 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Auxiliary storage locations for local model parameters: FAUX(10), C G(12),GAMMA(18),GSQRD, UP(10),US(10),RO,QP,QS, VP,VS,VD(10),QL: INCLUDE 'auxmod.inc' C auxmod.inc C C....................................................................... C C Auxiliary storage locations: INTEGER KODIND,ICBNEW,ISB2,ICB2,I,NY,NFUNC PARAMETER (NFUNC=4) REAL E11,F21,F31,C11,B11,FF11,FFE11,CB11,ECB11,U1,T1,BT1 REAL E12,F22,F32,C12,B12,FF12,FFE12,CB12,ECB12,U2,T2,BT2 REAL E22,F23,F33,C22,B22,FF21,FFE21,CB21,ECB21 REAL E(3),F(6,NFUNC), FF22,FFE22,CB22,ECB22 EQUIVALENCE (E(1),E11),(E(2),E12),(E(3),E22) REAL V0,DETC,TRECE,Z1,Z2,Z3,AUX1,AUX2,AUX3 SAVE V0 C C KODIND..Position in the code of elementary wave. C ICBNEW..The index of the complex block in which the initial point C of the ray should be situated, supplemented by the sign C '+' for P wave or '-' for S wave. Output from subroutine C CODE. C ISB2... Index of the simple block in which the initial point is C situated. C ICB2... Index of the complex block in which the initial point is C situated. C I... Auxiliary and loop variable. C NY... Number of defined locations of array Y. C INIDIM..Distinguishes between initial point, line, or surface. C E=(E11,E12,E22)... Projection matrix, see the subroutine INIS2. C F...Functions describing the initial surface and their C derivatives, see the subroutine INIS2. C F21,F22,F23, F31,F32,F33... Covariant components of the vectors C F(2,1),F(2,2),F(2,3), F(3,1),F(3,2),F(3,3) tangent to the C initial surface. C C11,C12,C22... Components of matrix C of space or space-time C scalar products, eventually of its square root. C B11,B12,B22... Components of inverse square root of matrix C. C FF11,FF12,FF21,FF22... Components of the auxiliary matrix FF. C FFE11,FFE21,FFE12,FFE22... Components of the matrix FF*E. C CB11,CB21,CB12,CB22... Components of the matrix 1-C*B. C ECB11,ECB21,ECB12,ECB22... Components of the matrix E*CB/Tr(E*C). C U1,U2... Slowness derivatives with respect to PAR1,PAR2. C T1,T2... Velocity*derivatives of the travel time along the initial C surface with respect to PAR1,PAR2. C BT1,BT2... Components of the vector (B+ECB)*T. C V0... Propagation velocity at the initial point. C DETC... Determinant of matrix C, eventually of its square root. C TRECE... Trace of the matrix E*C*E. C Z1,Z2,Z3... Unit normal to the initial surface - covariant comp. C AUX1,AUX2,AUX3... Auxiliary storage locations. C C....................................................................... C IF(MODCRT.GE.3) THEN C 613 PAUSE 'Error 613 in INIT2: This program branch is not coded' STOP C Interpolation mode of the complete ray tracing program has C not been enabled yet. See 'ray.for', description of input C data, (2), MODCRT. END IF C CALL INIS2(NFUNC,PAR1,PAR2,E,F,IEND) IF(IEND.NE.0) THEN RETURN END IF IF(F(1,1).LT.BOUNDR(1).OR.BOUNDR(2).LT.F(1,1).OR. * F(1,2).LT.BOUNDR(3).OR.BOUNDR(4).LT.F(1,2).OR. * F(1,3).LT.BOUNDR(5).OR.BOUNDR(6).LT.F(1,3).OR. * BOUNDR(7).LT.F(1,4)) THEN IEND=73 RETURN END IF IF(E11.EQ.0..AND.E12.EQ.0..AND.E22.EQ.0.) THEN C Initial point: IF(INIDIM.GT.0) THEN C 617 PAUSE 'Error 617 in INIT2: Strange common initial point' STOP C Initial conditions determined by subroutine INIS2 do not C resemble common initial point. Contact the authors. END IF ELSE IF(E11*E22-E12*E12.LE.0.001) THEN C Initial line: IF(INIDIM.NE.1) THEN C 618 PAUSE 'Error 618 in INIT2: Strange initial line' STOP C Initial conditions determined by subroutine INIS2 do not C resemble initial line. Contact the authors. END IF ELSE C Initial surface: IF(INIDIM.NE.2) THEN C 619 PAUSE 'Error 619 in INIT2: Strange initial surface' STOP C Initial conditions determined by subroutine INIS2 do not C resemble initial surface. Contact the authors. END IF END IF C C Initial travel time YI(1)=F(1,4) C Initial imaginary travel time YI(2)=0. C C Coordinates of the initial point of the ray YI3=YI(3) YI4=YI(4) YI5=YI(5) YI(3)=F(1,1) YI(4)=F(1,2) YI(5)=F(1,3) C C Local coordinate system: C Covariant components of vectors tangent to the initial surface IF(KOOR().NE.0) THEN CALL METRIC(YI(3),GSQRD,G,GAMMA) CALL SMVPRD(G,F(2,1),F(2,2),F(2,3),F21,F22,F23) CALL SMVPRD(G,F(3,1),F(3,2),F(3,3),F31,F32,F33) ELSE GSQRD=1. F21=F(2,1) F22=F(2,2) F23=F(2,3) F31=F(3,1) F32=F(3,2) F33=F(3,3) END IF C Scalar products of vectors tangent to the initial surface C11=F(2,1)*F21+F(2,2)*F22+F(2,3)*F23 C12=F(2,1)*F31+F(2,2)*F32+F(2,3)*F33 C22=F(3,1)*F31+F(3,2)*F32+F(3,3)*F33 DETC=C11*C22-C12*C12 C Unit normal to the initial surface - covariant components AUX1=GSQRD/SQRT(DETC) Z1=(F(2,2)*F(3,3)-F(2,3)*F(3,2))*AUX1 Z2=(F(2,3)*F(3,1)-F(2,1)*F(3,3))*AUX1 Z3=(F(2,1)*F(3,2)-F(2,2)*F(3,1))*AUX1 C C Modification of the coordinates of the initial point of the ray: IF(ADVANC.NE.0.) THEN C Shifting the initial point in the direction of the C unit normal to the initial surface - contravariant components IF(KOOR().NE.0) THEN YI(3)=F(1,1)+ADVANC*(G(1)*Z1+G(2)*Z2+G(4)*Z3) YI(4)=F(1,2)+ADVANC*(G(2)*Z1+G(3)*Z2+G(5)*Z3) YI(5)=F(1,3)+ADVANC*(G(4)*Z1+G(5)*Z2+G(6)*Z3) ELSE YI(3)=F(1,1)+ADVANC*Z1 YI(4)=F(1,2)+ADVANC*Z2 YI(5)=F(1,3)+ADVANC*Z3 END IF END IF C C Material parameters (defining ISB1I, ICB1I, YL(1) to YL(6)): IF(ICB1I.NE.0) THEN IF(YI(3).NE.YI3.OR.YI(4).NE.YI4.OR.YI(5).NE.YI5) THEN ICB1I=0 END IF END IF IF(ICB1I.EQ.0) THEN CALL BLOCK(.TRUE.,YI(3),0,ISB1I,I,ISB2,ICB2,FAUX) ISB1I=ISB2 C Defining locations of the array FSRFCA of the common /INITC/: DO 11 I=1,NSRFCA CALL SRFC2(NSRFC()+I,YI(3),FAUX) FSRFCA(I)=FAUX(1) 11 CONTINUE ELSE ICB2=IABS(ICB1I) ENDIF IF(ICB2.EQ.0) THEN IEND=72 RETURN ENDIF IY(2)=0 IY(6)=0 IY(8)=ICB2 CALL CODE(IY,KODIND,ICBNEW,IEND) IF(IEND.EQ.22) THEN IEND=72 RETURN ELSE IF(IEND.NE.0) THEN C 611 WRITE(*,'(A,I2)') ' Subroutine CODE reports IEND=',IEND PAUSE 'Error 611 in INIT2: Wrong function of subroutine CODE' STOP C Other reason of the termination of the ray computation C than 22 should not be reported by the subroutine CODE when C referenced by the subroutine INIT2. Contact the authors. END IF IF(ICB2.NE.IABS(ICBNEW)) THEN C 612 PAUSE 'Error 612 in INIT2: Wrong function of subroutine CODE' STOP C Subroutine CODE requires the first ray element to be C situated in another complex block than the initial point. C This error should not appear. Contact the authors. END IF IF(ICB1I.EQ.0.OR.ICB1I.NE.ICBNEW) THEN ICB1I=ICBNEW CALL PARM2(IABS(ICBNEW),YI(3),UP,US,YLI(3),QP,QS) CALL VELOC(ICBNEW,UP,US,QP,QS,YLI(1),YLI(2),VD,QL) V0=VD(1) YLI(4)=VD(2) YLI(5)=VD(3) YLI(6)=VD(4) ENDIF C C Important quantities at the initial point of the ray (C.R.T.6.1): C Slowness derivatives with respect to ray parameters AUX1=-(YLI(4)*F(2,1)+YLI(5)*F(2,2)+YLI(6)*F(2,3))/(V0*V0) AUX2=-(YLI(4)*F(3,1)+YLI(5)*F(3,2)+YLI(6)*F(3,3))/(V0*V0) U1=E11*AUX1+E12*AUX2 U2=E12*AUX1+E22*AUX2 C Slowness vector AUX1=( C22*F(2,4)-C12*F(3,4))/DETC AUX2=(-C12*F(2,4)+C11*F(3,4))/DETC AUX3=V0**(-2)-AUX1*F(2,4)-AUX2*F(3,4) IF(AUX3.LE.0.) THEN C Evanescent wave IEND=74 RETURN END IF AUX3=SQRT(AUX3) YI(6)=F21*AUX1+F31*AUX2+Z1*AUX3 YI(7)=F22*AUX1+F33*AUX2+Z2*AUX3 YI(8)=F23*AUX1+F33*AUX2+Z3*AUX3 C Space-time scalar products of vectors tangent to the surface T1=F(2,4)*V0 T2=F(3,4)*V0 C11=C11-T1*T1 C12=C12-T1*T2 C22=C22-T2*T2 DETC=SQRT(C11*C22-C12*C12) IF(INIDIM.NE.1) THEN C Initial surface or initial point: C Square root of the matrix C AUX1=SQRT(C11+C22+DETC+DETC) C11=(C11+DETC)/AUX1 C12=C12/AUX1 C22=(C22+DETC)/AUX1 C Inverse square root of the matrix C B11= C22/DETC B12=-C12/DETC B22= C11/DETC C First basis vector of ray-centred coordinate system AUX3=V0*(B11*T1+B12*T2) YI(9) =F21*B11+F31*B12-YI(6)*AUX3 YI(10)=F22*B11+F32*B12-YI(7)*AUX3 YI(11)=F23*B11+F33*B12-YI(8)*AUX3 C Geometrical spreading matrix Q YI(12)=C11*E11+C12*E12 YI(13)=C12*E11+C22*E12 YI(16)=C11*E12+C12*E22 YI(17)=C12*E12+C22*E22 C Matrix P FF11=F(4,4)-YI(6)*F(4,1)-YI(7)*F(4,2)-YI(8)*F(4,3)-T1*U1 FF12=F(5,4)-YI(6)*F(5,1)-YI(7)*F(5,2)-YI(8)*F(5,3) FF21=FF12-T2*U1 FF12=FF12-T1*U2 FF22=F(6,4)-YI(6)*F(6,1)-YI(7)*F(6,2)-YI(8)*F(6,3)-T2*U2 YI(14)=B11*FF11+B12*FF21 YI(15)=B12*FF11+B22*FF21 YI(18)=B11*FF12+B12*FF22 YI(19)=B12*FF12+B22*FF22 ELSE C Initial line: C Infinite part of the inverse square root of the matrix C B11=(1.-E11)/DETC B12= -E12 /DETC B22=(1.-E22)/DETC C Matrix CB=1-C*B CB11=1.-C11*B11+C12*B12 CB21= -C12*B11+C22*B12 CB12= -C11*B12+C12*B22 CB22=1.-C12*B12+C22*B22 C E-projection of the finite part of the inverse square root of C TRECE=SQRT(E11*C11+2.*E12*C12+E22*C22) ECB11=(E11*CB11+E12*CB21)/TRECE ECB21=(E12*CB11+E22*CB21)/TRECE ECB12=(E11*CB12+E12*CB22)/TRECE ECB22=(E12*CB12+E22*CB22)/TRECE C First basis vector of ray-centred coordinate system AUX1=B11+ECB11 AUX2=B12+ECB12 BT1=AUX1*T1+AUX2*T2 BT2=(B12+ECB21)*T1+(B22+ECB22)*T2 AUX3=V0*BT1 YI(9) =F21*AUX1+F31*AUX2-YI(6)*AUX3 YI(10)=F22*AUX1+F32*AUX2-YI(7)*AUX3 YI(11)=F23*AUX1+F33*AUX2-YI(8)*AUX3 C Geometrical spreading matrix Q YI(12)=E11*TRECE YI(13)=E12*TRECE YI(16)=E12*TRECE YI(17)=E22*TRECE C Matrix P FF11=F(4,4)-YI(6)*F(4,1)-YI(7)*F(4,2)-YI(8)*F(4,3) FF12=F(5,4)-YI(6)*F(5,1)-YI(7)*F(5,2)-YI(8)*F(5,3) FF22=F(6,4)-YI(6)*F(6,1)-YI(7)*F(6,2)-YI(8)*F(6,3) FFE11=FF11*E11+FF12*E12 FFE21=FF12*E11+FF22*E12 FFE12=FF11*E12+FF12*E22 FFE22=FF12*E12+FF22*E22 YI(14)=B11*FF11+B12*FF12+ECB11*FFE11+ECB12*FFE21-BT1*U1 YI(15)=B12*FF11+B22*FF12+ECB12*FFE11+ECB22*FFE21-BT2*U1 YI(18)=B11*FF12+B12*FF22+ECB11*FFE12+ECB12*FFE22-BT1*U2 YI(19)=B12*FF12+B22*FF22+ECB12*FFE12+ECB22*FFE22-BT2*U2 END IF C Take-off parameters YI(20)=PAR1 YI(21)=PAR2 C C Modification of the initial travel time: IF(ADVANC.NE.0.) THEN YI(1)=YI(1)+(YI(3)-F(1,1))*YI(6) * +(YI(4)-F(1,2))*YI(7) * +(YI(5)-F(1,3))*YI(8) END IF C C C Initial values for the complete ray tracing (C.R.T.6.2): DO 21 I=1,6 YL(I)=YLI(I) 21 CONTINUE DO 22 I=1,11 Y(I)=YI(I) 22 CONTINUE IF(ICB1I.GE.0) THEN NY=27+2 ELSE NY=27+8 ENDIF DO 23 I=12,NY Y(I)=0.0 23 CONTINUE Y(12)=1.0 Y(17)=1.0 Y(22)=1.0 Y(27)=1.0 Y(28)=1.0 IF(NY.GE.34) Y(34)=1.0 YY(1)=0.0 YY(2)=UEB YY(3)=0.0 YY(4)=0.0 YY(5)=0.0 IY(1)=NY IY(2)=KODIND IY(3)=0 IY(4)=ISB1I IY(5)=ICB1I IY(6)=0 C Note: IY(7),IY(8) may be undefined IY(7)=0 IY(8)=0 IY(9)=0 IY(10)=0 IY(11)=0 IY(12)=0 RETURN END C C======================================================================= C C C SUBROUTINE INIS1(LUN,NFUNC) INTEGER LUN,NFUNC C C Subroutine INIS1 reads the input data for the initial points of rays C and stores them in common block /INISC/, and if required, calls the C subroutine VAL1 to read the input data for the interpolated functions C of two variables (ray parameters), to determine the coefficients C necessary to compute an interpolatory function on a two dimensional C rectangular grid, and to store them in the memory. The functions C determined can be represented as a tensor product of splines under C tension. For actual mapping of points it is necessary to call the C subroutine INIS2, which also returns the first and second partial C derivatives. C C Input: C LUN... Logical unit number of the external input device C containing the input data. C NFUNC...Number of the functions required to be defined during the C current invocation of INIS1. Since the functions C specified in the input data do not coincide with the C required functions but are transformed to them, NFUNC need C not equal the number of functions specified in the input C data. C None of the input parameters are altered. C C No output. C C Common block /INISC/: INCLUDE 'initd.inc' C initd.inc C All the storage locations of the common block are defined in this C subroutine. C C Subroutines and external functions required: EXTERNAL VAL1 C VAL1, SORTV, READV... File 'val.for' of the package 'MODEL'. C CURVN1 or CURVB1 (alternatives), SURFB1, VAL3B1, SNHCSH, VGEN, C TERMS, TRIDEC, TRISOL... Subroutine package 'FITPACK' C (file 'fit.for' of the package 'MODEL'). C C Date: 1994, February 26 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Auxiliary storage locations: INTEGER LUSRC PARAMETER (LUSRC=9) INTEGER LFUNC,MFUNC CHARACTER*80 TEXTI CHARACTER*3 TFUNCT DATA TFUNCT/' '/ C C LUSRC...Logical unit number of the source-point file. The file is C opened and closed here. C LFUNC...Difference between the number NFUNC of the required C functions and the number of input functions specifying C them. C MFUNC...Number of functions specified in the input data. C TEXTI...String of 80 characters for various purposes. C C (1) Reading the name of the input data READ(LUN,*) TEXTI C C (2) Quantities defining the kind of initial conditions INIDIM=-1 INIPAR= 2 ADVANC= 0. READ(LUN,*) INIDIM,INIPAR,ADVANC C C (3) Data describing the initial point, curve or surface. IF(INIDIM.LT.0) THEN TEXTI='src.dat' READ(LUN,*) TEXTI OPEN(LUSRC,FILE=TEXTI,STATUS='OLD') READ(LUSRC,*) (TEXTI,I=1,20) TTINI=0. READ(LUSRC,*) TEXTI,X1INI,X2INI,X3INI,TTINI CLOSE(LUSRC) ELSE IF(INIDIM.EQ.0) THEN TTINI=0. READ(LUN,*) X1INI,X2INI,X3INI,TTINI ELSE IF(INIDIM.EQ.2.AND.INIPAR.GT.0) THEN READ(LUN,*) X1INI,X2INI,X3INI LFUNC=2 ELSE LFUNC=0 IF(INIDIM.EQ.1.AND.(INIPAR.LT.1.OR.INIPAR.GT.2)) THEN C 602 PAUSE 'Error 602 in INIS1: Wrong value of INIPAR' STOP C For INIDIM=1, there must be INIPAR=1 or INIPAR=2. END IF END IF READ(LUN,*) MFUNC IF(NFUNC-LFUNC.LE.MFUNC) THEN CALL VAL1(LUN,3,MFUNC,1,TFUNCT) ELSE C 601 PAUSE 'Error 601 in INIS1: Small number of input functions' STOP C The number of input functions is less than the number of C functions necessary to describe coordinates and travel C time along the initial surface. END IF END IF C RETURN END C C======================================================================= C C C SUBROUTINE INIS2(NFUNC,PAR1,PAR2,E,F,IEND) INTEGER NFUNC,IEND REAL PAR1,PAR2,E(3),F(6,NFUNC) C C Subroutine INIS2 evaluates the functional values and the derivatives C of the functions describing the initial surface. The first three C functions of given ray parameters are coordinates of the point C corresponding to the given ray parameters, the fourth function is the C initial value of the travel time. The single initial point common to C all rays or the initial line are treated as singular limiting cases of C the initial surface. The input data specifying the functions must C have been read by the subroutine INIS1. C C Input: C NFUNC...Number of functions required. It is assumed to be 4 in C this version (three coordinates and the travel time). C PAR1,PAR2... Ray parameters. C E... Array of the dimension at least 3. C F... Array of the dimension at least 6*NFUNC. C None of the input parameters except E and F are altered. C C Output: C E... Array containing the components E11, E12, E22 of the 2*2 C symmetric projection matrix onto the tangent space to the C ray parameter's manifold. For a non-degenerate initial C surface, E is the identity matrix. For a single initial C point, E is the zero matrix. For the initial line, E is C the projection matrix of the rank 1. Note that a C projection matrix E satisfies the relation E*E=E. C F(1:6,I)... For a non-degenerate initial surface, the value and C the first and second partial derivatives F, F1, F2, F11, C F12, F22 of the I-th function F(PAR1,PAR2). Note that C F1 = E11,E12 * F1 C F2 E12,E22 F2 , C and C F11,F12 = E11,E12 * F11,F12 * E11,E12 C F12,F22 E12,E22 F12,F22 E12,E22 . C Thus, in a degenerate case (i.e. if E is not the identity C matrix), the first derivatives are modified in the C following way, C F1 = F1 + F31 - E11,E12 * F31 C F2 F2 F32 E12,E22 F32 , C and second derivatives are modified as follows: C F11,F12 = F11,F12 + F311,F312 - E11,E12*F311,F312*E11,E12 C F12,F22 F12,F22 F312,F322 E12,E22 F312,F322 E12,E22. C Here F31, F32, F311, F312 and F322 are the derivatives of C F1, F2, F11, F12 and F22 with respect to the small C parameter (e.g. a radius) which shrinks to zero upon an C initial line or at a single initial point. C IEND... Information on the initial point of the ray: C 0... Computation of the ray may follow. C 71... There is no ray corresponding to the given ray C parameters. E.g., the given parameters do not belong to C the domain of the initial surface. C C Common block /INISC/: INCLUDE 'initd.inc' C initd.inc C None of the storage locations of the common block are altered. C C Subroutines and external functions required: EXTERNAL METRIC,VAL2,SPHERE,SQRT3 C METRIC..File 'metric.for' of the package 'MODEL'. C VAL2... File 'val.for' of the package 'MODEL'. C CURV2D OR CURVBD (alternatives), SURFBD, VAL3BD, SNHCSH, DSPLNZ, C INTRVL... Subroutine package 'FITPACK' (file 'fit.for' of C the package 'MODEL'). C SPHERE,SQRT3... This file. C C Date: 1996, May 9 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Auxiliary storage locations: INTEGER I,I1,I2,I11,I22,LFUNC REAL AUX1,AUX2,DUMMY,R(3),G(12),FF(6,3) C C I... Auxiliary loop variable. C I1,I11..Array subscripts of the first and second derivatives with C respect to INIPAR-th ray parameter. C I2,I22..Array subscripts of the first and second derivatives with C respect to the other than INIPAR-th ray parameter. C LFUNC...Difference between the numbers of required (NFUNC) and C interpolated functions C AUX1,AUX2... Auxiliary storage locations. C DUMMY...Dummy storage location. C R... Array used for general coordinates or ray parameters. C G... G(1)-G(6)... Covariant components of the symmetric 3*3 C metric tensor, or contravariant components of the C symmetric 3*3 matrix of the basis vectors of the local C Cartesian coordinate system (i.e. the square root of the C contravariant metric tensor). C G(7)-G(12)... Contravariant components of the symmetric C 3*3 metric tensor. C FF... General-purpose auxiliary array. Used to store local C Cartesian coordinates and their derivatives with respect C to the ray parameters. Temporarily used also as dummy C storage location for Christoffel symbols, for the last C interpolated function, e.t.c. C C....................................................................... C IEND=0 IF(INIDIM.LE.1.OR.INIPAR.GE.1) THEN C Matrix E of local Cartesian coordinate system basis vectors R(1)=X1INI R(2)=X2INI R(3)=X3INI CALL METRIC(R,DUMMY,G,FF) END IF IF(INIDIM.LE.0) THEN C Single initial point: C Projection matrix E(1)=0. E(2)=0. E(3)=0. C Contravariant components of the symmetric 3*3 matrix of the C basis vectors of the local Cartesian coordinate system CALL SQRT3(G(7),G) C Mapping of the ray parameters onto a unit sphere CALL SPHERE(INIPAR,PAR1,PAR2,FF,IEND) IF(IEND.NE.0) THEN RETURN END IF C Required functions (3 general coordinates and a travel time) F(1,1)=X1INI F(1,2)=X2INI F(1,3)=X3INI F(1,4)=TTINI DO 14 I=2,6 F(I,1)=G(1)*FF(I,1)+G(2)*FF(I,2)+G(4)*FF(I,3) F(I,2)=G(2)*FF(I,1)+G(3)*FF(I,2)+G(5)*FF(I,3) F(I,3)=G(4)*FF(I,1)+G(5)*FF(I,2)+G(6)*FF(I,3) F(I,4)=0. 14 CONTINUE ELSE C Initial line or initial surface: C Interpolated functions R(1)=PAR1 R(2)=PAR2 R(3)=0. IF(INIDIM.EQ.1) THEN R(3-INIPAR)=0. END IF IF(INIDIM.EQ.2.AND.INIPAR.GT.0) THEN LFUNC=2 ELSE LFUNC=0 END IF DO 21 I=LFUNC+1,NFUNC-1 CALL VAL2(3,I-LFUNC,1,R,F(1,I),DUMMY) F(4,I)=F(5,I) F(5,I)=F(6,I) F(6,I)=F(1,I+1) 21 CONTINUE CALL VAL2(3,NFUNC-LFUNC,1,R,FF,DUMMY) F(1,NFUNC)=FF(1,1) F(2,NFUNC)=FF(2,1) F(3,NFUNC)=FF(3,1) F(4,NFUNC)=FF(5,1) F(5,NFUNC)=FF(6,1) F(6,NFUNC)=FF(1,2) IF(INIDIM.EQ.1) THEN C Initial line: C Covariant components of the vector tangent to the initial line I1=1+INIPAR FF(6,1)=G(1)*F(I1,1)+G(2)*F(I1,2)+G(4)*F(I1,3) FF(6,2)=G(2)*F(I1,1)+G(3)*F(I1,2)+G(5)*F(I1,3) FF(6,3)=G(4)*F(I1,1)+G(5)*F(I1,2)+G(6)*F(I1,3) C Contravariant unit vector tangent to the initial line AUX2=F(I1,1)*FF(6,1)+F(I1,2)*FF(6,2)+F(I1,3)*FF(6,3) AUX1=SQRT(AUX2) FF(1,1)=F(I1,1)/AUX1 FF(1,2)=F(I1,2)/AUX1 FF(1,3)=F(I1,3)/AUX1 C Derivative of the unit vector tangent to the initial line I11=2*I1 AUX2=(F(I11,1)*FF(6,1)+F(I11,2)*FF(6,2)+F(I11,3)*FF(6,3))/AUX2 FF(2,1)=(F(I11,1)-FF(1,1)*AUX2)/AUX1 FF(2,2)=(F(I11,2)-FF(1,2)*AUX2)/AUX1 FF(2,3)=(F(I11,3)-FF(1,3)*AUX2)/AUX1 C Covariant vector normal to the interpolated surface I2=5-I1 FF(3,1)=FF(1,2)*F(I2,3)-FF(1,3)*F(I2,2) FF(3,2)=FF(1,3)*F(I2,1)-FF(1,1)*F(I2,3) FF(3,3)=FF(1,1)*F(I2,2)-FF(1,2)*F(I2,1) C Derivative of the vector normal to the interpolated surface FF(4,1)=FF(2,2)*F(I2,3)-FF(2,3)*F(I2,2)+ * FF(1,2)*F(5,3) -FF(1,3)*F(5,2) FF(4,2)=FF(2,3)*F(I2,1)-FF(2,1)*F(I2,3)+ * FF(1,3)*F(5,1) -FF(1,1)*F(5,3) FF(4,3)=FF(2,1)*F(I2,2)-FF(2,2)*F(I2,1)+ * FF(1,1)*F(5,2) -FF(1,2)*F(5,1) C Contravariant components FF(5,1)=G(7) *FF(3,1)+G(8) *FF(3,2)+G(10)*FF(3,3) FF(5,2)=G(8) *FF(3,1)+G(9) *FF(3,2)+G(11)*FF(3,3) FF(5,3)=G(10)*FF(3,1)+G(11)*FF(3,2)+G(12)*FF(3,3) FF(6,1)=G(7) *FF(4,1)+G(8) *FF(4,2)+G(10)*FF(4,3) FF(6,2)=G(8) *FF(4,1)+G(9) *FF(4,2)+G(11)*FF(4,3) FF(6,3)=G(10)*FF(4,1)+G(11)*FF(4,2)+G(12)*FF(4,3) C Required functions (3 general coordinates and a travel time) E(2)=0. IF(INIPAR.LE.1) THEN E(1)=1. E(3)=0. AUX1=COS(PAR2) AUX2=SIN(PAR2) ELSE E(1)=0. E(3)=1. AUX1=COS(PAR1) AUX2=SIN(PAR1) END IF I22=10-I11 DO 24 I=1,3 F(I22,I)=-AUX2*F(I2,I)+AUX1*FF(5,I) F(I2,I) = AUX1*F(I2,I)+AUX2*FF(5,I) F(5,I) = AUX1*F(5,I) +AUX2*FF(6,I) 24 CONTINUE F(I22,4)=0. F(I2,4)=0. F(5,4)=0. ELSE C Initial surface: C Projection matrix E(1)=1. E(2)=0. E(3)=1. C Required functions (3 general coordinates and a travel time) IF(INIPAR.GE.1) THEN C Contravariant components of the symmetric 3*3 matrix of the C basis vectors of the local Cartesian coordinate system CALL SQRT3(G(7),G) C Mapping of the ray parameters onto a unit sphere CALL SPHERE(INIPAR,PAR1,PAR2,FF,IEND) IF(IEND.NE.0) THEN RETURN END IF C Local Cartesian coordinates DO 33 I=1,3 FF(6,I)=F(6,3)*FF(1,I)+2.*F(3,3)*FF(3,I)+F(1,3)*FF(6,I) FF(5,I)=F(5,3)*FF(1,I)+F(3,3)*FF(2,I)+F(3,3)*FF(1,I) * +F(1,3)*FF(5,I) FF(4,I)=F(4,3)*FF(1,I)+2.*F(2,3)*FF(2,I)+F(1,3)*FF(4,I) FF(3,I)=F(3,3)*FF(1,I)+F(1,1)*FF(3,1) FF(2,I)=F(2,3)*FF(1,I)+F(1,1)*FF(2,1) FF(1,I)=F(1,3)*FF(1,I) 33 CONTINUE C General coordinates DO 34 I=1,6 F(I,1)=G(1)*FF(I,1)+G(2)*FF(I,2)+G(4)*FF(I,3) F(I,2)=G(2)*FF(I,1)+G(3)*FF(I,2)+G(5)*FF(I,3) F(I,3)=G(4)*FF(I,1)+G(5)*FF(I,2)+G(6)*FF(I,3) 34 CONTINUE F(1,1)=F(1,1)+X1INI F(1,2)=F(1,2)+X2INI F(1,3)=F(1,3)+X3INI END IF END IF END IF RETURN END C C======================================================================= C C C SUBROUTINE SQRT3(B,A) REAL B(6),A(6) C C Subroutine SQRT3 evaluates the square root A of the given real-valued C positive-semidefinite symmetric 3*3 matrix B. The square root is the C real-valued positive-semidefinite symmetric 3*3 matrix A satisfying C the equation A*A=B. C C Input: C B... Array of dimension at least 6, containing the components C B11, B12, B22, B13, B23, B33 of the given symmetric 3*3 C matrix B. C A... Array of dimension at least 6. C The input parameter B is not altered. C C Output. C A... Array containing the components A11, A12, A22, A13, A23, C A33 of the symmetric 3*3 matrix a which is the square root C of the given matrix B. C C No subroutines and external functions required. C C Date: 1990, January 22 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C No auxiliary storage locations C IF(B(2).EQ.0..AND.B(4).EQ.0..AND.B(5).EQ.0.) THEN C Diagonal matrix IF(B(1).LT.0..OR.B(3).LT.0..OR.B(6).LT.0.) THEN C 614 PAUSE'Error 614 in SQRT3: Matrix is not positive-semidefinite' STOP C Input matrix B is not positive-semidefinite. ELSE A(1)=SQRT(B(1)) A(2)=0. A(3)=SQRT(B(3)) A(4)=0. A(5)=0. A(6)=SQRT(B(6)) END IF ELSE C General symmetric matrix C 615 PAUSE 'Error 615 in SQRT3: This program branch is not coded' STOP C The square root of general symmetric matrix B has not been C coded. At present, only the square root of diagonal matrix can C be evaluated. END IF RETURN END C C======================================================================= C C C SUBROUTINE SPHERE(INIPAR,PAR1,PAR2,FF,IEND) INTEGER INIPAR,IEND REAL PAR1,PAR2,FF(6,3) C C Subroutine SPHERE transforms spherical coordinates PAR1, PAR2 into the C Cartesian coordinates of the corresponding point on the unit sphere. C It also evaluates the first and second derivatives of the Cartesian C coordinates with respect to PAR1 and PAR2. C C Input: C INIPAR..Determines the type of spherical coordinates: C INIPAR.LT.0: The same as for IABS(INIPAR), but with the C unit vector (T1,T2,T3) tangent to the ray changed to C (T1,-T2,-T3). C INIPAR.EQ.1: Polar-like spherical coordinates (colatitude, C longitude). C If SIN(colatitude).LT.0, the ray is reported out of the C ray-parameter domain: IEND=71. C INIPAR.GE.2: Geographic-like spherical coordinates C (longitude, latitude). C If COS(latitude).LT.0, the ray is reported out of the C ray-parameter domain: IEND=71. C INIPAR.EQ.3: The unit vector tangent to the ray, C expressed in the local Cartesian coordinate system C which basis vectors are given by the square root of C the metric tensor at the initial point, is given by C T1=PAR1*SIN(R)/R C T2=PAR2*SIN(R)/R C T3= COS(R) C with R=SQRT(PAR1*PAR1+PAR2*PAR2). C If R.GT.PI, the ray is reported out of the C ray-parameter domain: IEND=71. C PAR1,PAR2... Ray parameters. C FF... Array of the dimension at least 6*3. C None of the input parameters except FF are altered. C C Output: C FF(1:6,I)...I-th Cartesian coordinate of the point on the unit C sphere given by PAR1, PAR2, and its first and second C partial derivatives with respect to PAR1 and PAR2 in the C order FF, FF1, FF2, FF11, FF12, FF22. C IEND... Information on the initial point of the ray: C 0... Computation of the ray may follow. C 71... There is no ray corresponding to the given ray C parameters. I.e., the given parameters are outside the C domain allowed. C C No subroutines and external functions required. C C Date: 1997, July 5 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Auxiliary storage locations: REAL C1,C2,S1,S2,R,R1,R2,R11,R12,R22,R111,R112,R122,R222 C C C1,C2...Cosines of the take-off angles at a single initial point. C S1,S2...Sines of the take-off angles at a single initial point. C R,R1,R2,R11,R12,R22,R111,R112,R122,R222... C R=SQRT(PAR1*PAR1+PAR2*PAR2) and its partial derivatives. C IEND=0 IF(IABS(INIPAR).LE.2) THEN C1=COS(PAR1) S1=SIN(PAR1) C2=COS(PAR2) S2=SIN(PAR2) IF(IABS(INIPAR).LE.1) THEN C Polar-like spherical coordinates IF(S1.LT.0.) THEN IEND=71 RETURN END IF FF(1,1)= S1*C2 FF(1,2)= S1*S2 FF(1,3)= C1 IF(S1.EQ.0.) THEN C Avoiding null vectors S1=0.000001 END IF FF(2,1)= C1*C2 FF(2,2)= C1*S2 FF(2,3)=-S1 FF(3,1)=-S1*S2 FF(3,2)= S1*C2 FF(3,3)= 0. FF(4,1)=-S1*C2 FF(4,2)=-S1*S2 FF(4,3)=-C1 FF(5,1)=-C1*S2 FF(5,2)= C1*C2 FF(5,3)= 0. FF(6,1)=-S1*C2 FF(6,2)=-S1*S2 FF(6,3)= 0. ELSE C Geographic-like spherical coordinates IF(C2.LT.0.) THEN IEND=71 RETURN END IF FF(1,1)= C2*C1 FF(1,2)= C2*S1 FF(1,3)= S2 IF(C2.EQ.0.) THEN C Avoiding null vectors C2=0.000001 END IF FF(2,1)=-C2*S1 FF(2,2)= C2*C1 FF(2,3)= 0. FF(3,1)=-S2*C1 FF(3,2)=-S2*S1 FF(3,3)= C2 FF(4,1)=-C2*C1 FF(4,2)=-C2*S1 FF(4,3)= 0. FF(5,1)= S2*S1 FF(5,2)=-S2*C1 FF(5,3)= 0. FF(6,1)=-C2*C1 FF(6,2)=-C2*S1 FF(6,3)=-S2 END IF ELSE C Azimuthal equidistant projection R=SQRT(PAR1*PAR1+PAR2*PAR2) IF(R.GT.3.2) THEN IEND=71 RETURN ELSE IF(R.GT.0.) THEN S1=SIN(R) IF(S1.LT.0.) THEN IEND=71 RETURN END IF C1=COS(R) R1=PAR1/R R2=PAR2/R R11= R2*R2/R R12=-R1*R2/R R22= R1*R1/R R111= -3.*R11*R1 /R R112=(-R2/R-3.*R12*R1)/R R122=(-R1/R-3.*R12*R2)/R R222= -3.*R22*R2 /R FF(1,1)= S1*R1 FF(1,2)= S1*R2 FF(1,3)= C1 FF(2,1)= C1*R1*R1+S1*R11 FF(2,2)= C1*R1*R2+S1*R12 FF(2,3)=-FF(1,1) FF(3,1)= FF(2,2) FF(3,2)= C1*R2*R2+S1*R22 FF(3,3)=-FF(1,2) FF(4,1)=-S1*R1*R1*R1 +3.*C1*R1*R11+S1*R111 FF(4,2)=-S1*R1*R1*R2+C1*R11*R2+2.*C1*R1*R12+S1*R112 FF(4,3)=-FF(2,1) FF(5,1)= FF(4,2) FF(5,2)=-S1*R1*R2*R2+C1*R1*R22+2.*C1*R2*R12+S1*R122 FF(5,3)=-FF(2,2) FF(6,1)= FF(5,2) FF(6,2)=-S1*R2*R2*R2 +3.*C1*R2*R22+S1*R222 FF(6,3)=-FF(3,2) ELSE FF(1,1)= 0. FF(1,2)= 0. FF(1,3)= 1. FF(2,1)= 1. FF(2,2)= 0. FF(2,3)= 0. FF(3,1)= 0. FF(3,2)= 1. FF(3,3)= 0. FF(4,1)= 0. FF(4,2)= 0. FF(4,3)=-1. FF(5,1)= 0. FF(5,2)= 0. FF(5,3)= 0. FF(6,1)= 0. FF(6,2)= 0. FF(6,3)=-1. END IF END IF C IF(INIPAR.LT.0) THEN DO 12 J=2,3 DO 11 I=1,6 FF(I,J)=-FF(I,J) 11 CONTINUE 12 CONTINUE END IF C RETURN END C C======================================================================= Cinitc.inc 100666 1750 1750 7436 6425373366 11766 0 ustar klimes klimes CC INCLUDE 'initc.inc' C ------------------------------------------------------------------ INTEGER MSRFCA PARAMETER (MSRFCA=128) INTEGER ISB1I,ICB1I REAL YLI(6),YI(29),FSRFCA(MSRFCA) COMMON/INITC/ISB1I,ICB1I,YLI,YI,FSRFCA SAVE /INITC/ C ------------------------------------------------------------------ C ISB1I,ICB1I... Indices of a simple and a complex blocks in which C the initial point of the ray is situated (see C.R.T.6.1). C YLI... Array containing the values of the quantities YL(1)-YL(6) C (see C.R.T.5.5.4) describing the local properties of the C model at the initial point of the ray, see C.R.T.6.1. C They must not be changed outside the subroutine INIT2. C Description of YL C C YI... Array containing the following quantities describing the C properties of the rays and of the travel-time field, see C C.R.T.6.1: C YI(1)...Initial travel time. C YI(2)...Initial imaginary part of the complex travel time. C YI(3)-YI(5)... Coordinates of the initial point of the ray. C YI(6)-YI(8)... Covariant components of the initial slowness C vector. C YI(9)-YI(11)... Covariant components of the first basis vector of C the ray-centred coordinate system at the initial point of C the ray (perpendicular to the slowness vector C YI(6)-YI(8)). C YI(12),YI(16) QR11,QR12 C YI(13),YI(17) QR21,QR22 C YI(14),YI(18) PR11,PR12 C YI(15),YI(19)... PR21,PR22 C Elements of the ray geometrical spreading matrix QR, and C of the matrix PR (see C.R.T.,eq.(5.13)) at the initial C point of the ray. C YI(20),YI(21)... Take-off parameters of the ray. C C The above quantities are defined in subroutine INIT2 of file C 'init.for'. C INIT2 C Following quantities Y(22)-Y(29) are defined in subroutine RPAR4 C of file 'rpar.for'. C RPAR4 C C In addition to the above quantities describing the properties C defined for a single ray, there are also quantities describing C the properties of the discrete system of computed rays in the C vicinity of the computed ray. These quantities are C YI(22)..Area of the element of the ray-parameter surface, C corresponding to the ray, see C.R.T.,eq.(6.1). C YI(23),YI(24),YI(25)... Components 11, 12, 22 of the symmetric C matrix inverse to the specific moment of the element of C the ray-parameter surface corresponding to the ray, see C C.R.T.,eq.(6.2). C C Additional quantities related to the shooting algorithm: C YI(26),YI(27)... Normalized take-off parameters of the ray, both C taking the values between 0 and 1. C YI(28),YI(29)... For a successful ray, values of the X1 and X2 C functions parametrizing the reference surface. C X1 and X2 functions C Otherwise zeros. C C The index of the last allocated numeric unit of array FSRFCA is C named MSRFCA. Dimension MSRFCA may be adjusted if necessary. C C Common block /INITC/ is included in external procedures INIT1 and C INIT2 of 'init.for', in OUTP of 'raycb.for', in 'rpar.for', C in 'writ.for', in 'scropc.for', and may be included in any other C subroutine. C C Date: 1997, September 5 C Coded by Ludek Klimes C C======================================================================= Cinitd.inc 100666 1750 1750 1565 6425373366 11764 0 ustar klimes klimes CC INCLUDE 'initd.inc' C ------------------------------------------------------------------ INTEGER INIDIM,INIPAR REAL X1INI,X2INI,X3INI,TTINI,ADVANC COMMON/INISC/INIDIM,INIPAR,X1INI,X2INI,X3INI,TTINI,ADVANC SAVE /INISC/ C ------------------------------------------------------------------ C INIDIM,INIPAR,ADVANC... Input data (2) of 'init.for'. C X1INI,X2INI,X3INI,TTINI... Input data (3A) of 'init.for' if they C are defined. C C Common block /INISC/ is included in subroutines INIS1 and INIS2 C in order to communicate the input data to the subroutine INIS2. C C Date: 1996, July 8 C Coded by Ludek Klimes C C======================================================================= Cinv1tt.for 100666 1750 1750 60563 6425373370 12135 0 ustar klimes klimes CC Program INV1TT to evaluate the derivatives of the travel time with C respect to the model coefficients. C C Version: 5.10 C Date: 1997, September 30 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 Just a preliminary demo version, illustrating the usage of the C routines designed to calculate the variations of travel times with C respect to model parameters (FORTRAN77 source code files 'var.for', C 'spsp.for', 'ap.for'). C C Program INV1TT assumes all model parameters (coefficients) stored in C the common block /VALC/ as in the submitted versions of user-defined C model specification FORTRAN77 source code files 'srfc.for', 'parm.for' C and 'val.for'. Thus, unlike the other parts of the complete ray C tracing, the INV1TT program cannot work with user's modifications of C the subroutines SRFC1, SRFC2, PARM1, and PARM2. C C....................................................................... C C C Description of data files: C C Main input data file read from the interactive device (*): C (1) 'INV1TT' C 'INV1TT' name of the input file described below. C Default: 'INV1TT'='inv1tt.dat'. C C C Input data INV1TT: C This main data file contains the names of other input and output C files. The data are read in by the list directed input (free C format). In the list of input data below, each numbered paragraph C indicates the beginning of a new input operation (new READ C statement). All input variables are of the type CHARACTER. Only C the first 80 characters of the strings are significant. C (1) 'MODEL','POINTS','FTT','DATA','INV1LOG',/ C 'MODEL'... Input data file containing the model parameters. C See the file 'model.for' of the package 'MODEL'. C Description of MODEL C 'POINTS'... Input data file containing the coordinates of shot and C receiver points. Its structure is described below. C Ignored (not opened) if the DATA filename below is C blank. C Description of file POINTS C 'FTT'... Input data file containing the travel times from the C field measurements. Its structure is described below. C Ignored (not opened) if the DATA filename below is C blank. C Description of file FTT C 'DATA'..Output file containing the computed travel times and their C derivatives with respect to the model coefficients. C Its structure is described below. C If the filename is blank, no file with objective prior C information is generated. C Description of file DATA C 'INV1LOG'... Output log file. Just for your information. C Not opened and generated if the DATA filename above is C blank. C Description of file IN1LOG C /... An obligatory slash at the end of line. C Default: 'MODEL'='model.dat', 'DATA'='data.out', C 'INV1LOG'='inv1log.out'. C (2) DIST,VPOWER,/ C DIST... Maximum distance between the source or receiver point and C the initial or end point of a synthetic ray. C VPOWER... Velocity power for the computation of the travel-time C check sum. If the VPOWER-th velocity power is expressed, C in all blocks of the model, in terms of explicit functions C of model coordinates, linearly homogeneous in their C coefficients (e.g. B-splines), the travel time minus its C check sum (see the log output file) should be zero within C rounding errors. Otherwise, the check sum may have no C sense. C VPOWER=0: no check sum is evaluated and printed. C /... An obligatory slash at the end of line. C Default: VPOWER=0.0. C (3) Any times the following data: C 'CRT-R','CRT-S','CRT-I' C 'CRT-R'... File with the quantities stored along rays (see C C.R.T.5.5.1). C Description of file CRT-R C 'CRT-S'... File with the quantities at the points of C intersection of rays with the specified surface at which C the receivers are situated for the case of two-point ray C tracing (see C.R.T.5.5.2). C If this filename is not blank, just the two-point rays C with minimum travel time at each receiver are considered. C If this filename is blank, all rays are taken into C account. C Attention: All rays taken into account must start in some C of the specified sources and terminate in some of the C specified receivers, see the input file FTT. C Description of file CRT-S C 'CRT-I'... File with the quantities at the initial points C of rays, corresponding to the above file rays or points of C intersection (see C.R.T.6.1). C Description of file CRT-I C (4) / (a slash). C Example of data INV1TT C C C Input data file POINTS: C This data file contains the coordinates of shot and receiver C points. The data are read in by the list directed input C (free format). In the list of input data below, each numbered C paragraph indicates the beginning of a new input operation (new C READ statement). The CHARACTER strings are explicitly mentioned C in this description. Otherwise, if the first letter of the C symbolic name of the input variable is I-N, the corresponding C value in input data must be of the type INTEGER. Otherwise, the C input parameter is of the type REAL. C (1) Several strings terminated by / (a slash). C (2) List of the sources and receivers: Any times the following data: C (2.1) POINT,X1,X2,X3 C POINT...CHARACTER*11 string containing the name of the source or C receiver point. C X1,X2,X3... Coordinates of the source or receiver point. C (3) / (a slash) or the end of file. C Example of data POINTS C C C Input data file FTT: C This data file contains the travel times from the field C measurements. The data are read in by the list directed input C (free format). In the list of input data below, each numbered C paragraph indicates the beginning of a new input operation (new C READ statement). The CHARACTER strings are explicitly mentioned C in this description. Otherwise, if the first letter of the C symbolic name of the input variable is I-N, the corresponding C value in input data must be of the type INTEGER. Otherwise, the C input parameter is of the type REAL. C (1) Several strings terminated by / (a slash). C (2) List of the travel times: Any times the following data (2.1): C (2.1) SOURCE,RECEIVER,TFIELD,TERR C SOURCE..CHARACTER*11 string containing the name of the source C point. C RECEIVER... CHARACTER*11 string containing the name of the C receiver point. The source and receiver points may be C mutually interchanged. C TFIELD..Travel time from a field measurement. C TERR... Error of the travel time from a field measurement. C (3) / (a slash) or the end of file. C Example of data FTT C C C Output file DATA: C (1) ND,NM,(INDM(I),I=1,NM) C ND... The number of data (i.e. the number of equations). C NM... Number of unknown model coefficients. C INDM... Indices of the model coefficients influencing the travel C times. The indices correspond to the relative location in C the memory. C B-spline coefficients are listed in the same order as the C grid velocities in the file 'MODEL'. C (2) ND-times the following data (2.1): C (2.1) KD,RD,ED,WD,(GD(I),I=1,NM) C KD... Index of the field travel time within the file 'ftt'. C The field travel times are indexed consecutively 1,2,3,... C RD... Field travel time minus the computed synthetic travel C time. In the case of multiple two-point rays, the first C arrival of them is considered. C ED... Prior error of the above travel time difference. C Identical to TERR, file 'FTT', part (3). I.e. the C synthetic travel time is assumed to be sufficiently C accurate. C WD... Field travel time (stored for the purpose to assess a C posterior data misfit covariance weighting matrix). C GD... Derivatives of the synthetic travel time with respect to C the model coefficients INDM. C C C Output log file INV1LOG: C (1) For each considered ray: C (1.1) SOURCE,RECEIVER,TFIELD,TDIF,SDIST,RDIST,CHECK C SOURCE..Name of the source point. C RECEIVER... Name of the receiver point. C TFIELD..Travel time from a field measurement. C TDIF... Field travel time minus the minimum synthetic travel time. C SDIST...Distance between the source and the initial point of the C synthetic ray. C RDIST...Distance between the receiver and the end point of the C synthetic ray. C CHECK...Synthetic travel time minus the travel time resulting from C the derivatives of the theoretical travel time with C respect to the model coefficients. This quantity should C not exceed in order the numerical error of the synthetic C travel time. C In this version defined just for the models described in C the terms of velocity. C C----------------------------------------------------------------------- C C Common block /VALC/: INCLUDE 'val.inc' C val.inc C None of the storage locations of the common block are altered. C C Common block /POINTC/: INCLUDE 'pointc.inc' C pointc.inc C C----------------------------------------------------------------------- C C Common block /RAMC/: INCLUDE 'ram.inc' C ram.inc C C Allocation of working arrays: C INTEGER MP,MT PARAMETER (MP=1000) PARAMETER (MT=4000) CHARACTER*11 POINT(MP) INTEGER KS(MT),KR(MT) REAL COOR(3,MP),TFIELD(MT),TERR(MT),TTMIN(MT) EQUIVALENCE (KS ,RAM ) EQUIVALENCE (KR ,RAM( MT+1)) EQUIVALENCE (TFIELD,RAM(2*MT+1)) EQUIVALENCE (TERR ,RAM(3*MT+1)) EQUIVALENCE (TTMIN ,RAM(4*MT+1)) EQUIVALENCE (COOR ,RAM(5*MT+1)) C INTEGER INDM(NPAR) REAL SUM(NPAR) C INDM... Indices of the unknown model parameters. EQUIVALENCE (SUM , RAM(5*MT+3*MP+1)) C C Output data: subjective prior information: REAL CS(1) C C----------------------------------------------------------------------- C C Filenames: CHARACTER*80 FILE2,FILE0,FILE1,FILE3,FILE4,FILE6 C C Logical unit numbers: INTEGER LU0,LU1,LU2,LU3,LU4,LU5,LU7,IU1,IU2 PARAMETER (LU0=10) PARAMETER (LU1=11) PARAMETER (LU2=12) PARAMETER (LU3=13) PARAMETER (LU4=14) PARAMETER (LU5=15) PARAMETER (LU7=17) C C Input data: CHARACTER*1 TEXT(10) CHARACTER*11 SRC,REC INTEGER NP,NT REAL DIST,DIST2,VPOWER C POINT...Names of the source and receiver points. C NP... Number of source and receiver points. C NT... Number of field travel times. C KS(I)...Index of the source point corresponding to the I-th field C travel time. C KR(I)...Index of the receiver point corresponding to the I-th C field travel time. C DIST... Maximum distance between the source or receiver point and C the initial or end point of a synthetic ray. C DIST2...DIST**2 C VPOWER... Velocity power for the computation of the travel-time C check SUM. C COOR... Coordinates of the source or receiver points. C TFIELD..Field travel times. C TERR... Field travel time errors. C C Output data: variations of the synthetic travel time: INTEGER NSUM,NM C NM... Number of the unknown model parameters. C C Auxiliary storage locations: INTEGER IS,IR,IT,ND,IRAYTT,I,J,K REAL TT,TTAUX,TDIF,XI1,XI2,XI3,XE1,XE2,XE3,PI(6),PE(6) REAL SI,SE,RI,RE,SDIST,RDIST C IS... Index of the source point. C IR... Index of the receiver point. C IT... Index of the field travel time. C ND... Number of synthetic travel times corresponding to the C field travel times. C IRAYTT..Index of the last processed ray. C I,J,K...Temporary storage locations. C TTMIN...Minimum synthetic travel times corresponding to the C individual field travel times. C TT... Synthetic travel time. C TTAUX...Temporary storage location. C TDIF... Field travel time minus the minimum synthetic travel time. C XI1,XI2,XI3,XE1,XE2,XE3... Coordinates of the initial and end C points of the last processed ray. C PI,PE...Slowness vectors at the initial and end points of the C last processed ray. C SI,SE,RI,RE... Squares of the distances between the source or C receiver points and the initial or end points of the ray. C SDIST...Distance between the source and the initial point of the C synthetic ray. C RDIST...Distance between the receiver and the end point of the C synthetic ray. C C....................................................................... C C Opening data files and reading the input data: C C Main input data file read from the interactive device (*): WRITE(*,'(A)') ' Enter the name of the main input data file: ' FILE0='inv1.dat' READ(*,*) FILE0 WRITE(*,'(A)') '+ ' C C Input data INV1TT: OPEN(LU0,FILE=FILE0,STATUS='OLD') FILE2='model.dat' FILE4='data.out' FILE6='inv1log.out' READ(LU0,*) FILE2,FILE0,FILE1,FILE4,FILE6 VPOWER=0. READ(LU0,*) DIST,VPOWER DIST2=DIST*DIST OPEN(LU4,FILE=FILE2,STATUS='OLD') CALL MODEL1(LU4) CLOSE(LU4) C C Number of unknown model parameters: CALL SOFT(2,0,0,0,0,0,0,0.,NM,INDM,CS) WRITE(*,'(A,I4,A)') '+',NM,' model parameters' C C....................................................................... C C Reading source and receiver points: C OPEN(LU4,FILE=FILE0,STATUS='OLD') NP=-1 READ(LU4,*,END=2) TEXT 1 CONTINUE NP=NP+1 IF(NP.GE.MP) THEN C INV1TT-01 PAUSE 'Error INV1TT-01: Too many source and receiver points' STOP END IF POINT(NP+1)=' ' READ(LU4,*,END=2) POINT(NP+1),(COOR(I,NP+1),I=1,3) IF(POINT(NP+1).NE.' ') GO TO 1 2 CONTINUE CLOSE(LU4) C C Reading field travel times: C OPEN(LU4,FILE=FILE1,STATUS='OLD') NT=0 READ(LU4,*,END=2) TEXT 3 CONTINUE NT=NT+1 IF(NT.GT.MT) THEN C INV1TT-02 PAUSE 'Error INV1TT-02: Too many field travel times' STOP END IF SRC=' ' READ(LU4,*,END=9) SRC,REC,TFIELD(NT),TERR(NT) IF(SRC.EQ.' ') THEN GO TO 9 END IF DO 4 I=1,NP IF(SRC.EQ.POINT(I)) THEN KS(NT)=I GO TO 5 END IF 4 CONTINUE C INV1TT-03 PAUSE 'Error INV1TT-03: Source name not recognized' STOP 5 CONTINUE DO 6 I=1,NP IF(REC.EQ.POINT(I)) THEN KR(NT)=I GO TO 7 END IF 6 CONTINUE C INV1TT-04 PAUSE 'Error INV1TT-04: Receiver name not recognized' STOP 7 CONTINUE GO TO 3 9 CONTINUE NT=NT-1 CLOSE(LU4) C C....................................................................... C C Computing quantities describing objective prior information: C OPEN(LU5,STATUS='SCRATCH',FORM='UNFORMATTED') OPEN(LU7,FILE=FILE6) WRITE(*,*) C KS(NT+1)=NP+1 KR(NT+1)=NP+1 TFIELD(NT+1)=0. IRAY=0 IWAVE=0 NSUM=IPAR(IPAR(IPAR(2))) DO 12 I=1,NT TTMIN(I)=999999. 12 CONTINUE C C Loop for the files with computed rays 20 CONTINUE FILE1=' ' READ(LU0,*,END=70) FILE1,FILE2,FILE3 IF(FILE1.EQ.' ') THEN GO TO 70 END IF I=INDEX(FILE1,' ') J=INDEX(FILE2,' ') K=INDEX(FILE3,' ') WRITE(*,'(''+Processing: '',3A)') FILE1(1:I),FILE2(1:J), * FILE3(1:K) WRITE(*,*) OPEN(LU1,FILE=FILE1,FORM='UNFORMATTED',STATUS='OLD') IF(FILE2.EQ.' ') THEN IU1=0 IU2=LU1 ELSE IU1=LU1 IU2=LU2 OPEN(LU2,FILE=FILE2,FORM='UNFORMATTED',STATUS='OLD') END IF OPEN(LU3,FILE=FILE3,FORM='UNFORMATTED',STATUS='OLD') IRAYTT=0 C C Loop for the points of intersection of rays with the surface 30 CONTINUE C Reading the results of the complete ray tracing CALL AP00(IU1,IU2,LU3) IF(IPT.LE.1.AND.IRAYTT.NE.0)THEN C New ray - recording results for the last ray iraytt C loop for field travel times - searching for two-point ray DO 39 IT=1,NT IS=KS(IT) IR=KR(IT) SI=(COOR(1,IS)-XI1)**2+(COOR(2,IS)-XI2)**2 * +(COOR(3,IS)-XI3)**2 RI=(COOR(1,IR)-XI1)**2+(COOR(2,IR)-XI2)**2 * +(COOR(3,IR)-XI3)**2 SE=(COOR(1,IS)-XE1)**2+(COOR(2,IS)-XE2)**2 * +(COOR(3,IS)-XE3)**2 RE=(COOR(1,IR)-XE1)**2+(COOR(2,IR)-XE2)**2 * +(COOR(3,IR)-XE3)**2 IF(SE.LE.SI.AND.RI.LE.RE) THEN C interchanging source and receiver points SI=SE RE=RI IS=KR(IT) IR=KS(IT) END IF IF((SI.LE.DIST2.AND.RE.LE.DIST2)) THEN C Synthetic ray may correspond to the field travel time C check for ray directions near the source C (allowable angle deviation +-30 deg: cosine**2=0.750) C (allowable angle deviation +-15 deg: cosine**2=0.933) TTAUX=(COOR(1,IR)-COOR(1,IS))*(XE1-XI1) * +(COOR(2,IR)-COOR(2,IS))*(XE2-XI2) * +(COOR(3,IR)-COOR(3,IS))*(XE3-XI3) IF(TTAUX.GT.0..AND.TTAUX*TTAUX.GT. * 0.933*((COOR(1,IR)-COOR(1,IS))**2 * +(COOR(2,IR)-COOR(2,IS))**2 * +(COOR(3,IR)-COOR(3,IS))**2) * *((XE1-XI1)**2+(XE2-XI2)**2+(XE3-XI3)**2) ) THEN C Synthetic ray corresponds to the field travel time TTAUX=TT-PI(1)*(COOR(1,IS)-XI1) * -PI(2)*(COOR(2,IS)-XI2) * -PI(3)*(COOR(3,IS)-XI3) * +PE(1)*(COOR(1,IR)-XE1) * +PE(2)*(COOR(2,IR)-XE2) * +PE(3)*(COOR(3,IR)-XE3) IF(TTAUX.LT.TTMIN(IT)) THEN TTMIN(IT)=TTAUX C Possible minimum synthetic travel time SDIST=SQRT(SI) RDIST=SQRT(RE) WRITE(LU5) IT,TT,TTAUX,SDIST,RDIST,(SUM(I),I=1,NSUM) END IF END IF END IF 39 CONTINUE IF(NT.EQ.0) THEN WRITE(LU5) NT+1,TT,TT,0.,0.,(SUM(I),I=1,NSUM) END IF IRAYTT=0 END IF IF(IWAVE.EQ.0) THEN GO TO 60 END IF C *** for future extensions (selection of two-point rays): C IF(IU1.NE.0) THEN C CALL AP30(IREC) C IF(IREC.EQ.0) THEN C IF(IPT.LE.1.) THEN C WRITE(*,'(''+WAVE:'',I3,'' RAY:'',I4,'' POINT:'', C * I4)') IWAVE,IRAY,IPT C END IF C GO TO 30 C END IF C END IF C *** IF(IPT.EQ.1.OR.MOD(IPT,10).EQ.0) THEN WRITE(*,'(''+WAVE:'',I3,'' RAY:'',I4,'' POINT:'',I4)') * IWAVE,IRAY,IPT END IF IRAYTT=IRAY XI1=YI(3) XI2=YI(4) XI3=YI(5) XE1=Y(3) XE2=Y(4) XE3=Y(5) CALL AP01(TT,TTAUX) CALL AP02(PI,PE) CALL AP29(NSUM,SUM) GO TO 30 C End of the loop for points of intersection of rays with surface C 60 CONTINUE CLOSE(LU1) CLOSE(LU2) GO TO 20 C C All minimum travel times and their derivatives are stored in the C scratch file LU5. C C....................................................................... C C Writing objective prior information: C 70 CONTINUE OPEN(LU4,FILE=FILE4) I=MAX0(INDEX(FILE4,' ')-1,11) WRITE(*,'(''+Generating the output: '',A)') FILE4(1:I) ND=0 DO 71 I=1,NT IF(TTMIN(I).LT.999999.) THEN ND=ND+1 END IF 71 CONTINUE C ND is the number of equations. C REWIND(LU5) WRITE(LU4,'(I9,5I13)') ND,NM WRITE(LU4,'(I9,5I13)') (INDM(I),I=1,NM) WRITE(LU7,'(2A)') ' SOURCE RECEIVER TFIELD ', * 'TFIELD-TT SDIST RDIST TT-CHECKSUM' 73 CONTINUE READ(LU5,END=79) IT,TT,TTAUX,SDIST,RDIST,(SUM(I),I=1,NSUM) TTMIN(NT+1)=TTAUX IF(TTAUX.EQ.TTMIN(IT)) THEN C Minimum synthetic travel time C C System of linear equations: TDIF=TFIELD(IT)-TTAUX WRITE(LU4,'(I9,4X,6G13.6)') IT,TDIF,TERR(IT),TFIELD(IT) WRITE(LU4,'(6G13.6)') (SUM(INDM(I)),I=1,NM) C C Check sums and log output: IF(VPOWER.NE.0.) THEN TTAUX=0. DO 74 I=1,NM J=INDM(I) IF(IPAR(IPAR(IPAR(1))).LT.J) THEN IF(SUM(J).NE.0.) THEN TTAUX=TTAUX+RPAR(J)*SUM(J) END IF END IF 74 CONTINUE IS=KS(IT) IR=KR(IT) TTAUX=TT+VPOWER*TTAUX WRITE(LU7,'(2(1X,A),5F12.6)') POINT(IS),POINT(IR), * TFIELD(IT),TDIF,SDIST,RDIST,TTAUX ELSE WRITE(LU7,'(2(1X,A),5F12.6)') POINT(IS),POINT(IR), * TFIELD(IT),TDIF,SDIST,RDIST END IF END IF GO TO 73 C 79 CONTINUE CLOSE(LU4) CLOSE(LU5) CLOSE(LU7) STOP END C C======================================================================= C INCLUDE 'modelv.for' C modelv.for INCLUDE 'metric.for' C metric.for INCLUDE 'srfc.for' C srfc.for INCLUDE 'parmv.for' C parmv.for INCLUDE 'valv.for' C valv.for INCLUDE 'fitv.for' C fitv.for INCLUDE 'var.for' C var.for INCLUDE 'spsp.for' C spsp.for INCLUDE 'soft.for' C soft.for INCLUDE 'means.for' C means.for INCLUDE 'ap.for' C ap.for INCLUDE 'apvar.for' C apvar.for C C======================================================================= Clen/ 40777 1750 1750 0 6425373370 10627 5 ustar klimes klimes len/len.txt 100666 1750 1750 10276 6425373370 12271 0 ustar klimes klimes Model with LENticular inclusion: 3-D boundary-value ray tracing by two-parametric shooting. Date: 1997, October 27 Written by Ludek Klimes Two-point ray tracing for the point source: 'len-crt.dat'... Sample main input data for the CRT program. This data file refers, among others, sample data file 'model.dat' of the MODEL specification package, which has therefore to be located in the current directory. 'len-rpa.dat'... Data controlling two-point ray tracing to given receivers. 'len-rec.dat'... Names and coordinates of the receivers. 'len-rp2.dat', 'len-rp4.dat', 'len-rp5.dat', 'len-rp6.dat', 'len-rp7.dat', 'color.dat', 'symbol.dat', 'symbol7.dat'... Data to to create PostScript figures displaying the distribution of the rays and homogeneous triangles in the normalized ray domain and on the reference surface. 'len-crt.bat'... MS-DOS batch file running 'crt.for' to trace the two-point rays of the refracted P wave and then rewriting the resulting travel times at the given receivers by means of program 'crtpts.for' into formatted file 'len-rec.out'. Input data files: 'len-crt.dat', 'model.dat', 'dcrt.dat', 'init.dat', 'len-src.dat', 'code1.dat ', 'len-rpa.dat', 'len-rec.dat', 'writ.dat', and data for plotting. 'len-crt'... Unix script -- counterpart of 'len-crt.bat'. Boundary-value rays corresponding to the plane wave incident at the bottom of the model: 'lenb-crt.dat'... Sample input data for the plane wave incident at the model bottom at 45 degrees. This data file refers 'model.dat' of the MODEL package, 'dcrt.dat', 'code1.dat', 'writ.dat' and 'len-rec.dat'. 'lenb-crt.bat'... MS-DOS batch file running 'crt.for' to trace the two-point rays of the refracted P wave and then rewriting the resulting travel times at the given receivers by means of program 'crtpts.for' into formatted output file 'lenb-rec.out'. Input data files: 'lenb-crt.dat', 'model.dat', 'dcrt.dat', 'code1.dat ', 'writ.dat', 'len-rec.dat'. 'lenb-crt'... Unix script -- counterpart of 'lenb-crt.bat'. Zero-offset boundary-value rays (exploding reflector): 'lenz-crt.dat'... Sample input data for the initial conditions for rays corresponding to exploding reflector. This data file refers 'model.dat' of the MODEL package, 'dcrt.dat', 'code1.dat', 'writ.dat' and 'len-rec.dat'. 'lenz-crt.bat'... MS-DOS batch file running 'crt.for' to trace the two-point rays of the refracted P wave and then rewriting the resulting travel times at the given receivers by means of program 'crtpts.for' into formatted output file 'lenz-rec.out'. Input data files: 'lenz-crt.dat', 'model.dat', 'dcrt.dat', 'code1.dat ', 'len-rec.dat', 'writ.dat'. 'lenz-crt'... Unix script -- counterpart of 'lenz-crt.bat'. Controlled initial-value ray tracing for the point source followed by travel-time interpolation into a given grid of points: 'leni-grd.h'... Dimensions of the given grid. 'leni-crt.dat'... Main input data for the CRT program. This data file refers, among others, sample data file 'model.dat' of the MODEL specification package, which has therefore to be located in the current directory. 'leni-rpa.dat'... Data controlling initial-value ray tracing. 'leni-mtt.bat'... Main input data for the . 'leni-mtt.bat'... MS-DOS batch file running 'crt.for' to trace the rays of the refracted P wave, then running program MTT interpolating Multivalued Travel Times inside ray cells, program MGRD converting file with multivalued travel times into several files with singlevalued travel times, and program GRDPS plotting the numbers and values of the calculated travel times. 'leni-mtt'... Unix script -- counterpart of 'len-mtt.bat' (not present in version 5.10). ====================================================================== len/len-crt.dat 100666 1750 1750 1126 6425373370 12762 0 ustar klimes klimes 'Main input data crt.dat: Data filenames for 3-D two-point ray tracing' 'model.dat' 'dcrt.dat' 'init.dat' 'code1.dat ' 'len-rpa.dat' 'writall.dat' 'len-log.out' ------------------------------------------------------------------------ Note: In most cases, it is convenient to locate data sets 'dcrt.dat', 'init.dat' and 'code1.dat' within this data file, below the above strings with filenames. Such an option is indicated by replacing the corresponding strings in the above data with blank strings. ======================================================================== len/len-rpa.dat 100666 1750 1750 542 6425373370 12735 0 ustar klimes klimes 'Data file len-rpar.dat: Ray parameters for two-point ray tracing' 2 -1 -2 -1 0.001 0.002 0 0 0 / (ISRFR,ISRFX1,ISRFX2,NREC,XERR,AERR,...) 'len-rec.dat' / (File with receiver coordinates) 0.0000 -1.3090 3.1416 -1.3090 0.0000 1.3090 18 30 1 / / / / / / ======================================================================== len/len-rec.dat 100666 1750 1750 1053 6425373370 12742 0 ustar klimes klimes / '02+10' 2. 10. / '04+10' 4. 10. / '06+10' 6. 10. / '08+10' 8. 10. / '10+10' 10. 10. / '12+10' 12. 10. / '14+10' 14. 10. / '16+10' 16. 10. / '18+10' 18. 10. / '20+10' 20. 10. / '22+10' 22. 10. / '24+10' 24. 10. / '26+10' 26. 10. / '28+10' 28. 10. / '30+10' 30. 10. / '32+10' 32. 10. / '34+10' 34. 10. / '36+10' 36. 10. / '38+10' 38. 10. / '40+10' 40. 10. / '42+10' 42. 10. / '44+10' 44. 10. / '46+10' 46. 10. / '48+10' 48. 10. / '50+10' 50. 10. / '52+10' 52. 10. / '54+10' 54. 10. / '56+10' 56. 10. / '58+10' 58. 10. / / len/len-rp2.dat 100666 1750 1750 352 6425373370 12655 0 ustar klimes klimes 1 0 0 0 1 0 0 / IRBAS,IRTWO,IRAUX,ITHOM,ISANG,ISHP,ISUC 0. 1. 0. 1. / PLIMIT 6* 'symbol.dat' 'color.dat' / HRBAS,HRTWO,HRAUX,HOR,VER,HTEXT,'SYMBOLS','COLORS' / 'INITIALPOINTS','TRIANGLES' 'len-rec.dat' / 'RECEIVERS',ISREC,ICREC,HREC len/len-rp4.dat 100666 1750 1750 362 6425373370 12660 0 ustar klimes klimes 1 0 1 0 1 0 0 / IRBAS,IRTWO,IRAUX,ITHOM,ISANG,ISHP,ISUC 0. 1. 0. 1. / PLIMIT 2* 0.08 3* 'symbol.dat' 'color.dat' / HRBAS,HRTWO,HRAUX,HOR,VER,HTEXT,'SYMBOLS','COLORS' / 'INITIALPOINTS','TRIANGLES' 'len-rec.dat' / 'RECEIVERS',ISREC,ICREC,HREC len/len-rp5.dat 100666 1750 1750 352 6425373370 12660 0 ustar klimes klimes 0 0 0 1 1 0 0 / IRBAS,IRTWO,IRAUX,ITHOM,ISANG,ISHP,ISUC 0. 1. 0. 1. / PLIMIT 6* 'symbol.dat' 'color.dat' / HRBAS,HRTWO,HRAUX,HOR,VER,HTEXT,'SYMBOLS','COLORS' / 'INITIALPOINTS','TRIANGLES' 'len-rec.dat' / 'RECEIVERS',ISREC,ICREC,HREC len/len-rp6.dat 100666 1750 1750 366 6425373370 12666 0 ustar klimes klimes 1 1 1 1 1 0 1 / IRBAS,IRTWO,IRAUX,ITHOM,ISANG,ISHP,ISUC 0. 1. 0. 1. / PLIMIT 1* 0.5 0.08 3* 'symbol.dat' 'color.dat' / HRBAS,HRTWO,HRAUX,HOR,VER,HTEXT,'SYMBOLS','COLORS' / 'INITIALPOINTS','TRIANGLES' 'len-rec.dat' / 'RECEIVERS',ISREC,ICREC,HREC len/len-rp7.dat 100666 1750 1750 402 6425373370 12656 0 ustar klimes klimes 1 1 1 1 0 0 0 / IRBAS,IRTWO,IRAUX,ITHOM,ISANG,ISHP,ISUC 0. 60. -20. 20. / PLIMIT 1* 0.5 0.1 3* 'symbol7.dat' 'color.dat' / HRBAS,HRTWO,HRAUX,HOR,VER,HTEXT,'SYMBOLS','COLORS' / 'INITIALPOINTS','TRIANGLES' 'len-rec.dat' 4 1 0.4 / 'RECEIVERS',ISREC,ICREC,HREC len/color.dat 100666 1750 1750 317 6425373370 12515 0 ustar klimes klimes 1 2 14 9 5 6 7 8 4 10 11 12 13 3 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 len/symbol.dat 100666 1750 1750 1744 6425373370 12731 0 ustar klimes klimes 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 len/symbol7.dat 100666 1750 1750 34 6425373370 12747 0 ustar klimes klimes 1 1 1 1 1 1 1 1 3 1 1 1 1 5 len/len-crt.bat 100666 1750 1750 5301 6425373370 12757 0 ustar klimes klimes @ECHO OFF REM ==================================================================== REM Two-point ray tracing in the model with LENticular inclusion (MS-DOS) REM ==================================================================== REM Ray tracing (refracted wave): REM ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ECHO 'len-crt.dat' / >crt.tmp ECHO >>crt.tmp crt