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