C                                                            <HTML><PRE>
C Program GRDGSE to convert the gridded data into the GSE format
C
C Version: 6.00
C Date: 2005, November 12
C
C Coded by: Petr Bulant
C     Department of Geophysics, Charles University Prague,
C     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C     http://sw3d.cz/staff/bulant.htm
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 Names of the input and output files:
C     GRD1='string'... Name of the input ASCII file with the grid
C             values to be understood as the first component of
C             the seismograms.
C             Default: GRD1=' '
C     GRD2='string'... Name of the input ASCII file with the grid
C             values to be understood as the second component of
C             the seismograms.
C             Default: GRD2=' '
C     GRD3='string'... Name of the input ASCII file with the grid
C             values to be understood as the third component of
C             the seismograms.
C             Default: GRD3=' '
C     For general description of the files with gridded data refer
C     to file <A HREF="../forms/forms.htm#GRD">forms.htm</A>.
C     SS='string'... Name of the output file containing the
C             input grid values written in the
C             <A HREF="gse.for#data" TYPE="text/html">GSE format</A>.
C             Default: SS='ss.gse'
C Data specifying dimensions of the input grid:
C     N1=positive integer... Number of gridpoints along the faster
C             axis (inner loop).  The gridpoints are understood as
C             the time samples along individual seismograms.
C             Default: N1=1
C     N2=positive integer... Number of gridpoints along the slower
C             axis (outer loop). The gridpoints are understood to
C             correspond to individual seismograms.
C             (N2 seismograms, each of them consisting of N1 points)
C             Default: N2=1
C Data specifying the time axis of the seismograms:
C     TSTART=real ... Start time, i.e. the time corresponding to
C             the first sample in seconds.
C             Default: TSTART=0.
C     TSTEP=real ... Time step between samples.
C             Default: TSTEP=1.
C
C=======================================================================
C
C Common block /RAMC/:
      INCLUDE 'ram.inc'
C     <A HREF="ram.inc" TYPE="text/html">ram.inc</A>
C
C.......................................................................
C
      EXTERNAL UARRAY
      REAL UARRAY
C
C     Filenames and parameters:
      CHARACTER*80 FSEP,FGRD1,FGRD2,FGRD3,FGSE
      CHARACTER*6  TEXT
      INTEGER LU
      REAL UNDEF
      PARAMETER (LU=1)
      INTEGER NCOMP,N1,N2,N1N2,IGRD1,IGRD2,JGRD1,JGRD2,IGRD3,JGRD3,I1,I2
      REAL TSTART,TSTEP
C
      UNDEF=UARRAY()
C
C-----------------------------------------------------------------------
C
C     Reading name of SEP file with input data:
      WRITE(*,'(A)') '+GRDGSE: Enter input filename: '
      FSEP=' '
      READ(*,*) FSEP
      WRITE(*,'(A)') '+GRDGSE: Working ...           '
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">GRDGSE-01</FONT>
        CALL ERROR('GRDGSE-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('GRD1'  ,FGRD1,' '         )
      CALL RSEP3T('GRD2'  ,FGRD2,' '         )
      CALL RSEP3T('GRD3'  ,FGRD3,' '         )
      CALL RSEP3T('SS'    ,FGSE ,'ss.gse'    )
      CALL RSEP3I('N1',N1,1)
      CALL RSEP3I('N2',N2,1)
      CALL RSEP3R('TSTART',TSTART,0.)
      CALL RSEP3R('TSTEP',TSTEP,1.)
C     Number of components:
      NCOMP=0
      IF (FGRD1.NE.' ') NCOMP=NCOMP+1
      IF (FGRD2.NE.' ') NCOMP=NCOMP+1
      IF (FGRD3.NE.' ') NCOMP=NCOMP+1
      IF(NCOMP.EQ.0) THEN
C       <A NAME="error02"></A><FONT COLOR="RED">GRDGSE-02</FONT>
        CALL ERROR('GRDGSE-02: No input grid given')
C       At least one of the files with seismogram components
C       should be specified.
      END IF
      N1N2=N1*N2
      IF(NCOMP*N1N2.GT.MRAM) THEN
C       <A NAME="error03"></A><FONT COLOR="RED">GRDGSE-03</FONT>
        CALL ERROR('GRDGSE-03: Too small array RAM(MRAM)')
C       Array RAM(MRAM) allocated in include file 'ram.inc' is too small
C       to contain the input grids (NCOMP*N1*N2 values).  You may
C       wish to increase the dimension MRAM in file 'ram.inc'.
C       <A HREF="ram.inc" TYPE="text/html">ram.inc</A>
      END IF
C
C     Reading input grids:
      IGRD1=1
      IF (FGRD1.NE.' ') THEN
        CALL RARRAY(LU,FGRD1,'FORMATTED',.TRUE.,UNDEF,N1N2,RAM(IGRD1))
        JGRD1=N1N2
      ELSE
        JGRD1=0
      ENDIF
      IGRD2=JGRD1+1
      IF (FGRD2.NE.' ') THEN
        CALL RARRAY(LU,FGRD2,'FORMATTED',.TRUE.,UNDEF,N1N2,RAM(IGRD2))
        JGRD2=JGRD1+N1N2
      ELSE
        JGRD2=JGRD1
      ENDIF
      IGRD3=JGRD2+1
      IF (FGRD3.NE.' ') THEN
        CALL RARRAY(LU,FGRD3,'FORMATTED',.TRUE.,UNDEF,N1N2,RAM(IGRD3))
        JGRD3=JGRD2+N1N2
      ELSE
        JGRD3=JGRD2
      ENDIF
C
C     Writing the output GSE file:
      OPEN(LU,FILE=FGSE)
      CALL WGSE1(LU,' ')
      TEXT='000000'
      DO 10, I1=1,N2
C       Name of the channel (for 999999 channels at the most):
        DO 20, I2=0,6-1
          TEXT(6-I2:6-I2)=
     *    CHAR(ICHAR('0')+MOD(I1,10**(I2+1))/10**I2)
 20     CONTINUE
        IF (FGRD1.NE.' ') THEN
          CALL WGSE2(LU,TEXT,' ',1,-999.,-999.,-999.,
     *                             TSTART,TSTEP,N1,RAM(IGRD1+(I1-1)*N1))
        ENDIF
        IF (FGRD2.NE.' ') THEN
          CALL WGSE2(LU,TEXT,' ',2,-999.,-999.,-999.,
     *                             TSTART,TSTEP,N1,RAM(IGRD2+(I1-1)*N1))
        ENDIF
        IF (FGRD3.NE.' ') THEN
          CALL WGSE2(LU,TEXT,' ',3,-999.,-999.,-999.,
     *                             TSTART,TSTEP,N1,RAM(IGRD3+(I1-1)*N1))
        ENDIF
  10  CONTINUE
      CALL WGSE3(LU)
      CLOSE(LU)
C
      WRITE(*,'(A)') '+GRDGSE: Done.                 '
      STOP
      END
C
C=======================================================================
C
      INCLUDE 'error.for'
C     <A HREF="error.for" TYPE="text/html">error.for</A>
      INCLUDE 'sep.for'
C     <A HREF="sep.for" TYPE="text/html">sep.for</A>
      INCLUDE 'gse.for'
C     <A HREF="gse.for" TYPE="text/html">gse.for</A>
      INCLUDE 'forms.for'
C     <A HREF="forms.for" TYPE="text/html">forms.for</A>
      INCLUDE 'length.for'
C     <A HREF="length.for" TYPE="text/html">length.for</A>
C
C=======================================================================
C                                                                 </PRE>
