C                                                            <HTML><PRE>
C Program GRDPTS to generate the file containing the coordinates of all
C gridpoints of the given grid.
C
C Version: 5.50
C Date: 2001, January 2
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 Name of the optional input file:
C     GRD='string'... String with the name of the input data file
C             containing the grid values.
C             This file is used only if KOLUMN.NE.0, see below.
C             The grid may also contain undefined values.  In this case,
C             if KOLUMN.NE.0, the gridpoints with undefined values are
C             not written to output file PTS.
C             If the filename is blank, all gridded values are assumed
C             undefined.
C             No default, GRD must be specified and cannot be blank if
C             KOLUMN.NE.0.
C Names of the output files:
C     PTS='string'...Name of the output file with the coordinates
C             of the gridpoints.
C             The file is not generated if PTS=' '.
C             Default: PTS='pts.out'
C     PLGN='string'... Name of the optional output file specifying the
C             polygons coinciding with grid faces.
C             The polygons are described in terms of the indices of
C             their vertices.
C             The file is not generated if PLGN=' ' (default).
C             For 3-D virtual reality, the polygons should be divided
C             into triangles by program <A HREF="trgl.for">trgl.for</A>.
C             Since the vertices have no normals, the current version of
C             program trgl.for does not work with them and parameter
C             TRGL should be used instead of PLGN.
C             <A HREF="#PLGN">Description of file PLGN</A>
C             Default: PLGN=' '
C     TRGL='string'... Name of the optional output file specifying the
C             triangles covering grid faces.
C             The triangles are described in terms of the indices of
C             their vertices.
C             The file is not generated if TRGL=' ' (default).
C             <A HREF="#TRGL">Description of file TRGL</A>
C             Default: TRGL=' '
C Data specifying the form of the output file with points:
C     KOLUMN=integer ... If non-zero, specifies the position in output
C             file PTS where to write the values at gridpoints.
C             KOLUMN=0:  Grid values are not written to file PTS.
C             KOLUMN=1, 2 or 3:  The corresponding coordinate is
C               replaced with grid values.
C             KOLUMN=4:  The corresponding coordinate is written after
C               the three coordinates, into the fourth numeric column.
C             Default: KOLUMN=0
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                                                     <A NAME="PTS"></A>
C Output file PTS with the gridpoints:
C (1) /
C (2) For each gridpoint data (2.1):
C (2.1) 'NNNNNN',X1,X2,X3,/ or
C       'NNNNNN',X1,X2,X3,X4,/
C     'NNNNNN'...  Name of the point - six-digit integer index of the
C             gridpoint (larger grids than 999999 gridpoints are not
C             expected to be converted into this form suitable for
C             a reasonably small number of points).
C      X1,X2,X3... Coordinates of the gridpoint.
C      X4...  Optional grid value.
C (3) /
C
C                                                    <A NAME="PLGN"></A>
C Optional output file PLGN with the polygons:
C (1) For each grid face data (1.1):
C (1.1) I1,I2,I3,I4,/
C     I1,I2,I3,I4... Integer indices of 4 vertices of the rectangle
C             forming the grid face.
C             The vertices are stored in file PTS and are indexed by
C             positive integers according to their order.
C     /...    List of vertices is terminated by a slash.
C
C                                                    <A NAME="TRGL"></A>
C Optional output file TRGL with the triangles:
C (1) For each triangle data (1.1):
C (1.1) I1,I2,I3,/
C     I1,I2,I3... Integer indices of 3 vertices of one of two triangles
C             forming the grid face.
C             The vertices are stored in file PTS and are indexed by
C             positive integers according to their order.
C     /...    List of vertices is terminated by a slash.
C
C=======================================================================
C
C Common block /RAMC/:
      INCLUDE 'ram.inc'
C     <A HREF="ram.inc">ram.inc</A>
      INTEGER IRAM(MRAM)
      EQUIVALENCE (IRAM,RAM)
C
C.......................................................................
C
C     Filenames and parameters:
      CHARACTER*80 FILSEP,FGRD,FPTS,FPLGN,FTRGL
      INTEGER LU,LU2
      REAL UNDEF
      PARAMETER (LU=1,LU2=2,UNDEF=-999999999.)
C
C     Input data:
      INTEGER KOLUMN,N1,N2,N3
      REAL O1,O2,O3,D1,D2,D3
