*
* $Id: epfhdr.F,v 1.1.1.1 1996/03/08 15:21:43 mclareni Exp $
*
* $Log: epfhdr.F,v $
* Revision 1.1.1.1  1996/03/08 15:21:43  mclareni
* Epio
*
*
#include "epio/pilot.h"
      SUBROUTINE EPFHDR(LUNIT,MLUSER,IHEAD,IBUF,IERR)
C. FAST LOGICAL RECORD HEADER READING ROUTINE.
C.
C. CONDITIONS FOR USE:
C. 1. 16 BIT UNITS ONLY (I.E. L.R.H. CONSISTS OF 16 BIT WORDS)
C. 2. NO SPANNED HEADERS
C. 3. ALWAYS MLUSER WORDS TRANSFERRED TO USER (WORD 3 IS HEADER LENGTH)
C.    THIS MAY EXCEPTIONALLY LEAD TO A PROGRAM RANGE ERROR IF THE INPUT
C.    BUFFER IBUF COINCIDES WITH THE END OF THE USER PROGRAM.
C.    REMEDY: INCREASE SIZE OF IBUF BY 16*MLUSER/(NO. OF BITS PER WORD)
C. 4. NO HEADERLESS BLOCKS
C. 5. NO OLD EP FORMAT
C. 6. NO UNKNOWN LENGTH RECORDS
C.
C. IN ADDITION, NO CHECKS PERFORMED WHETHER INPUT UNIT,
C. OR WHETHER HEADER CUT
C.
C. CONDITIONS 2. TO 6. ARE ALWAYS FULFILLED WHEN WRITING WITH EPIO,
C. CONDITION 1. IS DEFAULT WHEN WRITING WITH EPIO.
C.
C.--- INPUT
C.    LUNIT     USER UNIT NUMBER
C.    MLUNIT    NO. OF HEADER WORDS TRANSFERRED TO USER
C.--- I/O
C.    IBUF      USER BUFFER
C.--- OUTPUT
C.    IHEAD     MLUSER WORDS OF L.R.H. (REGARDLESS OF ACTUAL LENGTH OR
C.                OF STATUS WORD 26)
C.    IERR      ERROR NUMBER
C.
C. CALLS TO THIS ROUTINE ARE ENTIRELY COMPATIBLE WITH EPREAD CALLS
C.
#include "epio/epiocom.inc"
#if !defined(CERNLIB_F4)
      DIMENSION IHEAD(*)
#endif
#if defined(CERNLIB_F4)
      DIMENSION IHEAD(1)
#endif
#if defined(CERNLIB_VAX)||defined(CERNLIB_IBM)||defined(CERNLIB_APOLLO)
      INTEGER*2 IBUF(1),IW2(2)
      EQUIVALENCE (IW2(1),IW4)
#endif
#if defined(CERNLIB_CDC)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_NORD)||defined(CERNLIB_CRAY)||defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
      DIMENSION IBUF(1)
#endif
      DATA NEND/65535/
C--- CHECK WHETHER SAME USER UNIT AS LAST TIME
      IF(LASTUT.EQ.LUNIT)  GOTO 1552
C--- NEW UNIT - GET REF
      CALL EPUNIT(LUNIT,IERR)
      IF(IERR.NE.0)  GOTO 77777
 1552 IERR=0
      LPOS=LIST(ISTART+22)
C--- FOLLOWING POSSIBILITIES:
C    IF LPOS=0   THEN LIST(ISTART+23) = LAST DATA WORD OF PREVIOUS REC.
C    IF LPOS=1   THEN    -                -  HEADER -      -        -
C    IF LPOS=2   THEN LIST(ISTART+15) = OFFSET TO FIRST RECORD IN BLOCK
C                (WHICH MAY BE ZERO = NO RECORD STARTS IN THIS BLOCK)
C--- IF AT END OF BLOCK LAST TIME ROUND, READ NEW BLOCK
      IF(LIST(ISTART+14).EQ.0)  GOTO 20
      IP1=LIST(ISTART+23)
      IF(LPOS.NE.1)  GOTO 10
C--- IP1 POINTS TO END OF LAST HEADER - MOVE FORWARD (SKIP DATA)
      IP1=IP1+LIST(ISTART+20)-LIST(ISTART+21)
C--- READ IF OUTSIDE CURRENT BLOCK
      IF(IP1.LT.LIST(ISTART+14))  GOTO 30
      GOTO 20
   10 CONTINUE
C--- USE OFFSET IF AFTER BLOCK SKIP
      IF(LPOS.EQ.2)  IP1=LIST(ISTART+15)
      IF(IP1.NE.0) GOTO 30
   20 CONTINUE
C--- READ NEW BLOCK
      CALL EPBLIN(IBUF,IERR)
      IF(IERR.NE.0)  GOTO 9999
C--- CHECK WHETHER RECORD STARTS IN THIS BLOCK
      IP1=LIST(ISTART+15)
      IF(IP1.EQ.0)  GOTO 20
   30 CONTINUE
C--- WORK DONE - IP1 POINTS TO HEADER-1
#if defined(CERNLIB_CDC)||defined(CERNLIB_UNIVAC)||defined(CERNLIB_NORD)||defined(CERNLIB_CRAY)||defined(CERNLIB_STF77)||defined(CERNLIB_STF77VX)
      CALL BLO16W(IBUF,IP1+1,IHEAD,1,MLUSER)
#endif
#if defined(CERNLIB_IBM)||defined(CERNLIB_APOLLO)
      IW4=0
      DO 40 I=1,MLUSER
      IW2(2)=IBUF(IP1+I)
  40  IHEAD(I)=IW4
#endif
#if defined(CERNLIB_VAX)
      IW4=0
      DO 40 I=1,MLUSER
      IW2(1)=IBUF(IP1+I)
  40  IHEAD(I)=IW4
#endif
C--- CHECK WHETHER END-OF-DAT-IN-BLOCK INDICATOR RATHER THAN HEADER
      IF(IHEAD(1).EQ.NEND)GO TO 20
C--- CHECK FOR END-OF-RUN INDICATOR  (IHEAD(1)=0)
      IF(IHEAD(1).NE.0)  GOTO 50
      LIST(ISTART+14)=0
      IERR=10
      GOTO 9999
   50 CONTINUE
      IP1=IP1+IHEAD(3)
C--- FILL STATUS WORDS
      LIST(ISTART+12)=LIST(ISTART+12)+1
      LIST(ISTART+20)=IHEAD(1)
      LIST(ISTART+21)=IHEAD(3)
      LIST(ISTART+22)=1
      LIST(ISTART+23)=IP1
      IF(IP1.EQ.LIST(ISTART+14))  LIST(ISTART+14)=0
77777 RETURN
 9999 CALL EPERRH(LUNIT,IERR)
      GOTO 77777
      END