      PROGRAM PAKTND                                                                                                                
C     PROGRAM PAKTND (OUTEND,      NPAKTD,      OUTPUT,                 )       J2                                                  
C               TAPE1=OUTGCM,TAPE2=NPAKTD,TAPE6=OUTPUT)                                                                             
C     -------------------------------------------------                         J2                                                  
C                                                                               J2                                                  
C     DEC 04/03 - L. SOLHEIM                                                    J2                                                  
C                                                                                                                                   
CPAKTND  - UNPACK, REORDER AND REPACK GCM OUTPUT TENDENCY FILES         1  1    J1                                                  
C                                                                               J3                                                  
CAUTHOR  - L. SOLHEIM                                                           J3                                                  
C                                                                               J3                                                  
CPURPOSE - UNPACK, REORDER AND REPACK TENDENCY FILES AS THEY COME OUT OF THE    J3                                                  
C          GCM. REORDERED AND REPACKED RECORDS ARE APPENDED TO AN EXISTING      J3                                                  
C          TENDENCY FILE. THIS FILE WILL BE CREATED IF IT DOES NOT ALREADY      J3                                                  
C          EXIST.                                                               J3                                                  
C                                                                               J3                                                  
CINPUT FILE(S)...                                                               J3                                                  
C                                                                               J3                                                  
C      OUTEND = A FILE CONTAINING TENDENCY FIELDS CREATED BY THE MOST           J3                                                  
C               RECENT MODEL JOBSTRING.                                         J3                                                  
C      NPAKTD = POSSIBLY EMPTY FILE CONTAINING TENDENCY FIELDS THAT HAVE        J3                                                  
C               BEEN ACCUMULATED UP TO THIS POINT IN THE MODEL RUN FROM         J3                                                  
C               PREVIOUS INVOCATIONS OF THIS PROGRAM.                           J3                                                  
C                                                                               J3                                                  
C OUTPUT FILES...                                                               J3                                                  
C                                                                               J3                                                  
C      NPAKTD = NEW PACKED TENDENCY FILE CONSISTING OF ANY EXISTING             J3                                                  
C               RECORDS WITH NEW RECORDS FROM OUTEND APPENDED.                  J3                                                  
C-------------------------------------------------------------------------                                                          
                                                                                                                                    
      IMPLICIT REAL (A-H,O-Z), INTEGER (I-N)                                                                                        
                                                                                                                                    
      INTEGER, PARAMETER :: MAXX  = 271600                                                                                          
      INTEGER, PARAMETER :: MAXXR = 271600                                                                                          
      INTEGER, PARAMETER :: IUIN  = 1                                                                                               
      INTEGER, PARAMETER :: IUOUT = 2                                                                                               
                                                                                                                                    
      LOGICAL OK                                                                                                                    
                                                                                                                                    
      INTEGER INITBUF(8)                                                                                                            
                                                                                                                                    
      REAL F(MAXXR), G(MAXXR)                                                                                                       
                                                                                                                                    
      COMMON/BUFCOM/ IBUF(8),IDAT(MAXX)                                                                                             
                                                                                                                                    
C----------------------------------------------------------------------                                                             
C     * ATTATCH INPUT AND OUTPUT FILES TO UNITS IUIN AND IUOUT                                                                      
C----------------------------------------------------------------------                                                             
                                                                                                                                    
      NFIL=2                                                                                                                        
      CALL JCLPNT (NFIL,IUIN,IUOUT,6)                                                                                               
      IF ( NFIL.LT.2) CALL                         XIT('PAKTND',-1)                                                                 
                                                                                                                                    
C-----------------------------------------------------------------------                                                            
C     * READ THE OUTPUT FILE TO POSITION THE FILE POINTER AT END AND                                                                
C     * TO DETERMINE THE TIME (IBUF(2)) OF THE LAST RECORD, IF ANY.                                                                 
C-----------------------------------------------------------------------                                                            
                                                                                                                                    
       READ(IUOUT,END=100)                                                                                                          
   50  READ(IUOUT,END=60)                                                                                                           
       GOTO 50                                                                                                                      
   60  BACKSPACE IUOUT                                                                                                              
       BACKSPACE IUOUT                                                                                                              
       BACKSPACE IUOUT                                                                                                              
       CALL FBUFFIN(IUOUT,IBUF,-8,K,LEN)                                                                                            
                                                                                                                                    
