C
C Program MGRD (Multivalued GRiD) to convert multivalued grid into
C several singlevalued grids.
C
C Version: 6.00
C Date: 2005, November 12
C
C Coded by: Ludek Klimes
C Department of Geophysics, Charles University Prague,
C Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C E-mail: klimes@seis.karlov.mff.cuni.cz
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/output 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 Data describing the grid:
C N1=positive integer... Number of gridpoints along the X1 axis.
C Default: N1=1
C N2=positive integer... Number of gridpoints along the X2 axis.
C Default: N2=1
C N3=positive integer... Number of gridpoints along the X3 axis.
C Default: N3=1
C Names of input and output files:
C NUM='string'...Name of the input ASCII file containing, for each
C gridpoint, the integer number of given values in the
C gridpoint.
C For general description of files with gridded data refer
C to file forms.htm.
C Default: NUM='num.out'
C MGRD='string'...Name of the input file containing, for each
C gridpoint, all given values.
C For general description of the files with multivalued
C gridded data refer to file
C forms.htm.
C Default: MGRD='mgrd.out'
C GRD='string'...String in apostrophes controling the name(s) of the
C output ASCII files with data cubes:
C For IMGRD=0:
C The name of the output file with the generated
C single-valued grids stored as several "snapshots".
C The number of "snapshots" equals the maximum number of
C values given at a point.
C Otherwise:
C The template name of the output files with the generated
C single-valued grids. The number of output files equals
C the maximum number of values given at a point.
C Generation of names of output files:
C All digits contained within the filename are assumed
C to form an integer number. This number is increased
C by 0 for the first output file, by 1 for the second
C one, etc. The other characters of the filename remain
C unchanged.
C For general description of files with gridded data refer
C to file forms.htm.
C Default: GRD='grd00.out'
C IMGRD=integer:
C IMGRD=0: Output single-valued grids are stored as several
C "snapshots" in a single output file. The number of
C "snapshots" is appended to the end of the input SEP
C file in the form of: N4=integer
C Otherwise: Output single-valued grids are stored in
C separate output files.
C Default: IMGRD=0
C Output data appended at the end of SEP file (written just if IMGRD=0):
C N4=positive integer... Number of single-valued grids ("snapshots")
C in the output file GRD.
C Optional parameters specifying the form of the real quantities
C written in the output formatted files:
C MINDIG,MAXDIG=positive integers ... See the description in file
C forms.for.
C
C=======================================================================
C
C Common block /RAMC/:
INCLUDE 'ram.inc'
C ram.inc
C
INTEGER IRAM(MRAM)
EQUIVALENCE (IRAM,RAM)
C
C.......................................................................
C
EXTERNAL UARRAY
REAL UARRAY
C
CHARACTER*80 FGRD,FMUL,FVAL,FOUT
CHARACTER*10 TEXT
INTEGER LU1,LU2,MGRD,I,I4,N,N1,N2,N3,N4,N1N2N3
REAL UNDEF
PARAMETER (LU1=1,LU2=2)
C
UNDEF=UARRAY()
C
C-----------------------------------------------------------------------
C
C Reading name of SEP file with input data:
WRITE(*,'(A)') '+MGRD: Enter input filename: '
FGRD=' '
READ(*,*) FGRD
WRITE(*,'(A)') '+MGRD: Working ... '
C
C Reading all data from the SEP file into the memory:
IF (FGRD.NE.' ') THEN
CALL WSEP1(LU1,FGRD)
C File remains open for writing.
ELSE
C MGRD-04
CALL ERROR('MGRD-04: 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
C Reading input parameters from the SEP file:
CALL RSEP3T('NUM',FMUL,'num.out')
CALL RSEP3T('MGRD',FVAL,'mgrd.out')
CALL RSEP3T('GRD',FOUT,'grd00.out')
C
C Recalling the data specifying grid dimensions
C (arguments: Name of value in input data, Variable, Default):
CALL RSEP3I('N1',N1,1)
CALL RSEP3I('N2',N2,1)
CALL RSEP3I('N3',N3,1)
N1N2N3=N1*N2*N3
CALL RSEP3I('IMGRD',MGRD,0)
C
IF(N1N2N3.GT.MRAM) THEN
C MGRD-01
CALL ERROR('MGRD-01: Too small array RAM')
C Dimension MRAM of array RAM in include file
C ram.inc should probably be increased to
C accommodate the input integer grid values.
END IF
CALL RARRAI(LU2,FMUL,'FORMATTED',.TRUE.,1,N1N2N3,IRAM)
N4=0
N=0
DO 10 I=1,N1N2N3
N4=MAX0(IRAM(I),N4)
N=N+IRAM(I)
10 CONTINUE
IF(2*N1N2N3+N.GT.MRAM) THEN
C MGRD-02
CALL ERROR('MGRD-02: Too small array RAM')
C Dimension MRAM of array RAM in include file
C ram.inc should probably be increased to
C accommodate the input integer grid values, all input multivalued
C grid values, and one output singlevalued grid.
END IF
CALL RARRAY(LU2,FVAL,'FORMATTED',.TRUE.,UNDEF,N,RAM(2*N1N2N3+1))
C
C Loop over singlevalued grids:
DO 50 I4=1,N4
N=2*N1N2N3+I4
DO 20 I=1,N1N2N3
IF(IRAM(I).GE.I4) THEN
RAM(N1N2N3+I)=RAM(N)
ELSE
RAM(N1N2N3+I)=UNDEF
END IF
N=N+IRAM(I)
20 CONTINUE
C
IF(MGRD.EQ.0) THEN
C Writing output file:
IF(I4.EQ.1) THEN
OPEN(LU2,FILE=FOUT,FORM='FORMATTED')
END IF
CALL WARRAY(LU2,' ','FORMATTED',
* .TRUE.,UNDEF,.FALSE.,0.,N1N2N3,RAM(N1N2N3+1))
IF(I4.EQ.N4) THEN
CLOSE(LU2)
CALL WSEP3I(LU1,'N4',N4)
END IF
ELSE
C Generating new output filename:
IF(I4.GT.1) THEN
N=LEN(FOUT)
30 CONTINUE
DO 31 I=N,1,-1
IF(LLE('0',FOUT(I:I)).AND.LLE(FOUT(I:I),'8')) THEN
FOUT(I:I)=CHAR(ICHAR(FOUT(I:I))+1)
GO TO 32
ELSE IF(FOUT(I:I).EQ.'9') THEN
FOUT(I:I)='0'
N=I-1
GO TO 30
END IF
31 CONTINUE
C MGRD-03
CALL ERROR('MGRD-03: Too many output grids')
C The digits in the template name of the output files do not
C allow for the generation of all singlevalued output grids.
C The number of digits should be increased.
32 CONTINUE
END IF
C
C Writing output file:
CALL WARRAY(LU2,FOUT,'FORMATTED',
* .TRUE.,UNDEF,.FALSE.,0.,N1N2N3,RAM(N1N2N3+1))
END IF
50 CONTINUE
C
CLOSE(LU1)
WRITE(*,'(A)') '+MGRD: Done. '
STOP
END
C
C=======================================================================
C
INCLUDE 'error.for'
C error.for
INCLUDE 'sep.for'
C sep.for
INCLUDE 'forms.for'
C forms.for
INCLUDE 'length.for'
C length.for
C
C=======================================================================
C