      PROGRAM COMLEV                                                                                                                
C     PROGRAM COMLEV(XIN,      YIN,      XOUT,        YOUT,                     B2                                                  
C                                       XOUT2,       YOUT2,      OUTPUT,)       B2                                                  
C    1         TAPE1=XIN,TAPE2=YIN,TAPE3=XOUT,  TAPE4=YOUT,                     B2                                                  
C                                TAPE13=XOUT2,TAPE14=YOUT2,TAPE6=OUTPUT)        B2                                                  
C     ------------------------------------------------------------------        B2                                                  
C                                                                               B2                                                  
C     MAR 25/13 - S.KHARIN - (REVISED IN SUPPORT OF LEVELS BETWEEN 10 AND 1HPA) B2                                                  
C     MAR 02/09 - S.KHARIN - ORIGINAL VERSION                                                                                       
C                                                                               B2                                                  
CCOMLEV  - SELECTS COMMON SUBSET OF LEVELS FROM A PAIR OF INPUT FILES   2  4    B1                                                  
C                                                                               B3                                                  
CAUTHOR  - S.KHARIN                                                             B3                                                  
C                                                                               B3                                                  
CPURPOSE - SELECTS COMMON SUBSET OF LEVELS FROM A PAIR OF INPUT FILES           B3                                                  
C          SUPERLABELS ARE PROPAGATED THROUGH FROM INPUT FILES TO OUTPUT FILES  B3                                                  
C                                                                               B3                                                  
CINPUT FILE...                                                                  B3                                                  
C                                                                               B3                                                  
C      XIN  = 1ST INPUT MULTI-LEVEL FILE                                        B3                                                  
C      YIN  = 2ND INPUT MULTI-LEVEL FILE                                        B3                                                  
C                                                                               B3                                                  
COUTPUT FILE...                                                                 B3                                                  
C                                                                               B3                                                  
C      XOUT = 1ST OUTPUT MULTI-LEVEL FILE ON COMMON SUBSET OF LEVELS            B3                                                  
C      YOUT = 2ND OUTPUT MULTI-LEVEL FILE ON COMMON SUBSET OF LEVELS            B3                                                  
C                                                                               B3                                                  
C      XOUT2= (OPTIONAL) REMAINING LEVELS FROM 1ST FILE                         B3                                                  
C      YOUT2= (OPTIONAL) REMAINING LEVELS FROM 2ND FILE                         B3                                                  
C----------------------------------------------------------------------------                                                       
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      LOGICAL OK                                                                                                                    
                                                                                                                                    
      INTEGER LEVS1(200),LEVS2(200),LOUT(200)                                                                                       
      COMMON/ICOM/IBUF(8),IDAT(65341)                                                                                               
      DATA MAXX/65341/,MAXL/200/                                                                                                    
C---------------------------------------------------------------------                                                              
      NFF=7                                                                                                                         
      CALL JCLPNT(NFF,1,2,3,4,13,14,6)                                                                                              
      NF=NFF-1                                                                                                                      
      IF(NF.NE.4.AND.NF.NE.6)CALL                  XIT('COMLEV',-1)                                                                 
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 3                                                                                                                      
      REWIND 4                                                                                                                      
      IF(NF.EQ.6) THEN                                                                                                              
       REWIND 13                                                                                                                    
       REWIND 14                                                                                                                    
      ENDIF                                                                                                                         
                                                                                                                                    
C     * FIND LEVEL SETS.                                                                                                            
                                                                                                                                    
      CALL FILEV(LEVS1,NLEV1,IBUF,1)                                                                                                
      IF (NLEV1.EQ.0) THEN                                                                                                          
        WRITE(6,'(A)')' 1ST INPUT FILE IS EMPTY.'                                                                                   
        CALL                                       XIT('COMLEV',-2)                                                                 
      ENDIF                                                                                                                         
      IF(NLEV1.GT.MAXL) CALL                       XIT('COMLEV',-3)                                                                 
