C
C Program 'srp.for' (Source and Receiver Points, or SuRface Points) to
C generate files containing source and/or receiver points corresponding
C to given configuration parameter(s).
C
C The dependence of the source and receiver coordinates on the
C configuration parameters is assumed to be linear.
C
C Version: 5.20
C Date: 1998, October 20
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 the data files:
C
C The input data are read by the list directed input (free format), the
C output data are designed for the list directed input.
C In the description of data files, each numbered paragraph indicates
C the beginning of a new input operation (new READ statement) or a new
C output line.
C If the symbolic name of the input variable is enclosed in apostrophes,
C the corresponding value in input data is of the type CHARACTER, i.e.
C it should be a character string enclosed in apostrophes. If the first
C letter of the symbolic name is I-N, the corresponding value is of the
C type INTEGER. Otherwise, the input parameter is of the type REAL and
C may or may not contain a decimal point. Where indicated, a slash /
C should be placed after the last specified value, at the same line, to
C facilitate future extensions.
C
C Input data read from the * external unit:
C The interactive * external unit may also be redirected to the file
C containing the relevant data.
C (1) 'SRP','CNAME',C1,C2,/
C 'SRP'...Name of the input file specifying the unshifted points
C corresponding to zero configuration parameters, and the
C derivatives of their positions with respect to the
C configuration parameters.
C 'CNAME'... Character string which is, without trailing blanks,
C prefixed to the name of each unshifted point in order to
C create the name of the corresponding point shifted
C according to the configuration parameters C1,C2.
C C1,C2...Configuration parameters describing new, shifted positions
C of the given surface points (source, receivers, etc.).
C Default: 'SRP'='srp.dat', 'CNAME'=' ', C1=0., C2=0.
C
C
C Input file 'SRP' with the unshifted points:
C (1) 'PTS1','PTS2','PTS3',...,/
C One to MFILE=20 filenames terminated by a slash. Names of the
C output files with the shifted surface points, corresponding to
C given configuration parameters C1,C2. It is thus assumed, that
C the shifted points are written to the same files for all values
C of the configuration parameters.
C (2) For each filename, data (2.1) and (2.2):
C (2.1) For each point to be written to the output file data (2.1.1):
C (2.1.1) 'NAME',X10,X20,X30,X11,X21,X31,X12,X22,X32,/
C 'NAME'..Name of the unshifted point. It will be appended to given
C string 'CNAME' (with trailing blanks removed from both
C 'CNAME' and 'NAME') to form the name of the corresponding
C shifted point. The resulting composed name 'CNAMENAME' is
C truncated to 80 characters. However, some other
C applications may truncate the names of points to 12, 11,
C 8, or even 6 characters.
C X10,X20,X30... Coordinates of the unshifted points.
C X11,X21,X31... Derivatives of the coordinates with respect to the
C first configuration parameter C1.
C X12,X22,X32... Derivatives of the coordinates with respect to the
C second configuration parameter C2.
C Default: X10=0., X20=0., X30=0., X11=0., X21=0., X31=0., X12=0.,
C X22=0., X32=0.
C (2.2) /
C
C
C Output files PTS with the shifted surface points:
C (1) /
C (2) For each shifted point data (2.1):
C (2.1) 'CNAMENAME',X1,X2,X3,/
C 'CNAMENAME'..Name of the shifted point.
C X1,X2,X3... Coordinates of the shifted point,
C X1=X10+X11*C1+X12*C2,
C X2=X20+X21*C1+X22*C2,
C X3=X30+X31*C1+X32*C2.
C (3) /
C
C.......................................................................
C
C Date: 1997, April 29
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
PROGRAM srp
C
C Filenames:
INTEGER MFILE
PARAMETER (MFILE=20)
CHARACTER*80 FILE0,FILE1(MFILE)
C
C Logical unit numbers:
INTEGER LU0,LU1
PARAMETER (LU0=10)
PARAMETER (LU1=11)
C
C Data:
CHARACTER*80 NAME
CHARACTER*8 CNAME
CHARACTER*28 FORMAT
INTEGER I,J,L
REAL X(3),X1,X2,X3,X10,X20,X30,X11,X21,X31,X12,X22,X32,C1,C2
EQUIVALENCE (X(1),X1),(X(2),X2),(X(3),X3)
C
C I,J... Loop variables.
C X1,X2,X3... Coordinates of a point.
C X00,X10,X20,X01,X11,X21,X02,X12,X22... Projection matrix from
C configuration parameters to coordinates of a point.
C C1,C2.. Configuration parameters of a point.
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 data filename, configuration name, and two parameters: '
FILE0='srp.dat'
CNAME=' '
C1=0.
C2=0.
READ(*,*) FILE0,CNAME,C1,C2
C
OPEN(LU0,FILE=FILE0,STATUS='OLD')
DO 10 I=1,MFILE
FILE1(I)='$'
10 CONTINUE
READ(LU0,*) (FILE1(I),I=1,MFILE)
C
DO 11 L=LEN(CNAME),1,-1
IF(CNAME(L:L).NE.' ') THEN
GO TO 12
END IF
11 CONTINUE
12 CONTINUE
L=L+1
C
C Loop over output surface-point files:
DO 30 I=1,MFILE
IF(FILE1(I).EQ.'$') THEN
GO TO 90
END IF
OPEN(LU1,FILE=FILE1(I))
WRITE(LU1,'(A)') '/'
20 CONTINUE
NAME=CNAME
NAME(L:L)='$'
X10=0.
X20=0.
X30=0.
X11=0.
X21=0.
X31=0.
X12=0.
X22=0.
X32=0.
READ(LU0,*) NAME(L:80),X10,X20,X30,X11,X21,X31,X12,X22,X32
IF(NAME(L:80).EQ.'$'
* .AND.X10.EQ.0..AND.X20.EQ.0..AND.X30.EQ.0.
* .AND.X11.EQ.0..AND.X21.EQ.0..AND.X31.EQ.0.
* .AND.X12.EQ.0..AND.X22.EQ.0..AND.X32.EQ.0.) THEN
GO TO 29
END IF
DO 21 J=LEN(NAME),2,-1
IF(NAME(J:J).NE.' ') THEN
GO TO 22
END IF
21 CONTINUE
22 CONTINUE
X1=X10+X11*C1+X12*C2
X2=X20+X21*C1+X22*C2
X3=X30+X31*C1+X32*C2
FORMAT(1:4)='(3A,'
CALL FORM2(3,X,X,FORMAT(5:28))
WRITE(LU1,FORMAT) '''',NAME(1:J),''' ',X1,' ',X2,' ',X3,' /'
GO TO 20
29 CONTINUE
WRITE(LU1,'(A)') '/'
CLOSE(LU1)
30 CONTINUE
C
90 CONTINUE
CLOSE(LU0)
STOP
END
C
C=======================================================================
C
INCLUDE 'error.for'
C error.for
INCLUDE 'sep.for'
C sep.for
INCLUDE 'forms.for'
C forms.for
INCLUDE 'length.for'
C length.for
C
C=======================================================================
C