      PROGRAM TSCHECK                                                                                                               
C     PROGRAM TSCHECK (IN,       OUTPUT,                                )       A2                                                  
C    1           TAPE1=IN, TAPE6=OUTPUT)                                                                                            
C     ----------------------------------                                        A2                                                  
C                                                                               A2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       A2                                                  
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     FEB 16/88 - F. ZWIERS                                                                                                         
C                                                                               A2                                                  
CTSCHECK - PRODUCE A SUMMARY OF THE CONTENTS OF A FILE                  1  0    A1                                                  
C                                                                               A3                                                  
CAUTHOR  - F. ZWIERS                                                            A3                                                  
C                                                                               A3                                                  
CPURPOSE - PRODUCE A SUMMARY OUTPUT OF THE CONTENTS OF FILE "IN".               A3                                                  
C          THIS SUMMARY OUTPUT WILL BE CONSISTING OF:                           A3                                                  
C              1) ALL SUPERLABELS                                               A3                                                  
C              2) LABEL OF FIRST RECORD IN EACH SUPERLABELED FILE               A3                                                  
C              3) LABEL OF EACH RECORD (OR MULTILEVEL SET) AT                   A3                                                  
C                 WHICH THE SAVING INTERVAL (IN TIME STEPS) CHANGES             A3                                                  
C              4) LABEL OF THE LAST RECORD IN EACH SUPERLABELED FILE            A3                                                  
C                                                                               A3                                                  
CINPUT FILE...                                                                  A3                                                  
C                                                                               A3                                                  
C      IN = ANY DATA FILE WITH CCRN LABEL                                       A3                                                  
C----------------------------------------------------------------------------                                                       
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      DIMENSION F(18528)                                                                                                            
      INTEGER DTNEW,DTOLD,JBUF(8)                                                                                                   
      LOGICAL OK,FIRST                                                                                                              
C                                                                                                                                   
      COMMON/ICOM/IBUF(8),IDAT(18528)                                                                                               
      COMMON/MACHTYP/MACHINE,INTSIZE                                                                                                
C                                                                                                                                   
      DATA LA/18528/                                                                                                                
      DATA LHEAD/8/                                                                                                                 
C     DATA ILABL/4HLABL/                                                                                                            
C--------------------------------------------------------------------                                                               
      ILABL=NC4TO8("LABL")                                                                                                          
      NF=2                                                                                                                          
      CALL JCLPNT(NF,1,6)                                                                                                           
      REWIND 1                                                                                                                      
C                                                                                                                                   
      NR=0                                                                                                                          
      NW=0                                                                                                                          
      FIRST=.TRUE.                                                                                                                  
  110 CONTINUE                                                                                                                      
         CALL RECGET(1, -1,-1,-1,-1, IBUF,LA,OK)                                                                                    
         IF(.NOT.OK)THEN                                                                                                            
            IF(NR.EQ.0)THEN                                                                                                         
               CALL                                XIT('TSCHECK',-101)                                                              
            ELSE                                                                                                                    
               WRITE(6,6002)NR,JBUF                                                                                                 
               WRITE(6,6005)NW                                                                                                      
               CALL                                XIT('TSCHECK',0)                                                                 
            ENDIF                                                                                                                   
         ENDIF                                                                                                                      
         NR=NR+1                                                                                                                    
         CALL LBLCHK(LR,NWDS,NPACK,IBUF)                                                                                            
         NW=NW+LR/MACHINE                                                                                                           
         IF(IBUF(1).EQ.ILABL)THEN                                                                                                   
            IF(NR.EQ.1)THEN                                                                                                         
               WRITE(6,6010) NR,IBUF,(F(I),I=1,8)                                                                                   
            ELSE                                                                                                                    
               WRITE(6,6002) NR-1,JBUF                                                                                              
               WRITE(6,6010) NR,IBUF,(F(I),I=1,8)                                                                                   
            ENDIF                                                                                                                   
            FIRST=.TRUE.                                                                                                            
         ELSE                                                                                                                       
            IF(FIRST)THEN                                                                                                           
               ITOLD=IBUF(2)                                                                                                        
               DTOLD=0                                                                                                              
               WRITE(6,6013) NR,IBUF                                                                                                
            ELSE                                                                                                                    
               ITNEW=IBUF(2)                                                                                                        
               IF(ITNEW.NE.ITOLD)THEN                                                                                               
                  DTNEW=ITNEW-ITOLD                                                                                                 
                  IF(DTNEW.NE.DTOLD)THEN                                                                                            
                     WRITE(6,6015) NR-1,JBUF,DTNEW                                                                                  
                     DTOLD=DTNEW                                                                                                    
                  ENDIF                                                                                                             
                  ITOLD=ITNEW                                                                                                       
               ENDIF                                                                                                                
            ENDIF                                                                                                                   
            DO 120 I=1,8                                                                                                            
               JBUF(I)=IBUF(I)                                                                                                      
  120       CONTINUE                                                                                                                
            FIRST=.FALSE.                                                                                                           
         ENDIF                                                                                                                      
      GO TO 110                                                                                                                     
C--------------------------------------------------------------------                                                               
 6002 FORMAT(/' ',I5,2X,A4,I10,2X,A4,I10,2I6,I9,I3,                                                                                 
     1       ' -------- LAST RECORD'/                                                                                               
     2       ' ---------------------------------------',                                                                            
     3       '--------------------------------------'//)                                                                            
 6005 FORMAT('0FILE LENGTH (INCLUDING LABELS) IS',I8,' WORDS')                                                                      
 6010 FORMAT(' ',I5,2X,A4,I10,2X,A4,I10,2I6,I9,I3,'  =',8A8/)                                                                       
 6013 FORMAT(' ',I5,2X,A4,I10,2X,A4,I10,2I6,I9,I3,                                                                                  
     1       ' -------- FIRST RECORD'/)                                                                                             
 6015 FORMAT(' ',I5,2X,A4,I10,2X,A4,I10,2I6,I9,I3,                                                                                  
     1       ' SAVE INTERVAL:',I6)                                                                                                  
      END                                                                                                                           
