Bugfix in AliPoints2Memory

[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / fq / fzichh.F

*
* $Id$
*
* $Log$
* Revision 1.2  1996/04/18 16:10:28  mclareni
* Incorporate changes from J.Zoll for version 3.77
*
* Revision 1.1.1.1  1996/03/06 10:47:10  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
      SUBROUTINE FZICHH (IOMODE,MREC,IHOW)

C-    Check physical block header in MREC

C-     in :  IHOW = 1  fast block expected
C-                  0  steering block expected
C-                 -1  scanning for next steering block
C-                 -2  steering block expected when starting

C-    out :  IRETN in IQUEST(1)
C-           IRETN = 0  as expected
C-                   1  trouble
C-                   3  steering block ok, but with wrong length
C-                   4  end-of-file reached (only IBM just now)


#include "zebra/zunit.inc"
#include "zebra/quest.inc"
#include "zebra/fzcx.inc"
#include "zebra/fzci.inc"
#include "fzhci.inc"
C--------------    End CDE                             --------------
      DIMENSION    MREC(8)
#include "fzstamp.inc"
#include "fzntolds.inc"
#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBMD)
C     PARAMETER   (MASK   = Z FF000000)
      PARAMETER   (MASK   =  -16777216)
#endif

#include "zebra/q_jbyt.inc"


      IRETN = 0
      CALL UCOPY (MREC,MPHRI,8)
      JMODI = JBYT(MPHRI(5),30,3)
      NWRI  = JBYT(MPHRI(5),1,28)
      IF (MPHRI(1) .NE. MCCW1)     GO TO 71
      IF (MPHRI(2) .NE. MCCW2)     GO TO 71
      IF (MPHRI(3) .NE. MCCW3)     GO TO 71
      IF (MPHRI(4) .NE. MCCW4)     GO TO 71
      IF (JMODI.GE.5)              GO TO 71
      IF (JMODI.EQ.3)              GO TO 71
      IF (NWRI.GE.NTOLDS)          GO TO 71

      IF (JRECI.LT.0)              GO TO 71
      IF (NTLRI.LT.0)              GO TO 71
      IF (NTLRI.GT.NWRI)           GO TO 71
      IF (NFSTI.LT.0)              GO TO 71
      IF (NFSTI.GE.16384)          GO TO 71
      IF (IOMODE.NE.0)             GO TO 26
      IF (NFSTI*MAXREI.GT.NTOLDS)  GO TO 71
      IF (NWRI.NE.MAXREI)          GO TO 61

   26 IF (IHOW.GT.0)               GO TO 41
   27 IQUEST(1) = IRETN
      RETURN

C----              Unexpected steering block

   41 IRETN = 1
      GO TO 27

C----              Steering block of unexpected length

   61 IF (IHOW.LE.0)  IRETN = 3
      GO TO 27

C----              Not a steering block

   71 IF (IHOW.GT.0)               GO TO 27
#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMIBMD)

C----     IBM :  detect end-of-file on direct-access file if :
C--                1) file-format D
C--                2) just after Zebra EoF
C--                3) record starts with FF000000, rest zero

      IF (IOMODE.NE.0)             GO TO 74
      IF (IFIFOI.NE.2)             GO TO 74
      IF (IACTVI.NE.4)             GO TO 74
      IF (MPHRI(1).NE.MASK)        GO TO 74
      DO 73  J=2,8
      IF (MREC(J).NE.0)            GO TO 74
   73 CONTINUE
      IRETN = 4
      GO TO 27

#endif
   74 IRETN = 1
#if defined(CERNLIB_QPRINT)
      IF (IHOW.EQ.-1)              GO TO 27
      IF (LOGLVI.LT.-1)            GO TO 27
      LUN = LUNI
      IF (IOMODE.NE.0)  LUN = LUNX
      IQUEST(1) = MCCW1
      IQUEST(2) = MCCW2
      IQUEST(3) = MCCW3
      IQUEST(4) = MCCW4
      CALL UCOPY (MPHRI,  IQUEST(5), 8)
      IQUEST(13) = NWRI
      CALL UCOPY (JRECI,  IQUEST(14),3)
      WRITE (IQLOG,9801) LUN,(IQUEST(J),J=1,16)
 9801 FORMAT (1X/' FZIPHx.  LUN=',I4,', Error 201, dump Block Header :'
#endif
#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))&&(defined(CERNLIB_B60M))
     F/4X,'Must be:',4O23
     F/4X,'Oct 1-4:',4O23/8X,'5-8:',4O23/4X,'Dec 5-8:',4I23)
#endif
#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))&&(!defined(CERNLIB_B60M))
     F/4X,'Must be:',4O17
     F/4X,'Oct 1-4:',4O17/8X,'5-8:',4O17/4X,'Dec 5-8:',4I17)
#endif
#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))
     F/4X,'Must be:',4Z17
     F/4X,'Hex 1-4:',4Z17/8X,'5-8:',4Z17/4X,'Dec 5-8:',4I17)
#endif
      GO TO 27
      END