      PROGRAM RELABL                                                                                                                
C     PROGRAM RELABL (OLD,       NEW,       INPUT,       OUTPUT,        )       B2                                                  
C    1          TAPE1=OLD, TAPE2=NEW, TAPE5=INPUT, TAPE6=OUTPUT)                                                                    
C     ----------------------------------------------------------                B2                                                  
C                                                                               B2                                                  
C     NOV 25/09 - S.KHARIN (ADD OPTION FOR 10-CHARACTER JBUF(4)-JBUF(8))        B2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                           
C     JUL 17/00 - F. MAJAESS (REVISE TO ACCEPT UP TO 10 DIGITS TIMESTEP)                                                            
C     JAN 06/92 - E. CHAN  (REPLACE FORMATTED I/O TO UNIT 2 WITH I/O TO                                                             
C                           AN INTERNAL FILE AND USE CHARACTER STRINGS TO                                                           
C                           BUFFER DATA WHEN CHECKING FOR BLANK FIELDS)                                                             
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     JUN 20/83 - R.LAPRISE.                                                                                                        
C     JUN 06/81 - N.E. SARGENT, J.R. GILLESPIE.                                                                                     
C                                                                               B2                                                  
CRELABL  - CHANGES COMPLETE LABELS IN A FILE                            1  1 C  B1                                                  
C                                                                               B3                                                  
CAUTHOR  - N.SARGENT                                                            B3                                                  
C                                                                               B3                                                  
CPURPOSE - COPIES A FILE CHANGING LABELS WHERE INDICATED.                       B3                                                  
C          NOTE - ANY PART OF THE LABEL CAN BE CHANGED AND CHANGING             B3                                                  
C                 THE PACKING DENSITY CAUSES THE FIELD TO BE REPACKED.          B3                                                  
C                                                                               B3                                                  
CINPUT FILE...                                                                  B3                                                  
C                                                                               B3                                                  
C      OLD = INPUT FILE TO BE CHANGED.                                          B3                                                  
C                                                                               B3                                                  
COUTPUT FILE...                                                                 B3                                                  
C                                                                               B3                                                  
C      NEW = COPY OF FILE OLD WITH SOME OF THE LABELS CHANGED.                  B3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               B5                                                  
C      FLAG = IF THE 11TH POSITION OF THE FIRST INPUT CARD LINE IS NON BLANCK   B5                                                  
C             THEN JBUF(4)-JBUF(8) AND KBUF(4)-KBUF(8) ARE INTERPRETED AS       B5                                                  
C             10-CHARACTER STRINGS.  OTHERWISE, THEY ARE INTERPRETED AS         B5                                                  
C             5-CHARACTER STRINGS (DEFAULT BEHAVIOUR).                          B5                                                  
C      JBUF = LABEL TYPE(S) TO BE CHANGED                                       B5                                                  
C             BLANK SUBFIELDS ARE IGNORED AND A BLANK CARD CAUSES ALL           B5                                                  
C             THE RECORD LABELS IN THE INPUT FILE TO BE CHANGED                 B5                                                  
C             ACCORDING TO KBUF CARD SUBFIELD VALUES, (PROVIDED KBUF            B5                                                  
C             CARD IS NOT BLANK)                                                B5                                                  
C      KBUF = VALUES TO WHICH LABELS ARE TO BE CHANGED.                         B5                                                  
C             BLANK SUBFIELDS ARE NOT CHANGED.                                  B5                                                  
C                                                                               B5                                                  
C      NOTE - INPUT FILE RECORD LABELS REMAIN UNCHANGED IF ANY SUBFIELD         B5                                                  
C             IN JBUF CARD DOES NOT MATCH THE CORRESPONDING SUBFIELD            B5                                                  
C             READ OR IF KBUF CARD IS BLANK.                                    B5                                                  
C             THE FIRST 2 DIGITS IN THE TIMESTEP FIELD ARE IGNORED IF           B5                                                  
C             THE REMAINING 8 DIGITS ARE NOT DIFFERENT FROM ZERO.               B5                                                  
C             THE INTEGER FIELDS ARE LIMITED BY THE (32/64 BITS) INTEGER MODE   B5                                                  
C             THE "RELABL" EXECUTABLE IS GENERATED IN; (IE. LIMIT OF 2147483647 B5                                                  
C             IN 32 BITS INTEGER MODE).                                         B5                                                  
C             ALSO, LABELS ARE READ WITH ALPHANUMERIC FORMAT BUT                B5                                                  
C             CHANGED INTERNALLY TO THE NORMAL FORM OF                          B5                                                  
C             (' ',A4,I10,1X,A4,I10,4I6).                                       B5                                                  
C                                                                               B5                                                  
CEXAMPLE OF INPUT CARDS...                                                      B5                                                  
C                                                                               B5                                                  
C*RELABL   KIND  TIMESTEP NAMELEVELIIIIIJJJJJGLOBLNPACK                         B5                                                  
C*         ....++++++++++ ....+++++.....+++++.....+++++                         B5                                                  
C                                                                               B5                                                  
C*RELABL   GRID             ST                                                  B5                                                  
C*         GRID           TEMP    1              0    2                         B5                                                  
C                                                                               B5                                                  
C (CHANGE ALL GRIDS WITH NAME "ST" TO "TEMP", SET LEVEL=1,                      B5                                                  
C  INDICATE A GLOBAL FIELD OF 0 AND PACKING DENSITY OF 2.)                      B5                                                  
C                                                                               B5                                                  
C*RELABL  +KIND  TIMESTEP NAME     LEVEL     IIIII     JJJJJ     GLOBLNPACK     B5                                                  
C*         ....++++++++++ ....++++++++++..........++++++++++..........+++++     B5                                                  
C                                                                               B5                                                  
C*RELABL  +TIME             ST                                                  B5                                                  
C*         TIME           TEMP         1                      19309621    2     B5                                                  
C                                                                               B5                                                  
C (CHANGE ALL TIME SERIES WITH NAME "ST" TO "TEMP", SET LEVEL=1,                B5                                                  
C  CODE DIMENSIONS IN GRID IN KBUF(7) AS CCCRRRKQ WHERE CCC=193 IS NLON,        B5                                                  
C  RRR=096 IS NLAT, K=2 IS PACKING DENSITY, Q=1 INDICATES GRID.                 B5                                                  
C  SEE LBL2T.F AND T2LBL.F FOR INFORMATION ON THE CODING.)                      B5                                                  
C----------------------------------------------------------------------------                                                       
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      INTEGER JNOTB(8),KNOTB(8),JBUF(8),KBUF(8)                                                                                     
      LOGICAL OK                                                                                                                    
      CHARACTER JSTR*80, KSTR*80                                                                                                    
      CHARACTER BLANK4*4,BLANK5*5,BLANKX*10                                                                                         
      COMMON G(65341)                                                                                                               
      COMMON /BUFCOM/ IBUF(8), IDAT(65341)                                                                                          
      DATA MAXX /65341/                                                                                                             
      DATA BLANK4,BLANK5,BLANKX/'    ','     ','          '/                                                                        
