      PROGRAM XAPPEND                                                                                                               
C     PROGRAM XAPPEND (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 - D.LIU,F.MAJAESS                                                                                                   
C                                                                               B2                                                  
CXAPPEND - APPENDS SUPER-LABELLED DATA SETS                             2  1    B1                                                  
C                                                                               B3                                                  
CAUTHOR  - D.LIU,F.MAJAESS                                                      B3                                                  
C                                                                               B3                                                  
CPURPOSE - APPENDS SUPERLABELLED SETS OF FILE 'ADD' WITH THAT OF FILE 'OLD'.    B3                                                  
C          NOTE - THIS PROGRAM WORKS LIKE XJOIN EXCEPT FOR SUPERLABELLED        B3                                                  
C                 DATA SETS THAT APPEAR IN BOTH 'OLD' AND 'ADD', IN WHICH       B3                                                  
C                 CASE, THE DATA UNDER SUCH A SUPERLABEL IN FILE 'OLD' WILL     B3                                                  
C                 BE APPENDED WITH THE DATA UNDER THE SAME SUPERLABEL IN        B3                                                  
C                 FILE 'ADD'.                                                   B3                                                  
C                                                                               B3                                                  
CINPUT FILES...                                                                 B3                                                  
C                                                                               B3                                                  
C      OLD = FILE OF SUPERLABELLED SETS                                         B3                                                  
C      ADD = FILE CONTAINING SUPERLABELLED SETS TO BE APPENDED                  B3                                                  
C            THE CURRENT MAXIMUM NUMBER OF SUPERLABELLED SETS IN FILE           B3                                                  
C            'OLD' IS 1000.                                                     B3                                                  
C                                                                               B3                                                  
COUTPUT FILE...                                                                 B3                                                  
C                                                                               B3                                                  
C      NEW = COPY OF OLD WITH SUPERLABELLED SETS MERGED                         B3                                                  
C                                                                                                                                   
C------------------------------------------------------------------------------                                                     
                                                                                                                                    
C     PARAMETER "MAXSETS" REFERS TO THE MAXIMUM NUMBER OF SUPERLABELLED                                                             
C     SETS WHICH CAN BE PROCESSED FROM FILE 'ADD'                                                                                   
                                                                                                                                    
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER (MAXSETS=1000)                                                                                                      
                                                                                                                                    
      CHARACTER*64 SPRLBL,SPRLBL2,SUPER,SUPER2,RLABL(MAXSETS)                                                                       
      COMMON/ICOM/ IBUF(8),IDAT(65341)                                                                                              
      COMMON/JCOM/ JBUF(8),JDAT(65341)                                                                                              
      EQUIVALENCE (SPRLBL,IDAT), (SPRLBL2,JDAT)                                                                                     
                                                                                                                                    
      LOGICAL APPEND,APPENDED                                                                                                       
      COMMON/MACHTYP/ MACHINE,INTSIZE                                                                                               
                                                                                                                                    
      DATA MAXX/65341/                                                                                                              
C-----------------------------------------------------------------------                                                            
                                                                                                                                    
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,3,6)                                                                                                      
      IF (NFF.LT.4) CALL                           XIT('XAPPEND',-1)                                                                
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 3                                                                                                                      
      MAXLEN=MAXX+8                                                                                                                 
                                                                                                                                    
C     * INITIALIZE SUPERLABELS ARRAY "RLABL" BY SCANNING                                                                            
C     * THE SUPERLABELS IN FILE 'ADD'.                                                                                              
                                                                                                                                    
      LABLN=0                                                                                                                       
      N=0                                                                                                                           
 110  CALL FBUFFIN(2,JBUF,MAXLEN,K,LEN)                                                                                             
                                                                                                                                    
      IF (K.EQ.0) THEN                                                                                                              
C        * NOTHING IS READ IN THIS TIME                                                                                             
                                                                                                                                    
         IF(N.EQ.0) THEN                                                                                                            
C           * NOTHING EVER READ IN (IE. FILE IS EMPTY)                                                                              
            WRITE(6,6010)                                                                                                           
            CALL                                   XIT('XAPPEND',-2)                                                                
         ENDIF                                                                                                                      
                                                                                                                                    
         IF(LABLN.EQ.0) THEN                                                                                                        
