      PROGRAM PAKRS2                                                                                                                
C     PROGRAM PAKRS2  (OLDRS,       NEWRS,       OUTPUT,                )       J2                                                  
C    1           TAPE1=OLDRS, TAPE2=NEWRS, TAPE6=OUTPUT)                                                                            
C     --------------------------------------------------                        J2                                                  
C                                                                               J2                                                  
C     SEP 25/06 - F. MAJAESS  (REVISED IN SUPPORT OF R4I4 MODE)                 J2                                                  
C     MAR 17/04 - M. LAZARE.  (NO "CG->RG" CONVERSION FOR IBUF(7).NE.0)                                                             
C     NOV 24/03 - M. LAZARE.  (ADD SPEC CONVERSION)                                                                                 
C     APR 23/03 - M. LAZARE.  (BASED ON PAKRS, ADDING GRID CONVERSION)                                                              
C     JUN 14/94 - E. CHAN.     PREVIOUS VERSION PAKRS.                                                                              
C                                                                               J2                                                  
CPAKRS2-   CONVERTS FIELDS TO RESTART FILE (HAVING PACKING DENSITY 1            J1                                                  
C          ON "REGULAR" GRID AND SPECTRAL TRIANGLE) FROM INTERNAL MODEL         J1                                                  
C          FORMAT (HAVING NATIVE MACHINE FORMAT AND CHAINED S-N                 J1                                                  
C          ALTERNATING LATITUDES AND HIGH-LOW ZONAL WAVENUMBER                  J1                                                  
C          ORDERING )                                                   1  1    J1                                                  
C                                                                               J3                                                  
CAUTHOR  - M.LAZARE                                                             J3                                                  
C                                                                               J3                                                  
CPURPOSE - CONVERTS FIELDS TO RESTART FILE (PACKED WITH IBUF(8)=1 ON            J3                                                  
C          "REGULAR" GRID AND SPECTRAL TRIANGLE) FROM INTERNAL MODEL            J3                                                  
C          FORMAT (HAVING NATIVE MACHINE FORMAT AND CHAINED S-N                 J3                                                  
C          ALTERNATING LATITUDES AND HIGH-LOW ZONAL WAVENUMBER ORDERING )       J3                                                  
C                                                                               J3                                                  
CINPUT FILE(S)...                                                               J3                                                  
C                                                                               J3                                                  
C      OLDRS        = CONVERTED RESTART FILE IN NATIVE MACHINE FORMAT           J3                                                  
C                     (IBUF(8)=0) ON CHAINED S-N ALTERNATING PAIRS.             J3                                                  
C                                                                               J3                                                  
COUTPUT FILES...                                                                J3                                                  
C                                                                               J3                                                  
C      NEWRS        = FILE CONTAINING PORTABLE DATA TO RESTART THE MODEL        J3                                                  
C--------------------------------------------------------------------------                                                         
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
C                                                                                                                                   
      INTEGER LSR(2,66)                                                                                                             
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
                                                                                                                                    
      COMMON/BLANCK/ F(271600),G(271600)                                                                                            
      COMMON/BUFCOM/ IBUF(8),IDAT(271600)                                                                                           
                                                                                                                                    
      DATA MAXX/271600/                                                                                                             
C----------------------------------------------------------------------                                                             
      NFIL=3                                                                                                                        
      CALL JCLPNT (NFIL,1,2,6)                                                                                                      
C                                                                                                                                   
C     * FOR GRIDS, CONVERT FROM "CHAINED" GRID (ALTERNATING POLE/EQUATOR),                                                          
C     * TO "TRUE" GRID, IE F->G.                                                                                                    
C     * SIMILAR FOR SPECTRAL FIELDS, IE (1,LM,2,LM-1...) -> (1,2,...LM-1,LM).                                                       
C     * ENSURE THAT ALL FIELDS IN RESTART FILE ARE CONVERTED TO                                                                     
C     * 64-BIT IEEE FORMAT.                                                                                                         
C     * NOTE THAT NO GRID CONVERSION IS DONE IF IBUF(7).NE.0 SINCE THIS                                                             
C     * SPECIAL FLAG IS SET ONLY FOR S/L FIELDS OR RCM.                                                                             
C                                                                                                                                   
      NR=0                                                                                                                          
      NCR=0                                                                                                                         
      NSP=0                                                                                                                         
  100 CALL GETFLD2 (1,F,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                   
      IF ( .NOT.OK )  THEN                                                                                                          
        IF( NR.EQ.0 ) THEN                                                                                                          
          CALL                                     XIT('PAKRS2',-1)                                                                 
        ELSE                                                                                                                        
          WRITE(6,6000) IBUF                                                                                                        
          WRITE(6,6020) NR,NCR                                                                                                      
          CALL                                     XIT('PAKRS2',0)                                                                  
        ENDIF                                                                                                                       
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * IN THE FOLLOWING, NOTE THAT NO "CG->RG" CONVERSION IS DONE IF                                                               
C     * IBUF(7)=-1, IE FOR S/L FIELDS.                                                                                              
C     * RESET IBUF(7) TO ZERO IF S/L FIELD SO THAT DIAGNOSTICS WILL WORK                                                            
C     * (FOR INSTANCE, "CMPLBL" OF TRANSFORMED TEMPERATURE FROM SPECTRAL                                                            
C     * VERSUS S/L MOISTURE). THIS IS NOT DONE FOR THE RCM CASES.                                                                   
C                                                                                                                                   
      IF ( IBUF(8).EQ.0 ) THEN                                                                                                      
                                                                                                                                    
        IBUF(8)=1                                                                                                                   
                                                                                                                                    
        IF(IBUF(1).EQ.NC4TO8("GRID") .AND. IBUF(7).EQ.0) THEN                                                                       
          CALL CGTORG  (G,F,IBUF(5),IBUF(6))                                                                                        
          CALL PUTFLD2 (2,G,IBUF,MAXX)                                                                                              
        ELSE IF(IBUF(1).EQ.NC4TO8("SPEC"))               THEN                                                                       
          IF(NSP.EQ.0) CALL DIMGT(LSR,LA,LR,LM,KTR,IBUF(7))                                                                         
          CALL REC2TRI (G,F,LA,LSR,LM)                                                                                              
          CALL PUTFLD2 (2,G,IBUF,MAXX)                                                                                              
          NSP=1                                                                                                                     
        ELSE                                                                                                                        
          IF(IBUF(7).EQ.10) IBUF(7)=0                                                                                               
          CALL PUTFLD2 (2,F,IBUF,MAXX)                                                                                              
        ENDIF                                                                                                                       
                                                                                                                                    
      ELSE                                                                                                                          
                                                                                                                                    
        CALL PUTFLD2 (2,F,IBUF,MAXX)                                                                                                
                                                                                                                                    
      ENDIF                                                                                                                         
C                                                                                                                                   
      NCR=NCR+1                                                                                                                     
      IF ( NR.EQ.0 ) WRITE(6,6000) IBUF                                                                                             
      NR=NR+1                                                                                                                       
      GOTO 100                                                                                                                      
C                                                                                                                                   
C     * ERROR EXIT.                                                                                                                 
C                                                                                                                                   
  901 CALL                                         XIT('PAKRS2',-2)                                                                 
C---------------------------------------------------------------------                                                              
 6000 FORMAT(1X,A4,I10,1X,A4,5I10)                                                                                                  
 6020 FORMAT ('  RECORDS READ      =',I6,                                                                                           
     1      /,'  RECORDS CONVERTED =',I6)                                                                                           
      END                                                                                                                           
