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 http://sw3d.cz/staff/klimes.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/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 quantities C written in the output formatted files: C MINDIG,MAXDIG=positive integers ... See the description in file C forms.for. C NUMLIN=positive integer ... Number of reals or integers in one C line of the output file. 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 C should probably be increased to accommodate the input integer C 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 C should probably be increased to accommodate the input C 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