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 Refer to file 'anraygse.htm' for the description C of the input parameters. C C Version: 4.75 C Date: 2017, May 15 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 '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 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 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 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 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 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) X1=DST X2=DST X3=DST TO=TO+TSHIFT IF (LREC) THEN IF (IREC.GE.1000) THEN C ANRAYGSE-03 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 error.for INCLUDE 'sep.for' C sep.for INCLUDE 'gse.for' C gse.for INCLUDE 'length.for' C length.for C C======================================================================= C