C
C     Other variables:
      CHARACTER*42 FORMAT
      LOGICAL LWRITE
      INTEGER NCOL,N,I,I1,I2,I3,J1,J2,J3,J4
      REAL X(4),X1,X2,X3,X4
      EQUIVALENCE (X(1),X1),(X(2),X2),(X(3),X3),(X(4),X4)
C
C-----------------------------------------------------------------------
C
C     Reading input SEP parameter file:
      WRITE(*,'(A)') '+GRDPTS: Enter input filename: '
      FILSEP=' '
      READ(*,*) FILSEP
      IF (FILSEP.EQ.' ') THEN
C       <A NAME="error01"></A><FONT COLOR="RED">GRDPTS-01</FONT>
        CALL ERROR('GRDPTS-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
      CALL RSEP1(LU,FILSEP)
      WRITE(*,'(A)') '+GRDPTS: Working ...           '
C
C     Reading input parameters from the SEP file:
      CALL RSEP3T('GRD' ,FGRD ,' ')
      CALL RSEP3T('PTS' ,FPTS ,'pts.out')
      CALL RSEP3T('PLGN',FPLGN,' ')
      CALL RSEP3T('TRGL',FTRGL,' ')
      CALL RSEP3I('KOLUMN',KOLUMN,0)
      IF (KOLUMN.LT.0.OR.4.LT.KOLUMN) THEN
C       <A NAME="error02"></A><FONT COLOR="RED">GRDPTS-02</FONT>
        CALL ERROR('GRDPTS-02: Wrong value of KOLUMN')
C       KOLUMN must be 0, 1, 2, 3 or 4.
      ENDIF
      IF (KOLUMN.NE.0.AND.FGRD.EQ.' ') THEN
C       <A NAME="error03"></A><FONT COLOR="RED">GRDPTS-03</FONT>
        CALL ERROR('GRDPTS-03: File GRD not specified')
C       Input file GRD with gridded values must be specified if
C       KOLUMN.NE.0.
C       There is no default filename.
      ENDIF
      NCOL=MAX0(3,KOLUMN)
C     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     Writing output points:
      IF(FPTS.NE.' ') THEN
        IF(KOLUMN.NE.0) THEN
          IF(N1*N2*N3.GT.MRAM) THEN
C           <A NAME="error04"></A><FONT COLOR="RED">GRDPTS-04</FONT>
            CALL ERROR('GRDPTS-04: Too small array RAM(MRAM)')
C           Array RAM(MRAM) allocated in include file 'ram.inc' is too
C           small to contain N1*N2*N3 grid values.
C           You may wish to increase the dimension MRAM in file
C           <A HREF="ram.inc">ram.inc</A>.
          END IF
C         Reading grid values:
          CALL RARRAY(LU,FGRD,'FORMATTED',.TRUE.,UNDEF,N1*N2*N3,RAM)
        END IF
        OPEN(LU,FILE=FPTS)
        WRITE(LU,'(A)') '/'
        FORMAT(1:10)='(A,I6.6,A,'
        I=0
        N=1
        DO 23 I3=0,N3-1
          X3=O3+D3*FLOAT(I3)
          DO 22 I2=0,N2-1
            X2=O2+D2*FLOAT(I2)
            DO 21 I1=0,N1-1
              X1=O1+D1*FLOAT(I1)
              I=I+1
              IF(KOLUMN.EQ.0) THEN
                LWRITE=.TRUE.
              ELSE
                IF(RAM(I).NE.UNDEF) THEN
                  X(KOLUMN)=RAM(I)
                  IRAM(I)=N
                  LWRITE=.TRUE.
                ELSE
                  IRAM(I)=0
                  LWRITE=.FALSE.
                END IF
              END IF
              IF(LWRITE) THEN
C               Writing:
                CALL FORM2(NCOL,X,X,FORMAT(11:10+8*NCOL))
                WRITE(LU,FORMAT)
     *                        '''',I,''' ',X1,(' ',X(J4),J4=2,NCOL),' /'
                N=N+1
              END IF
   21       CONTINUE
   22     CONTINUE
   23   CONTINUE
        WRITE(LU,'(A)') '/'
        CLOSE(LU)
      END IF
C
C     Writing output polygons:
      IF(FPLGN.NE.' ') THEN
        OPEN(LU,FILE=FPLGN)
      END IF
      IF(FTRGL.NE.' ') THEN
        OPEN(LU2,FILE=FTRGL)
      END IF
      IF(FPLGN.NE.' '.OR.FTRGL.NE.' ') THEN
        DO 33 I3=0,N3-1
          DO 32 I2=0,N2-2
            DO 31 I1=0,N1-2
              I=1+I1+N1*(I2+N2*I3)
              J1=I
              J2=I+1
              J3=I+N1+1
              J4=I+N1
              IF(KOLUMN.NE.0) THEN
                J1=IRAM(J1)
                J2=IRAM(J2)
                J3=IRAM(J3)
                J4=IRAM(J4)
              END IF
              IF(FPLGN.NE.' ') THEN
                IF(J1.NE.0.AND.J2.NE.0.AND.J3.NE.0.AND.J4.NE.0) THEN
                  WRITE(LU,'(4(I6,A))') J1,' ',J2,' ',J3,' ',J4,' /'
                END IF
              END IF
              IF(FTRGL.NE.' ') THEN
                IF(J1.NE.0.AND.J2.NE.0.AND.J3.NE.0) THEN
                  WRITE(LU2,'(3(I6,A))') J1,' ',J2,' ',J3,' /'
                END IF
                IF(J1.NE.0.AND.J3.NE.0.AND.J4.NE.0) THEN
                  WRITE(LU2,'(3(I6,A))') J1,' ',J3,' ',J4,' /'
                END IF
              END IF
   31       CONTINUE
   32     CONTINUE
   33   CONTINUE
        DO 43 I3=0,N3-2
          DO 42 I2=0,N2-1
            DO 41 I1=0,N1-2
              I=1+I1+N1*(I2+N2*I3)
              J1=I
              J2=I+1
              J3=I+N1*N2+1
              J4=I+N1*N2
              IF(KOLUMN.NE.0) THEN
                J1=IRAM(J1)
                J2=IRAM(J2)
                J3=IRAM(J3)
                J4=IRAM(J4)
              END IF
              IF(FPLGN.NE.' ') THEN
                IF(J1.NE.0.AND.J2.NE.0.AND.J3.NE.0.AND.J4.NE.0) THEN
                  WRITE(LU,'(4(I6,A))') J1,' ',J2,' ',J3,' ',J4,' /'
                END IF
              END IF
              IF(FTRGL.NE.' ') THEN
                IF(J1.NE.0.AND.J2.NE.0.AND.J3.NE.0) THEN
                  WRITE(LU2,'(3(I6,A))') J1,' ',J2,' ',J3,' /'
                END IF
                IF(J1.NE.0.AND.J3.NE.0.AND.J4.NE.0) THEN
                  WRITE(LU2,'(3(I6,A))') J1,' ',J3,' ',J4,' /'
                END IF
              END IF
   41       CONTINUE
   42     CONTINUE
   43   CONTINUE
        DO 53 I3=0,N3-2
          DO 52 I2=0,N2-2
            DO 51 I1=0,N1-1
              I=1+I1+N1*(I2+N2*I3)
              J1=I
              J2=I+N1
              J3=I+N1*N2+N1
              J4=I+N1*N2
              IF(KOLUMN.NE.0) THEN
                J1=IRAM(J1)
                J2=IRAM(J2)
                J3=IRAM(J3)
                J4=IRAM(J4)
              END IF
              IF(FPLGN.NE.' ') THEN
                IF(J1.NE.0.AND.J2.NE.0.AND.J3.NE.0.AND.J4.NE.0) THEN
                  WRITE(LU,'(4(I6,A))') J1,' ',J2,' ',J3,' ',J4,' /'
                END IF
              END IF
              IF(FTRGL.NE.' ') THEN
                IF(J1.NE.0.AND.J2.NE.0.AND.J3.NE.0) THEN
                  WRITE(LU2,'(3(I6,A))') J1,' ',J2,' ',J3,' /'
                END IF
                IF(J1.NE.0.AND.J3.NE.0.AND.J4.NE.0) THEN
                  WRITE(LU2,'(3(I6,A))') J1,' ',J3,' ',J4,' /'
                END IF
              END IF
   51       CONTINUE
   52     CONTINUE
   53   CONTINUE
      END IF
      IF(FPLGN.NE.' ') THEN
        CLOSE(LU)
      END IF
      IF(FTRGL.NE.' ') THEN
        CLOSE(LU2)
      END IF
C
      WRITE(*,'(A)') '+GRDPTS: 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>
