      PROGRAM JOINER                                                                                                                
C     PROGRAM JOINER (INA,       INB,       OUT,       OUTPUT,          )       B2                                                  
C    1          TAPE1=INA, TAPE2=INB, TAPE3=OUT, TAPE6=OUTPUT)                                                                      
C     --------------------------------------------------------                  B2                                                  
C                                                                               B2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       B2                                                  
C     JAN 14/92 - E. CHAN  (END READ USING FBUFFIN IF K.GE.0)                   B2                                                  
C     JUL 21/92 - E. CHAN  (REPLACE UNFORMATTED I/O WITH I/O ROUTINES)                                                              
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII AND                                                                 
C                           REPLACE BUFFERED I/O)                                                                                   
C     FEB 13/80 - J.D.HENDERSON.                                                                                                    
C                                                                               B2                                                  
CJOINER  - JOINS TWO FILES. RESULT HAS ASCENDING STEP NUMBERS.          2  1    B1                                                  
C                                                                               B3                                                  
CAUTHOR  - J.D.HENDERSON                                                        B3                                                  
C                                                                               B3                                                  
CPURPOSE - JOINS TOGETHER TWO TIME ORDERED GCM DIAGNOSTICS FILES INA            B3                                                  
C          AND INB PUTTING THE RESULTING DATASET ON FILE OUT.                   B3                                                  
C          TIMESTEP NUMBERS SHOULD BE INCREASING FROM INA TO INB.               B3                                                  
C          COPYING BEGINS IN INB ONLY WHEN HIGHER STEP NUMBERS ARE              B3                                                  
C          READ AND ONLY THE FIRST OF MULTIPLE SAVES IN INB IS SAVED.           B3                                                  
C          THIS PROGRAM CAN RUN ON EITHER GRID OR SPECTRAL FILES.               B3                                                  
C                                                                               B3                                                  
CINPUT FILES...                                                                 B3                                                  
C                                                                               B3                                                  
C      INA = FIRST  INPUT FILE                                                  B3                                                  
C      INB = SECOND INPUT FILE                                                  B3                                                  
C                                                                               B3                                                  
COUTPUT FILE...                                                                 B3                                                  
C                                                                               B3                                                  
C      OUT = FILE OF INA,INB JOINED                                             B3                                                  
C-------------------------------------------------------------------------                                                          
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/BUFCOM/IBUF(65341)                                                                                                     
      DATA LMAX/65341/                                                                                                              
C                                                                                                                                   
C---------------------------------------------------------------------                                                              
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,3,6)                                                                                                      
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 3                                                                                                                      
C                                                                                                                                   
C     * COPY THE FIRST FILE WITHOUT ANY CHECKING.                                                                                   
C                                                                                                                                   
      NRECS=0                                                                                                                       
  110 CALL FBUFFIN(1,IBUF,LMAX,K,LEN)                                                                                               
      IF (K.GE.0) GO TO 150                                                                                                         
      NRECS=NRECS+1                                                                                                                 
      CALL FBUFOUT(3,IBUF,LEN,K)                                                                                                    
      GO TO 110                                                                                                                     
C                                                                                                                                   
C     * STOP IF THE FIRST FILE IS EMPTY.                                                                                            
C     * NSTEP = LAST STEP NUMBER IN FIRST FILE.                                                                                     
C                                                                                                                                   
  150 WRITE(6,6010) NRECS                                                                                                           
      IF(NRECS.EQ.0)THEN                                                                                                            
        WRITE(6,6020)                                                                                                               
        CALL                                       XIT('JOINER',-1)                                                                 
      ENDIF                                                                                                                         
      NSTEP=IBUF(2)                                                                                                                 
      NRTOT=NRECS                                                                                                                   
C                                                                                                                                   
C     * THE NAME AND LEVEL OF THE FIRST FIELD ON THE SECOND FILE                                                                    
C     * ARE USED TO DETERMINE THE START OF EACH NEW GROUP.                                                                          
C                                                                                                                                   
      CALL FBUFFIN(2,IBUF,-8,K,LEN)                                                                                                 
      IF (K.GE.0) GOTO 250                                                                                                          
      NAM1=IBUF(3)                                                                                                                  
      LEV1=IBUF(4)                                                                                                                  
      BACKSPACE 2                                                                                                                   
      BACKSPACE 2                                                                                                                   
C                                                                                                                                   
C     * ADD THE SECOND FILE TO THE END OF THE FIRST ONE.                                                                            
C     * CHECK FOR DUPLICATE GROUPS (SAME STEP NUMBER).                                                                              
C                                                                                                                                   
      NSKIP=0                                                                                                                       
      NRECS=0                                                                                                                       
  210 CALL FBUFFIN(2,IBUF,LMAX,K,LEN)                                                                                               
      IF (K.GE.0) GO TO 250                                                                                                         
      IF(IBUF(3).EQ.NAM1.AND.IBUF(4).EQ.LEV1) LASTIN=NSTEP                                                                          
      IF(IBUF(2).LE.LASTIN) THEN                                                                                                    
        NSKIP=NSKIP+1                                                                                                               
        GO TO 210                                                                                                                   
      ENDIF                                                                                                                         
      NSTEP=IBUF(2)                                                                                                                 
      CALL FBUFOUT(3,IBUF,LEN,K)                                                                                                    
      NRECS=NRECS+1                                                                                                                 
      GO TO 210                                                                                                                     
C                                                                                                                                   
  250 IF(NSKIP.GT.0) WRITE(6,6030) NSKIP                                                                                            
      WRITE(6,6035) NRECS                                                                                                           
      NRTOT=NRTOT+NRECS                                                                                                             
      WRITE(6,6050) NRTOT                                                                                                           
      IF(NRECS.EQ.0)THEN                                                                                                            
        WRITE(6,6040)                                                                                                               
        CALL                                       XIT('JOINER',-2)                                                                 
      ENDIF                                                                                                                         
      CALL                                         XIT('JOINER',0)                                                                  
C---------------------------------------------------------------------                                                              
 6010 FORMAT('0',I6,' RECORDS COPIED FROM FIRST FILE')                                                                              
 6020 FORMAT('0..FIRST INPUT FILE IS EMPTY')                                                                                        
 6030 FORMAT('0',I6,' RECORDS SKIPPED IN SECOND FILE')                                                                              
 6035 FORMAT('0',I6,' RECORDS ADDED FROM SECOND FILE')                                                                              
 6040 FORMAT('0..SECOND FILE EMPTY OR HAS NO NEW STEPS')                                                                            
 6050 FORMAT('0',I6,' RECORDS NOW ON NEW FILE')                                                                                     
      END                                                                                                                           