C           * NO SUPERLABEL IS FOUND                                                                                                
            WRITE(6,6020)                                                                                                           
            CALL                                   XIT('XAPPEND',-3)                                                                
         ENDIF                                                                                                                      
                                                                                                                                    
      ELSE                                                                                                                          
                                                                                                                                    
         IF(JBUF(1).EQ.NC4TO8("LABL")) THEN                                                                                         
C           * STORE SUPERLABEL IN ARRAY                                                                                             
            LABLN=LABLN + 1                                                                                                         
            IF (LABLN .GT. MAXSETS) CALL           XIT('XAPPEND',-4)                                                                
            RLABL(LABLN)=SPRLBL2                                                                                                    
         ENDIF                                                                                                                      
         N=N + 1                                                                                                                    
                                                                                                                                    
         GOTO 110                                                                                                                   
      ENDIF                                                                                                                         
                                                                                                                                    
C     * INITIALIZE VARIABLES.                                                                                                       
C     * GET READY TO READ RECORDS FROM FILE OLD.                                                                                    
                                                                                                                                    
 120  NA=0                                                                                                                          
      APPEND=.FALSE.                                                                                                                
      APPENDED=.FALSE.                                                                                                              
                                                                                                                                    
C     * READ THE FIRST RECORD IN FILE 'OLD'                                                                                         
                                                                                                                                    
      CALL FBUFFIN(1,IBUF,MAXLEN,K,LEN)                                                                                             
      IF (K.EQ.0) GOTO 170                                                                                                          
                                                                                                                                    
 130  IF (IBUF(1).EQ.NC4TO8("LABL")) THEN                                                                                           
         APPEND=.FALSE.                                                                                                             
         APPENDED=.FALSE.                                                                                                           
                                                                                                                                    
C        * CHECK IF SUPERLABEL EXISTS IN FILE 'ADD'.                                                                                
C        * IF YES, THE DATA IN FILE 'ADD' IS TO BE APPENDED.                                                                        
                                                                                                                                    
         SUPER=SPRLBL                                                                                                               
         DO I=1, LABLN                                                                                                              
            IF (SUPER.EQ.RLABL(I)) THEN                                                                                             
               APPEND=.TRUE.                                                                                                        
               RLABL(I)="_NULL"                                                                                                     
            ENDIF                                                                                                                   
         ENDDO                                                                                                                      
      ENDIF                                                                                                                         
                                                                                                                                    
C     * BUT FIRST, WRITE OUT ALL RECORDS BEFORE THE NEXT LABEL.                                                                     
                                                                                                                                    
 140  CALL FBUFOUT(3,IBUF,LEN,K)                                                                                                    
      IF (K.GE.0) THEN                                                                                                              
        WRITE(6,6080)                                                                                                               
        CALL                                       XIT('XAPPEND',-5)                                                                
      ENDIF                                                                                                                         
      CALL FBUFFIN(1,IBUF,MAXLEN,K,LEN)                                                                                             
      IF (K.EQ.0) GOTO 150                                                                                                          
      IF (IBUF(1).NE.NC4TO8("LABL")) GOTO 140                                                                                       
                                                                                                                                    
C     * THEN, APPENED RECORDS IN FILE 'ADD' IF APPEND IS SET.                                                                       
                                                                                                                                    
 150  IF (APPEND) THEN                                                                                                              
         WRITE(6,6070) SUPER                                                                                                        
         REWIND 2                                                                                                                   
         NA=NA+1                                                                                                                    
                                                                                                                                    