C-----------------------------------------------------------------------                                                            
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,5,6)                                                                                                      
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
C                                                                                                                                   
C     * READ IDENTIFIERS FOR LABELS TO BE CHANGED.                                                                                  
C                                                                                                                                   
      READ(5,5010,END=902) JSTR                                                 B4                                                  
      READ(5,5010,END=903) KSTR                                                 B4                                                  
      WRITE(6,5010)JSTR                                                                                                             
      WRITE(6,5010)KSTR                                                                                                             
      IF(JSTR(11:11).EQ.' ')THEN                                                                                                    
        READ(JSTR,5020) JBUF                                                                                                        
        READ(KSTR,5020) KBUF                                                                                                        
        WRITE(6,5020) JBUF                                                                                                          
        WRITE(6,5020) KBUF                                                                                                          
        IFLG=0                                                                                                                      
      ELSE                                                                                                                          
        READ(JSTR,5030) JBUF                                                                                                        
        READ(KSTR,5030) KBUF                                                                                                        
        WRITE(6,5030) JBUF                                                                                                          
        WRITE(6,5030) KBUF                                                                                                          
        IFLG=1                                                                                                                      
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * DETERMINE WHAT TO CHANGE IN JBUF                                                                                            
C                                                                                                                                   
      JN=0                                                                                                                          
                                                                                                                                    
