      PROGRAM RMERGEML                                                                                                              
C     PROGRAM RMERGEML (OUT,       IN1,...,       IN88,      OUTPUT,    )       B2                                                  
C    1            TAPE1=OUT,TAPE11=IN1,...,TAPE98=IN88,TAPE6=OUTPUT)                                                                
C     ------------------------------------------------------------              B2                                                  
C                                                                               B2                                                  
C     NOV 18/17 - S.KHARIN (CONVERT TO DYNAMICAL MEMORY ALLOCATION)             B2                                                  
C                                                                                                                                   
CRMERGEML  - MERGES UP TO 88 (MULTI-LEVEL) INPUT FILES INTO ONE FILE.  88  1    B1                                                  
C                                                                               B3                                                  
CAUTHOR  - S. KHARIN                                                            B3                                                  
C                                                                               B3                                                  
CPURPOSE - MERGES UP TO 88 (MULTI-LEVEL) INPUT FILES INTO ONE FILE.             B3                                                  
C          THIS IS A MULTI-LEVEL VERSION OF RMERGE.                             B3                                                  
C                                                                               B3                                                  
CINPUT FILES...                                                                 B3                                                  
C                                                                               B3                                                  
C      IN1,.. = (MULTI-LEVEL) INPUT FILES.                                      B3                                                  
C                                                                               B3                                                  
COUTPUT FILE...                                                                 B3                                                  
C                                                                               B3                                                  
C      OUT    = OUTPUT FILE WITH ALL INPUT FILES MERGED TOGETHER.               B3                                                  
C                                                                                                                                   
C--------------------------------------------------------------------------                                                         
C                                                                                                                                   
      LOGICAL OK,SPEC                                                                                                               
C                                                                                                                                   
      PARAMETER (MAXL=500)                                                                                                          
      INTEGER LEV(MAXL)                                                                                                             
                                                                                                                                    
      INTEGER LABL(16)                                                                                                              
      INTEGER, ALLOCATABLE :: IBUF(:)                                                                                               
      COMMON /MACHTYP/ MACHINE,INTSIZE                                                                                              
C---------------------------------------------------------------------                                                              
      NF=90                                                                                                                         
      CALL JCLPNT(NF,1,11,12,13,14,15,16,17,18,19,20,                                                                               
     1                 21,22,23,24,25,26,27,28,29,30,                                                                               
     2                 31,32,33,34,35,36,37,38,39,40,                                                                               
     3                 41,42,43,44,45,46,47,48,49,50,                                                                               
     4                 51,52,53,54,55,56,57,58,59,60,                                                                               
     5                 61,62,63,64,65,66,67,68,69,70,                                                                               
     6                 71,72,73,74,75,76,77,78,79,80,                                                                               
     7                 81,82,83,84,85,86,87,88,89,90,                                                                               
     8                 91,92,93,94,95,96,97,98,6)                                                                                   
      NF=NF-2                                                                                                                       
      WRITE(6,6010) NF                                                                                                              
      IF(NF.LT.1)CALL                              XIT('RMERGEML',-1)                                                               
      REWIND 1                                                                                                                      
      DO N=1,NF                                                                                                                     
        REWIND 10+N                                                                                                                 
      ENDDO                                                                                                                         
                                                                                                                                    
C     * READ THE FIRST RECORD TO GET THE SIZE                                                                                       
                                                                                                                                    
      CALL FBUFFIN(-11,LABL,-8,K,LEN)                                                                                               
      IF(K.GE.0)THEN                                                                                                                
        CALL                                       XIT('RMERGEML',-2)                                                               
      ENDIF                                                                                                                         
      REWIND 1                                                                                                                      
      CALL PRTLAB (LABL)                                                                                                            
      MAXX=LABL(5)*LABL(6)*MACHINE                                                                                                  
      KIND=LABL(1)                                                                                                                  
      SPEC=(KIND.EQ.NC4TO8("SPEC") .OR. KIND.EQ.NC4TO8("FOUR"))                                                                     
      IF(SPEC) MAXX=MAXX*2                                                                                                          
C                                                                                                                                   
C     * ALLOCATE ARRAYS                                                                                                             
C                                                                                                                                   
      ALLOCATE(IBUF(MAXX+8*MACHINE))                                                                                                
C                                                                                                                                   
C     * FIND THE NUMBER OF LEVELS,                                                                                                  
C                                                                                                                                   
      CALL FILEV(LEV,NLEV,IBUF,11)                                                                                                  
      IF (NLEV.EQ.0) THEN                                                                                                           
        WRITE(6,6005)                                                                                                               
        CALL                                       XIT('RMERGEML',-3)                                                               
      ENDIF                                                                                                                         
      IF (NLEV.GT.MAXL) CALL                       XIT('RMERGEML',-4)                                                               
      KIND=IBUF(1)                                                                                                                  
      WRITE(6,6007) NLEV,(LEV(NL),NL=1,NLEV)                                                                                        
      CALL PRTLAB(IBUF)                                                                                                             
      REWIND 11                                                                                                                     
C                                                                                                                                   
      NREC=0                                                                                                                        
      NSET=0                                                                                                                        
 100  CONTINUE                                                                                                                      
      DO N=1,NF                                                                                                                     
        DO NL=1,NLEV                                                                                                                
        CALL RECGET(10+N,KIND,-1,-1,LEV(NL),IBUF,MAXX,OK)                                                                           
        IF (.NOT.OK) THEN                                                                                                           
          CALL PRTLAB(IBUF)                                                                                                         
          WRITE(6,6020) NSET,NREC                                                                                                   
C                                                                                                                                   
C         * ABORT IF INPUT FILE IS SHORTER THAN THE FIRST INPUT FILE                                                                
C                                                                                                                                   
          IF(NSET.EQ.0.OR.N.NE.1.OR.NL.NE.1) CALL  XIT('RMERGEML',-5)                                                               
          DEALLOCATE(IBUF)                                                                                                          
          CALL                                     XIT('RMERGEML',0)                                                                
        ENDIF                                                                                                                       
        NREC=NREC+1                                                                                                                 
        IF(NREC.EQ.1) CALL PRTLAB(IBUF)                                                                                             
C                                                                                                                                   
C       * SAVE RECORD                                                                                                               
C                                                                                                                                   
        CALL RECPUT(1,IBUF)                                                                                                         
        ENDDO                                                                                                                       
      ENDDO                                                                                                                         
      NSET=NSET+1                                                                                                                   
      GO TO 100                                                                                                                     
C-----------------------------------------------------------------------------                                                      
 6005 FORMAT('*** ERROR: INPUT FILE IS EMPTY.')                                                                                     
 6007 FORMAT('0NLEVS =',I5/                                                                                                         
     1       '0LEVELS = ',15I6/100(10X,15I6/))                                                                                      
 6010 FORMAT(' MERGE ',I5,' FILES INTO ONE FILE, RECORD BY RECORD.')                                                                
 6020 FORMAT(' PROCESSED RECORDS FROM INPUT FILES :',I10/                                                                           
     1       '     SAVED RECORDS IN  OUTPUT FILE  :',I10)                                                                           
      END                                                                                                                           