C                                                                                                                                   
C     * CONVERT POSITIVE LEVELS BETWEEN 10MB AND 1MB TO NEGATIVE NOTATION                                                           
C                                                                                                                                   
      DO L=1,NLEV1                                                                                                                  
        IF(LEVS1(L).LT.10.AND.LEVS1(L).GE.1)LEVS1(L)=-LEVS1(L)*100                                                                  
      ENDDO                                                                                                                         
      WRITE(6,6010) NLEV1,(LEVS1(L),L=1,NLEV1)                                                                                      
                                                                                                                                    
      CALL FILEV(LEVS2,NLEV2,IBUF,2)                                                                                                
      IF (NLEV2.EQ.0) THEN                                                                                                          
        WRITE(6,'(A)')' 2ND INPUT FILE IS EMPTY.'                                                                                   
        CALL                                       XIT('COMLEV',-4)                                                                 
      ENDIF                                                                                                                         
      IF(NLEV2.GT.MAXL) CALL                       XIT('COMLEV',-5)                                                                 
C                                                                                                                                   
C     * CONVERT POSITIVE LEVELS BETWEEN 10MB AND 1MB TO NEGATIVE NOTATION                                                           
C                                                                                                                                   
      DO L=1,NLEV2                                                                                                                  
        IF(LEVS2(L).LT.10.AND.LEVS2(L).GE.1)LEVS2(L)=-LEVS2(L)*100                                                                  
      ENDDO                                                                                                                         
      WRITE(6,6020) NLEV2,(LEVS2(L),L=1,NLEV2)                                                                                      
C                                                                                                                                   
C     * FIND COMMON SET OF LEVELS                                                                                                   
C                                                                                                                                   
      NLOUT=0                                                                                                                       
      DO L1=1,NLEV1                                                                                                                 
        DO L2=1,NLEV2                                                                                                               
          IF(LEVS1(L1).EQ.LEVS2(L2))THEN                                                                                            
            NLOUT=NLOUT+1                                                                                                           
            LOUT(NLOUT)=LEVS1(L1)                                                                                                   
          ENDIF                                                                                                                     
        ENDDO                                                                                                                       
      ENDDO                                                                                                                         
      IF (NLOUT.EQ.0) THEN                                                                                                          
        WRITE(6,'(A)')' THE COMMON SUBSET IS EMPTY.'                                                                                
        CALL                                       XIT('COMLEV',-6)                                                                 
      ENDIF                                                                                                                         
      WRITE(6,6030) NLOUT,(LOUT(L),L=1,NLOUT)                                                                                       
C                                                                                                                                   
C     * LOOP OVER THE FIRST FILE                                                                                                    
C                                                                                                                                   
      NINP=0                                                                                                                        
      NOUT=0                                                                                                                        
      NOUT2=0                                                                                                                       
  100 CALL RECGET(1,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                       
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,*) ' READ ',NINP,' RECORDS FROM UNIT 1.'                                                                            
        WRITE(6,*) ' WRITE',NOUT,' RECORDS TO   UNIT 3.'                                                                            
        IF(NF.EQ.6)THEN                                                                                                             
          WRITE(6,*) ' WRITE',NOUT2,' RECORDS TO   UNIT 13.'                                                                        
        ENDIF                                                                                                                       
        GOTO 110                                                                                                                    
      ENDIF                                                                                                                         
      NINP=NINP+1                                                                                                                   
                                                                                                                                    
      IF(IBUF(1).EQ.NC4TO8("LABL").OR.                                                                                              
     1   IBUF(1).EQ.NC4TO8("CHAR")) THEN                                                                                            
C                                                                                                                                   
C       * PASS SUPERLABELS THROUGH                                                                                                  
C                                                                                                                                   
        CALL RECPUT(3,IBUF)                                                                                                         
        NOUT=NOUT+1                                                                                                                 
      ELSE                                                                                                                          
