      PROGRAM REPACK                                                                                                                
C     PROGRAM REPACK (XIN,       XOUT,       INPUT,       OUTPUT,       )       B2                                                  
C    1          TAPE1=XIN, TAPE2=XOUT, TAPE5=INPUT, TAPE6=OUTPUT)                                                                   
C     -----------------------------------------------------------               B2                                                  
C                                                                               B2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       B2                                                  
C     MAR 05/02 - F.MAJAESS (REVISED TO HANDLE "CHAR" KIND RECORDS)                                                                 
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     MAY 13/83 - R.LAPRISE, J.D.HENDERSON                                                                                          
C                                                                               B2                                                  
CREPACK  - REPACKS A FILE                                               1  1 C  B1                                                  
C                                                                               B3                                                  
CAUTHOR  - J.D.HENDERSON                                                        B3                                                  
C                                                                               B3                                                  
CPURPOSE - REPACKS A COMPLETE FILE WITH A NEW PACKING DENSITY.                  B3                                                  
C                                                                               B3                                                  
CINPUT FILE...                                                                  B3                                                  
C                                                                               B3                                                  
C      XIN  = FILE TO BE REPACKED.                                              B3                                                  
C                                                                               B3                                                  
COUTPUT FILE...                                                                 B3                                                  
C                                                                               B3                                                  
C      XOUT = COPY OF FILE XIN PACKED WITH NEW PACKING DENSITY.                 B3                                                  
C                                                                                                                                   
CINPUT PARAMETER...                                                                                                                 
C                                                                               B5                                                  
C      NEWPAK = NEW PACKING DENSITY FOR THE FILE.                               B5                                                  
C                                                                               B5                                                  
CEXAMPLE OF INPUT CARD...                                                       B5                                                  
C                                                                               B5                                                  
C*REPACK.     4                                                                 B5                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/BLANCK/G(65341)                                                                                                        
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
      COMMON/ICOM/IBUF(8),IDAT(65341)                                                                                               
      DATA MAXX/65341/                                                                                                              
C---------------------------------------------------------------------                                                              
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,5,6)                                                                                                      
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
C                                                                                                                                   
C     * READ THE NEW PACKING DENSITY FROM A CARD.                                                                                   
C                                                                                                                                   
      READ(5,5010,END=902) NEWPAK                                               B4                                                  
      WRITE(6,6010)NEWPAK                                                                                                           
C                                                                                                                                   
C     * READ THE NEXT FIELD FROM FILE XIN.                                                                                          
C                                                                                                                                   
      NR=0                                                                                                                          
  150 CALL GETFLD2(1,G,-1,0,0,0,IBUF,MAXX,OK)                                                                                       
      IF(.NOT.OK)THEN                                                                                                               
        IF(NR.EQ.0) CALL                           XIT('REPACK',-1)                                                                 
        WRITE(6,6025) IBUF                                                                                                          
        WRITE(6,6020) NR                                                                                                            
        CALL                                       XIT('REPACK',0)                                                                  
      ENDIF                                                                                                                         
      IF(NR.EQ.0) WRITE(6,6025) IBUF                                                                                                
C                                                                                                                                   
C     * CHANGE THE PACKING DENSITY AND SAVE ON FILE XOUT.                                                                           
C     * "LABL" AND "CHAR" KIND RECORDS ARE COPIED UNCHANGED.                                                                        
C                                                                                                                                   
      IF(IBUF(1).NE.NC4TO8("LABL").AND.                                                                                             
     +   IBUF(1).NE.NC4TO8("CHAR")     ) IBUF(8)=NEWPAK                                                                             
      CALL PUTFLD2(2,G,IBUF,MAXX)                                                                                                   
      NR=NR+1                                                                                                                       
      GO TO 150                                                                                                                     
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
  902 CALL                                         XIT('REPACK',-2)                                                                 
C---------------------------------------------------------------------                                                              
 5010 FORMAT(10X,I5)                                                            B4                                                  
 6010 FORMAT('0NEW PACKING DENSITY =',I5)                                                                                           
 6020 FORMAT(' ',I6,'  RECORDS READ')                                                                                               
 6025 FORMAT(' ',A4,I10,2X,A4,I10,4I6)                                                                                              
      END                                                                                                                           
