MINICERN/packlib/zebra/mq/mzbook.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:11:17  mclareni
   6 * Incorporate changes from J.Zoll for version 3.77
   7 *
   8 * Revision 1.1.1.1  1996/03/06 10:47:18  mclareni
   9 * Zebra
  10 *
  11 *
  12 #include "zebra/pilot.h"
  13       SUBROUTINE MZBOOK (IXP,LP,LSUPP,JBP, CHIDH,NL,NS,ND,NIOP,NZP)
  14
  15 C-    Book a bank, user called
  16
  17 #include "zebra/zbcd.inc"
  18 #include "zebra/mqsys.inc"
  19 #include "zebra/mzcl.inc"
  20 C--------------    End CDE                             --------------
  21       DIMENSION    IXP(9),LP(9),LSUPP(9),JBP(9),NIOP(9),NZP(9)
  22       CHARACTER    CHIDH*(*)
  23 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  24       DIMENSION    NAMESR(2)
  25       DATA  NAMESR / 4HMZBO, 4HOK   /
  26 #endif
  27 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  28       DATA  NAMESR / 6HMZBOOK /
  29 #endif
  30 #if !defined(CERNLIB_QTRHOLL)
  31       CHARACTER    NAMESR*8
  32       PARAMETER   (NAMESR = 'MZBOOK  ')
  33 #endif
  34
  35 #include "zebra/q_jbyt.inc"
  36
  37 #include "zebra/qtrace.inc"
  38
  39       NQID = IQQUES
  40       NIO  = MIN (4, LEN(CHIDH))
  41       IF  (NIO.NE.0)  CALL UCTOH (CHIDH,NQID,4,NIO)
  42       NQNL  = NL
  43       NQNS  = NS
  44       NQND  = ND
  45       NQBIA = JBP(1)
  46
  47       IODORG = NIOP(1)
  48       NIO = JBYT (IODORG,12,4)
  49
  50       IF (NIO.EQ.0)  THEN
  51           NQIOCH(1) = IODORG
  52         ELSE
  53           CALL UCOPY (NIOP,NQIOCH,NIO+1)
  54           NQIOSV(1) = 0
  55         ENDIF
  56
  57       CALL MZLIFT (IXP,LP,LSUPP,63, NQID, NZP)
  58
  59 #include "zebra/qtrace99.inc"
  60       RETURN
  61       END
  62 *      ==================================================
  63 #include "zebra/qcardl.inc"