C                                                                                                                                   
C       * CONVERT POSITIVE LEVELS BETWEEN 10MB AND 1MB TO NEGATIVE NOTATION                                                         
C                                                                                                                                   
        IF(IBUF(4).LT.10.AND.IBUF(4).GE.1)IBUF(4)=-IBUF(4)*100                                                                      
C                                                                                                                                   
C       * SELECT COMMON LEVELS                                                                                                      
C                                                                                                                                   
        DO L=1,NLOUT                                                                                                                
          IF(IBUF(4).EQ.LOUT(L)) THEN                                                                                               
            CALL RECPUT(3,IBUF)                                                                                                     
            NOUT=NOUT+1                                                                                                             
            GOTO 100                                                                                                                
          ENDIF                                                                                                                     
        ENDDO                                                                                                                       
        IF(NF.EQ.6)THEN                                                                                                             
          CALL RECPUT(13,IBUF)                                                                                                      
          NOUT2=NOUT2+1                                                                                                             
        ENDIF                                                                                                                       
      ENDIF                                                                                                                         
      GO TO 100                                                                                                                     
 110  CONTINUE                                                                                                                      
C                                                                                                                                   
C     * LOOP OVER THE SECOND FILE                                                                                                   
C                                                                                                                                   
      NINP=0                                                                                                                        
      NOUT=0                                                                                                                        
      NOUT2=0                                                                                                                       
  200 CALL RECGET(2,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                       
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,*) ' READ ',NINP,' RECORDS FROM UNIT 2.'                                                                            
        WRITE(6,*) ' WRITE',NOUT,' RECORDS TO   UNIT 4.'                                                                            
        IF(NF.EQ.6)THEN                                                                                                             
          WRITE(6,*) ' WRITE',NOUT2,' RECORDS TO   UNIT 14.'                                                                        
        ENDIF                                                                                                                       
        CALL                                       XIT('COMLEV',0)                                                                  
      ENDIF                                                                                                                         
      NINP=NINP+1                                                                                                                   
                                                                                                                                    
      IF(IBUF(1).EQ.NC4TO8("LABL").OR.                                                                                              
     1   IBUF(1).EQ.NC4TO8("CHAR")) THEN                                                                                            
C                                                                                                                                   
C       * PASS SUPERLABELS THROUGH                                                                                                  
C                                                                                                                                   
        CALL RECPUT(4,IBUF)                                                                                                         
        NOUT=NOUT+1                                                                                                                 
      ELSE                                                                                                                          
C                                                                                                                                   
C       * CONVERT POSITIVE LEVELS BETWEEN 10MB AND 1MB TO NEGATIVE NOTATION                                                         
C                                                                                                                                   
        IF(IBUF(4).LT.10.AND.IBUF(4).GE.1)IBUF(4)=-IBUF(4)*100                                                                      
C                                                                                                                                   
C       * SELECT COMMON LEVELS                                                                                                      
C                                                                                                                                   
        DO L=1,NLOUT                                                                                                                
          IF(IBUF(4).EQ.LOUT(L)) THEN                                                                                               
            CALL RECPUT(4,IBUF)                                                                                                     
            NOUT=NOUT+1                                                                                                             
            GOTO 200                                                                                                                
          ENDIF                                                                                                                     
        ENDDO                                                                                                                       
        IF(NF.EQ.6)THEN                                                                                                             
          CALL RECPUT(14,IBUF)                                                                                                      
          NOUT2=NOUT2+1                                                                                                             
        ENDIF                                                                                                                       
      ENDIF                                                                                                                         
      GO TO 200                                                                                                                     
                                                                                                                                    
C---------------------------------------------------------------------                                                              
 6010 FORMAT(' NLEV1 =',I5/' LEVS IN1 = ',15I6/100(10X,15I6/))                                                                      
 6020 FORMAT(' NLEV2 =',I5/' LEVS IN2 = ',15I6/100(10X,15I6/))                                                                      
 6030 FORMAT(' NLOUT =',I5/' LEVS OUT = ',15I6/100(10X,15I6/))                                                                      
      END                                                                                                                           
