      PROGRAM GCMRCPY                                                                                                               
C     PROGRAM GCMRCPY(XIN,       XOUT,       INPUT,       OUTPUT,        )      B2                                                  
C    1          TAPE1=XIN, TAPE2=XOUT, TAPE5=INPUT, TAPE6=OUTPUT)                                                                   
C     ---------------------------------------------------------                 B2                                                  
C                                                                               B2                                                  
C     MAY 7 2018  - S.KHARIN                                                    B2                                                  
C                                                                               B2                                                  
CGCMRCPY - COPY RECORDS FOR A GIVEN RANGE AND NAMES.                    1  1 C  B1                                                  
C                                                                               B3                                                  
CAUTHOR  - S.KHARIN                                                             B3                                                  
C                                                                               B3                                                  
CPURPOSE - COPY RECORDS FOR A GIVEN TIME RANGE AND START AND END NAMES.         B3                                                  
C                                                                               B3                                                  
CINPUT FILE...                                                                  B3                                                  
C                                                                               B3                                                  
C      XIN  = INPUT FILE.                                                       B3                                                  
C                                                                               B3                                                  
COUTPUT FILE...                                                                 B3                                                  
C                                                                               B3                                                  
C      XOUT = SELECTED RECORDS.                                                 B3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               B5                                                  
C      N1     = FIRST TIME STEP TO BE COPIED                                    B5                                                  
C             = -1 TO IGNORE N1.                                                B5                                                  
C      N2     = LAST TIME STEP TO BE COPIED                                     B5                                                  
C             = -1 TO IGNORE N2.                                                B5                                                  
C      NAME1  = NAME TO START. IGNORED IF BLANK.                                B5                                                  
C      NAME2  = NAME TO QUIT. IGNORED IF BLANK.                                 B5                                                  
C      LSPLB  = 0, USE NAMES IN IBUF(3) TO SPLIT FILES.                         B5                                                  
C               1, USE SUPERLABEL (READ IN NEXT INPUT CARD) TO SPLIT FILE.      B5                                                  
C                  USE N1 AND N2 TO COUNT THIS SUPERLABEL.                      B5                                                  
C                                                                               B5                                                  
CEXAMPLE OF INPUT CARD...                                                       B5                                                  
C                                                                               B5                                                  
C*GCMRCPY          1    232723 PHIS PHIS                                        B5                                                  
C                                                                               B5                                                  
C*GCMRCPY          1         1              1                                   B5                                                  
C*GCMRCPY     DATA DESCRIPTION                                                  B5                                                  
C                                                                                                                                   
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      CHARACTER*60 SPRLBL                                                                                                           
      CHARACTER*64 SLABEL                                                                                                           
      COMMON/ICOM/IBUF(8),IDATA(65351)                                                                                              
      EQUIVALENCE (IDATA,SLABEL)                                                                                                    
      DATA MAXX/65351/                                                                                                              
C---------------------------------------------------------------------                                                              
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,5,6)                                                                                                      
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
C                                                                                                                                   
C     * READ N1,N2 AND NEWNAM FROM CARD.                                                                                            
C                                                                                                                                   
      READ(5,5000,END=900) N1,N2,NAME1,NAME2,LSPLB                              B4                                                  
      WRITE(6,6000) N1,N2,NAME1,NAME2,LSPLB                                                                                         
      IF(LSPLB.EQ.1)THEN                                                                                                            
        READ(5,5001,END=901) SPRLBL                                             B4                                                  
        WRITE(6,6001) SPRLBL                                                                                                        
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * SET SWITCHES                                                                                                                
C                                                                                                                                   
      LTIME1=1                                                                                                                      
      IF(N1.EQ.-1.OR.LSPLB.EQ.1)LTIME1=0                                                                                            
      LTIME2=1                                                                                                                      
      IF(N2.EQ.-1.OR.LSPLB.EQ.1)LTIME2=0                                                                                            
                                                                                                                                    
      LNAME1=1                                                                                                                      
      IF(NAME1.EQ.NC4TO8("    "))LNAME1=0                                                                                           
      LNAME2=1                                                                                                                      
      IF(NAME2.EQ.NC4TO8("    "))LNAME2=0                                                                                           
                                                                                                                                    
