C
C Program GRDGSE to convert the gridded data into the GSE format C C Version: 8.00 C Date: 2022, April 24 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 Description of data files: C C Input data read from the standard input device (*): C The data are read by the list directed input (free format) and C consist of a single string 'SEP': C 'SEP'... String in apostrophes containing the name of the input C SEP parameter or history file with the input data. C No default, 'SEP' must be specified and cannot be blank. C C C Input data file 'SEP': C File 'SEP' has the form of the SEP C parameter file. The parameters, which do not differ from their C defaults, need not be specified in file 'SEP'. C Names of the input and output files: C GRD1='string'... Name of the input ASCII file with the grid C values to be understood as the first component of C the seismograms. C Default: GRD1=' ' C GRD2='string'... Name of the input ASCII file with the grid C values to be understood as the second component of C the seismograms. C Default: GRD2=' ' C GRD3='string'... Name of the input ASCII file with the grid C values to be understood as the third component of C the seismograms. C Default: GRD3=' ' C For general description of the files with gridded data refer C to file forms.htm. C SS='string'... Name of the output file containing the C input grid values written in the C GSE format. C Default: SS='ss.gse' C Data specifying dimensions of the input grid: C N1=positive integer... Number of gridpoints along the faster C axis (inner loop). The gridpoints are understood as C the time samples along individual seismograms. C Default: N1=1 C N2=positive integer... Number of gridpoints along the slower C axis (outer loop). The gridpoints are understood to C correspond to individual seismograms. C (N2 seismograms, each of them consisting of N1 points) C Default: N2=1 C Data specifying the time axis of the seismograms: C TSTART=real... Start time, i.e. the time corresponding to C the first sample in seconds. C Default: TSTART=0. C TSTEP=real... Time step between samples. C Default: TSTEP=1. C Input data to optionally control the form of the output GSE files: C GSEWIDTH=positive integer... Width of the output field reserved C for one integer value of the seismogram. Refer to the C description in file 'gse.for'. C Form of the input/output files: C FORM='string'... Form of the input/output files: either C 'FORMATTED' or 'UNFORMATTED' (case insensitive). C Default: FORM='FORMATTED' C FORMR='string'... Form of the input file. If both FORM and FORMR C are specified, FORMR is used for output files. C Default: FORMR=FORM C Value of undefined quantities: C UNDEF=real... The value to be used for undefined real quantities. C Default: UNDEF=undefined value used in forms.for C C======================================================================= C C Common block /RAMC/: INCLUDE 'ram.inc' C ram.inc C C....................................................................... C EXTERNAL UARRAY REAL UARRAY C C Filenames and parameters: CHARACTER*80 FSEP,FGRD1,FGRD2,FGRD3,FGSE CHARACTER*6 TEXT INTEGER LU REAL UNDEF PARAMETER (LU=1) INTEGER NCOMP,N1,N2,N1N2,IGRD1,IGRD2,JGRD1,JGRD2,IGRD3,JGRD3,I1,I2 REAL TSTART,TSTEP C C----------------------------------------------------------------------- C C Reading name of SEP file with input data: WRITE(*,'(A)') '+GRDGSE: Enter input filename: ' FSEP=' ' READ(*,*) FSEP WRITE(*,'(A)') '+GRDGSE: Working ... ' C C Reading all data from the SEP file into the memory: IF (FSEP.NE.' ') THEN CALL RSEP1(LU,FSEP) ELSE C GRDGSE-01 CALL ERROR('GRDGSE-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 UNDEF=UARRAY() C C Reading input parameters from the SEP file: CALL RSEP3T('GRD1' ,FGRD1,' ' ) CALL RSEP3T('GRD2' ,FGRD2,' ' ) CALL RSEP3T('GRD3' ,FGRD3,' ' ) CALL RSEP3T('SS' ,FGSE ,'ss.gse' ) CALL RSEP3I('N1',N1,1) CALL RSEP3I('N2',N2,1) CALL RSEP3R('TSTART',TSTART,0.) CALL RSEP3R('TSTEP',TSTEP,1.) C Number of components: NCOMP=0 IF (FGRD1.NE.' ') NCOMP=NCOMP+1 IF (FGRD2.NE.' ') NCOMP=NCOMP+1 IF (FGRD3.NE.' ') NCOMP=NCOMP+1 IF(NCOMP.EQ.0) THEN C GRDGSE-02 CALL ERROR('GRDGSE-02: No input grid given') C At least one of the files with seismogram components C should be specified. END IF N1N2=N1*N2 IF(NCOMP*N1N2.GT.MRAM) THEN C GRDGSE-03 CALL ERROR('GRDGSE-03: Too small array RAM(MRAM)') C Array RAM(MRAM) allocated in include file 'ram.inc' is too small C to contain the input grids (NCOMP*N1*N2 values). You may C wish to increase the dimension MRAM in file 'ram.inc'. C ram.inc END IF C C Reading input grids: IGRD1=1 IF (FGRD1.NE.' ') THEN CALL RARRAY(LU,FGRD1,.TRUE.,UNDEF,N1N2,RAM(IGRD1)) JGRD1=N1N2 ELSE JGRD1=0 ENDIF IGRD2=JGRD1+1 IF (FGRD2.NE.' ') THEN CALL RARRAY(LU,FGRD2,.TRUE.,UNDEF,N1N2,RAM(IGRD2)) JGRD2=JGRD1+N1N2 ELSE JGRD2=JGRD1 ENDIF IGRD3=JGRD2+1 IF (FGRD3.NE.' ') THEN CALL RARRAY(LU,FGRD3,.TRUE.,UNDEF,N1N2,RAM(IGRD3)) JGRD3=JGRD2+N1N2 ELSE JGRD3=JGRD2 ENDIF C C Writing the output GSE file: OPEN(LU,FILE=FGSE) CALL WGSE1(LU,' ') TEXT='000000' DO 10, I1=1,N2 C Name of the channel (for 999999 channels at the most): DO 20, I2=0,6-1 TEXT(6-I2:6-I2)= * CHAR(ICHAR('0')+MOD(I1,10**(I2+1))/10**I2) 20 CONTINUE IF (FGRD1.NE.' ') THEN CALL WGSE2(LU,TEXT,' ',1,-999.,-999.,-999., * TSTART,TSTEP,N1,RAM(IGRD1+(I1-1)*N1)) ENDIF IF (FGRD2.NE.' ') THEN CALL WGSE2(LU,TEXT,' ',2,-999.,-999.,-999., * TSTART,TSTEP,N1,RAM(IGRD2+(I1-1)*N1)) ENDIF IF (FGRD3.NE.' ') THEN CALL WGSE2(LU,TEXT,' ',3,-999.,-999.,-999., * TSTART,TSTEP,N1,RAM(IGRD3+(I1-1)*N1)) ENDIF 10 CONTINUE CALL WGSE3(LU) CLOSE(LU) C WRITE(*,'(A)') '+GRDGSE: 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 'forms.for' C forms.for INCLUDE 'length.for' C length.for C C======================================================================= C