C     * SCAN FILE 'ADD' TILL A MATCHING LABEL IS FOUND.                                                                             
C     * COPY DATA AND EXIT LOOP IMMEDIATELY.                                                                                        
                                                                                                                                    
 160     CALL FBUFFIN(2,JBUF,MAXLEN,M,LEN2)                                                                                         
         IF (M.EQ.0) GOTO 170                                                                                                       
         IF (JBUF(1).EQ.NC4TO8("LABL")) THEN                                                                                        
            IF (APPENDED) GOTO 170                                                                                                  
            SUPER2=SPRLBL2                                                                                                          
         ELSE                                                                                                                       
            IF (SUPER2.EQ.SUPER) THEN                                                                                               
              CALL FBUFOUT(3,JBUF,LEN2,M)                                                                                           
              IF (M.GE.0) THEN                                                                                                      
                WRITE(6,6080)                                                                                                       
                CALL                               XIT('XAPPEND',-6)                                                                
              ENDIF                                                                                                                 
              WRITE(6,6030) JBUF                                                                                                    
              APPENDED=.TRUE.                                                                                                       
            ENDIF                                                                                                                   
         ENDIF                                                                                                                      
         GOTO 160                                                                                                                   
      ENDIF                                                                                                                         
                                                                                                                                    
C     * GO ON WITH THE NEXT SUPERLABEL IN FILE 'OLD'.                                                                               
C     * STOP IF END OF FILE REACHED.                                                                                                
                                                                                                                                    
 170  IF (K.NE.0) GOTO 130                                                                                                          
                                                                                                                                    
C     * NOW THAT ALL THE RECORDS IN FILE 'OLD' HAVE BEEN                                                                            
C     * PROCESSED, APPEND THE REST OF THE LABELLED DATA SETS IN                                                                     
C     * FILE 'ADD' THAT HAVE NOT BEEN COPIED TO THE NEW FILE.                                                                       
                                                                                                                                    
      DO 190 I=1, LABLN                                                                                                             
         IF (RLABL(I).EQ."_NULL") GOTO 190                                                                                          
         REWIND 2                                                                                                                   
         APPENDED=.FALSE.                                                                                                           
 180     CALL FBUFFIN(2,JBUF,MAXLEN,M,LEN2)                                                                                         
         IF (M.EQ.0) GOTO 190                                                                                                       
         IF (JBUF(1).EQ.NC4TO8("LABL")) THEN                                                                                        
            IF (APPENDED) GOTO 190                                                                                                  
            SUPER2=SPRLBL2                                                                                                          
         ENDIF                                                                                                                      
         IF (SUPER2.EQ.RLABL(I)) THEN                                                                                               
            CALL FBUFOUT(3,JBUF,LEN2,M)                                                                                             
            IF (M.GE.0) THEN                                                                                                        
              WRITE(6,6080)                                                                                                         
              CALL                                 XIT('XAPPEND',-7)                                                                
            ENDIF                                                                                                                   
            APPENDED=.TRUE.                                                                                                         
         ENDIF                                                                                                                      
         GOTO 180                                                                                                                   
 190  CONTINUE                                                                                                                      
                                                                                                                                    
      WRITE(6,6040) LABLN                                                                                                           
      WRITE(6,6050) NA                                                                                                              
      IF (NA.LT.LABLN) THEN                                                                                                         
         WRITE(6,6060)                                                                                                              
         DO I=1,LABLN                                                                                                               
            IF (RLABL(I).NE."_NULL") WRITE(6,6070) RLABL(I)                                                                         
         ENDDO                                                                                                                      
      ENDIF                                                                                                                         
      CALL                                         XIT('XAPPEND',0)                                                                 
C-----------------------------------------------------------------------                                                            
 6010 FORMAT('0...FILE2 EMPTY')                                                                                                     
 6020 FORMAT('0...FILE2 CONTAINS NO SUPERLABEL')                                                                                    
 6030 FORMAT(2X,' MERGED BY APPENDING: ',A4,I10,2X,A4,I10,2I6,I9,I3)                                                                
 6040 FORMAT(3X,'A TOTAL OF ',I4,' SUPER-LABELLED SETS FOUND IN FILE2.')                                                            
 6050 FORMAT(3X,I4,' OF THESE SETS MERGED WITH THOSE IN FILE1.')                                                                    
 6060 FORMAT(/,3X,'THE REST ARE APPENDED:')                                                                                         
 6070 FORMAT(3X,A64)                                                                                                                
 6080 FORMAT(3X,'WRITE OPERATION FAILED')                                                                                           
                                                                                                                                    
      END                                                                                                                           
