C
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 Version: 4.45
C Date: 2004, June 10
C
C Coded by: Petr Bulant
C Department of Geophysics, Charles University Prague,
C Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C E-mail: bulant@seis.karlov.mff.cuni.cz
C
C-----------------------------------------------------------------------
C
C Subroutines and external functions required:
EXTERNAL WGSE1,WGSE2,WGSE3,RSEP1,RSEP3T,ERROR,LENGTH
C WGSE1,WGSE2,WGSE3 ...
C File 'gse.for'.
C RSEP1,RSEP3T ... File 'sep.for'.
C ERROR ... File 'error.for'.
C LENGTH ... File 'length.for'.
C
C-----------------------------------------------------------------------
C Common block /RAMC/:
INCLUDE 'ram.inc'
C ram.inc
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
INTEGER I,NT,MCOMP,NDST,ILOC
REAL XSOUR,YSOUR,ZSOUR,TSOUR,RSTEP,DT,DF,DST,TO,AREDUC,X1,X2,X3
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 ANRAYGSE-01
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
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:
10 CONTINUE
READ(LU8,'(2F10.3,1E12.5,I5)',END=90) DST,TO,AREDUC,NT
IF (NT.GT.MT) THEN
C ANRAYGSE-02
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
DO 20, I=1,NT
SEIS(I)=(FLOAT(IS(I))/999.1)*AREDUC
20 CONTINUE
CALL WGSE2(LUGSE,' ',' ',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 error.for
INCLUDE 'sep.for'
C sep.for
INCLUDE 'gse.for'
C gse.for
INCLUDE 'length.for'
C length.for
C
C=======================================================================
C