C
C Program 'ptsgrd.for' to generate grid file containing undefined values
C at gridpoints closest to the given points and zeros elswhere
C
C Version: 5.30
C Date: 1999, April 6
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 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) 'SEP',/
C 'SEP'...String in apostrophes containing the name of the input
C file with the data specifying grid dimensions.
C Description of file SEP
C /... Input data line must be terminated by a slash.
C Default: 'SEP'='grd.h'.
C
C
C Data file SEP has the form of the SEP (Stanford Exploration Project)
C parameter file:
C All the data are specified in the form of PARAMETER=VALUE, e.g.
C N1=50, with PARAMETER directly preceding = without intervening
C spaces and with VALUE directly following = without intervening
C spaces. The PARAMETER=VALUE couple must be delimited by a space
C or comma from both sides.
C The PARAMETER string is not case-sensitive.
C PARAMETER= followed by a space resets the default parameter value.
C All other text in the input files is ignored. The file thus may
C contain unused data or comments without leading comment character.
C Everything between comment character # and the end of the
C respective line is ignored, too.
C The PARAMETER=VALUE couples may be specified in any order.
C The last appearance takes precedence.
C Imput and output filenames:
C PTS='string'... String in apostrophes containing the name of the
C input file with the coordinates of the points.
C Default: PTS=' '
C PTSGRD='string'... String in apostrophes containing the name of
C the output file with the grid values.
C Default: PTSGRD=' '
C Data specifying grid dimensions:
C N1=positive integer... Number of gridpoints along the X1 axis.
C Default: N1=1
C N2=positive integer... Number of gridpoints along the X2 axis.
C Default: N2=1
C N3=positive integer... Number of gridpoints along the X3 axis.
C Default: N3=1
C O1=real... First coordinate of the grid origin (first point of the
C grid).
C Default: O1=0.
C O2=real... Second coordinate of the grid origin.
C Default: O2=0.
C O3=real... Third coordinate of the grid origin.
C Default: O3=0.
C D1=real... Grid interval in the direction of the first coordinate
C axis.
C Default: D1=1.
C D2=real... Grid interval in the direction of the second coordinate
C axis.
C Default: D2=1.
C D3=real... Grid interval in the direction of the third coordinate
C axis.
C Default: D3=1.
C
C
C Input file PTS with given points:
C (1) None to several strings terminated by /
C (2) For each gridpoint data (2.1):
C (2.1) 'NAME',X1,X2,X3,/
C 'NAME'... Name of the point. Any string different from '$'.
C X1,X2,X3... Coordinates of the point.
C (3) / or end of file
C
C-----------------------------------------------------------------------
C
C Common block /RAMC/:
INCLUDE 'ram.inc'
C ram.inc
C
C.......................................................................
C
C Filenames and parameters:
CHARACTER*80 FSEP,FPTS,FGRD
INTEGER LU
REAL UNDEF
PARAMETER (LU=1,UNDEF=-999999.)
C
C Data:
CHARACTER*1 TEXT
INTEGER I,I1,I2,I3,N1,N2,N3
REAL D1,D2,D3,O1,O2,O3,X1,X2,X3
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)') '+PTSGRD: Enter SEP data filename: '
FSEP=' '
READ(*,*) FSEP
WRITE(*,'(A)') '+PTSGRD: Working... '
C
C Reading data from file FSEP to the memory
CALL RSEP1(LU,FSEP)
C
C Recalling the data specifying grid dimensions
CALL RSEP3I('N1',N1,1)
CALL RSEP3I('N2',N2,1)
CALL RSEP3I('N3',N3,1)
CALL RSEP3R('O1',O1,0.)
CALL RSEP3R('O2',O2,0.)
CALL RSEP3R('O3',O3,0.)
CALL RSEP3R('D1',D1,1.)
CALL RSEP3R('D2',D2,1.)
CALL RSEP3R('D3',D3,1.)
C
C Input and output filenames:
CALL RSEP3T('PTS' ,FPTS,' ')
CALL RSEP3T('PTSGRD',FGRD,' ')
IF(FPTS.NE.' '.AND.FGRD.NE.' ') THEN
DO 10 I=1,N1*N2*N3
RAM(I)=0.
10 CONTINUE
C
OPEN(LU,FILE=FPTS,STATUS='OLD')
READ(LU,*) (TEXT,I=1,20)
20 CONTINUE
TEXT='$'
X1=0.
X2=0.
X3=0.
READ(LU,*,END=29) TEXT,X1,X2,X3
IF(TEXT.EQ.'$') THEN
GO TO 29
END IF
I1=NINT((X1-O1)/D1)
I2=NINT((X2-O2)/D2)
I3=NINT((X3-O3)/D3)
IF(0.LE.I1.AND.I1.LT.N1.AND.
* 0.LE.I2.AND.I2.LT.N2.AND.
* 0.LE.I3.AND.I3.LT.N3) THEN
RAM(1+I1+N1*(I2+N2*I3))=UNDEF
END IF
GO TO 20
29 CONTINUE
CLOSE(LU)
C
C Writing output grid values:
CALL WARRAY(LU,FGRD,'FORMATTED',.TRUE.,UNDEF,.FALSE.,0.,
* N1*N2*N3,RAM)
END IF
WRITE(*,'(A)') '+PTSGRD: 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