MINICERN/packlib/zebra/fq/fzimtb.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:10:34  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 FZIMTB
  14
  15 C-    ready memory occupation table for input
  16 C-    ready space for the relocation table
  17 C-    called from FZIN
  18
  19 #include "zebra/zbcd.inc"
  20 #include "zebra/zmach.inc"
  21 #include "zebra/zunit.inc"
  22 #include "zebra/mqsys.inc"
  23 #include "zebra/eqlqf.inc"
  24 #include "zebra/mzcn.inc"
  25 #include "zebra/mzct.inc"
  26 #include "zebra/fzci.inc"
  27 #include "zebra/fzcseg.inc"
  28 #include "zebra/fzcocc.inc"
  29 C--------------    End CDE                             --------------
  30
  31       DIMENSION    ITOSOR(20), ISORDV(20), ISORSP(20)
  32       DIMENSION    LSTAV(20),             LENDV(20)
  33       EQUIVALENCE (LSTAV(1),IQUEST(60)), (LENDV(1),IQUEST(80))
  34
  35 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  36       DIMENSION    NAMESR(2)
  37       DATA  NAMESR / 4HFZIM, 4HTB   /
  38 #endif
  39 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  40       DATA  NAMESR / 6HFZIMTB /
  41 #endif
  42 #if !defined(CERNLIB_QTRHOLL)
  43       CHARACTER    NAMESR*8
  44       PARAMETER   (NAMESR = 'FZIMTB  ')
  45 #endif
  46
  47 #include "zebra/q_shiftl.inc"
  48 #include "zebra/q_jbyt.inc"
  49
  50 C----              Input information
  51
  52 C-    if NQSEG = 0 :   read non-segmented
  53
  54 C-    if NQSEG > 0 :   read segmented according to :
  55 C-       IQSEGD        segment selection table set by the user
  56 C-       IQ(LFISEG+1)  copy of the segmentation table from the pilot
  57
  58 C----              Output information
  59
  60 C-    The memory occupation table at LQ(LQMTA) ready for the material
  61 C-    to be accepted :
  62 C-        skip :   LQ(LMT)   = 0
  63 C-                 LQ(LMT+1) = 0
  64 C-                 LQ(LMT+3) = -NW words to be skipped
  65
  66 C-        read :   LQ(LMT)   = JDIV
  67 C-                 LQ(LMT+1) = 1
  68 C-                 LQ(LMT+3) = LSTA
  69 C-                 LQ(LMT+4) = LEND
  70
  71 C-    The space at LQ(LQTA) ready (and big enough) to receive
  72 C-    the relocation table.
  73
  74 C-    The common /FZOCC/ indicates the amount of space IQOCSP(J)
  75 C-    reserved at the end/start of division IQOCDV(J) for J=1,NQOCC
  76 C-    and blocked by a dummy bank.
  77
  78
  79 #include "zebra/qtrace.inc"
  80
  81       IFLGAR = 0
  82       IF (NQSEG.LE.0)  THEN
  83
  84 C--                Single segment
  85
  86           NQSEG = 1
  87           NSOR  = 1
  88           NOCC  = 1
  89           ITOSOR(1) = 1
  90           IQSEGD(1) = JQDIVI
  91           ISORDV(1) = JQDIVI
  92           IQOCDV(1) = JQDIVI
  93           ISORSP(1) = NWBKI
  94           IQOCSP(1) = NWBKI
  95           GO TO 41
  96         ENDIF
  97
  98 C--                Multiple segments, tidy division numbers
  99
 100 #if defined(CERNLIB_QDEBPRI)
 101       IF (LOGLVI.GE.3)   WRITE (IQLOG,9016)  (J,
 102      +                   IQSEGH(1,J),IQSEGH(2,J),IQSEGD(J),J=1,NQSEG)
 103  9016 FORMAT (1X/' FZIMTB-  Segment Selection Table as set by the user'
 104 #endif
 105 #if (defined(CERNLIB_QDEBPRI))&&(!defined(CERNLIB_HEX))
 106      F/(10X,I2,1X,2A4,O23))
 107 #endif
 108 #if (defined(CERNLIB_QDEBPRI))&&(defined(CERNLIB_HEX))
 109      F/(10X,I2,1X,2A4,Z17))
 110 #endif
 111
 112       LFISEG = LQFI + JAUSEG
 113       IF (3*NQSEG.NE.IQ(KQSP+LFISEG))  GO TO 715
 114       LSPACE = KQSP + LFISEG + 2*NQSEG
 115
 116       DO 27  JS=1,NQSEG
 117       IXDIV = IQSEGD(JS)
 118       IF   (IXDIV)           22, 23, 24
 119    22 IF (IXDIV.LT.-7)             GO TO 714
 120       ITOSOR(JS) = -IQ(LSPACE+JS)
 121       GO TO 27
 122
 123    23 JDIV = JQDIVI
 124       GO TO 25
 125
 126    24 JDIV = JBYT (IXDIV,1,26)
 127       IF (JDIV.GT.20)              GO TO 714
 128       JSTO = JBYT (IXDIV,27,4)
 129       IF   (JSTO.NE.0)  THEN
 130           IF (JSTO.NE.JQSTOR)      GO TO 714
 131         ENDIF
 132
 133       IF (JDIV.EQ.0)               GO TO 23
 134       IF   (JDIV.GT.JQDVLL)  THEN
 135           IF (JDIV.LT.JQDVSY)      GO TO 714
 136         ENDIF
 137
 138    25 IQSEGD(JS) = JDIV
 139       ITOSOR(JS) = 0
 140    27 CONTINUE
 141
 142 C----              Construct tables sorted by division number
 143
 144 C-             ISOR  table :  one entry per segment
 145 C-             IQOC  table :  one entry per target division
 146
 147       NSOR  = 0
 148       NOCC  = 0
 149       JANX  = 1
 150       JENX  = NQSEG
 151
 152 C--                Find largest division number not yet done
 153
 154    31 JDVBIG = 0
 155       JA   = JANX
 156       JANX = 0
 157       JE   = JENX
 158       JENX = 0
 159       DO 35  JS=JA,JE
 160       IF (ITOSOR(JS).NE.0)         GO TO 35
 161       JENX = JS
 162       IF (JANX.EQ.0)  JANX=JS
 163       JDIV = IQSEGD(JS)
 164       IF (JDIV.LE.JDVBIG)          GO TO 35
 165       JDVBIG = JDIV
 166       JSBIG  = JS
 167    35 CONTINUE
 168       IF (JDVBIG.EQ.0)             GO TO 41
 169
 170       NSOR = NSOR + 1
 171       ITOSOR(JSBIG) = NSOR
 172       ISORDV(NSOR)  = JDVBIG
 173       ISORSP(NSOR)  = IQ(LSPACE+JSBIG)
 174
 175       NOCC = NOCC + 1
 176       IQOCDV(NOCC) = JDVBIG
 177       IQOCSP(NOCC) = IQ(LSPACE+JSBIG)
 178
 179 C--                Find further segments for the same division
 180
 181       IF (JSBIG.EQ.JENX)           GO TO 31
 182       DO 37  JS=JSBIG+1,JENX
 183       IF (ITOSOR(JS).NE.0)         GO TO 37
 184       IF (IQSEGD(JS).NE.JDVBIG)    GO TO 37
 185       NSOR = NSOR + 1
 186       ITOSOR(JS)   = NSOR
 187       ISORDV(NSOR) = JDVBIG
 188       ISORSP(NSOR) = IQ(LSPACE+JS)
 189       IQOCSP(NOCC) = IQOCSP(NOCC) + IQ(LSPACE+JS)
 190    37 CONTINUE
 191       GO TO 31
 192
 193 C----              Reserve space in divisions
 194
 195    41 IF (NOCC.EQ.0)               GO TO 81
 196       JOCC   = 0
 197    42 JOCC   = JOCC + 1
 198       JQDIVI = IQOCDV(JOCC)
 199       NW     = IQOCSP(JOCC)
 200       CALL MZRESV
 201       NQRESV = NQRESV - NW
 202       IF (NQRESV.LT.0)       CALL MZGAR1
 203
 204 C--                Forward division
 205
 206       IF (JQMODE.EQ.0)  THEN
 207           IQLN = LQEND(KQT+JQDIVI)
 208           IQNX = IQLN + NW
 209           LQEND(KQT+JQDIVI) = IQNX
 210
 211 C--                Reverse division
 212
 213         ELSE
 214           IQNX = LQSTA(KQT+JQDIVI)
 215           IQLN = IQNX - NW
 216           LQSTA(KQT+JQDIVI) = IQLN
 217         ENDIF
 218       NQOCC = JOCC
 219
 220 C--                Fill space reserved with dummy bank
 221
 222       LQ(KQS+IQLN)   = 12
 223       LQ(KQS+IQLN+1) = 0
 224       LQ(KQS+IQLN+2) = 0
 225       LQ(KQS+IQLN+3) = 0
 226       LQ(KQS+IQLN+5) = IQLETT(1)
 227       LQ(KQS+IQLN+6) = 0
 228       LQ(KQS+IQLN+7) = 0
 229       LQ(KQS+IQLN+8) = NW - 10
 230       LQ(KQS+IQLN+9) = 0
 231       IF (JOCC.NE.NOCC)            GO TO 42
 232
 233 C----              Allocate space for the relocation tables
 234
 235    46 NWTR = 2*NWTABI + 2
 236       NWTM = 8*NQSEG
 237       IF (NWTR+NWTM.LT.NQWKTB)  THEN
 238 C--                Both tables in the normal work area
 239           LQMTA = LQWKTB
 240           LQRTA = LQMTA + NWTM
 241         ELSE
 242           JQSTMV = -1
 243           CALL MZFGAP
 244           IF (NQGAPN.EQ.0)         GO TO 61
 245           IF (IQGAP(1,1).LT.NWTR)  THEN
 246 C--                MO table in the (smaller) gap, LR table in area
 247               IF (NQWKTB.LT.NWTR)  GO TO 61
 248               LQMTA = IQGAP(2,1)
 249               LQRTA = LQWKTB
 250             ELSE
 251 C--                MO table in area, LR table in (bigger) gap
 252               LQMTA = LQWKTB
 253               LQRTA = IQGAP(2,1)
 254             ENDIF
 255         ENDIF
 256
 257       LQMTE = LQMTA + NWTM
 258       LQTA  = LQRTA + 1
 259       LQTE  = LQTA  + 2*NWTABI
 260       LQRTE = LQTE
 261 #if defined(CERNLIB_QDEVZE)
 262       IF (LOGLVI.GE.4)  WRITE (IQLOG,9141) LQMTA,LQMTE,LQTA,LQTE
 263  9141 FORMAT (' FZIMTB-  Tables : LQMTA,LQMTE,LQTA,LQTE=',4I9)
 264 #endif
 265
 266 C----              Calculate start adrs on the sorted table
 267
 268       JSOR   = 1
 269       JOCC   = 1
 270    52 JQDIVI = ISORDV(JSOR)
 271
 272       IF (IQMODE(KQT+JQDIVI).EQ.0)  THEN
 273           LSTA = LQEND(KQT+JQDIVI) - IQOCSP(JOCC)
 274         ELSE
 275           LSTA = LQSTA(KQT+JQDIVI)
 276         ENDIF
 277
 278       LEND = LSTA + ISORSP(JSOR)
 279
 280       LENDV(JSOR) = LEND
 281       LSTAV(JSOR) = LSTA
 282       JOCC = JOCC + 1
 283
 284    54 IF (JSOR.EQ.NSOR)            GO TO 55
 285       JSOR = JSOR + 1
 286       IF (ISORDV(JSOR).NE.JQDIVI)  GO TO 52
 287       LSTA = LEND
 288       LEND = LSTA + ISORSP(JSOR)
 289       LENDV(JSOR) = LEND
 290       LSTAV(JSOR) = LSTA
 291       GO TO 54
 292
 293 C----              Transfer the information from the sorted table
 294 C-                 to the memory occupation table
 295
 296    55 LMT = LQMTA
 297
 298       DO  59  JS=1,NQSEG
 299       JSOR = ITOSOR(JS)
 300       IF (JSOR.GE.0)               GO TO 57
 301       LQ(LMT)   = 0
 302       LQ(LMT+1) = 0
 303       LQ(LMT+2) = 0
 304       LQ(LMT+3) = JSOR
 305       LQ(LMT+4) = JSOR
 306       LQ(LMT+5) = 0
 307       LQ(LMT+6) = 0
 308       LQ(LMT+7) = 0
 309 #if defined(CERNLIB_QDEBPRI)
 310       IF (LOGLVI.GE.3)   WRITE (IQLOG,9055) JS, -JSOR
 311  9055 FORMAT (' FZIMTB-  skip segment',I3,I9,' WORDS')
 312 #endif
 313       GO TO 59
 314
 315    57 LQ(LMT)   = ISORDV(JSOR)
 316       LQ(LMT+1) = 1
 317       LQ(LMT+2) = 0
 318       LQ(LMT+3) = LSTAV(JSOR)
 319       LQ(LMT+4) = LENDV(JSOR)
 320       LQ(LMT+5) = 0
 321       LQ(LMT+6) = 0
 322       LQ(LMT+7) = 0
 323 #if defined(CERNLIB_QDEBPRI)
 324       IF (LOGLVI.GE.3)  THEN
 325           WRITE (IQLOG,9058)  JS,LQ(LMT),LQ(LMT+3),LQ(LMT+4)
 326         ENDIF
 327  9058 FORMAT (' FZIMTB-  read segment',I3,' into division/from/to'
 328      F,I3,2I9)
 329 #endif
 330    59 LMT  = LMT + 8
 331 #include "zebra/qtrace99.inc"
 332       RETURN
 333
 334 C------            Garbage collection to make room for the table
 335
 336    61 IF (IFLGAR.GE.2)             GO TO 721
 337       IXSTOR = ISHFTL (JQSTOR,26)
 338       IF (IFLGAR.NE.0)             GO TO 63
 339
 340       IXSTOR = MZIXCO (IXSTOR+21,22,23,24)
 341       CALL MZGARB (IXSTOR, 0)
 342       IFLGAR = 1
 343       IF (JQSTOR.NE.0)             GO TO 46
 344       IFLGAR = 2
 345       GO TO 46
 346
 347 C--                Collect also the primary store
 348
 349    63 IFLGAR = 2
 350       J = MZIXCO (21,22,23,24)
 351       CALL MZGARB (J, 0)
 352       CALL MZSDIV (IXSTOR,-7)
 353       GO TO 46
 354
 355 C----              All segments to be skipped
 356
 357    81 NWBKI  = 0
 358       JRETCD = -4
 359 #if defined(CERNLIB_QDEBPRI)
 360       IF (LOGLVI.GE.3)   WRITE (IQLOG,9081)
 361  9081 FORMAT (' FZIMTB-  skip all segments')
 362 #endif
 363       GO TO 999
 364
 365 C-------------------------------------------------
 366 C-                 ERROR CONDITIONS
 367 C-------------------------------------------------
 368
 369 C----              User error
 370
 371 C-    JERROR = 15  NQSEG has been changed by the user
 372   715 JERROR = 15
 373       IQUEST(14)= NQSEG
 374       IQUEST(15)= IQ(KQSP+LFISEG)
 375       NWERR = 2
 376       GO TO 719
 377
 378 C-    JERROR = 14  invalid division number in segment table
 379   714 JERROR = 14
 380       IQUEST(14)= JS
 381       IQUEST(15)= 0
 382       IQUEST(16)= IXDIV
 383       NWERR = 3
 384
 385   719 JRETCD = 4
 386       GO TO 999
 387
 388 C----              Not enough space
 389
 390 C-    JERROR = 21  not enough space
 391   721 JERROR = 21
 392
 393       JRETCD = 3
 394       GO TO 999
 395       END
 396 *      ==================================================
 397 #include "zebra/qcardl.inc"