C                                                            <HTML><PRE>
C Program ANRAYGSE to read the synthetic seismograms written
C in the form of file LU8 of package ANRAY and to write them
C in the GSE format.
C
C Refer to file <A HREF="../document/anraygse.htm">'anraygse.htm'</A> for the description
C of the input parameters.
C
C Version: 4.73
C Date: 2012, November 8
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
C Subroutines and external functions required:
      EXTERNAL WGSE1,WGSE2,WGSE3,RSEP1,RSEP3T,ERROR,LENGTH
C     WGSE1,WGSE2,WGSE3... File <A HREF="../../forms/gse.for" TYPE="text/html">'gse.for'</A>.
C     RSEP1,RSEP3T... File <A HREF="../../forms/sep.for" TYPE="text/html">'sep.for'</A>.
C     ERROR... File <A HREF="../../forms/error.for" TYPE="text/html">'error.for'</A>.
C     LENGTH... File <A HREF="../../forms/length.for" TYPE="text/html">'length.for'</A>.
C
C-----------------------------------------------------------------------
C Common block /RAMC/:
      INCLUDE 'ram.inc'
C     <A HREF="../../forms/ram.inc" TYPE="text/html">ram.inc</A>
      INTEGER MT
      PARAMETER (MT=MRAM/2)
      INTEGER IS(MT)
      REAL SEIS(MT)
      EQUIVALENCE (IS,RAM(1))
      EQUIVALENCE (SEIS,RAM(MT+1))
C-----------------------------------------------------------------------
C
C     Auxiliary storage locations:
      INTEGER LUSEP,LU8,LUGSE
      PARAMETER (LUSEP=1,LU8=2,LUGSE=3)
      CHARACTER*80 FILSEP,FILLU8,FILGSE
      CHARACTER*6 RECNAM
      INTEGER I,NT,MCOMP,NDST,ILOC,IREC
      LOGICAL LREC
      REAL XSOUR,YSOUR,ZSOUR,TSOUR,RSTEP,DT,DF,DST,TO,AREDUC,X1,X2,X3,
     * TSHIFT
      CHARACTER*80 MPRINT,IPRINT,STEXT
C
C.......................................................................
C
C     Reading name of SEP file with input data:
      WRITE(*,'(A)') '+ANRAYGSE: Enter input filename: '
      FILSEP=' '
      READ(*,*) FILSEP
C
C     Reading all data from the SEP file into the memory:
      IF (FILSEP.NE.' ') THEN
        CALL RSEP1(LUSEP,FILSEP)
      ELSE
C       <A NAME="error01"></A><FONT COLOR="RED">ANRAYGSE-01</FONT>
        CALL ERROR('ANRAYGSE-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)') '+ANRAYGSE: Working...            '
C
C     Reading file LU8:
      CALL RSEP3T('LU8',FILLU8 ,'lu8.out')
      OPEN(LU8,FILE=FILLU8,STATUS='OLD')
C     Opening output file GSE:
      CALL RSEP3T('SS',FILGSE,'ss.gse')
      OPEN(LUGSE,FILE=FILGSE)
C     Reading optional time shift:
      CALL RSEP3R('TSHIFT',TSHIFT,0.)
C     Reading receiver name generation switch:
      CALL RSEP3I('IRECNAM',IREC,0)
      LREC=.FALSE.
      RECNAM='      '
      IF (IREC.EQ.1) THEN
        LREC=.TRUE.
        RECNAM='rec   '
      ENDIF
C
C     Reading and writing the headers of the files:
      READ(LU8,'(A)') MPRINT
      READ(LU8,'(A)') IPRINT
      READ(LU8,'(A)') STEXT
      READ(LU8,'(5F10.5,2E15.7)') XSOUR,YSOUR,ZSOUR,TSOUR,RSTEP,DT,DF
      READ(LU8,'(16I5)') NDST,NT,MCOMP,ILOC
      CALL WGSE1(LUGSE,' ')
C
      IF (MCOMP.EQ.0) MCOMP=3
      X1=-999.
      X2=-999.
      X3=-999.
C
C     Reading and writing seismograms:
      IREC=0
  10  CONTINUE
        READ(LU8,'(2F10.3,1E12.5,I5)',END=90) DST,TO,AREDUC,NT
        IREC=IREC+1
        IF (NT.GT.MT) THEN
C         <A NAME="error02"></A><FONT COLOR="RED">ANRAYGSE-02</FONT>
          CALL ERROR('ANRAYGSE-02: Small arrays IS and SEIS')
C         The dimension MT of arrays IT and SEIS should be enlarged.
        ENDIF
        READ(LU8,'(20I4)') (IS(I),I=1,NT)
        IF (ILOC.EQ.0) THEN
          X1=DST
          X2=DST
        ELSEIF (ILOC.EQ.1) THEN
          X3=DST
        ENDIF
        TO=TO+TSHIFT
        IF (LREC) THEN
          IF (IREC.GE.1000) THEN
C           <A NAME="error03"></A><FONT COLOR="RED">ANRAYGSE-03</FONT>
            CALL ERROR('ANRAYGSE-03: Too many receiver names')
C           This version of the code enables up to 999 receiver names.
          ENDIF
          RECNAM(6:6)=CHAR(ICHAR('0')+MOD(IREC,10))
          RECNAM(5:5)=CHAR(ICHAR('0')+IREC/10)
          RECNAM(4:4)=CHAR(ICHAR('0')+IREC/100)
        ENDIF
        DO 20, I=1,NT
          SEIS(I)=(FLOAT(IS(I))/999.1)*AREDUC
  20    CONTINUE
        CALL WGSE2(LUGSE,RECNAM,' ',MCOMP,X1,X2,X3,TO,DT,NT,SEIS)
      GOTO 10
  90  CONTINUE
      CLOSE(LU8)
      CALL WGSE3(LUGSE)
      WRITE(*,'(A)') '+ANRAYGSE: Done.                 '
      STOP
      END
C
C=======================================================================
C
      INCLUDE 'error.for'
C     <A HREF="../../forms/error.for" TYPE="text/html">error.for</A>
      INCLUDE 'sep.for'
C     <A HREF="../../forms/sep.for" TYPE="text/html">sep.for</A>
      INCLUDE 'gse.for'
C     <A HREF="../../forms/gse.for" TYPE="text/html">gse.for</A>
      INCLUDE 'length.for'
C     <A HREF="../../forms/length.for" TYPE="text/html">length.for</A>
C
C=======================================================================
C                                                                 </PRE>
