C                                                            <HTML><PRE>
C Program PTSGRD to generate grid file containing undefined values
C at the gridpoints closest to the given points and zeros at the other
C gridpoints
C
C Version: 5.40
C Date: 2000, January 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                                                    <A NAME="data"></A>
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                                                     <A NAME="SEP"></A>
C Input data file 'SEP':
C     File 'SEP' has the form of the <A HREF="../forms/sep.htm">SEP</A>
C     parameter file.  The parameters, which do not differ from their
C     defaults, need not be specified in file 'SEP'.
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             If PTS=' ', zeros at all gridpoints are generated.
C             <A HREF="#PTS">Description of the file PTS</A>
C             Default: PTS=' '
C     PTSGRD='string'... String in apostrophes containing the name of
C             the output file with the grid values.
C             For general description of files with gridded data refer
C             to file <A HREF="../forms/forms.htm#GRD">forms.htm</A>.
C             No default, 'PTSGRD' must be specified and cannot be blank
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 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             <A HREF="forms.for#MAXDIG">forms.for</A>.
C
C                                                     <A NAME="PTS"></A>
C Input file PTS with given points:
C (1) None to several strings terminated by / (a slash)
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     <A HREF="ram.inc">ram.inc</A>
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     Reading name of SEP file with input data:
      WRITE(*,'(A)') '+PTSGRD: Enter input filename: '
      FSEP=' '
      READ(*,*) FSEP
C
C     Reading all data from the SEP file into the memory:
      IF (FSEP.NE.' ') THEN
        CALL RSEP1(LU,FSEP)
      ELSE
C       <A NAME="error01"></A><FONT COLOR="RED">PTSGRD-01</FONT>
        CALL ERROR('PTSGRD-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
      WRITE(*,'(A)') '+PTSGRD: Working...            '
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 (FGRD.EQ.' ') THEN
C       <A NAME="error02"></A><FONT COLOR="RED">PTSGRD-02</FONT>
        CALL ERROR('PTSGRD-02: Output file PTSGRD not given')
C       Output file PTSGRD must be specified.
C       There is no default filename.
      ENDIF
C
      DO 10 I=1,N1*N2*N3
        RAM(I)=0.
   10 CONTINUE
C
      IF(FPTS.NE.' ') THEN
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)
      END IF
C
C     Writing output grid values:
      CALL WARRAY(LU,FGRD,'FORMATTED',.TRUE.,UNDEF,.FALSE.,0.,
     *                                                     N1*N2*N3,RAM)
      WRITE(*,'(A)') '+PTSGRD: Done.                 '
      STOP
      END
C
C=======================================================================
C
      INCLUDE 'error.for'
C     <A HREF="error.for">error.for</A>
      INCLUDE 'sep.for'
C     <A HREF="sep.for">sep.for</A>
      INCLUDE 'forms.for'
C     <A HREF="forms.for">forms.for</A>
      INCLUDE 'length.for'
C     <A HREF="length.for">length.for</A>
C
C=======================================================================
C                                                                 </PRE>
