      PROGRAM TIMLAG                                                                                                                
C     PROGRAM TIMLAG (X,       Y,       RTX,       LTY,       INPUT,            C2                                                  
C    1                                                        OUTPUT,   )       C2                                                  
C    2          TAPE1=X, TAPE2=Y, TAPE3=RTX, TAPE4=LTY, TAPE5=INPUT,                                                                
C    3                                                  TAPE6=OUTPUT)                                                               
C     ---------------------------------------------------------------           C2                                                  
C                                                                               C2                                                  
C     NOV 02/04 - S.KHARIN (ABORT FOR LAG < 0 AND WORK CORRECTLY FOR LAG = 0)   C2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                           
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     NOV 17/86 - R.LAPRISE.                                                                                                        
C                                                                               C2                                                  
CTIMLAG  - SHIFTS FILES BY RECORD(S)                                    2  2 C  C1                                                  
C                                                                               C3                                                  
CAUTHOR  - R. LAPRISE                                                           C3                                                  
C                                                                               C3                                                  
CPURPOSE - COPY X INTO RTX, LEAVING OUT  LAST NSHFT RECORDS, AND                C3                                                  
C          COPY Y INTO LTY, LEAVING OUT FIRST NSHFT RECORDS, I.E.               C3                                                  
C                                                                               C3                                                  
C          FOR    X = < X(1),      X(2),       ...             ,X(N) >,         C3                                                  
C          AND    Y = < Y(1),      Y(2),       ...             ,Y(N) >,         C3                                                  
C          THEN RTX = < X(1),      X(2),       ... ,X(N-NSHFT) >,               C3                                                  
C          AND  LTY = < Y(1+NSHFT),Y(2+NSHFT), ... ,Y(N)       >.               C3                                                  
C                                                                               C3                                                  
C          NOTE - THE USE OF THE SAME DATASET FOR X AND Y IS NOT RECOMENDED.    C3                                                  
C                                                                               C3                                                  
CINPUT FILES...                                                                 C3                                                  
C                                                                               C3                                                  
C      X   = ANY FILE WITH CCRN LABEL                                           C3                                                  
C      Y   = ANY FILE WITH CCRN LABEL                                           C3                                                  
C                                                                               C3                                                  
COUTPUT FILES...                                                                C3                                                  
C                                                                               C3                                                  
C      RTX = FILE X WITHOUT THE LAST  NSHFT RECORDS                             C3                                                  
C      LTY = FILE Y WITHOUT THE FIRST NSHFT RECORDS                             C3                                                  
C                                                                                                                                   
CINPUT PARAMETER...                                                                                                                 
C                                                                               C5                                                  
C      NSHFT = NUMBER OF RECORDS TO SHIFT EACH FILE                             C5                                                  
C                                                                               C5                                                  
CEXAMPLE OF INPUT CARD...                                                       C5                                                  
C                                                                               C5                                                  
C*TIMLAG          10                                                            C5                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      LOGICAL OK                                                                                                                    
      COMMON /ICOM/ IBUF(8),IDAT(65341)                                                                                             
      DATA MAXDAT/65341/                                                                                                            
C---------------------------------------------------------------------                                                              
      NFIL=6                                                                                                                        
      CALL JCLPNT(NFIL,1,2,3,4,5,6)                                                                                                 
      REWIND 2                                                                                                                      
      REWIND 4                                                                                                                      
C                                                                                                                                   
C     * READ-IN INPUT DIRECTIVES.                                                                                                   
C                                                                                                                                   
      READ(5,5000,END=901)NSHFT                                                 C4                                                  
      WRITE(6,6001)NSHFT                                                                                                            
      IF (NSHFT.LT.0) CALL                         XIT(' TIMLAG',-1)                                                                
C-------------------------------------------------------------------------                                                          
C     * SKIP THE FIRST NSHFT RECORDS IN FILE 2.                                                                                     
C                                                                                                                                   
      IF(NSHFT.GE.1) THEN                                                                                                           
         DO 100 N=1,NSHFT                                                                                                           
           CALL RECGET(2,-1,-1,-1,-1,IBUF,MAXDAT,OK)                                                                                
           IF(.NOT.OK) CALL                        XIT(' TIMLAG',-2)                                                                
  100    CONTINUE                                                                                                                   
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * COPY ALL FOLLOWING RECORDS FROM FILE 2 TO FILE 4.                                                                           
C                                                                                                                                   
      NREC=0                                                                                                                        
  200 CONTINUE                                                                                                                      
        CALL RECGET(2,-1,-1,-1,-1,IBUF,MAXDAT,OK)                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
          IF(NREC.EQ.0) CALL                       XIT(' TIMLAG',-3)                                                                
          WRITE(6,6000)4,IBUF                                                                                                       
          GO TO 290                                                                                                                 
        ENDIF                                                                                                                       
        IF(NREC.EQ.0)WRITE(6,6000)4,IBUF                                                                                            
        CALL RECPUT(4,IBUF)                                                                                                         
        NREC=NREC+1                                                                                                                 
      GO TO 200                                                                                                                     
C--------------------------------------------------------------------------                                                         
C     * FILE 2 IS EXHAUSTED. COPY FIRST NREC FROM FILE 1 FO FILE 3.                                                                 
C                                                                                                                                   
  290 CONTINUE                                                                                                                      
      REWIND 1                                                                                                                      
      REWIND 3                                                                                                                      
      DO 300 N=1,NREC                                                                                                               
        CALL RECGET(1,-1,-1,-1,-1,IBUF,MAXDAT,OK)                                                                                   
        IF(.NOT.OK) CALL                           XIT(' TIMLAG',-4)                                                                
        CALL RECPUT(3,IBUF)                                                                                                         
        IF(N.EQ.1 .OR. N.EQ.NREC)WRITE(6,6000)3,IBUF                                                                                
  300 CONTINUE                                                                                                                      
C                                                                                                                                   
      WRITE(6,6002)NREC                                                                                                             
      CALL                                         XIT(' TIMLAG',0)                                                                 
  901 CALL                                         XIT(' TIMLAG',-5)                                                                
C---------------------------------------------------------------------------                                                        
 5000 FORMAT(10X,I10)                                                           C4                                                  
 6000 FORMAT(' FILE',I2,'...',1X,A4,I10,1X,A4,5I10)                                                                                 
 6001 FORMAT('0NSHFT',I10)                                                                                                          
 6002 FORMAT(I10,' RECORDS WRITTEN ON BOTH FILES')                                                                                  
      END                                                                                                                           
