      PROGRAM XJOIN                                                                                                                 
C     PROGRAM XJOIN (OLD,      ADD,      NEW,       OUTPUT,             )       B2                                                  
C    1         TAPE1=OLD,TAPE2=ADD,TAPE3=NEW, TAPE6=OUTPUT)                                                                         
C     -----------------------------------------------------                     B2                                                  
C                                                                               B2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       B2                                                  
C     SEP 29/98 - F.MAJAESS (CHECK FOR STATUS OF WRITE OPERATION ON UNIT 3)                                                         
C     JUN 24/97 - D. LIU                                                                                                            
C                                                                               B2                                                  
CXJOIN   - JOINS UP TWO SUPERLABELLED FILES                             2  1    B1                                                  
C                                                                               B3                                                  
CAUTHOR  - D. LIU                                                               B3                                                  
C                                                                               B3                                                  
CPURPOSE - JOIN UP ONE SUPERLABELLED FILE TO ANOTHER SUPERLABELLED FILE.        B3                                                  
C          NOTE - IN CASE SOME SUPERLABELLED SETS CONTAINED IN FILE 'ADD'       B3                                                  
C                 ALREADY EXIST IN FILE 'OLD', THESE DUPLICATE SETS IN          B3                                                  
C                 'OLD' ARE DELETED BEFORE THE NEW ONES IN 'ADD' ARE            B3                                                  
C                 ADDED.                                                        B3                                                  
C                                                                               B3                                                  
CINPUT FILES...                                                                 B3                                                  
C                                                                               B3                                                  
C      OLD = FILE OF SUPERLABELLED SETS (CAN BE EMPTY)                          B3                                                  
C      ADD = FILE CONTAINING NEW SETS TO ADD/REPLACE                            B3                                                  
C            THE CURRENT MAXIMUM NUMBER OF SUPERLABELLED SETS TO BE ADDED       B3                                                  
C            IS 1000.                                                           B3                                                  
C                                                                               B3                                                  
COUTPUT FILE...                                                                 B3                                                  
C                                                                               B3                                                  
C      NEW = COPY OF OLD WITH NEW SETS ADDED OR REPLACED.                       B3                                                  
C                                                                                                                                   
C----------------------------------------------------------------------------                                                       
C                                                                                                                                   
                                                                                                                                    
C     PARAMETER MAXSETS REFERS TO THE MAXIMUM NUMBER OF                                                                             
C     SUPERLABELLED SETS THAT CAN BE ADDED AT ONE TIME                                                                              
                                                                                                                                    
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER (MAXSETS=1000)                                                                                                      
                                                                                                                                    
      CHARACTER*64 SPRLBL, RLABL2(MAXSETS)                                                                                          
      COMMON/ICOM/ IBUF(8), LABEL(65341)                                                                                            
      EQUIVALENCE (SPRLBL,LABEL)                                                                                                    
C                                                                                                                                   
      LOGICAL COPY                                                                                                                  
      COMMON/MACHTYP/ MACHINE,INTSIZE                                                                                               
C                                                                                                                                   
      DATA LA/65341/                                                                                                                
C--------------------------------------------------------------------                                                               
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,3,6)                                                                                                      
      IF (NFF.LT.4) CALL                           XIT('XJOIN',-1)                                                                  
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 3                                                                                                                      
      MAXLEN=LA+8                                                                                                                   
                                                                                                                                    
C     * SCAN FILE 'ADD' AND SAVE SUPERLABELS TO BE ADDED.                                                                           
                                                                                                                                    
      LABLN=0                                                                                                                       
      N=0                                                                                                                           
 111  CALL FBUFFIN(2,IBUF,MAXLEN,K,LEN)                                                                                             
      IF (K.EQ.0) THEN                                                                                                              
         IF(N.EQ.0) CALL                           XIT('XJOIN',-2)                                                                  
         GOTO 110                                                                                                                   
      ELSEIF(IBUF(1).EQ.NC4TO8("LABL")) THEN                                                                                        
         LABLN=LABLN + 1                                                                                                            
         IF (LABLN .GT. MAXSETS) CALL              XIT('XJOIN',-3)                                                                  
         N=N + 1                                                                                                                    
         RLABL2(LABLN)=SPRLBL                                                                                                       
      ENDIF                                                                                                                         
      GOTO 111                                                                                                                      
                                                                                                                                    
C     * READ THE NEXT RECORD FROM FILE OLD.                                                                                         
                                                                                                                                    
 110  CALL FBUFFIN(1,IBUF,MAXLEN,K,LEN)                                                                                             
      IF (K.EQ.0) GOTO 215                                                                                                          
      IF (IBUF(1).EQ.NC4TO8("LABL")) THEN                                                                                           
                                                                                                                                    
C     * CHECK THE SET-LABEL JUST READ.                                                                                              
C     * IF IT IS THE SAME AS ONE IN FILE 'ADD', DO NOT COPY IT.                                                                     
        COPY=.TRUE.                                                                                                                 
        DO I=1, LABLN                                                                                                               
           IF (SPRLBL.EQ.RLABL2(I)) COPY=.FALSE.                                                                                    
        ENDDO                                                                                                                       
      ENDIF                                                                                                                         
                                                                                                                                    
C                                                                                                                                   
C     * COPY THIS RECORD ONTO FILE NEW IF NO DUPLICATE.                                                                             
C                                                                                                                                   
      IF (COPY) THEN                                                                                                                
        CALL FBUFOUT(3,IBUF,LEN,K)                                                                                                  
        IF (K.GE.0) THEN                                                                                                            
          WRITE(6,6040)                                                                                                             
          CALL                                     XIT('XJOIN',-4)                                                                  
        ENDIF                                                                                                                       
      ENDIF                                                                                                                         
                                                                                                                                    
      GO TO 110                                                                                                                     
                                                                                                                                    
C     * DONE WITH THE OLD FILE. NOW APPEND THE NEW SETS.                                                                            
                                                                                                                                    
  215 REWIND 2                                                                                                                      
      NS=0                                                                                                                          
  220 CALL FBUFFIN(2,IBUF(1),MAXLEN,K,LEN)                                                                                          
      IF (K.EQ.0) THEN                                                                                                              
        WRITE(6,6030) NS                                                                                                            
        CALL                                       XIT('XJOIN',0)                                                                   
      ENDIF                                                                                                                         
      CALL FBUFOUT(3,IBUF,LEN,K)                                                                                                    
      IF (K.GE.0) THEN                                                                                                              
        WRITE(6,6040)                                                                                                               
        CALL                                       XIT('XJOIN',-5)                                                                  
      ENDIF                                                                                                                         
      IF (IBUF(1).EQ.NC4TO8("LABL")) THEN                                                                                           
          WRITE(6,6020) IBUF, SPRLBL                                                                                                
          NS=NS+1                                                                                                                   
      ENDIF                                                                                                                         
      GO TO 220                                                                                                                     
                                                                                                                                    
C--------------------------------------------------------------------                                                               
 6020 FORMAT(' ',A4,I10,1X,A4,I10,4I6,A64)                                                                                          
 6030 FORMAT(3X,I5,' SUPER LABELLED SETS MERGED.')                                                                                  
 6040 FORMAT(3X,'WRITE OPERATION FAILED')                                                                                           
      END                                                                                                                           
