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 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 ... C File 'gse.for'. C RSEP1,RSEP3T ... C File 'sep.for'. C ERROR ... File C 'error.for'. C LENGTH ... File C '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