C                                                                                                                                   
C     * READ THE NEXT RECORD FROM FILE XIN.                                                                                         
C                                                                                                                                   
      NRIN=0                                                                                                                        
      NROUT=0                                                                                                                       
      NSPLB=0                                                                                                                       
 150  CALL FBUFFIN(1,IBUF,MAXX,K,LEN)                                                                                               
      IF(K.GE.0) GO TO 200                                                                                                          
      IF(NRIN.EQ.0) CALL PRTLAB(IBUF)                                                                                               
      NRIN=NRIN+1                                                                                                                   
                                                                                                                                    
      IF(LTIME1.EQ.1.AND.IBUF(2).LT.N1)GOTO 150                                                                                     
      IF(LTIME2.EQ.1.AND.IBUF(2).GT.N2)GOTO 200                                                                                     
                                                                                                                                    
      IF(LTIME1.EQ.1.AND.IBUF(2).EQ.N1.AND.LNAME1.EQ.1.AND.                                                                         
     &     IBUF(3).NE.NAME1)THEN                                                                                                    
        GOTO 150                                                                                                                    
      ELSE                                                                                                                          
        LNAME1=0                                                                                                                    
      ENDIF                                                                                                                         
      IF(LTIME1.EQ.1.AND.IBUF(2).EQ.N2.AND.LNAME2.EQ.1.AND.                                                                         
     &     IBUF(3).EQ.NAME2)THEN                                                                                                    
        GOTO 200                                                                                                                    
      ENDIF                                                                                                                         
                                                                                                                                    
      IF(LSPLB)THEN                                                                                                                 
        IF(IBUF(1).EQ.NC4TO8("LABL"))THEN                                                                                           
          IF(SLABEL(5:64).EQ.SPRLBL) NSPLB=NSPLB+1                                                                                  
          LWRITE=0                                                                                                                  
          IF(NSPLB.LT.N1) GOTO 150                                                                                                  
          IF(NSPLB.GT.N2) GOTO 200                                                                                                  
          CALL FBUFOUT(2,IBUF,LEN,K)                                                                                                
          LWRITE=1                                                                                                                  
          NROUT=NROUT+1                                                                                                             
          GOTO 150                                                                                                                  
        ELSE                                                                                                                        
          IF(LWRITE)THEN                                                                                                            
            CALL FBUFOUT(2,IBUF,LEN,K)                                                                                              
            NROUT=NROUT+1                                                                                                           
          ENDIF                                                                                                                     
        ENDIF                                                                                                                       
      ELSE                                                                                                                          
        CALL FBUFOUT(2,IBUF,LEN,K)                                                                                                  
        NROUT=NROUT+1                                                                                                               
      ENDIF                                                                                                                         
      GOTO 150                                                                                                                      
                                                                                                                                    
 200  CONTINUE                                                                                                                      
                                                                                                                                    
      IF(NRIN.EQ.0.OR.NROUT.EQ.0) CALL             XIT('GCMRCPY',-1)                                                                
      CALL PRTLAB(IBUF)                                                                                                             
      WRITE(6,6010)NRIN,NROUT                                                                                                       
      CALL                                         XIT('GCMRCPY',0)                                                                 
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
  900 CALL                                         XIT('GCMRCPY',-2)                                                                
  901 CALL                                         XIT('GCMRCPY',-3)                                                                
C---------------------------------------------------------------------                                                              
 5000 FORMAT(10X,2I10,2(1X,A4),I5)                                              B4                                                  
 5001 FORMAT(14X,A60)                                                                                                               
 6000 FORMAT('0 GCMRCPY RECORDS FROM N1 =',I10, ' TO N2 =',I10,                                                                     
     +       ', NAME1 = ',A4,', NAME2 = ',A4,' LSPLB=',I5)                                                                          
 6001 FORMAT('0 GCMRCPY SPLIT AT SUPERLABEL = ',A60)                                                                                
 6010 FORMAT('0 GCMRCPY READ ',I10,' AND COPIED ',I10,' RECORDS.')                                                                  
      END                                                                                                                           
