FTN4
      SUBROUTINE CKTHD(LU1,HDR,BUFR,IERR) 
     +,92069-16205 REV.2013 790418
C 
C 
C*****************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED.
C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR
C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR
C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. 
C****************************************************************** 
C 
C 
C     SOURCE:    92069-18205
C     RELOC:     92069-16205
C 
C 
C****************************************************************:
C 
C 
C****************************************************** 
C CKTHD CHECKS THAT THE HEADER INFO THE USER ENTERED INTO HDR 
C CORRESPONDS TO THE HDR INFO OFF THE TAPE AS STORED IN BUFR. 
C******************************************************** 
      INTEGER LU1,HDR(1),BUFR(1),IERR 
      DOUBLE PRECISION REEL1,REEL2
C***************************************************
C SEE IF ITS OK.
C 
      CALL COMP(LU1,HDR,BUFR,19,IERR) 
      IF (IERR .GE. 0) GO TO 9500 
C********************************************************** 
C BRANCH ACCORDING TO WHERE THE WORDS DON'T MATCH.
C 
      IERR2=-IERR 
      IF (IERR2 .LT. 8) GO TO 9000
      IF (IERR2 .LE. 11) GO TO 9010 
      IF (IERR2 .EQ. 12) CALL DBER2(LU1,7777,6HXXXXXX,6HCKTHD ,2HAB)
      IF (IERR2 .EQ. 13) GO TO 9017 
      IF (IERR2 .EQ. 14) GO TO 9019 
      IF (IERR2 .LE. 19) GO TO 9020 
      CALL DBER2(LU1,7777,6HXXXXXX,6HCKTHD ,2HAB) 
C*************************************************
C************************************************ 
C ERROR HANDLING POINTS.
C 
C***********************************************************
C TAPE NOT SAVED BY PROPER PROGRAM. 
C 
9000  CONTINUE
      CALL REIO(2,LU1,40H TAPE POSITIONED WRONG OR NOT SAVED BY _,20) 
      CALL REIO(2,LU1,HDR,4)
      IERR=-212 
      CALL DBER2(LU1,IERR,6HXXXXXX,6HCKTHD ,2HXX) 
      RETURN
C***********************************************
C ROOT NAMRS DON'T AGREE. 
C 
9010  CALL REIO(2,LU1,27H INCORRECT ROOT FILE NAME._,-27) 
      IERR=-243 
      CALL DBER2(LU1,IERR,6HXXXXXX,6HCKTHD ,2HXX) 
      RETURN
C**************************************************** 
C BAD SECURITY CODE.
C 
9017  CONTINUE
      CALL REIO(2,LU1,19H BAD SECURITY CODE.,-19) 
      IERR=-213 
      CALL DBER2(LU1,IERR,6HXXXXXX,6HCKTHD ,2HXX) 
      RETURN
C*****************************************************
C BAD CARTRIDGE.
C 
9019  CONTINUE
      CALL REIO(2,LU1,15H BAD CARTRIDGE.,-15) 
      IERR=-244 
      CALL DBER2(LU1,IERR,6HXXXXXX,6HCKTHD ,2HXX) 
      RETURN
C********************************************** 
C LVLWD DOES NOT AGREE. 
9020  CALL REIO(2,LU1,16H BAD LEVEL WORD.,8)
      IERR=-211 
      CALL DBER2(LU1,IERR,6HXXXXXX,6HCKTHD ,2HXX) 
      RETURN
C************************************************************ 
C CHECK ITS THE RIGHT REEL NUMBER.
C 
9500  CONTINUE
      IF (HDR(21) .EQ. BUFR(21)) GO TO 9900 
      CALL CNUMD(BUFR(21),REEL1)
      CALL REIO(2,LU1,31H YOU INCORRECTLY MOUNTED REEL _,-31) 
      CALL REIO(2,LU1,REEL1,3)
      IERR=-242 
      CALL DBER2(LU1,IERR,6HXXXXXX,6HCKTHD ,2HXX) 
      RETURN
C*******************************************************
C EVERYTHING IS FINE. BUMP THE HEADER FOR THE NEXT REEL.
C 
9900  HDR(21)=HDR(21)+1 
      RETURN
      END 
                                                                                                                                                            