MINICERN/packlib/zebra/rz/rzobkn.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 10:47:25  mclareni
   6 * Zebra
   7 *
   8 *
   9 #include "zebra/pilot.h"
  10       SUBROUTINE RZOBKN
  11 *
  12 ************************************************************************
  13 *
  14 *      RZ internal routine to write data according to internal table
  15 *      previously built by FZOTAB
  16 *
  17 * Called by RZOUT
  18 *
  19 *  Author  : J.Zoll,R.Brun,B.Holl
  20 *  Written : 03.05.86
  21 *  Last mod: 25.06.93 JDS Add IEVENT to RZWRT calls
  22 *
  23 ************************************************************************
  24 #include "zebra/mqsys.inc"
  25 #include "zebra/mzct.inc"
  26 #include "zebra/mzcn.inc"
  27 #include "zebra/mzioc.inc"
  28 #include "zebra/fzcx.inc"
  29 #include "zebra/rzclun.inc"
  30 *
  31 *-----------------------------------------------------------------------
  32 *
  33 *     New event
  34 *
  35       IEVENT = 0
  36 *
  37 *         Write NWTABX,NWBKX,LENTRX
  38 *
  39 #if !defined(CERNLIB_FQXISN)
  40       IF(IMODEX.GT.0)THEN
  41          MFO(1) = 1
  42          MFO(2) = -1
  43          JFOEND = 2
  44       ENDIF
  45 #endif
  46       CALL RZWRT(NWTABX,3,0,IEVENT)
  47       IF(IQUEST(1).NE.0) GO TO 99
  48 *
  49 *     Event continued
  50 *
  51       IEVENT = 1
  52 *
  53 *         Write memory description table
  54 *
  55       IF(NWTABX.GT.0)THEN
  56          CALL RZWRT(LQ(LQTA),NWTABX,0,IEVENT)
  57          IF(IQUEST(1).NE.0) GO TO 99
  58       ENDIF
  59 *
  60 *         Write bank material
  61 *
  62       LTB = LQTA
  63   10  L   = LQ(LTB)
  64       LE  = LQ(LTB+1)
  65 #if !defined(CERNLIB_FQXISN)
  66       IF(IMODEX.LE.0)GO TO 50
  67 *
  68 *        in eXchange format
  69 *
  70   20  IQLN= L
  71       IWD = LQ(KQS+L)
  72       NST = JBYT(IWD,1,16) - 12
  73       IF(NST.LT.0)GO TO 40
  74 *
  75 *         True bank
  76 *
  77       IQLS  = L + NST + 1
  78       IQNIO = JBYT(IQ(KQS+IQLS),19,4)
  79       IQNL  = IQ(KQS+IQLS-3)
  80       IQND  = IQ(KQS+IQLS-1)
  81       IQNX  = IQLS + IQND + 9
  82 *
  83 *         First word, I/O words, links, next-link, up-link
  84 *
  85       N = IQNIO + IQNL
  86       MFO(1) = 1
  87       MFO(2) = N + 3
  88       MFO(3) = 2
  89       MFO(4) = 2
  90       MFO(5) = 5
  91       MFO(6) = 1
  92       MFO(7) = 1
  93       MFO(8) = -1
  94       JFOEND = 8
  95       CALL RZWRT(LQ(KQS+L),N+10,0,IEVENT)
  96       IF(IQUEST(1).NE.0) GO TO 99
  97 *
  98 *         Data words
  99 *
 100       IF( IQND .NE. 0 ) THEN
 101          CALL MZIOCR(LQ(KQS+IQLN))
 102          IF(IQUEST(1).LT.0)GO TO 99
 103          IQUEST(1)=0
 104          CALL RZWRT(IQ(KQS+IQLS+1),IQND,0,IEVENT)
 105          IF(IQUEST(1).NE.0) GO TO 99
 106       ENDIF
 107    30 L = IQNX
 108       IF(L.LT.LE) GO TO 20
 109       LTB = LTB + 2
 110       IF(LTB.LT.LQTE) GO TO 10
 111       GO TO 99
 112 *
 113 *         Short dead region
 114 *
 115    40 NWD = NST + 12
 116       IQNX= L + NWD
 117       GO TO 30
 118 #endif
 119 *
 120 *         in Native mode
 121 *
 122    50 N = LE - L
 123       IF(N.GT.0)THEN
 124          CALL RZWRT(LQ(KQS+L),N,0,IEVENT)
 125          IF(IQUEST(1).NE.0) GO TO 99
 126       ENDIF
 127       LTB = LTB + 2
 128       IF(LTB.LT.LQTE)GO TO 10
 129 *
 130    99 RETURN
 131       END