FTN4 SUBROUTINE CKFHD(LU1,TAPE,BUFR,BUFSZ,NAMR,ISIZE,JREC,ITYPE,IERR) +,92069-16206 REV.2013 790511 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-18206 C RELOC: 92069-16206 C C C****************************************************************: C C C**************************************************** C CKFHD DOES THE FOLLOWING: C 1) READS ONE RECORD FROM TAPE. C 2) VERIFIES THAT ITS A FILEHEAD. C 3) IF NOT, GIVES NEGATIVE ERROR RETURN. C 4) IF SO,PUTS INFORMATION INTO NAMR,ISIZE,JREC,AND ITYPE AND RETURNS. C**************************************************** INTEGER LU1,TAPE,BUFR(1),BUFSZ,NAMR(1),ISIZE(1),JREC,ITYPE,IERR LOGICAL EOF COMPLEX S(6) DATA S/8HFILEHEAD,8H21XX ,4*8H / C**************************************************************** C CALL TAPER(LU1,TAPE,BUFR,BUFSZ,LEN,EOF,IERR) IF (IERR .LT. 0) RETURN C********************************************************* C MAKE SURE THE BUFR JUST READ CONTAINS A FILEHEAD. C CALL COMP(LU1,BUFR,S,8,IERR) IF (IERR .LT. 0) GO TO 9000 C********************************************************** C HAVE A VALID FILEHEAD, TRANSFER DATA FROM BUFR INTO PARAMETERS C PASSED IN AND RETURN. C DO 10 J=1,6 NAMR(J)=BUFR(J+8) 10 CONTINUE JREC=BUFR(19) ITYPE=BUFR(20) ISIZE(1)=BUFR(21) ISIZE(2)=BUFR(22) IERR=0 RETURN C************************************************************ C ERROR: THIS IS NOT A FILEHEAD. WRITE MESSAGE AND LEAVE C NEGATIVE ERROR AND RETURN. C 9000 CONTINUE CALL REIO(2,LU1,18H BAD HEADER RECORD,-18) IERR=-7777 CALL DBER2(LU1,IERR,6HXXXXXX,6HCKFHD ,2HXX) RETURN END