*
* $Id: epfrd.F,v 1.1.1.1 1996/03/08 15:21:43 mclareni Exp $
*
* $Log: epfrd.F,v $
* Revision 1.1.1.1  1996/03/08 15:21:43  mclareni
* Epio
*
*
#include "epio/pilot.h"
      SUBROUTINE EPFRD(LUNIT,MODE,NW,IREC,IBUF,IERR)
C. FAST LOGICAL RECORD DATA 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 HEADERLESS BLOCKS
C. 3. NO OLD EP FORMAT
C. 4. NO UNKNOWN LENGTH RECORDS
C. 5. MODES 11, 12, 13 ONLY (OTHERWISE ERROR 8)
C.
C. IN ADDITION, NO CHECKS PERFORMED WHETHER INPUT UNIT
C.
C. CONDITIONS 2. TO 4. ARE ALWAYS FULFILLED WHEN WRITING WITH EPIO,
C. CONDITION 1. IS DEFAULT WHEN WRITING WITH EPIO.
C.
C. USER DATA WILL BE TRUNCATED AT VALUE IN STATUS WORD 2, BUT NO ERROR
C. WILL BE SIGNALLED.
C.
C.--- INPUT
C.    LUNIT     USER UNIT NUMBER
C.    MODE      ONE OF 11, 12, 13 (SEE EPREAD)
C.--- I/O
C.    IBUF      USER BUFFER
C.--- OUTPUT
C.    NW        NO. OF WORDS IN IREC
C.    IREC      RECORD TRANSFERRED TO USER
C.    IERR      ERROR NUMBER
C.
C. CALLS TO THIS ROUTINE ARE ENTIRELY COMPATIBLE WITH EPREAD CALLS
C.
#include "epio/epiocom.inc"
      DIMENSION IBUF(1),IREC(1)
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
      NW=0
      L32=0
      IF(MODE.LT.11.OR.MODE.GT.13)  GOTO 9901
      ICOM=MODE-10
      LPOS=LIST(ISTART+22)
      IF(LPOS.NE.1)  GOTO 9902
      IP1=LIST(ISTART+23)
C-- MAX. NO OF 16 BIT WORDS TO USER RECORD
      MLUSER=LIST(ISTART+2)
      IF(ICOM.EQ.1)  MLUSER=MLUSER*LIST(4)/16
      IF(ICOM.EQ.3)  MLUSER=2*MLUSER
C--- TOTAL NO. OF 16 BIT WORDS IN DATA PART
      NWDS=LIST(ISTART+20)-LIST(ISTART+21)
C--- NO. OF 16 BIT WORDS IN BLOCK
      NP=LIST(ISTART+14)
      IF(NP.NE.0)  GOTO 20
C--- READ NEW BLOCK
   10 CONTINUE
      CALL EPBLIN(IBUF,IERR)
      IF(IERR.NE.0)  GOTO 9999
      IP1=LIST(ISTART+7)
      NP=LIST(ISTART+14)
   20 CONTINUE
C--- NO. OF 16 BIT WORDS OF DATA PART IN THIS BLOCK
      NLT=MIN0(NWDS,NP-IP1)
C--- TOTAL NO. OF 16 BIT WORDS TO GO TO USER RECORD
      NUT=MIN0(NLT,MLUSER-NW)
      IF(NUT.LE.0)  GOTO 40
C--- TRANSFER ACCORDING TO MODE
      IF(MODE.EQ.13)GO TO 33
      IF(MODE.EQ.12)GO TO 32
C--- BIT STRING
      CALL W16MOV(IBUF,IP1+1,IREC,NW+1,NUT)
      GOTO 35
   32 CONTINUE
C--- 16 BIT WORDS
      CALL BLO16W(IBUF,IP1+1,IREC,NW+1,NUT)
      GOTO 35
   33 CONTINUE
C--- 32 BIT WORDS
      IF(L32.EQ.0)  GOTO 34
C--- GET SECOND HALF OF SPLIT 32 BIT WORD
      CALL W16MOV(IBUF,IP1+1,KEEP,2,1)
      NW=NW+1
      CALL BLO32W(KEEP,1,IREC,NW,1)
      IP1=IP1+1
      NLT=NLT-1
      NWDS=NWDS-1
      L32=0
   34 CONTINUE
C--- 32 BIT WORDS
      NUT=MIN0(NLT/2,MLUSER-NW)
      IF(NWDS.LE.NLT)NUT=MIN0((NLT+1)/2,MLUSER-NW)
      CALL BLO32W(IBUF,IP1+1,IREC,NW+1,NUT)
      IF(MOD(NLT,2).EQ.0)  GOTO 35
C--- KEEP FIRST HALF OF SPLIT 32 BIT WORD
      L32=1
      CALL W16MOV(IBUF,NP,KEEP,1,1)
   35 CONTINUE
C--- UPDATE POINTER IN IREC
      NW=NW+NUT
   40 CONTINUE
C--- UPDATE POINTERS IN IBUF
      IP1=IP1+NLT
      NWDS=NWDS-NLT
      IF(NWDS.GT.0)  GOTO 10
C--- RECORD FINISHED - UPDATE STATUS WORDS
      IF(IP1.EQ.NP)  LIST(ISTART+14)=0
      LIST(ISTART+22)=0
      LIST(ISTART+23)=IP1
77777 RETURN
 9901 CONTINUE
C--- INVALID MODE IN CALL
      IERR=8
      GOTO 9999
 9902 CONTINUE
C--- ATTEMPT TO READ DATA BEFORE HEADER
      IERR=9
 9999 CALL EPERRH(LUNIT,IERR)
      GOTO 77777
      END