MINICERN/packlib/zebra/mq/mzpush.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:11:58  mclareni
   6 * Incorporate changes from J.Zoll for version 3.77
   7 *
   8 * Revision 1.1.1.1  1996/03/06 10:47:19  mclareni
   9 * Zebra
  10 *
  11 *
  12 #include "zebra/pilot.h"
  13       SUBROUTINE MZPUSH (IXDIV,LORGP,INCNLP,INCNDP,CHOPT)
  14
  15 C-    Change the size of a bank, user called
  16
  17 #include "zebra/zbcd.inc"
  18 #include "zebra/zstate.inc"
  19 #include "zebra/zunit.inc"
  20 #include "zebra/zvfaut.inc"
  21 #include "zebra/mqsys.inc"
  22 #include "zebra/mzcl.inc"
  23 #include "zebra/mzcn.inc"
  24 #include "zebra/mzct.inc"
  25 C--------------    End CDE                             --------------
  26       DIMENSION    IXDIV(9),LORGP(9),INCNLP(9),INCNDP(9)
  27       CHARACTER    *(*) CHOPT
  28 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  29       DIMENSION    NAMESR(2)
  30       DATA  NAMESR / 4HMZPU, 4HSH   /
  31 #endif
  32 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  33       DATA  NAMESR / 6HMZPUSH /
  34 #endif
  35 #if !defined(CERNLIB_QTRHOLL)
  36       CHARACTER    NAMESR*8
  37       PARAMETER   (NAMESR = 'MZPUSH  ')
  38 #endif
  39
  40 #include "zebra/q_jbit.inc"
  41 #include "zebra/q_jbyt.inc"
  42 #include "zebra/q_sbit1.inc"
  43 #include "zebra/q_sbyt.inc"
  44
  45 #include "zebra/qtrace.inc"
  46
  47       IF (IXDIV(1).EQ.-7)          GO TO 12
  48       CALL MZSDIV (IXDIV,0)
  49
  50    12 CALL MZCHNB (LORGP)
  51       LORG  = LORGP(1)
  52       INCNL = INCNLP(1)
  53       INCND = INCNDP(1)
  54
  55       CALL UOPTC (CHOPT,'RI',IQUEST)
  56       IFLAG = MIN (2, IQUEST(1)+2*IQUEST(2))
  57
  58 C-         IFLAG = 0  general
  59 C-                 1  R-educe
  60 C-                 2  I-solated
  61
  62 #if defined(CERNLIB_QDEVZE)
  63       IF (NQDEVZ.NE.0)
  64      +WRITE (IQLOG,9809) LORG,INCNL,INCND,IFLAG
  65  9809 FORMAT (1X/' DEVZE MZPUSH,  Entry for LORG,INCNL,INCND,IFLAG= '
  66      F,5I8)
  67 #endif
  68 #if defined(CERNLIB_QDEBUG)
  69       IF (IQVSTA.NE.0)       CALL ZVAUTX
  70 #endif
  71       IF ((INCNL.EQ.0) .AND. (INCND.EQ.0))  GO TO 999
  72       LQSYSR(KQT+1) = LORG
  73
  74 C--                Find division
  75
  76       JQDIVI = MZFDIV (-7, LORG)
  77       IF (JQDIVI.EQ.0)             GO TO 91
  78
  79 C--                Set bank parameters
  80
  81 #if defined(CERNLIB_QDEBUG)
  82       CALL MZCHLS (-7,LORG)
  83       IF (IQFOUL.NE.0)             GO TO 91
  84       NL    = IQNL
  85       NS    = IQNS
  86       ND    = IQND
  87       NQNIO = IQNIO
  88       NQID  = IQID
  89 #endif
  90 #if defined(CERNLIB_QDEVZE)
  91       IF (NQDEVZ.GE.7)
  92      +WRITE (IQLOG,9831) JQDIVI,IQLS,IQID,IQNL,IQNS,IQND
  93  9831 FORMAT (16X,'JQDIVI,IQLS,IQID,IQNL,IQNS,IQND=',I3,I7,1X,A4,4I8)
  94 #endif
  95 #if !defined(CERNLIB_QDEBUG)
  96       NQID  = IQ(KQS+LORG-4)
  97       NL    = IQ(KQS+LORG-3)
  98       NS    = IQ(KQS+LORG-2)
  99       ND    = IQ(KQS+LORG-1)
 100       NQNIO = JBYT (IQ(KQS+LORG),19,4)
 101 #endif
 102       NQNL = NL + INCNL
 103       NQNS = MIN (NS,NQNL)
 104       NQND = ND + INCND
 105       IF (NS.EQ.NL)  NQNS = NQNL
 106 #if defined(CERNLIB_QDEBPRI)
 107       IF (NQLOGL.GE.2)
 108      + WRITE (IQLOG,9032) JQSTOR,JQDIVI,LORG,NQID,INCNL,INCND,CHOPT
 109  9032 FORMAT (' MZPUSH-  Store/Div',2I3,' L/ID/INCNL/INCND/OPT=',
 110      FI9,1X,A4,2I7,1X,A)
 111 #endif
 112       IF (JBIT(IQ(KQS+LORG),IQDROP).NE.0)   GO TO 92
 113
 114 C--                Check for bad parameters
 115
 116       IF (NQND+NQNL.GE.LQSTA(KQT+21)) GO TO 93
 117       IF (NQND.LT.0)               GO TO 93
 118       IF (NQNL.GT.64000)           GO TO 93
 119       IF (NQNS.LT.0)               GO TO 93
 120
 121       NLC = MIN (NL,NQNL)
 122       NSC = MIN (NS,NQNS)
 123       NDC = MIN (ND,NQND)
 124
 125 C--                Check giving up non-zero structural links
 126
 127       IF (NQNS.GE.NS)              GO TO 36
 128       L  = LORG - NS - 1
 129       LD = LORG - NQNS
 130    34 L  = L + 1
 131       IF (L.GE.LD)                 GO TO 36
 132       LNZ = LQ(KQS+L)
 133    35 IF (LNZ.EQ.0)                GO TO 34
 134       IF (LQ(KQS+LNZ+2).NE.L)         GO TO 34
 135       IF (JBIT(IQ(KQS+LNZ),IQDROP).EQ.0)   GO TO 94
 136       LNZ = LQ(KQS+LNZ)
 137       GO TO 35
 138
 139 C--                Ready I/O characteristic
 140
 141    36 LN = LORG - NL - NQNIO - 1
 142       CALL UCOPY (LQ(KQS+LN),NQIOCH,NQNIO+1)
 143       IF (NQNIO.NE.0)  NQIOSV(1)=0
 144       NQIOCH(1) = MSBYT (NQNL+NQNIO+12,NQIOCH(1),1,16)
 145
 146 C--                Re-enter after garbage collection, if any
 147
 148    41 LE = LORG + ND + 9
 149
 150 C------            Check for short-cuts
 151
 152       INCTT = INCNL + INCND
 153       INCMX = MAX (INCNL,INCND)
 154       INCMI = MIN (INCNL,INCND)
 155       CALL MZRESV
 156       IF (JQMODE.NE.0)             GO TO 45
 157
 158 C--                Last bank in forward division
 159
 160       IF (LE.NE.LQEND(KQT+JQDIVI))    GO TO 51
 161       IF (INCNL.GE.0)              GO TO 42
 162       IF (IFLAG.NE.1)              GO TO 42
 163       IF ((NQRESV.GE.INCTT).AND.(NQRESV.LT.INCND))  GO TO 42
 164
 165       LNN = LN - INCNL
 166       CALL UCOPY (NQIOCH,LQ(KQS+LNN),NQNIO+1)
 167       IQ(KQS+LORG-3) = NQNL
 168       IQ(KQS+LORG-2) = NQNS
 169
 170       NWD = -INCNL
 171       CALL MZPUDX (LN,NWD)
 172       INCNL = 0
 173       INCTT = INCND
 174       LN    = LNN
 175       NL    = NQNL
 176
 177    42 NQRESV = NQRESV - INCTT
 178       IF (NQRESV.LT.0)             GO TO 49
 179       NDELTA = INCNL
 180       LNEW   = LORG + NDELTA
 181       LQEND(KQT+JQDIVI) = LQEND(KQT+JQDIVI) + INCTT
 182 #if defined(CERNLIB_QDEVZE)
 183       IF (NQDEVZ.GE.7)  WRITE (IQLOG,9848) NDELTA,LNEW
 184 #endif
 185       IF (NDELTA.EQ.0)  THEN
 186           IQ(KQS+LNEW-1) = NQND
 187           IF (IFLAG.NE.0)          GO TO 81
 188           IF (INCMI.GE.0)          GO TO 81
 189           GO TO 71
 190         ELSE
 191           CALL UCOPY2 (LQ(KQS+LORG-NLC),LQ(KQS+LNEW-NLC),NLC+NDC+9)
 192           IF (INCNL.GT.0)  CALL VZERO (LQ(KQS+LNEW-NQNL),INCNL)
 193           LQ(KQS+LN)     = NQIOCH(1)
 194           IQ(KQS+LNEW-3) = NQNL
 195           IQ(KQS+LNEW-2) = NQNS
 196           IQ(KQS+LNEW-1) = NQND
 197           GO TO 61
 198         ENDIF
 199
 200 C--                First bank in reverse division
 201
 202    45 IF (LN.NE.LQSTA(KQT+JQDIVI))    GO TO 51
 203       IF (INCND.GE.0)              GO TO 47
 204       IF (IFLAG.NE.1)              GO TO 47
 205       IF ((NQRESV.GE.INCTT).AND.(NQRESV.LT.INCNL))  GO TO 47
 206       IQ(KQS+LORG-1) = NQND
 207
 208       L   = LE + INCND
 209       NWD = -INCND
 210       CALL MZPUDX (L,NWD)
 211       INCND = 0
 212       INCTT = INCNL
 213       ND    = NQND
 214
 215    47 NQRESV = NQRESV - INCTT
 216       IF (NQRESV.LT.0)             GO TO 49
 217       LNN    = LN - INCTT
 218       NDELTA = -INCND
 219       LQSTA(KQT+JQDIVI) = LNN
 220
 221       LNEW  = LORG + NDELTA
 222
 223       IF (NDELTA.NE.0)  CALL UCOPY2 (LQ(KQS+LORG-NLC)
 224      +,                              LQ(KQS+LNEW-NLC), NLC+NDC+9)
 225
 226       IF (INCNL.GT.0)  CALL VZERO (LQ(KQS+LNEW-NQNL),INCNL)
 227       CALL UCOPY (NQIOCH,LQ(KQS+LNN),NQNIO+1)
 228
 229       IQ(KQS+LNEW-3) = NQNL
 230       IQ(KQS+LNEW-2) = NQNS
 231       IQ(KQS+LNEW-1) = NQND
 232 #if defined(CERNLIB_QDEVZE)
 233       IF (NQDEVZ.GE.7)  WRITE (IQLOG,9848) NDELTA,LNEW
 234  9848 FORMAT (' DEVZE MZPUSH,  Edge bank with NDELTA,LNEW=',2I8)
 235 #endif
 236
 237       IF (NDELTA.NE.0)             GO TO 61
 238       IF (IFLAG.NE.0)              GO TO 81
 239       IF (INCMI.GE.0)              GO TO 81
 240       GO TO 71
 241
 242 C--                Garbage collection
 243
 244    49 CALL MZGAR1
 245       LORG = LQSYSR(KQT+1)
 246       LN   = LORG - NL - NQNIO - 1
 247 #if defined(CERNLIB_QDEVZE)
 248       IF (NQDEVZ.GE.7)
 249      +WRITE (IQLOG,9849)
 250  9849 FORMAT (1X/' DEVZE MZPUSH,  Garbage collected for edge bank')
 251 #endif
 252       GO TO 41
 253
 254 C----              Reduction only
 255
 256    51 IF (INCMX.GT.0)              GO TO 56
 257       IF (INCNL.EQ.0)              GO TO 52
 258
 259 C--                Link part
 260
 261       LNN = LN - INCNL
 262       CALL UCOPY (NQIOCH,LQ(KQS+LNN),NQNIO+1)
 263       IQ(KQS+LORG-3)= NQNL
 264       IQ(KQS+LORG-2)= NQNS
 265
 266       CALL MZPUDX (LN,-INCNL)
 267
 268 #if defined(CERNLIB_QDEVZE)
 269       IF (NQDEVZ.GE.7)
 270      +WRITE (IQLOG,9851) INCNL
 271  9851 FORMAT (' DEVZE MZPUSH,  In-situ links with INCNL=',I8)
 272 #endif
 273       IF (INCND.EQ.0)              GO TO 54
 274
 275 C--                Data part
 276
 277    52 IQ(KQS+LORG-1) = NQND
 278       LD  = LE + INCND
 279       NWD = -INCND
 280       CALL MZPUDX (LD,NWD)
 281 #if defined(CERNLIB_QDEVZE)
 282       IF (NQDEVZ.GE.7)
 283      +WRITE (IQLOG,9852) INCND
 284  9852 FORMAT (' DEVZE MZPUSH,  In-situ data with INCND=',I8)
 285 #endif
 286
 287    54 LNEW   = LORG
 288       NDELTA = 0
 289       IF (IFLAG.NE.0)              GO TO 999
 290       GO TO 71
 291
 292 C------            Lift replacement bank
 293
 294    56 J = 64*(32*NQNIO + NQNIO + 1) + 1
 295       NQIOCH(1) = MSBYT (J,NQIOCH(1),1,16)
 296
 297       NQBIA = 2
 298       CALL MZLIFT (-7,LNEW,0,63,NQID,-1)
 299       LORG   = LQSYSR(KQT+1)
 300       NDELTA = LNEW - LORG
 301
 302       CALL UCOPY (LQ(KQS+LORG-NLC),LQ(KQS+LNEW-NLC),NLC+4)
 303       CALL UCOPY (IQ(KQS+LORG),    IQ(KQS+LNEW),    NDC+1)
 304       IQ(KQS+LORG) = MSBIT1 (IQ(KQS+LORG),IQDROP)
 305 #if defined(CERNLIB_QDEVZE)
 306       IF (NQDEVZ.GE.7)
 307      +WRITE (IQLOG,9857) LORG,LNEW
 308  9857 FORMAT (' DEVZE MZPUSH,  Push by copy LORG -> LNEW=',2I8)
 309 #endif
 310
 311 C------            Up-date immediate links only
 312
 313    61 IF (IFLAG.LT.2)              GO TO 71
 314 #if defined(CERNLIB_QDEVZE)
 315       IF (NQDEVZ.GE.7)
 316      +WRITE (IQLOG,9861)
 317  9861 FORMAT (' DEVZE MZPUSH,  Update immediate links only')
 318 #endif
 319
 320 C----              Update according to k-link in pushed bank
 321
 322       K = LQ(KQS+LNEW+2)
 323       IF (K.EQ.0)                  GO TO 62
 324       IF (LQ(KQS+K).NE.LORG)          GO TO 95
 325       LQ(KQS+K) = LNEW
 326
 327 C----              Update according to link 0
 328
 329    62 K = LNEW
 330       L = LQ(KQS+K)
 331       IF (L.EQ.0)                  GO TO 65
 332       IF (L.EQ.LORG)               GO TO 64
 333       LQ(KQS+L+2) = K
 334    63 K = L
 335       L = LQ(KQS+K)
 336       IF (L.EQ.0)                  GO TO 65
 337       IF (L.NE.LORG)               GO TO 63
 338    64 LQ(KQS+K) = LNEW
 339
 340 C----              Update k- and up-link in vertically dependent banks
 341
 342    65 K = LNEW - NSC - 1
 343
 344 C--                          each link
 345    66 K = K + 1
 346       IF (K.GE.LNEW)               GO TO 81
 347       L = LQ(KQS+K)
 348       IF (L.EQ.0)                  GO TO 66
 349       IF (LQ(KQS+L+2).NE.K-NDELTA)    GO TO 66
 350       LQ(KQS+L+2) = K
 351
 352 C--                          and its linear structure
 353
 354       LF = L
 355    68 LQ(KQS+L+1) = LNEW
 356       L = LQ(KQS+L)
 357       IF (L.EQ.LF)                 GO TO 66
 358       IF (L.NE.0)                  GO TO 68
 359       GO TO 66
 360
 361 C------            Global update of links
 362
 363    71 MQDVGA = 0
 364       MQDVWI = 0
 365       JQSTMV = -1
 366 #if defined(CERNLIB_QDEBPRI)
 367       IF (NQLOGL.GE.1)
 368      + WRITE (IQLOG,9071) JQSTOR,JQDIVI,LORG,NQID
 369  9071 FORMAT (' MZPUSH-  Store/Div',2I3,' Relocation pass for L/ID ='
 370      F,I9,1X,A4)
 371 #endif
 372 #if defined(CERNLIB_QDEVZE)
 373       IF (NQDEVZ.GE.7)
 374      +WRITE (IQLOG,9871)
 375  9871 FORMAT (' DEVZE MZPUSH,  Update by relocation pass')
 376 #endif
 377
 378       CALL MZTABM
 379
 380       LMT  = LQMTA - 8
 381    74 LMT  = LMT + 8
 382       IF (LQ(LMT).NE.JQDIVI)       GO TO 74
 383       LQ(LMT+1) = 2
 384
 385       CALL MZTABX
 386       LQMTE = LQMTLU
 387
 388       LQ(LQTA-1) = LORG - NL - NQNIO - 1
 389       LQ(LQTA)   = LORG - NLC
 390       LQ(LQTA+1) = LORG + NDC + 9
 391       LQ(LQTA+2) = NDELTA
 392       LQ(LQTA+3) = 0
 393       LQ(LQTA+4) = LORG + ND + 9
 394
 395       LQTE  = LQTA + 4
 396
 397       CALL MZRELX
 398
 399       NQDPSH(KQT+JQDIVI) = NQDPSH(KQT+JQDIVI) + 1
 400
 401 C------            Finished, reset LORG, clear new data words
 402
 403    81 LORGP(1) = LNEW
 404       IF (INCND.GT.0)  CALL VZERO (IQ(KQS+LNEW+ND+1),INCND)
 405 #include "zebra/qtrace99.inc"
 406       RETURN
 407
 408 C----              Error conditions
 409
 410    95 NQCASE = 3
 411       NQFATA = 1
 412       IQUEST(19) = K
 413       GO TO 92
 414
 415    94 NQCASE = 1
 416       NQFATA = 2
 417       IQUEST(19) = L - LORG
 418       IQUEST(20) = LQ(KQS+L)
 419    93 NQCASE = NQCASE + 1
 420    92 NQCASE = NQCASE + 1
 421       NQFATA = NQFATA + 7
 422       IQUEST(12) = NQID
 423       IQUEST(13) = NS
 424       IQUEST(14) = NL
 425       IQUEST(15) = ND
 426       IQUEST(16) = NQNIO
 427       IQUEST(17) = INCNL
 428       IQUEST(18) = INCND
 429    91 NQCASE = NQCASE + 1
 430       NQFATA = NQFATA + 1
 431       IQUEST(11) = LORG
 432 #include "zebra/qtofatal.inc"
 433       END
 434 *      ==================================================
 435 #include "zebra/qcardl.inc"