C     * TYPE                                                                                                                        
                                                                                                                                    
      IF(JSTR(12:15).NE.BLANK4)THEN                                                                                                 
        JN=JN+1                                                                                                                     
        JNOTB(JN)=1                                                                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
C     * TIMESTEP                                                                                                                    
                                                                                                                                    
      IF(JSTR(16:25).NE.BLANKX)THEN                                                                                                 
        JN=JN+1                                                                                                                     
        JNOTB(JN)=2                                                                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
C     * NAME                                                                                                                        
                                                                                                                                    
      IF(JSTR(27:30).NE.BLANK4)THEN                                                                                                 
        JN=JN+1                                                                                                                     
        JNOTB(JN)=3                                                                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
C     * LEVEL                                                                                                                       
                                                                                                                                    
      IF((IFLG.EQ.0.AND.JSTR(31:35).NE.BLANK5).OR.                                                                                  
     1   (IFLG.EQ.1.AND.JSTR(31:40).NE.BLANKX))THEN                                                                                 
        JN=JN+1                                                                                                                     
        JNOTB(JN)=4                                                                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
C     * NLON                                                                                                                        
                                                                                                                                    
      IF((IFLG.EQ.0.AND.JSTR(36:40).NE.BLANK5).OR.                                                                                  
     1   (IFLG.EQ.1.AND.JSTR(41:50).NE.BLANKX))THEN                                                                                 
        JN=JN+1                                                                                                                     
        JNOTB(JN)=5                                                                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
C     * NLAT                                                                                                                        
                                                                                                                                    
      IF((IFLG.EQ.0.AND.JSTR(41:45).NE.BLANK5).OR.                                                                                  
     1   (IFLG.EQ.1.AND.JSTR(51:60).NE.BLANKX))THEN                                                                                 
        JN=JN+1                                                                                                                     
        JNOTB(JN)=6                                                                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
C     * GRID CODING                                                                                                                 
                                                                                                                                    
      IF((IFLG.EQ.0.AND.JSTR(46:50).NE.BLANK5).OR.                                                                                  
     1   (IFLG.EQ.1.AND.JSTR(61:70).NE.BLANKX))THEN                                                                                 
        JN=JN+1                                                                                                                     
        JNOTB(JN)=7                                                                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
C     * PACKING                                                                                                                     
                                                                                                                                    
      IF((IFLG.EQ.0.AND.JSTR(51:55).NE.BLANK5).OR.                                                                                  
     1   (IFLG.EQ.1.AND.JSTR(71:75).NE.BLANKX))THEN                                                                                 
        JN=JN+1                                                                                                                     
        JNOTB(JN)=8                                                                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * DETERMINE WHAT TO CHANGE IN JBUF                                                                                            
C                                                                                                                                   
      KN=0                                                                                                                          
                                                                                                                                    
C     * TYPE                                                                                                                        
                                                                                                                                    
      IF(KSTR(12:15).NE.BLANK4)THEN                                                                                                 
        KN=KN+1                                                                                                                     
        KNOTB(KN)=1                                                                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
C     * TIMESTEP                                                                                                                    
                                                                                                                                    
      IF(KSTR(16:25).NE.BLANKX)THEN                                                                                                 
        KN=KN+1                                                                                                                     
        KNOTB(KN)=2                                                                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
C     * NAME                                                                                                                        
                                                                                                                                    
      IF(KSTR(27:30).NE.BLANK4)THEN                                                                                                 
        KN=KN+1                                                                                                                     
        KNOTB(KN)=3                                                                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
C     * LEVEL                                                                                                                       
                                                                                                                                    
      IF((IFLG.EQ.0.AND.KSTR(31:35).NE.BLANK5).OR.                                                                                  
     1   (IFLG.EQ.1.AND.KSTR(31:40).NE.BLANKX))THEN                                                                                 
        KN=KN+1                                                                                                                     
        KNOTB(KN)=4                                                                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
