MINICERN/packlib/zebra/rz/rzins.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:55  mclareni
   6 * Extend the include file cleanup to dzebra, rz and tq, and also add
   7 * dependencies in some cases.
   8 *
   9 * Revision 1.1.1.1  1996/03/06 10:47:24  mclareni
  10 * Zebra
  11 *
  12 *
  13 #include "zebra/pilot.h"
  14       SUBROUTINE RZINS(IXDIVP,LSUPP,JBIASP,LBANK)
  15 *
  16 ************************************************************************
  17 *
  18 *         To read a data structure and make relocation
  19 *
  20 * Called by RZIN
  21 *
  22 *  Author  : J.Zoll/R.Brun/B.Holl
  23 *  Written : 09.05.86
  24 *  Last mod: 20.01.93 RB bug fix in call to MZIOCR
  25 *
  26 ************************************************************************
  27 #include "zebra/zmach.inc"
  28 #include "zebra/mqsys.inc"
  29 #include "zebra/mzct.inc"
  30 #include "zebra/mzioc.inc"
  31 #include "zebra/mzcn.inc"
  32 #include "zebra/fzci.inc"
  33 #include "zebra/fzcseg.inc"
  34 #include "zebra/fzcocc.inc"
  35 #include "zebra/rzclun.inc"
  36       DIMENSION    IXDIVP(9),LSUPP(9),JBIASP(9),IDUM(3)
  37       EQUIVALENCE (IOPTR,IQUEST(95))
  38 *
  39 *-----------------------------------------------------------------------
  40 *
  41
  42 #if !defined(CERNLIB_FQXISN)
  43 #include "zebra/q_jbyt.inc"
  44 #endif
  45
  46       IXDIVI = IXDIVP(1)
  47       JRETCD = 0
  48       JERROR = 0
  49       NQOCC  = 0
  50       NQSEG  = 0
  51 *
  52 *            Read header
  53 *
  54       CALL RZREAD(NWTABI,3,1,1)
  55       IF(IQUEST(1).NE.0) GO TO 99
  56       NWIOI  = 0
  57       NWUHI  = 0
  58       NWUHCI = 0
  59       NWUMXI = 0
  60       NWTXI  = 0
  61       NWSEGI = 0
  62 *
  63 *            Get store / divison
  64 *
  65       CALL MZSDIV(IXDIVI,7)
  66       IF(JQDIVI.EQ.0) JQDIVI=2
  67 *
  68       IF(LBANK.NE.0.AND.IOPTR.NE.0)THEN
  69          NLINK=IQ(KQS+LBANK-3)
  70          NWK  =NWBKI-10-NLINK
  71          IF(IQ(KQS+LBANK-1).LT.NWK)GO TO 91
  72 #if !defined(CERNLIB_FQXISN)
  73          IF(IMODEX.GT.0)THEN
  74             CALL MZIOCR(LQ(KQS+LBANK-NLINK-1))
  75             IF(IQUEST(1).LT.0)GO TO 99
  76             IQUEST(1)=0
  77          ENDIF
  78 #endif
  79          CALL RZREAD(IQ(KQS+LBANK+1),NWK,NWTABI+14+NLINK,0)
  80          GO TO 99
  81       ENDIF
  82 *
  83 *            Read memory occupation table
  84 *
  85       LQSYSR(KQT+1)=LSUPP(1)
  86       CALL FZIMTB
  87       IF(JRETCD.EQ.3)GO TO 91
  88       CALL RZREAD(LQ(LQTA+NWTABI),NWTABI,4,1)
  89       IF(IQUEST(1).NE.0) GO TO 99
  90 *
  91 *            Read the data
  92 *
  93       LSTA = LQ(LQMTA+3)
  94       LEND = LQ(LQMTA+4)
  95 #if !defined(CERNLIB_FQXISN)
  96       IF(IMODEX.LE.0)GO TO 30
  97 *
  98 *            in eXchange mode
  99 *
 100       LIN = LSTA
 101       NWR = NWTABI+4
 102    10 CONTINUE
 103       CALL RZREAD(LQ(KQS+LIN),1,NWR,1)
 104       IF(IQUEST(1).NE.0)GO TO 99
 105       NWR   = NWR+1
 106       IWD   = LQ(KQS+LIN)
 107       NST   = JBYT(IWD,1,16)-12
 108       IF(NST.LT.0)GO TO 20
 109 *
 110 *            True bank
 111 *
 112       IQLN = LIN
 113       IQLS = LIN + NST + 1
 114       IF(IQLS+8.GE.LEND)GO TO 92
 115       MFO(1) =  1
 116       MFO(2) =  NST + 2
 117       MFO(3) =  2
 118       MFO(4) =  2
 119       MFO(5) =  5
 120       MFO(6) =  1
 121       MFO(7) =  1
 122       MFO(8) = -1
 123       JFOEND =  8
 124       NWFOTT = NST+9
 125       NWFODN = 0
 126       CALL RZREAD(LQ(KQS+LIN+1),NST+9,NWR,0)
 127       IF(IQUEST(1).NE.0)GO TO 99
 128       NWR    = NWR+NST+9
 129       IQNIO  = JBYT(IQ(KQS+IQLS),19,4)
 130       IQNL   = IQ(KQS+IQLS-3)
 131       IQND   = IQ(KQS+IQLS-1)
 132       IF(IQNIO+IQNL.NE.NST)GO TO 92
 133       LIN    = IQLS + IQND + 9
 134       IF(IQND.GT.0)THEN
 135          IF(LIN.GT.LEND)GO TO 92
 136          CALL MZIOCR(LQ(KQS+IQLN))
 137          IF(IQUEST(1).LT.0)GO TO 99
 138          IQUEST(1)=0
 139          CALL RZREAD(IQ(KQS+IQLS+1),IQND,NWR,0)
 140          IF(IQUEST(1).NE.0)GO TO 99
 141          NWR = NWR+IQND
 142       ENDIF
 143       IF(LIN.LT.LEND)GO TO 10
 144       GO TO 40
 145 *
 146 *            Short dead region
 147 *
 148    20 NWD = JBYT(IWD,17,IQDROP-17)
 149       IF(NWD.EQ.0.OR.NWD.NE.NST+12)GO TO 92
 150       IF(JBYT(IWD,IQDROP,IQBITW-IQDROP).NE.1)GO TO 92
 151       LIN = LIN + NWD
 152       IF(LIN.LT.LEND)GO TO 10
 153       GO TO 40
 154 #endif
 155 *
 156 *            in native mode
 157 *
 158    30 NWR = LEND - LSTA
 159       CALL RZREAD(LQ(KQS+LSTA),NWR,NWTABI+4,0)
 160       IF(IQUEST(1).NE.0) GO TO 99
 161
 162 *
 163 *            Relocation
 164 *
 165    40 CONTINUE
 166       CALL FZIREL
 167       IF(JRETCD.NE.0)GO TO 93
 168 *
 169 *            Link structure and return
 170 *
 171       JB=JBIASP(1)
 172       IF(JB.GE.2)THEN
 173          LSUPP(1)=LENTRI
 174       ELSE
 175          LSUPP(1)=LQSYSR(KQT+1)
 176          CALL ZSHUNT(IXDIVI,LENTRI,LSUPP,JB,1)
 177       ENDIF
 178 *
 179       IQUEST(1)  = 0
 180       IQUEST(11) = IEVFLI
 181       IQUEST(12) = 0
 182       IQUEST(13) = LENTRI
 183       IQUEST(14) = NWBKI
 184       GO TO 99
 185 *
 186 *            Not enough space
 187 *
 188
 189    91 IQUEST(11)= -2
 190       IQUEST(1) =  1
 191       GO TO 99
 192 *
 193 *            Inconsistent bank material
 194 *
 195    92 IQUEST(11)= -3
 196       IQUEST(1) =  1
 197       GO TO 99
 198 *
 199 *            Bad data
 200 *
 201
 202    93 IQUEST(11)= -3
 203       IQUEST(1) =  1
 204
 205    99 RETURN
 206       END