C      * FBUFFIN ERROR...IUOUT WILL BE OVERWRITTEN                                                                                  
                                                                                                                                    
       IF (K.GE.0) GOTO 100                                                                                                         
                                                                                                                                    
       LASTIME=IBUF(2)                                                                                                              
       GO TO 110                                                                                                                    
  100  REWIND IUOUT                                                                                                                 
       LASTIME=-1                                                                                                                   
  110 CONTINUE                                                                                                                      
                                                                                                                                    
C-----------------------------------------------------------------------                                                            
C     * READ INPUT FILE TO PROCESS INPUT FIELDS AND WRITE SELECTED ONES                                                             
C     * TO THE OUTPUT FILE.                                                                                                         
C-----------------------------------------------------------------------                                                            
                                                                                                                                    
      REWIND IUIN                                                                                                                   
      NRECIN=0                                                                                                                      
      NRECOUT=0                                                                                                                     
                                                                                                                                    
C     * DEFAULT PACKING DENSITY FOR TENDENCY FILES                                                                                  
                                                                                                                                    
      NPACK=4                                                                                                                       
      INITBUF(:)=0                                                                                                                  
      INITBUF(1)=NC4TO8("NONE")                                                                                                     
      INITBUF(3)=NC4TO8("DONE")                                                                                                     
                                                                                                                                    
  210 CALL RECGET(IUIN,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                    
      IF (.NOT.OK) GO TO 400                                                                                                        
      NRECIN=NRECIN+1                                                                                                               
                                                                                                                                    
C     * TENDENCY FILES SHOULD CONTAIN ONLY "GRID" RECORDS                                                                           
                                                                                                                                    
      IF (IBUF(1).NE.NC4TO8("GRID")) CALL          XIT('PAKTND',-2)                                                                 
                                                                                                                                    
C     * DISCARD RECORDS WITH TIMES LESS THAN THE TIME OF THE LAST RECORD                                                            
C     * IN THE OUTPUT FILE AS IT WAS AT THE START OF THIS PROGRAM.                                                                  
                                                                                                                                    
      IF (IBUF(2).LE.LASTIME) GO TO 210                                                                                             
      NRECOUT=NRECOUT+1                                                                                                             
                                                                                                                                    
C     * UNPACK THE FIELD                                                                                                            
                                                                                                                                    
      CALL RECUP2(G,IBUF)                                                                                                           
                                                                                                                                    
C     * CONVERT FROM MODEL INTERNAL FORMAT TO "REGULAR" GRID.                                                                       
                                                                                                                                    
      CALL CGTORG (F,G,IBUF(5),IBUF(6))                                                                                             
      IBUF(8)=NPACK                                                                                                                 
                                                                                                                                    
C     * SAVE THE LABEL OF THE FIRST MATCHING RECORD.                                                                                
                                                                                                                                    
      IF (NRECOUT.EQ.1 ) INITBUF(1:8)=IBUF(1:8)                                                                                     
                                                                                                                                    
C     * WRITE THIS RECORD TO THE OUTPUT FILE, WITH PACKING DENSITY = NPACK                                                          
                                                                                                                                    
      CALL PUTFLD2 (IUOUT,F,IBUF,MAXX)                                                                                              
      GO TO 210                                                                                                                     
                                                                                                                                    
  400 CONTINUE                                                                                                                      
                                                                                                                                    
      IF(NRECIN.EQ.0) THEN                                                                                                          
                                                                                                                                    
C       * ABORT ON EMPTY INPUT FILE.                                                                                                
                                                                                                                                    
        WRITE(6,*)'PAKTND: EMPTY INPUT FILE ...'                                                                                    
        CALL                                       XIT('PAKTND',-3)                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
C---------------------------------------------------------------------                                                              
C     * WRITE SUMMARY INFO TO STDOUT                                                                                                
C---------------------------------------------------------------------                                                              
      WRITE(6,*)'PAKTND: LABEL OF FIRST RECORD WRITTEN:'                                                                            
      WRITE(6,'(1X,A4,I10,1X,A4,I10,4I8)') (INITBUF(I),I=1,8)                                                                       
      WRITE(6,*)'PAKTND: ',NRECIN,' RECORDS READ'                                                                                   
      WRITE(6,*)'PAKTND: ',NRECOUT,' RECORDS ADDED TO TENDENCY FILE'                                                                
                                                                                                                                    
C---------------------------------------------------------------------                                                              
C     * NORMAL EXIT.                                                                                                                
C---------------------------------------------------------------------                                                              
      CALL                                         XIT('PAKTND',0)                                                                  
                                                                                                                                    
      END                                                                                                                           
