C                                                            <HTML><PRE>
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                                                    <A NAME="data"></A>
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                                                     <A NAME="SEP"></A>
C Input/output data file 'SEP':
C     File 'SEP' has the form of the <A HREF="../forms/sep.htm">SEP</A>
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 <A HREF="../forms/forms.htm#GRD">forms.htm</A>.
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             <A HREF="../forms/forms.htm#MGRD">forms.htm</A>.
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 <A HREF="../forms/forms.htm#GRD">forms.htm</A>.
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             <A HREF="forms.for#MAXDIG" TYPE="text/html">forms.for</A>.
C     NUMLIN=positive integer ... Number of reals or integers in one
C             line of the output file. See the description in file
C             <A HREF="forms.for#NUMLIN" TYPE="text/html">forms.for</A>.
C
C=======================================================================
C
C Common block /RAMC/:
      INCLUDE 'ram.inc'
C     <A HREF="ram.inc" TYPE="text/html">ram.inc</A>
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       <A NAME="error04"></A><FONT COLOR="RED">MGRD-04</FONT>
        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       <A NAME="error01"></A><FONT COLOR="RED">MGRD-01</FONT>
        CALL ERROR('MGRD-01: Too small array RAM')
C       Dimension MRAM of array RAM in include file
C       <A HREF="ram.inc" TYPE="text/html">ram.inc</A>
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       <A NAME="error02"></A><FONT COLOR="RED">MGRD-02</FONT>
        CALL ERROR('MGRD-02: Too small array RAM')
C       Dimension MRAM of array RAM in include file
C       <A HREF="ram.inc" TYPE="text/html">ram.inc</A>
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             <A NAME="error03"></A><FONT COLOR="RED">MGRD-03</FONT>
              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     <A HREF="error.for" TYPE="text/html">error.for</A>
      INCLUDE 'sep.for'
C     <A HREF="sep.for" TYPE="text/html">sep.for</A>
      INCLUDE 'forms.for'
C     <A HREF="forms.for" TYPE="text/html">forms.for</A>
      INCLUDE 'length.for'
C     <A HREF="length.for" TYPE="text/html">length.for</A>
C
C=======================================================================
C                                                                 </PRE>
