C
C Program MGRD (Multivalued GRiD) to convert multivalued grid into
C several singlevalued grids.
C
C Version: 5.10
C Date: 1997, October 20
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
C Description of the data files:
C
C The data are read in by the list directed input (free format).
C In the description of data files, each numbered paragraph indicates
C the beginning of a new input operation (new READ statement).
C If the symbolic name of the input variable is enclosed in apostrophes,
C the corresponding value in input data is of the type CHARACTER, i.e.
C it should be a character string enclosed in apostrophes. If the first
C letter of the symbolic name is I-N, the corresponding value is of the
C type INTEGER. Otherwise, the input parameter is of the type REAL and
C may or may not contain a decimal point.
C
C Input data read from the * external unit:
C The interactive * external unit may also be redirected to the file
C containing the relevant data.
C (1) 'SEP','NUM','MGRD','GRD',/
C 'SEP'...String in apostrophes containing the name of the input
C file with the data specifying grid dimensions.
C Description of file SEP
C 'NUM'...String in apostrophes containing the name of the input
C ASCII file containing, for each gridpoint, the integer
C number of given values.
C 'MGRD'..String in apostrophes containing the name of the input
C file containing, for each gridpoint, all given values.
C 'GRD'...String in apostrophes containing the template name of the
C output ASCII files with the generated single-valued grid
C values. The number of output files equals the maximum
C number of values given at a point.
C Generation of names of output files:
C All digits contained within the filename are assumed to
C form an integer number. This number is increased by 1
C for the first output file, by 2 for the second one, etc.
C The other characters of the filename remain unchanged.
C /... Input data line must be terminated by a slash.
C Default: 'SEP'='grd.h', 'NUM'='num.out', 'MGRD'='mgrd.out',
C 'GRD'='grd00.out'
C
C
C Data file SEP has the form of the SEP (Stanford Exploration Project)
C parameter file:
C All the data are specified in the form of PARAMETER=VALUE, e.g.
C N1=50, with PARAMETER directly preceding = without intervening
C spaces and with VALUE directly following = without intervening
C spaces. The PARAMETER=VALUE couple must be delimited by a space
C or comma from both sides.
C The PARAMETER string is not case-sensitive.
C PARAMETER= followed by a space resets the default parameter value.
C All other text in the input files is ignored. The file thus may
C contain unused data or comments without leading comment character.
C Everything between comment character # and the end of the
C respective line is ignored, too.
C The PARAMETER=VALUE couples may be specified in any order.
C The last appearance takes precedence.
C Data specifying grid dimensions:
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
C=======================================================================
C
C Common block /RAMC/:
INCLUDE 'ram.inc'
C ram.inc
C
INTEGER IRAM(MRAM)
EQUIVALENCE (IRAM,RAM)
C
C.......................................................................
C
CHARACTER*80 FGRD,FMUL,FVAL,FOUT
INTEGER LU,I,J,M,N,N1,N2,N3,N1N2N3
REAL UNDEF
PARAMETER (LU=1,UNDEF=-999999.)
C
C.......................................................................
C
C Main input data:
C Default:
FGRD='grd.h'
FMUL='num.out'
FVAL='mgrd.out'
FOUT='grd00.out'
C Reading main input data:
WRITE (*,'(2A)')
* ' Enter 4 filenames (SEP,NUM,MGRD,GRD): '
READ (*,*) FGRD,FMUL,FVAL,FOUT
C
C Reading all the data from file FGRD to the memory
C (SEP parameter file form):
CALL RSEP1(LU,FGRD)
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
C
IF(N1N2N3.GT.MRAM) THEN
C MGRD-01
PAUSE '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.
STOP
END IF
CALL RARRAI(LU,FMUL,'FORMATTED',.TRUE.,1,N1N2N3,IRAM)
M=0
N=0
DO 10 I=1,N1N2N3
M=MAX0(IRAM(I),M)
N=N+IRAM(I)
10 CONTINUE
IF(2*N1N2N3+N.GT.MRAM) THEN
C MGRD-02
PAUSE '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.
STOP
END IF
CALL RARRAY(LU,FVAL,'FORMATTED',.TRUE.,UNDEF,N,RAM(2*N1N2N3+1))
C
C Loop over singlevalued grids:
DO 50 J=1,M
N=2*N1N2N3+J
DO 20 I=1,N1N2N3
IF(IRAM(I).GE.J) THEN
RAM(N1N2N3+I)=RAM(N)
ELSE
RAM(N1N2N3+I)=UNDEF
END IF
N=N+IRAM(I)
20 CONTINUE
C
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
PAUSE '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.
STOP
32 CONTINUE
CALL WARRAY(LU,FOUT,'FORMATTED',
* .TRUE.,UNDEF,.FALSE.,0.,N1N2N3,RAM(N1N2N3+1))
50 CONTINUE
C
STOP
END
C
C=======================================================================
C
INCLUDE 'sep.for'
C sep.for
INCLUDE 'length.for'
C length.for
INCLUDE 'forms.for'
C forms.for
C
C=======================================================================
C