MINICERN/packlib/zebra/fq/fzotab.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:10:50  mclareni
   6 * Incorporate changes from J.Zoll for version 3.77
   7 *
   8 * Revision 1.1.1.1  1996/03/06 10:47:14  mclareni
   9 * Zebra
  10 *
  11 *
  12 #include "zebra/pilot.h"
  13       SUBROUTINE FZOTAB
  14
  15 C-    Construct table of material to be output,
  16 C-    called from FZOUT, RZOUT, MZCOPY
  17
  18 #include "zebra/zlimit.inc"
  19 #include "zebra/mqsys.inc"
  20 #include "zebra/eqlqf.inc"
  21 #include "zebra/mzcn.inc"
  22 #include "zebra/mzct.inc"
  23 #include "zebra/fzcx.inc"
  24 #include "zebra/fzcseg.inc"
  25 C--------------    End CDE                             --------------
  26       EQUIVALENCE (LMT,LQMTB), (LS,IQLS), (LNX,IQNX)
  27 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  28       DIMENSION    NAMESR(2)
  29       DATA  NAMESR / 4HFZOT, 4HAB   /
  30 #endif
  31 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  32       DATA  NAMESR / 6HFZOTAB /
  33 #endif
  34 #if !defined(CERNLIB_QTRHOLL)
  35       CHARACTER    NAMESR*8
  36       PARAMETER   (NAMESR = 'FZOTAB  ')
  37 #endif
  38
  39 #include "zebra/q_jbit.inc"
  40 #include "zebra/q_jbyt.inc"
  41 #include "zebra/q_sbit0.inc"
  42
  43
  44 #include "zebra/qtrace.inc"
  45
  46   101 MQDVGA = 0
  47       MQDVWI = 0
  48       NWBKX  = 0
  49       NQSEG  = 0
  50
  51       IF (MODTBX.NE.0)  THEN
  52           NSTEP = 4
  53         ELSE
  54           NSTEP = 2
  55         ENDIF
  56
  57       CALL MZCHLS (-7,LENTRX)
  58       IF (IQFOUL.NE.0)                    GO TO 911
  59       IF (JBIT(IQ(KQS+LENTRX),IQDROP).NE.0)  GO TO 911
  60
  61       IF (IOPTXD.NE.0)             GO TO 301
  62       IF (IOPTXS.EQ.0)             GO TO 201
  63
  64 C----              Single bank output
  65
  66       CALL MZTABM
  67       LQTE = LQTA + NSTEP
  68
  69       LQ(LQTA)   = IQLN
  70       LQ(LQTA+1) = IQNX
  71       NWBKX      = IQNX - IQLN
  72
  73       IOPTXL = 0
  74       IOPTXD = 0
  75       GO TO 361
  76
  77 C-------------------------------------------------
  78 C-                 d/s defined by LENTRX
  79 C-------------------------------------------------
  80
  81   201 IF (IOPTXM.EQ.0)  THEN
  82           IF (IOPTXL.EQ.0)  THEN
  83               CALL MZMARK (IXDIVX,LENTRX,'.',0,0)
  84             ELSE
  85               CALL MZMARK (IXDIVX,LENTRX,'L',0,0)
  86             ENDIF
  87         ENDIF
  88
  89       LIMLOW = LQLIML - IQ(KQS+LQLIML-3) - JBYT(IQ(KQS+LQLIML),19,4) - 1
  90       LIMHI  = LQLIMH + IQ(KQS+LQLIMH-1) + 9
  91
  92 C----              Memory occupation table
  93
  94       CALL MZTABM
  95
  96 C--                First division concerned
  97
  98   226 IF (LIMLOW.LT.LQ(LQMTA+4))   GO TO 227
  99       LQMTA = LQMTA + 8
 100       GO TO 226
 101
 102 C--                Last division concerned
 103
 104   227 LMT = LQMTA
 105       LQ(LMT+3) = LIMLOW
 106   228 IF (LIMHI.LE.LQ(LMT+4))      GO TO 229
 107       LMT = LMT + 8
 108       GO TO 228
 109
 110   229 LQ(LMT+4) = LIMHI
 111       LQMTE = LMT + 8
 112
 113 C----              Relocation table
 114
 115       LMT   = LQMTA
 116
 117 C--                Next division
 118
 119   232 IF (LQ(LMT+1).LT.0)          GO TO 249
 120       NWDIV  = 0
 121       JDIV   = LQ(LMT)
 122       LNX    = LQ(LMT+3)
 123       LQMTC2 = LQ(LMT+4)
 124       NEW = 0
 125
 126 C--                Next bank
 127
 128   234 MODE = NEW
 129   235 LN   = LNX
 130       IF (LN.GE.LQMTC2)            GO TO 247
 131 #if defined(CERNLIB_QDEBUG)
 132       CALL MZCHLN (-7,LN)
 133       IF (IQFOUL.NE.0)             GO TO 912
 134 #endif
 135 #if !defined(CERNLIB_QDEBUG)
 136       NST = JBYT(LQ(KQS+LN),1,16) - 11
 137       IF (NST.GT.0)  THEN
 138           LS  = LN + NST
 139           LNX = LS + IQ(KQS+LS-1) + 9
 140         ELSE
 141           LS  = LN - 8
 142           LNX = LN + NST + 11
 143         ENDIF
 144 #endif
 145       NEW = JBIT(IQ(KQS+LS),IQMARK)
 146       IF (NEW.EQ.1)  IQ(KQS+LS)= MSBIT0 (IQ(KQS+LS),IQMARK)
 147       IF (NEW.EQ.MODE)             GO TO 235
 148       IF (NEW.EQ.0)                GO TO 244
 149
 150 C--                Start of a live group
 151
 152       LQ(LQTE) = LN
 153       IF (LQTE.LT.LQRTE)           GO TO 234
 154       CALL MZTABH
 155       IF (IQPART.LE.0)             GO TO 234
 156       GO TO 261
 157
 158 C--                Start of a dead group
 159
 160   244 NWDIV = NWDIV + (LN - LQ(LQTE))
 161       LQ(LQTE+1) = LN
 162       LQTE = LQTE + NSTEP
 163       GO TO 234
 164
 165 C--                End of division
 166
 167   247 IF (MODE.EQ.0)               GO TO 248
 168       NWDIV = NWDIV + (LN - LQ(LQTE))
 169       LQ(LQTE+1) = LN
 170       LQTE = LQTE + NSTEP
 171
 172 C--                Add to segment table
 173
 174   248 IF (NWDIV.EQ.0)              GO TO 249
 175       NWBKX = NWBKX + NWDIV
 176       NQSEG = NQSEG + 1
 177       IQSEGH(1,NQSEG) = IQDN1(KQT+JDIV)
 178       IQSEGH(2,NQSEG) = IQDN2(KQT+JDIV)
 179       IQSEGD(NQSEG)   = NWDIV
 180
 181 C--                Step to next division
 182
 183   249 LMT = LMT + 8
 184       IF (LMT.LT.LQMTE)            GO TO 232
 185       GO TO 361
 186
 187 C------            Not enough space, garbage collection
 188
 189   261 IF (JFLGAX.NE.0)             GO TO 264
 190       JFLGAX = 1
 191       LQSYSR(KQT+1) = LENTRX
 192       IXGARB = MZIXCO (IXDIVX,21,22,23)
 193       IXGARB = MZIXCO (IXGARB,24,0,0)
 194       CALL MZGARB (IXGARB,0)
 195       LENTRX = LQSYSR(KQT+1)
 196       GO TO 269
 197
 198   264 IF (JFLGAX.GE.2)             GO TO 913
 199       JFLGAX = 2
 200       IF (JQSTOR.EQ.0)             GO TO 913
 201       IXGARB = MZIXCO (21,22,23,24)
 202       CALL MZGARB (IXGARB,0)
 203       CALL MZSDIV (IXDIVX,0)
 204   269 IF (MODTBX.EQ.0)             GO TO 101
 205       IQUEST(1) = 1
 206       GO TO 101
 207
 208 C-------------------------------------------------
 209 C-                 complete divisions
 210 C-------------------------------------------------
 211
 212   301 MQDVGA = MZDVAC (IXDIVX)
 213       CALL MZTABM
 214       IOPTXL = 1
 215
 216       IF (IOPTXI.EQ.0)             GO TO 321
 217
 218 C----              Immediate dump of divisions
 219
 220   305 IF (LQ(LMT+1).NE.3)          GO TO 307
 221       NWDIV = LQ(LMT+4) - LQ(LMT+3)
 222       NWBKX = NWBKX + NWDIV
 223       LQ(LQTE)   = LQ(LMT+3)
 224       LQ(LQTE+1) = LQ(LMT+4)
 225       LQTE = LQTE + NSTEP
 226
 227 C--                Add to segment table
 228
 229       JDIV  = LQ(LMT)
 230       NQSEG = NQSEG + 1
 231       IQSEGH(1,NQSEG) = IQDN1(KQT+JDIV)
 232       IQSEGH(2,NQSEG) = IQDN2(KQT+JDIV)
 233       IQSEGD(NQSEG)   = NWDIV
 234   307 LMT = LMT + 8
 235       IF (LMT.LT.LQMTE)            GO TO 305
 236       GO TO 361
 237
 238 C----              Filtered dump of divisions
 239
 240   321 CONTINUE
 241
 242 C--                Next division
 243
 244   332 IF (LQ(LMT+1).NE.3)          GO TO 349
 245       NWDIV  = 0
 246       JDIV   = LQ(LMT)
 247       LNX    = LQ(LMT+3)
 248       LQMTC2 = LQ(LMT+4)
 249       NEW = 1
 250
 251 C--                Next bank
 252
 253   334 MODE = NEW
 254   335 LN   = LNX
 255       IF (LN.GE.LQMTC2)            GO TO 347
 256 #if defined(CERNLIB_QDEBUG)
 257       CALL MZCHLN (-7,LN)
 258       IF (IQFOUL.NE.0)             GO TO 912
 259 #endif
 260 #if !defined(CERNLIB_QDEBUG)
 261       NST = JBYT(LQ(KQS+LN),1,16) - 11
 262       IF (NST.GT.0)  THEN
 263           LS  = LN + NST
 264           LNX = LS + IQ(KQS+LS-1) + 9
 265         ELSE
 266           LS  = LN - 8
 267           LNX = LN + NST + 11
 268         ENDIF
 269 #endif
 270       NEW = JBIT(IQ(KQS+LS),IQDROP)
 271       IF (NEW.EQ.0)                GO TO 336
 272       IF (MODE.NE.0)               GO TO 335
 273       GO TO 344
 274
 275 C--                Inspect structural links of live bank
 276
 277   336 K = LS - IQ(KQS+LS-2) - 1
 278   337 K = K + 1
 279       IF (K.GT.LS)                 GO TO 340
 280       L = LQ(KQS+K)
 281       IF (L.EQ.0)                    GO TO 337
 282       IF (JBIT(IQ(KQS+L),IQDROP).EQ.0)  GO TO 337
 283       KD = LQ(KQS+L+2)
 284   338 L  = LQ(KQS+L)
 285       IF (L.EQ.0)                    GO TO 339
 286       IF (JBIT(IQ(KQS+L),IQDROP).NE.0)  GO TO 338
 287       LQ(KQS+K) = L
 288       IF (KD.NE.K)                 GO TO 337
 289       LQ(KQS+L+2) = K
 290       GO TO 337
 291
 292   339 LQ(KQS+K) = 0
 293       GO TO 337
 294
 295   340 IF (MODE.EQ.0)               GO TO 335
 296
 297 C--                Start of a live group
 298
 299       LQ(LQTE) = LN
 300       IF (LQTE.LT.LQRTE)           GO TO 334
 301       CALL MZTABH
 302       IF (IQPART.LE.0)             GO TO 334
 303       GO TO 261
 304
 305 C--                Start of a dead group
 306
 307   344 NWDIV = NWDIV + (LN - LQ(LQTE))
 308       LQ(LQTE+1) = LN
 309       LQTE = LQTE + NSTEP
 310       GO TO 334
 311
 312 C--                End of division
 313
 314   347 IF (MODE.NE.0)               GO TO 348
 315       NWDIV = NWDIV + (LN - LQ(LQTE))
 316       LQ(LQTE+1) = LN
 317       LQTE = LQTE + NSTEP
 318
 319 C--                Add to segment table
 320
 321   348 IF (NWDIV.EQ.0)              GO TO 349
 322       NWBKX = NWBKX + NWDIV
 323       NQSEG = NQSEG + 1
 324       IQSEGH(1,NQSEG) = IQDN1(KQT+JDIV)
 325       IQSEGH(2,NQSEG) = IQDN2(KQT+JDIV)
 326       IQSEGD(NQSEG)   = NWDIV
 327
 328 C--                Step to next division
 329
 330   349 LMT = LMT + 8
 331       IF (LMT.LT.LQMTE)            GO TO 332
 332
 333   361 IQUEST(1) = 0
 334       NWTABX    = LQTE - LQTA
 335       IF (NQSEG.EQ.1)  NQSEG=0
 336       NWSEGX = 3*NQSEG
 337       GO TO 999
 338
 339 C-------------------------------------------------
 340 C-                 ERROR HANDLING
 341 C-------------------------------------------------
 342
 343   911 IQUEST(2)  = 11
 344       IQUEST(11) = LENTRX
 345       GO TO 971
 346
 347   912 IQUEST(2)  = 12
 348       IQUEST(11) = JQSTOR
 349       IQUEST(12) = JDIV
 350       GO TO 971
 351
 352   913 IQUEST(2)  = 13
 353
 354   971 IF (MODTBX.EQ.0)  THEN
 355           IF (IOPTXP.EQ.0)       CALL ZTELL (IQUEST(2),1)
 356         ENDIF
 357       IQUEST(1) = -2
 358
 359 #include "zebra/qtrace99.inc"
 360       RETURN
 361       END
 362 *      ==================================================
 363 #include "zebra/qcardl.inc"