MINICERN/packlib/zebra/fq/fzhook.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 10:47:11  mclareni
   6 * Zebra
   7 *
   8 *
   9 #include "zebra/pilot.h"
  10 #if defined(CERNLIB_FZCHANNEL)
  11       SUBROUTINE FZHOOK (LUNP,TARGET,BUF)
  12
  13 C-    Connect user routine TARGET for Channel mode, User called
  14
  15 #include "zebra/zunit.inc"
  16 #include "zebra/mqsys.inc"
  17 #include "zebra/eqlqf.inc"
  18 #include "zebra/fzci.inc"
  19 #include "zebra/fzcx.inc"
  20 #include "zebra/fzcf.inc"
  21 C--------------    End CDE                             --------------
  22       DIMENSION    LUNP(9), BUF(9)
  23       EXTERNAL     TARGET
  24
  25 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  26       DIMENSION    NAMESR(2)
  27       DATA  NAMESR / 4HFZHO, 4HOK   /
  28 #endif
  29 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  30       DATA  NAMESR / 6HFZHOOK /
  31 #endif
  32 #if !defined(CERNLIB_QTRHOLL)
  33       CHARACTER    NAMESR*8
  34       PARAMETER   (NAMESR = 'FZHOOK  ')
  35 #endif
  36
  37 *     quick trace without test on capacity
  38 #include "zebra/qtraceq.inc"
  39
  40       LUN   = LUNP(1)
  41
  42       CALL FZLOC (LUN,0)
  43       IF (LUNF.EQ.0)    LOGLVF=1
  44       IF (IACMOF.NE.3)  LOGLVF=1
  45
  46 #if defined(CERNLIB_QPRINT)
  47       IF (LOGLVF.GE.1)   WRITE (IQLOG,9024) LUN
  48  9024 FORMAT (1X/' FZHOOK.  Connect user routine for LUN=',I3)
  49
  50 #endif
  51       IF (LUNF.EQ.0)               GO TO 91
  52       IF (IACMOF.NE.3)             GO TO 92
  53
  54       IQUEST(2) = JUMPAD (TARGET)
  55       IQ(KQSP+LQFF+1) = IQUEST(2)
  56       IF (LUNF.EQ.LUNI)  IADOPI = IQUEST(2)
  57       IF (LUNF.EQ.LUNX)  IADOPX = IQUEST(2)
  58       GO TO 999
  59
  60 C-------------------------------------------------
  61 C-                 Error handling
  62 C-------------------------------------------------
  63
  64    91 IQUEST(1) = 1
  65       CALL ZFATAM ('FZHOOK - Stream not existing.')
  66
  67    92 IQUEST(1) = 2
  68       CALL ZFATAM ('FZHOOK - Stream not ready for Channel mode.')
  69
  70 #include "zebra/qtrace99.inc"
  71       RETURN
  72       END
  73 *      ==================================================
  74 #include "zebra/qcardl.inc"
  75 #endif