C
C Subroutine file 'gse.for' to write and read seismograms in the GSE 1.0
C data exchange format.
C
C Version: 5.70
C Date: 2003, May 20
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 Reference to GSE 1.0:
C     GSETT-2 (1990): Instructions for the conduct of the preparatory
C             test of phase 3 of GSETT-2.
C             Ad hoc Group of Scientific Experts (GSE) to consider
C             international cooperative measures to detect and identify
C             seismic events - Conference Room Paper 190/Rev.4,
C             Geneva, Switzerland, September 1990.
C Reference to GSE 2.0:
C     GSETT-3 (1995): Formats.
C             Group of Scientific Experts - Conference Room Paper 243,
C             Conference on Disarment, United Nations, Geneva,
C             Switzerland, July 1995.
C Reference to GSE 2.1:
C     GSETT-3 (1997): Provisional GSE 2.1 Message Formats and Protocols.
C             Operation Annex 3.  May 1997.
C
C.......................................................................
C
C This FORTRAN77 file consists of the following external procedures:
C     WGSE1...Subroutine designed to write the header section.  It
C             should be called once after opening the output GSE file.
C             WGSE1
C     WGSE2...Subroutine designed to write one seismogram.
C             WGSE2
C     WGSE2C..Entry of subroutine WGSE2 designed to accumulate
C             individual lines to be written to the Comment sections of
C             the next seismograms written by WGSE2.  Entry WGSE2C need
C             not be considered unless using the Comment sections of the
C             Waveform identification sections for special purposes.
C             WGSE2C
C     WGSE2D..Entry of subroutine WGSE2 designed to delete the lines
C             accumulated by previous invocations of WGSE2C.  Usually
C             not needed.
C             WGSE2D
C     WGSE3...Subroutine designed to write the end of data file
C             indicator.  It should be called once before closing the
C             output GSE file.
C             WGSE3
C     RGSE1...Subroutine designed to read the text from the header
C             section.  It may be called once after opening the input
C             GSE file.
C             RGSE1
C     RGSE2...Subroutine designed to read one seismogram.  The next
C             seismogram will be read during the next invocation of this
C             subroutine.
C             RGSE2
C     RGSE2C..Entry of subroutine RGSE2 designed to pass individual
C             lines of the Comment section of the last seismogram read
C             by RGSE2.  Entry RGSE2C need not be considered unless
C             using the Comment sections of the Waveform identification
C             sections for special purposes.
C             RGSE2C
C
C.......................................................................
C
C                                                    
C Structure of the GSE 1.0 waveform data exchange file:
C (1) Header section:
C     Position: Format: Item:
C     01-04     A4      'XW01'... Obligatory string, an abbreviation for
C                       the waveform data exchange file.
C     05-45     41X     Reserved for the information on the data
C                       transmission, see the GSE 1.0 standard (blank
C                       for synthetic data).  Left blank during writing,
C                       skipped during reading.
C     46-80     1X,A34  Text describing the file or the data.  Left
C                       justified.  The GSE 1.0 standard requires the
C                       first 6 characters of the text (positions 47-52)
C                       to identify the data day in the form: YYMMDD,
C                       see parameter text of subroutine WGSE1.
C (2) For each seismogram (2.1), (2.2), (2.3), (2.4), (2.5), and (2.6):
C (2.1) Waveform identification section, Line 1:
C     Position: Format: Item:
C     01-04     A4      'WID1'... Obligatory string, an abbreviation for
C                       the waveform identification section.
C     05-10     1X,I5   Year (often zero for synthetic data).  Left
C                       blank during writing, skipped during reading.
C     11-13     I3      Day of the year (often zero for synthetic data).
C                       If start time (argument TSTART of subroutine
C                       WGSE2) is positive, WGSE2 writes day 001.  If
C                       start time TSTART is negative, WGSE2 writes day
C                       000 and time TSTART increased by 86400 seconds
C                       before conversion to hours, minutes and seconds.
C                       Subroutine RGSE2 deems a positive day or a blank
C                       day to be 001, and a non-positive day to be 000.
C     14-16     1X,I2   Start hours (often zero for synthetic data).
C     17-19     1X,I2   Start minutes (often zero for synthetic data).
C     20-22     1X,I2   Start seconds.
C     23-26     1X,I3   Start miliseconds.
C     27        I1      Start tenths of miliseconds (in the GSE 1.0
C                       standard, start time is rounded to miliseconds
C                       and this position should be left free).
C                       Written by subroutine WGSE2 if non-zero.
C                       This position makes likely the greatest
C                       difference between the GSE 1.0 standard and this
C                       implementation, but need not necessarily
C                       influence the portability of the data files.
C     28-35     I8      Number of samples.
C     36-42     1X,A6   Station name (sometimes used for synthetic
C                       data, sometimes blank or '-').  Left justified.
C     43-51     1X,A8   Channel name (occasionally used for synthetic
C                       data, often blank or '-' even for real data).
C                       Left justified.
C     52-54     1X,A2   Component, recommendation for synthetic data:
C                         '- ' OR ' 0'... Undefined,
C                         '-E' OR ' 1'... X1 component,
C                         '-N' OR ' 2'... X2 component,
C                         '-Z' OR ' 3'... X3 component, etc.
C                       The component (channel identifier) is written to
C                       the GSE file by subroutine WGSE2 in the form of
C                       integer (format I2), which is probably unusual
C                       for the field data.  However, GSE 1.0 standard
C                       admits an arbitrary string composed of two
C                       uppercase characters.
C     55-66   1X,F11.7  Samples per second.
C     67-73     1X,A6   Instrument type ('-' for synthetic data).
C                       '-     ' written by subroutine WGSE2, skipped
C                       during reading.
C     74-78     1X,A4   Data format, recommendation for synthetic data:
C                         'INT5'... Format(16(1X,I4),
C                         'INTV'... Integers, list directed input (free
C                                   format), linewidth 80 characters.
C     79-80     1X,I1   Differencing flag, recommendation for synthetic
C                       data:
C                         '0' or ' '... Actual seismogram stored, no
C                                   differences.  Differences are not
C                                   assumed by the subroutines of this
C                                   file.
C (2.2) Waveform identification section, Line 2:
C     Position: Format: Item:
C     01-09     F9.6    Amplitude corresponding to 1 in the seismogram.
C     10        A1      Units of the amplitude:
C                         '0' or ' '... Displacement in nanometers,
C                         '1'... Particle velocity in nanometers/second,
C                         '2'... Acceleration in nanometers/second**2.
C                       Left blank by subroutine WGSE2, not read by
C                       subroutine RGSE2.
C     11-17     F7.4    Calibration period (-1 for synthetic data).
C                       -1. written by subroutine WGSE2, not read by
C                       subroutine RGSE2.
C     18-27     1X,F9.4 X2 coordinate (only geographical coordinates
C                       allowed by the GSE 1.0 standard for field data).
C     28-37     1X,F9.4 X1 coordinate (only geographical coordinates
C                       allowed by the GSE 1.0 standard for field data).
C     38-47     1X,F9.4 X3 coordinate (only elevation above sea level in
C                       metres allowed by the GSE standard for field
C                       data).
C     48-57     1X,F9.4 Depth of sensor (often -999 (N/A) for synthetic
C                       data).
C                       -999. written by subroutine WGSE2, not read by
C                       subroutine RGSE2.
C     58-65     1X,F7.2 Beam azimuth (-1 (N/A) for synthetic data).
C                       -1. written by subroutine WGSE2, not read by
C                       subroutine RGSE2.
C     66-73     1X,F7.2 Beam slowness (-1 (N/A) for synthetic data).
C                       -1. written by subroutine WGSE2, not read by
C                       subroutine RGSE2.
C     74-80     1X,F6.1 Orientation of horizontal sensors, measured
C                       clockwise from the X2-axis (mostly -1 (N/A) for
C                       synthetic data).
C                       -1. written by subroutine WGSE2, not read by
C                       subroutine RGSE2.
C (2.3) Waveform identification section - Comments:
C     None to several lines with character strings, FORMAT(A80),
C     containing application specific information.  Usually not used.
C     First four characters of a line must not match any of the
C     following strings: 'X***', 'WID*', 'DAT*', 'STOP', where * stands
C     for a wild character.  To use columns 3 to 80 only seems to be the
C     best way of contingently introducing this specific information.
C     The comment lines are accumulated by means of invocation of entry
C     WGSE2C of subroutine WGSE2.
C     Example:
C       If we like to write real-valued data into the comment lines in
C       the SEP format, subroutine
C       WSEPR may be called to generate
C       string containing 2 spaces followed by the NAME=RVAL couple.
C       Here NAME is the name of the parameter and RVAL is the value.
C       For instance, string '  X1SRC=2.5' indicates that parameter
C       X1SRC, used by some programs for the X1 source coordinate, has
C       the value of 2.5.
C       The string may then be stored in the memory by the invocation of
C       entry WGSE2C.  All strings stored by invocations of WGSE2C are
C       written to individual comment lines of the corresponding
C       seismogram by each invocation of subroutine WGSE2.
C       After reading a seismogram by the invocation of subroutine
C       RGSE2, corresponding individual comment lines may be retrieved
C       by the respective invocations of entry RGSE2C.  The comment
C       lines may be collected in the memory by subroutine
C       RSEP2 and the values of the
C       real-valued parameters may be obtained by the invocations of
C       subroutine RSEP3R.
C (2.4) Waveform data section - Beginning:
C     Position: Format: Item:
C     01-04     A4      'DAT1'... Obligatory string, an abbreviation for
C                       the waveform data section.
C (2.5) Waveform data section:
C     Seismogram formatted according to the specified data format,
C     assumed to be readable by list directed input into an integer or
C     real array.
C (2.6) Waveform data section - End:
C     Position: Format: Item:
C     01-04     A4      'CHK1'... Obligatory string, an abbreviation for
C                       the checksum.
C     05-09     5X
C     10-24     I or F  Sum of all data values (before compression or
C                       differencing).
C (3) End of data file indicator:
C     Position: Format: Item:
C     01-04     A4      'STOP'... Obligatory string at the end.
C Note: GSE file may contain many other sections or lines than described
C above, but they are not written and read by the subroutines of this
C file.
C
C=======================================================================
C
C     
C
      SUBROUTINE WGSE1(LU,TEXT)
      CHARACTER*(*) TEXT
      INTEGER LU
C
C Subroutine designed to write the header section.  It should be called
C once after opening the output GSE file.
C
C Input:
C     LU...   Logical unit number of the external output device already
C             open for formatted sequential output.
C     TEXT... String containing the text to be stored in the header
C             section.  Maximum of 34 characters will be stored.
C             Note that the GSE standard requires the first 6 characters
C             of the text to identify the data day in the form: YYMMDD.
C             Such a restriction is not required by the subroutines of
C             this file.
C The input parameters are not altered.
C
C No output.
C
C-----------------------------------------------------------------------
C
C     No temporary storage locations.
C
C.......................................................................
C
C     Writing header section:
      WRITE(LU,'(A4,42X,A)') 'XW01',TEXT(1:MIN0(LEN(TEXT),34))
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE WGSE2(LU,STAT,CHAN,KOMP,
     *                                 X1,X2,X3,TSTART,TSTEP,NSEIS,SEIS)
      INTEGER LU,KOMP,NSEIS
      CHARACTER*(*) STAT,CHAN
      REAL X1,X2,X3,TSTART,TSTEP,SEIS(NSEIS)
C
C Subroutine designed to write one seismogram.
C
C Input:
C     LU...   Logical unit number of the external output device already
C             open for formatted sequential output.
C     STAT... String with the station name (not required, may be ' ' or
C             '-').
C     CHAN... String with the channel name (often ' ' or '-').
C     KOMP... Component (nonnegative integer not exceeding 99):
C               0... Undefined component (e.g., scalar time function),
C               1... X1 component,
C               2... X2 component,
C               3... X3 component, etc.
C             The component (channel identifier) is written to the GSE
C             file in the form of integer (format I2), which is probably
C             unusual for the field data.  However, GSE standard admits
C             an arbitrary string composed of 2 uppercase characters.
C             For example, the components of the 3*3 Green function may
C             be numbered 1,2,3,4,5,6,7,8,9.  In the case of complex
C             functions, the imaginary parts may be distinguished from
C             the corresponding real parts by KOMP increased by 10.
C     X1,X2,X3... Coordinates of the receiver.
C             -999.0000 stands for the undefined value, that may be
C             applicable especially for, e.g., X2 in 2-D synthetic
C             calculations.
C     TSTART..Start time, i.e. the time corresponding to the first
C             sample in seconds.  In the GSE file, the time is converted
C             to hours, minutes, seconds, and days from the beginning of
C             an unspecified year.  Times greater than 86400 seconds in
C             absolute value are not assumed.  Formal day corresponding
C             to negative times in GSE 1.0 format is January 0.
C     TSTEP...Time step between samples.
C     NSEIS...Number of samples.
C     (SEIS(I),I=1,NSEIS)... Seismogram.  The leading and trailing zeros
C             will be removed before writing.
C The input parameters are not altered.
C
C No output.
C
C.......................................................................
C
C     
C
C     ENTRY WGSE2C(COMLIN)
      CHARACTER*(*) COMLIN
C
C Entry designed to accumulate individual lines to be written to the
C Comment sections of the next seismograms written by WGSE2.  Entry
C WGSE2C need not be considered unless using the Comment sections of the
C Waveform identification sections for special purposes.
C
C Input:
C     COMLIN..Line to be written to the comment lines of the waveform
C             identification section.  The lines passed by the first
C             MLINES invocations of WGSE2C are accumulated and written
C             by each next invocation of WGSE2, until the lines are
C             deleted by invocation of WGSE2D.  Parameter MLINES may be
C             adjusted below.
C The input parameter is not altered.
C
C No output.
C
C.......................................................................
C
C     
C
C     ENTRY WGSE2D
C
C Entry designed to delete the lines accumulated by previous invocations
C of WGSE2C.  The accumulation by invocations of WGSE2C then begins from
C the scratch.  WGSE2D is not required too often.
C
C No Input, no output.
C
C-----------------------------------------------------------------------
C
C     Parameters:
      LOGICAL FIXED
      INTEGER NWIDTH,NFORM
      PARAMETER (FIXED=.FALSE.)
      PARAMETER (NWIDTH=5,NFORM=80/NWIDTH)
C
C     NWIDTH is the width of the output field reserved for one integer
C             value of the seismogram.  The number of output digits is
C             then NWIDTH-2.  NWIDTH must be taken from interval 3 to 9,
C             but NWIDTH=3 or 4 is strongly discouraged.
C     FIXED...FIXED=.TRUE.:  Fixed-length format,
C             FIXED=.FALSE.: Variable-length format.
C
C     Temporary storage locations:
      CHARACTER*6  FORMAT
      CHARACTER*4  FORM
      CHARACTER*80 LINE
      CHARACTER*6  STAT6
      CHARACTER*8  CHAN8
      INTEGER IDAY,IH,IM,IS,IMS,IMS4,I,L,NSEIS1,NSEIS2,ISEIS(0:25)
      REAL TMS4,FSTEP,AMPL,AUX
C
C     Storage location for Comments of Waveform identification section:
      INTEGER MLINES,NLINES
      PARAMETER (MLINES=20)
      CHARACTER*80 LINES(MLINES)
      SAVE NLINES,LINES
      DATA NLINES/0/
C     MLINES..Only the first MLINES comment lines are stored.
C
C.......................................................................
C
C     Output format:
      FORMAT='(16I5)'
      IF(NWIDTH.NE.5) THEN
        WRITE(FORMAT(5:5),'(I1)') NWIDTH
      END IF
      FORM='INTV'
      IF(FIXED) THEN
        FORM(4:4)=FORMAT(5:5)
      END IF
C
C     Nonzero part of the seismogram and the maximum amplitude:
      DO 11 NSEIS1=1,NSEIS
        IF(SEIS(NSEIS1).NE.0.) THEN
          GO TO 12
        END IF
   11 CONTINUE
   12 CONTINUE
      DO 13 NSEIS2=NSEIS,NSEIS1,-1
        IF(SEIS(NSEIS2).NE.0.) THEN
          GO TO 14
        END IF
   13 CONTINUE
   14 CONTINUE
      AMPL=0.
      DO 15 I=NSEIS1,NSEIS2
        AMPL=AMAX1(ABS(SEIS(I)),AMPL)
   15 CONTINUE
      AMPL=AMPL/FLOAT(10**(NWIDTH-2)-1)
      AUX=AMPL/2.
      DO 16 NSEIS1=NSEIS1,NSEIS2
        IF(ABS(SEIS(NSEIS1)).GT.AUX) THEN
          GO TO 17
        END IF
   16 CONTINUE
   17 CONTINUE
      DO 18 NSEIS2=NSEIS2,NSEIS1,-1
        IF(ABS(SEIS(NSEIS2)).GT.AUX) THEN
          GO TO 19
        END IF
   18 CONTINUE
   19 CONTINUE
C
C     Writing waveform identification section:
      IF(ABS(TSTART).GT.86400.) THEN
C       GSE-01
        CALL ERROR('GSE-01: Starting time greater than 86400')
      END IF
      TMS4=(TSTART+FLOAT(NSEIS1-1)*TSTEP)*10000.
      IF(TMS4.LT.-.5) THEN
        IDAY=000
        IMS4=INT(TMS4-.5)+864000000
      ELSE
        IDAY=001
        IMS4=INT(TMS4+.5)
      END IF
      IMS=IMS4/10
      IMS4=IMS4-IMS*10
      IS=IMS/1000
      IMS=IMS-IS*1000
      IM=IS/60
      IS=IS-IM*60
      IH=IM/60
      IM=IM-IH*60
      I=MAX0(NSEIS2-NSEIS1+1,0)
      STAT6=STAT
      CHAN8=CHAN
      FSTEP=1./TSTEP
      IF(IMS4.EQ.0) THEN
        IF(FSTEP.LT.999.99999995) THEN
          WRITE(LU,'(A4,6X,I3.3,3(1X,I2.2),I4.3,1X,
     *                      I8,1X,A6,1X,A8,1X,I2,1X,F11.7,1X,A1,6X,A4)')
     *              'WID1',IDAY, IH,IM,IS,IMS,
     *                       I,STAT6,CHAN8, KOMP,   FSTEP, '-',  FORM
        ELSE IF(FSTEP.LT.9999.9999995) THEN
          WRITE(LU,'(A4,6X,I3.3,3(1X,I2.2),I4.3,1X,
     *                      I8,1X,A6,1X,A8,1X,I2,1X,F11.6,1X,A1,6X,A4)')
     *              'WID1',IDAY, IH,IM,IS,IMS,
     *                       I,STAT6,CHAN8, KOMP,   FSTEP, '-',  FORM
        ELSE IF(FSTEP.LT.9999999.9995) THEN
          WRITE(LU,'(A4,6X,I3.3,3(1X,I2.2),I4.3,1X,
     *                      I8,1X,A6,1X,A8,1X,I2,1X,F11.3,1X,A1,6X,A4)')
     *              'WID1',IDAY, IH,IM,IS,IMS,
     *                       I,STAT6,CHAN8, KOMP,   FSTEP, '-',  FORM
        ELSE
          WRITE(LU,'(A4,6X,I3.3,3(1X,I2.2),I4.3,1X,
     *                      I8,1X,A6,1X,A8,1X,I2,1X,F11.0,1X,A1,6X,A4)')
     *              'WID1',IDAY, IH,IM,IS,IMS,
     *                       I,STAT6,CHAN8, KOMP,   FSTEP, '-',  FORM
        END IF
      ELSE
        IF(FSTEP.LT.999.99999995) THEN
          WRITE(LU,'(A4,6X,I3.3,3(1X,I2.2),I4.3,I1,
     *                      I8,1X,A6,1X,A8,1X,I2,1X,F11.7,1X,A1,6X,A4)')
     *              'WID1',IDAY, IH,IM,IS,IMS,IMS4,
     *                       I,STAT6,CHAN8, KOMP,   FSTEP, '-',  FORM
        ELSE IF(FSTEP.LT.9999.9999995) THEN
          WRITE(LU,'(A4,6X,I3.3,3(1X,I2.2),I4.3,I1,
     *                      I8,1X,A6,1X,A8,1X,I2,1X,F11.6,1X,A1,6X,A4)')
     *              'WID1',IDAY, IH,IM,IS,IMS,IMS4,
     *                       I,STAT6,CHAN8, KOMP,   FSTEP, '-',  FORM
        ELSE IF(FSTEP.LT.9999999.9995) THEN
          WRITE(LU,'(A4,6X,I3.3,3(1X,I2.2),I4.3,I1,
     *                      I8,1X,A6,1X,A8,1X,I2,1X,F11.3,1X,A1,6X,A4)')
     *              'WID1',IDAY, IH,IM,IS,IMS,IMS4,
     *                       I,STAT6,CHAN8, KOMP,   FSTEP, '-',  FORM
        ELSE
          WRITE(LU,'(A4,6X,I3.3,3(1X,I2.2),I4.3,I1,
     *                      I8,1X,A6,1X,A8,1X,I2,1X,F11.0,1X,A1,6X,A4)')
     *              'WID1',IDAY, IH,IM,IS,IMS,IMS4,
     *                       I,STAT6,CHAN8, KOMP,   FSTEP, '-',  FORM
        END IF
      END IF
      IF(-999.9999.LE.X1.AND.X1.LE.9999.9999.AND.
     *   -999.9999.LE.X2.AND.X2.LE.9999.9999.AND.
     *   -999.9999.LE.X3.AND.X3.LE.9999.9999) THEN
        IF(0.0099999.LT.AMPL.AND.AMPL.LE.99.999999) THEN
          WRITE(LU,
     *     '(  F9.6,  1X,  F7.0,3(1X,  F9.4  ),  F10.0,F8.0,F8.0,F7.0)')
     *         AMPL,       -1.0,    X2,X1,X3,    -999.,-1.0,-1.0,-1.0
        ELSE
          WRITE(LU,
     *     '(1PE9.3E2,1X,0PF7.0,3(1X,  F9.4  ),  F10.0,F8.0,F8.0,F7.0)')
     *         AMPL,       -1.0,    X2,X1,X3,    -999.,-1.0,-1.0,-1.0
        END IF
      ELSE
        IF(0.0099999.LT.AMPL.AND.AMPL.LE.99.999999) THEN
          WRITE(LU,
     *     '(  F9.6,  1X,  F7.0,3(1X,1PE9.3E1),0PF10.0,F8.0,F8.0,F7.0)')
     *         AMPL,       -1.0,    X2,X1,X3,    -999.,-1.0,-1.0,-1.0
        ELSE
          WRITE(LU,
     *     '(1PE9.3E2,1X,0PF7.0,3(1X,1PE9.3E1),0PF10.0,F8.0,F8.0,F7.0)')
     *         AMPL,       -1.0,    X2,X1,X3,    -999.,-1.0,-1.0,-1.0
        END IF
      END IF
C
C     Writing waveform identification section - Comments:
      DO 23 I=1,NLINES
        DO 21 L=LEN(LINES(I)),2,-1
          IF(LINES(I)(L:L).NE.' ') THEN
            GO TO 22
          END IF
   21   CONTINUE
        L=1
   22   CONTINUE
        WRITE(LU,'(A)') LINES(I)(1:L)
   23 CONTINUE
C
C     Writing waveform data section:
      WRITE(LU,'(A4)') 'DAT1'
      IH=0
      DO 59 IS=NSEIS1,NSEIS2,NFORM
        IM=MIN0(NSEIS2-IS,NFORM-1)
        DO 51 I=0,IM
          AUX=SEIS(IS+I)/AMPL
          AUX=SIGN(ABS(AUX)+.5,AUX)
          ISEIS(I)=INT(AUX)
          IH=IH+ISEIS(I)
   51   CONTINUE
        IF(FIXED) THEN
          WRITE(LU,FORMAT) (ISEIS(I),I=0,IM)
        ELSE
          WRITE(LINE,FORMAT) (ISEIS(I),I=0,IM)
          IM=0
          DO 52 I=2,80
            IF(LINE(I-1:I).NE.'  ') THEN
              IM=IM+1
              LINE(IM:IM)=LINE(I:I)
            END IF
   52     CONTINUE
          WRITE(LU,'(A)') LINE(1:IM)
        END IF
   59 CONTINUE
      WRITE(LU,'(A4,5X,I15)') 'CHK1',IH
C
      RETURN
C
C-----------------------------------------------------------------------
C
      ENTRY WGSE2C(COMLIN)
C
C.......................................................................
C
      IF(NLINES.LT.MLINES) THEN
        NLINES=NLINES+1
        LINES(NLINES)=COMLIN
      END IF
      RETURN
C
C-----------------------------------------------------------------------
C
      ENTRY WGSE2D
C
C.......................................................................
C
      NLINES=0
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE WGSE3(LU)
      INTEGER LU
C
C Subroutine designed to write the end of data file indicator.  It
C should be called once before closing the output GSE file.
C
C Input:
C     LU...   Logical unit number of the external output device already
C             open for formatted sequential output.  The logical unit
C             is not closed in this subroutine.
C The input parameter is not altered.
C
C No output.
C
C-----------------------------------------------------------------------
C
C     No temporary storage locations.
C
C.......................................................................
C
C     Writing end of data file indicator:
      WRITE(LU,'(A4)') 'STOP'
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE RGSE1(LU,TEXT)
      CHARACTER*(*) TEXT
      INTEGER LU
C
C Subroutine designed to read the text from the header section.  It may
C be called once after opening the input GSE file.
C
C Input:
C     LU...   Logical unit number of the external input device
C             containing the input data, already open for formatted
C             sequential input.
C The input parameter is not altered.
C
C Output:
C     TEXT... String containing the text to read from the header
C             section.  Maximum of 34 characters are stored in the file.
C
C-----------------------------------------------------------------------
C
C     Temporary storage locations:
      CHARACTER*4 XW01
C
C.......................................................................
C
C     Searching for header section:
   10 CONTINUE
        READ(LU,'(A4,42X,A)',END=80) XW01,TEXT
        IF(XW01.EQ.'XW01') THEN
          RETURN
        END IF
      GO TO 10
C
C     End of file:
   80 CONTINUE
C     GSE-51
      CALL WARN('GSE-51: No header section in input GSE file')
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE RGSE2(LU,STAT,CHAN,KOMP,
     *                           X1,X2,X3,TSTART,TSTEP,NSEIS,MSEIS,SEIS)
      INTEGER LU,KOMP,NSEIS,MSEIS
      CHARACTER*(*) STAT,CHAN
      REAL X1,X2,X3,TSTART,TSTEP,SEIS(MSEIS)
C
C Subroutine designed to read one seismogram.  The next seismogram will
C be read during the next invocation of this subroutine.
C
C Input:
C     LU...   Logical unit number of the external input device
C             containing the input data, already open for formatted
C             sequential input.
C     MSEIS...Dimension of array SEIS, i.e. the maximum number of
C             samples.
C The input parameters are not altered.
C
C Output:
C     STAT... String with the station name.  6 characters at the most,
C             but may be declared even as CHARACTER*1 if not required.
C             See also subroutine WGSE2.
C     CHAN... String with the channel name.  8 characters at the most,
C             but may be declared even as CHARACTER*1 if not required.
C             See also subroutine WGSE2.
C     KOMP... Component (nonnegative integer):
C               0... Undefined or unrecognized component,
C               1... X1 component,
C               2... X2 component,
C               3... X3 component,
C             or another positive integer written by subroutine WGSE2.
C             In addition to the nonnegative integers written by WGSE2,
C             channel identifiers in the form of strings containing
C             characters 'E','N','Z' are recognized as components 1,2,3,
C             respectively.
C     X1,X2,X3... Coordinates of the receiver.
C             -999.0000 means an undefined value, that may apply
C             especially to one of the coordinates in 2-D synthetic
C             calculations.
C     TSTART..Start time, i.e. the time corresponding to the first
C             sample.  Days are almost ignored: the time is measured
C             since the last midnight if the day of the year in the GSE
C             file is positive or blank, and from the next midnight
C             (i.e. TSTART is negative) if the day of the year is not
C             positive (e.g. January 0).
C     TSTEP...Time step between samples.
C     NSEIS...Number of output samples, or -1 if there is no more
C             seismogram to be read.
C     (SEIS(I),I=1,NSEIS)... Seismogram without the leading and trailing
C             zeros.
C
C.......................................................................
C
C     
C
C     ENTRY RGSE2C(COMLIN,*)
      CHARACTER*(*) COMLIN
C
C Entry designed to pass individual lines of the Comment section of the
C last seismogram read by RGSE2.  Entry RGSE2C need not be considered
C unless using the Comment sections of the Waveform identification
C sections for special purposes.
C
C Input:
C     *...    Label of the statement in the calling subroutine for the
C             alternate return when no comment line remains for the
C             output.  The label should be preceded by *.  For example,
C             if the comment lines are to be processed by subroutine
C             RSEP2, the calling code may read
C                10 CONTINUE
C                     CALL RGSE2C(COMLIN,*20)
C                     CALL RSEP2(COMLIN)
C                   GO TO 10
C                20 CONTINUE
C
C Output:
C     COMLIN..One line of the Comment section of the last seismogram
C             read by RGSE2.  The first invocation of RGSE2 returns the
C             first comment line, the second invocation of RGSE2 returns
C             the second comment line and so on.  At most the first
C             MLINES comment lines are recorded and may be output.
C             Parameter MLINES may be adjusted below.
C
C-----------------------------------------------------------------------
C
C     Storage location for Comments of Waveform identification section:
      INTEGER MLINES,NLINES
      PARAMETER (MLINES=20)
      CHARACTER*80 LINES(MLINES)
      SAVE NLINES,LINES
C     MLINES..Only the first MLINES comment lines are stored.
C
C     Temporary storage locations:
      CHARACTER*80 LINE
      CHARACTER*1  COMP1,COMP2
      CHARACTER*4  FORM
      INTEGER IDAY,IH,IM,IS,IMS,IMS4,I
      REAL FSTEP,AMPL
C
C.......................................................................
C
C     Searching for waveform identification section:
   10 CONTINUE
        READ(LU,'(A)',END=80) LINE
        IF(LINE(1:4).EQ.'WID1') THEN
          GO TO 20
        ELSE IF(LINE(1:4).EQ.'STOP') THEN
          GO TO 90
        END IF
      GO TO 10
C
C     Reading waveform identification section:
   20 CONTINUE
      READ(LINE,'(13X,
     *   3(1X,I2),1X,I3,I1,I8,1X,A6,1X,A8,1X,2A1,1X,F11.7,8X,A4,1X,I1)')
     *   IH,IM,IS,IMS,IMS4,NSEIS,STAT, CHAN,COMP1,COMP2,FSTEP,FORM,I
      IF(LINE(11:13).NE.' ') THEN
        READ(LINE(11:13),'(I3)') IDAY
        IF(IDAY.LE.0) THEN
          IH=IH-24
        END IF
      END IF
      TSTART=FLOAT((IH*60+IM)*60+IS)+FLOAT(10*IMS+IMS4)/10000.
      IF(NSEIS.GT.MSEIS) THEN
C       GSE-02
        CALL ERROR('GSE-02: Seismogram longer than array')
      END IF
      IF(LLE('0',COMP1).AND.LLE(COMP1,'9')) THEN
        KOMP=ICHAR(COMP1)-ICHAR('0')
      ELSE
        KOMP=0
      END IF
      IF(LLE('0',COMP2).AND.LLE(COMP2,'9')) THEN
        KOMP=ICHAR(COMP2)-ICHAR('0')+10*KOMP
      END IF
      IF(KOMP.EQ.0) THEN
        IF(COMP1.EQ.'Z'.OR.COMP2.EQ.'Z') THEN
          KOMP=3
        ELSE IF(COMP1.EQ.'N'.OR.COMP2.EQ.'N') THEN
          KOMP=2
        ELSE IF(COMP1.EQ.'E'.OR.COMP2.EQ.'E') THEN
          KOMP=1
        END IF
      END IF
      TSTEP=1./FSTEP
      IF(FORM(1:3).NE.'INT') THEN
C       GSE-03
        CALL ERROR('GSE-03: Data format not supported')
      END IF
      IF(I.NE.0) THEN
C       GSE-04
        CALL ERROR('GSE-04: Data differences not supported')
      END IF
      READ(LU,'(F9.6,8X,3(1X,F9.4))') AMPL,X2,X1,X3
C
C     Searching for waveform data section:
      NLINES=0
   30 CONTINUE
        READ(LU,'(A)') LINE
        IF(LINE(1:4).EQ.'DAT1') THEN
          GO TO 50
        ELSE
C         Reading waveform identification section - Comments
          IF(NLINES.LT.MLINES) THEN
            NLINES=NLINES+1
            LINES(NLINES)=LINE
          END IF
        END IF
      GO TO 30
C
C     Reading waveform data section:
   50 CONTINUE
      IF(NSEIS.GT.0) THEN
        READ(LU,*) (SEIS(I),I=1,NSEIS)
      END IF
C     Checksum is not read here.
C
C     Removing leading and trailing zeros, and renormalizing:
      DO 51 NSEIS=NSEIS,1,-1
        IF(SEIS(NSEIS).NE.0.) THEN
          GO TO 52
        END IF
   51 CONTINUE
   52 CONTINUE
      DO 53 IS=1,NSEIS
        IF(SEIS(IS).NE.0.) THEN
          GO TO 54
        END IF
   53 CONTINUE
   54 CONTINUE
      IF(IS.GT.1) THEN
        IS=IS-1
        TSTART=TSTART+FLOAT(IS)*TSTEP
        NSEIS=NSEIS-IS
        DO 55 I=1,NSEIS-IS
          SEIS(I)=SEIS(I+IS)
   55   CONTINUE
      END IF
      DO 59 I=1,NSEIS
        SEIS(I)=SEIS(I)*AMPL
   59 CONTINUE
C
      RETURN
C
C     End of file:
   80 CONTINUE
C     GSE-52
      CALL WARN('GSE-52: End of input GSE file encountered')
C     GSE file is not terminated by string STOP in the first 4 columns,
C     or NSEIS=-1 has not been checked during previous invocation and
C     subroutine RGSE2 was called again.
   90 CONTINUE
      NSEIS=-1
      RETURN
C
C-----------------------------------------------------------------------
C
      ENTRY RGSE2C(COMLIN,*)
C
C.......................................................................
C
      IF(NLINES.LE.0) THEN
C       No comment line left - return to the label given by argument *:
        RETURN 1
      END IF
C
      COMLIN=LINES(1)
      NLINES=NLINES-1
      DO 99 I=1,NLINES
        LINES(I)=LINES(I+1)
   99 CONTINUE
      RETURN
      END
C
C=======================================================================
C