C
C Program SRP (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.50
C Date: 2001, May 10
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 Description of data files:
C
C Input data read from the standard input device (*):
C The data are read by the list directed input (free format) and
C consist of a single string 'SEP':
C 'SEP'...String in apostrophes containing the name of the input
C SEP parameter or history file with the input data.
C No default, 'SEP' must be specified and cannot be blank.
C
C
C Input data file 'SEP':
C File 'SEP' has the form of the SEP
C parameter file. The parameters, which do not differ from their
C defaults, need not be specified in file 'SEP'.
C Name of the input file, configuration parameters:
C SRP='string'...Name of the input file specifying the unshifted
C points corresponding to zero configuration parameters,
C and the derivatives of their positions with respect to the
C configuration parameters.
C Description of the file SRP
C Default: 'SRP'='srp.dat'
C CNAME='string'... Character string which is, without trailing
C blanks, prefixed to the name of each unshifted point in
C order to create the name of the corresponding point
C shifted according to the configuration parameters CPAR1,
C CPAR2.
C Default: 'CNAME'=' '
C CPAR1=real, CPAR2=real...Configuration parameters describing new,
C shifted positions of the given surface points.
C Default: CPAR1=0., CPAR2=0.
C Optional parameters specifying the form of the real quantities
C written in the output formatted files:
C MINDIG,MAXDIG=positive integers ... See the description in file
C forms.for.
C
C
C Input file 'SRP' with the unshifted points:
C (1) 'PTS1','PTS2','PTS3',...,/
C One to MFILE=1024 filenames terminated by a slash. Names of the
C output files with the shifted surface points, corresponding to
C given configuration parameters CPAR1, CPAR2. It is thus assumed,
C that the shifted points are written to the same files for all
C values of the configuration parameters. A filename should not
C exceed 12 characters.
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 CPAR1.
C X12,X22,X32... Derivatives of the coordinates with respect to the
C second configuration parameter CPAR2.
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*CPAR1+X12*CPAR2,
C X2=X20+X21*CPAR1+X22*CPAR2,
C X3=X30+X31*CPAR1+X32*CPAR2.
C (3) /
C
C-----------------------------------------------------------------------
C
CHARACTER*80 FILSEP
INTEGER LU
PARAMETER (LU=1)
C
C Filenames:
INTEGER MFILE
PARAMETER (MFILE=1024)
CHARACTER*12 FILE1(MFILE)
CHARACTER*80 FILE0
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 Reading name of SEP file with input data:
WRITE(*,'(A)') '+SRP: Enter input filename: '
FILSEP=' '
READ(*,*) FILSEP
WRITE(*,'(A)') '+SRP: Working ... '
C
C Reading all data from the SEP file into the memory:
IF (FILSEP.NE.' ') THEN
CALL RSEP1(LU,FILSEP)
ELSE
C SRP-01
CALL ERROR('SRP-01: SEP file not given')
C Input file in the form of the SEP (Stanford Exploration Project)
C parameter or history file must be specified.
C There is no default filename.
ENDIF
C
C Reading input parameters from the SEP file:
CALL RSEP3T('SRP',FILE0,'srp.dat')
CALL RSEP3T('CNAME',CNAME,' ')
CALL RSEP3R('CPAR1',C1,0.)
CALL RSEP3R('CPAR2',C2,0.)
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)
WRITE(*,'(A)') '+SRP: Done. '
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