C     * NLON                                                                                                                        
                                                                                                                                    
      IF((IFLG.EQ.0.AND.KSTR(36:40).NE.BLANK5).OR.                                                                                  
     1   (IFLG.EQ.1.AND.KSTR(41:50).NE.BLANKX))THEN                                                                                 
        KN=KN+1                                                                                                                     
        KNOTB(KN)=5                                                                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
C     * NLAT                                                                                                                        
                                                                                                                                    
      IF((IFLG.EQ.0.AND.KSTR(41:45).NE.BLANK5).OR.                                                                                  
     1   (IFLG.EQ.1.AND.KSTR(51:60).NE.BLANKX))THEN                                                                                 
        KN=KN+1                                                                                                                     
        KNOTB(KN)=6                                                                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
C     * GRID CODING                                                                                                                 
                                                                                                                                    
      IF((IFLG.EQ.0.AND.KSTR(46:50).NE.BLANK5).OR.                                                                                  
     1   (IFLG.EQ.1.AND.KSTR(61:70).NE.BLANKX))THEN                                                                                 
        KN=KN+1                                                                                                                     
        KNOTB(KN)=7                                                                                                                 
      ENDIF                                                                                                                         
                                                                                                                                    
C     * PACKING                                                                                                                     
                                                                                                                                    
      IF((IFLG.EQ.0.AND.KSTR(51:55).NE.BLANK5).OR.                                                                                  
     1   (IFLG.EQ.1.AND.KSTR(71:80).NE.BLANKX))THEN                                                                                 
        KN=KN+1                                                                                                                     
        KNOTB(KN)=8                                                                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * READ THE NEXT RECORD ON FILE OLD.                                                                                           
C                                                                                                                                   
      NMODS=0                                                                                                                       
      IRECS=0                                                                                                                       
  250 CALL GETFLD2 (1, G, -1,-1,-1,-1, IBUF, MAXX, OK)                                                                              
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6040) IRECS,NMODS                                                                                                   
        IF(IRECS.EQ.0) CALL                        XIT('RELABL',-1)                                                                 
        CALL                                       XIT('RELABL',0)                                                                  
      ENDIF                                                                                                                         
      IRECS=IRECS+1                                                                                                                 
C                                                                                                                                   
C     * CHECK IF LABEL IS TO BE CHANGED.                                                                                            
C                                                                                                                                   
      IF(JN.EQ.0) GOTO 400                                                                                                          
      DO 300 I=1,JN                                                                                                                 
      IF(IBUF(JNOTB(I)).NE.JBUF(JNOTB(I))) GO TO 600                                                                                
  300 CONTINUE                                                                                                                      
  400 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * CHANGE LABEL.                                                                                                               
C                                                                                                                                   
      IF(KN.EQ.0) GO TO 600                                                                                                         
      IF(NMODS.EQ.0) WRITE(6,5030) IBUF                                                                                             
      DO 500 I=1,KN                                                                                                                 
  500 IBUF(KNOTB(I))=KBUF(KNOTB(I))                                                                                                 
      IF(NMODS.EQ.0) WRITE(6,5030) IBUF                                                                                             
      NMODS=NMODS+1                                                                                                                 
C                                                                                                                                   
  600 CALL PUTFLD2 (2, G, IBUF, MAXX)                                                                                               
      GO TO 250                                                                                                                     
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
  902 CALL                                         XIT('RELABL',-2)                                                                 
  903 CALL                                         XIT('RELABL',-3)                                                                 
C                                                                                                                                   
C-----------------------------------------------------------------------                                                            
 5010 FORMAT(A80)                                                               B4                                                  
 5020 FORMAT(10X,1X,A4,I10,1X,A4,5I5)                                                                                               
 5030 FORMAT(10X,1X,A4,I10,1X,A4,5I10)                                                                                              
 6040 FORMAT('0 RECORDS READ =',I6,'  RECORDS MODIFIED =',I6)                                                                       
      END                                                                                                                           
