| fe4da5cc |
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" |
git://git.uio.no / u / mrichter / AliRoot.git / blame