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