MINICERN/packlib/zebra/mq/mzstor.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:12:06  mclareni
   6 * Incorporate changes from J.Zoll for version 3.77
   7 *
   8 * Revision 1.1.1.1  1996/03/06 10:47:17  mclareni
   9 * Zebra
  10 *
  11 *
  12 #include "zebra/pilot.h"
  13       SUBROUTINE MZSTOR (IXSTOR,CHNAME,CHOPT
  14      +,                  IFENCE,LV,LLR,LLD,LIMIT,LAST)
  15
  16 C-    Initialize new Zebra store region, user called
  17
  18 #include "zebra/zbcd.inc"
  19 #include "zebra/zmach.inc"
  20 #include "zebra/zstate.inc"
  21 #include "zebra/zunit.inc"
  22 #include "zebra/mqsys.inc"
  23 #include "zebra/mzcwk.inc"
  24 C--------------    End CDE                             --------------
  25       DIMENSION    IXSTOR(9),IFENCE(9)
  26       DIMENSION    LV(9),LLR(9),LLD(9),LIMIT(9),LAST(9)
  27       DIMENSION    MMSYSL(5), NAMELA(2), NAMESY(2)
  28       CHARACTER    *(*) CHNAME,CHOPT
  29 #if defined(CERNLIB_QMVDS)
  30       SAVE         MMSYSL, NAMELA, NAMESY, NAMWSP, NAMEDV
  31 #endif
  32 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  33       DIMENSION    NAMESR(2)
  34       DATA  NAMESR / 4HMZST, 4HOR   /
  35 #endif
  36 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  37       DATA  NAMESR / 6HMZSTOR /
  38 #endif
  39 #if !defined(CERNLIB_QTRHOLL)
  40       CHARACTER    NAMESR*8
  41       PARAMETER   (NAMESR = 'MZSTOR  ')
  42 #endif
  43 #if defined(CERNLIB_QHOLL)
  44       DATA  MMSYSL / 4HSYSL,0,0,101,2/
  45       DATA  NAMELA / 4Hsyst, 4Hem   /
  46       DATA  NAMESY / 4Hsyst, 4Hem   /
  47       DATA  NAMWSP / 4Hqwsp /
  48       DATA  NAMEDV / 4HQDIV /
  49 #endif
  50 #if !defined(CERNLIB_QHOLL)
  51       DATA  MMSYSL / 0,0,0,101,2/
  52 #endif
  53
  54 #include "zebra/q_sbit1.inc"
  55 #include "zebra/q_shiftl.inc"
  56 #include "zebra/q_locf.inc"
  57
  58
  59 C--                Clear Zebra tables on first entry
  60
  61       IF (NQSTOR.NE.-1)            GO TO 13
  62       CALL VZERO (NQOFFT,32)
  63       LQATAB = LOCF (IQTABV(1)) - 1
  64       LQASTO = LOCF (LQ(1)) - 1
  65       LQBTIS = LQATAB - LQASTO
  66       LQWKTB = LOCF(IQWKTB(1)) - LQASTO
  67       LQWKFZ = LOCF(IQWKFZ(1)) - LQASTO
  68       NQTSYS = LOCF(IQDN2(20)) - LQATAB
  69       NQWKTB = NQWKTT
  70
  71 C-      KQFT=342 relies on LQFSTA(1) to be LQSTA(1+342) in /MZCC/
  72       KQFT = 342
  73 #if defined(CERNLIB_QPRINT)
  74       IF (NQLOGD.GE.-1)
  75      +WRITE (IQLOG,9011) LQATAB,LQATAB
  76  9011 FORMAT (1X/' MZSTOR.  ZEBRA table base TAB(0) in /MZCC/ at adr'
  77 #endif
  78 #if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))
  79      F,I12,1X,O11,' OCT')
  80 #endif
  81 #if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))&&(!defined(CERNLIB_B64))
  82      F,I12,1X,Z11,' HEX')
  83 #endif
  84 #if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))&&(defined(CERNLIB_B64))
  85      F,I12,1X,Z16,' HEX')
  86 #endif
  87    13 CONTINUE
  88 #if !defined(CERNLIB_QHOLL)
  89       CALL UCTOH ('SYSL',    MMSYSL, 4,4)
  90       CALL UCTOH ('system  ',NAMELA, 4,8)
  91       CALL UCTOH ('system  ',NAMESY, 4,8)
  92       CALL UCTOH ('qwsp'    ,NAMWSP, 4,4)
  93       CALL UCTOH ('QDIV'    ,NAMEDV, 4,4)
  94 #endif
  95
  96 #include "zebra/qtrace.inc"
  97
  98       CALL UOPTC (CHOPT,'Q:',IQUEST)
  99       LOGQ   = IQUEST(1)
 100       IFLSPL = IQUEST(2)
 101
 102       JQSTOR = NQSTOR + 1
 103       CALL VZERO (KQT,27)
 104
 105 C--                Calculate store off-set
 106
 107       LQSTOR = LOCF(LV(1)) - 1
 108       KQS    = LQSTOR - LQASTO
 109
 110       NFEND  = (LQSTOR+1) - LOCF(IFENCE(1))
 111       NQFEND = NFEND
 112
 113 C--                Printing name of store
 114
 115       NQSNAM(1) = IQBLAN
 116       NQSNAM(2) = IQBLAN
 117       N = MIN (8, LEN(CHNAME))
 118       IF (N.NE.0)  CALL UCTOH (CHNAME,NQSNAM,4,N)
 119
 120 C--                Set log level
 121
 122       NQLOGL = NQLOGD
 123       IF (LOGQ.NE.0)  NQLOGL=-2
 124
 125 C--                Permanent links et al.
 126
 127       NQSTRU = LOCF(LLR(1)) - (LQSTOR+1)
 128       NQREF  = LOCF(LLD(1)) - (LQSTOR+1)
 129       NQLINK = NQREF
 130       LQ2END = LOCF(LIMIT(1)) - LQSTOR
 131       NDATAT = LOCF(LAST(1))  - LQSTOR
 132
 133 C--                Calculate table off-set
 134
 135       NDATA = NDATAT
 136       LOCT  = LQATAB
 137       IF (JQSTOR.NE.0)  THEN
 138           NDATA = NDATA  - NQTSYS
 139           NQSNAM(6) = NDATA
 140           LOCT  = LQSTOR + NDATA
 141           KQT   = LOCT   - LQATAB
 142           NDATA = NDATA - 4
 143           CALL VFILL (LQ(KQS+NDATA),10,IQNIL)
 144         ENDIF
 145
 146 #if defined(CERNLIB_QPRINT)
 147       IF (NQLOGL.GE.-1)
 148      +WRITE (IQLOG,9021) JQSTOR,NQSNAM(1),NQSNAM(2)
 149      +,                  LQSTOR,LOCT,LQSTOR,LOCT,KQS,KQT,KQS,KQT
 150      +,                  NQSTRU,NQREF,LQ2END,NDATAT,NFEND
 151  9021 FORMAT (1X/' MZSTOR.  Initialize Store',I3,'  in ',2A4,
 152      F/10X,'with Store/Table at absolute adrs',2I12
 153 #endif
 154 #if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))
 155      F/40X,'OCT',2(1X,O11)/40X,'OCT',2(1X,O11)
 156 #endif
 157 #if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))&&(!defined(CERNLIB_B64))
 158      F/40X,'HEX',2(1X,Z11)/40X,'HEX',2(1X,Z11)
 159 #endif
 160 #if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))&&(defined(CERNLIB_B64))
 161      F/30X,'HEX',2(1X,Z16)/30X,'HEX',2(1X,Z16)
 162 #endif
 163 #if defined(CERNLIB_QPRINT)
 164      F/30X,'relative adrs',2I12
 165      F/10X,'with',I6,' Str. in',I6,' Links in',I7,' Low words in'
 166      F,I8,' words.'
 167      F/10X,'This store has a fence of',I5,' words.')
 168 #endif
 169
 170 C--                Set minimum sizes
 171
 172       NSYS   =  400
 173       NQMINR =   40
 174       NWF    = 2000
 175       IF (JQSTOR.EQ.0)  NQMINR=164
 176
 177 C--                Check parameters valid
 178
 179       IF (NQSTRU.LT.0)               GO TO 91
 180       IF (NQREF .LT.NQSTRU)          GO TO 91
 181       IF (NDATAT.LT.NQLINK+NWF)      GO TO 91
 182       IF (LQ2END.LT.NQLINK+NQMINR)   GO TO 91
 183       IF (NFEND .LT.1)               GO TO 92
 184       IF (NFEND .GE.1001)            GO TO 92
 185       IF (IFLSPL.EQ.1)  THEN
 186           IF (JQSTOR.EQ.0)           GO TO 96
 187           GO TO 39
 188         ENDIF
 189
 190 #if (!defined(CERNLIB_QSINGLST))&&(defined(CERNLIB_QDEBUG))
 191 C--                Check overlapping stores
 192
 193       IF (JQSTOR.EQ.0)             GO TO 41
 194       KSA = KQS - NQFEND
 195       KSE = KQS + NDATAT
 196
 197       DO 36  JSTO=1,JQSTOR
 198       JT  = NQOFFT(JSTO)
 199       JS  = NQOFFS(JSTO)
 200       JSA = JS  - IQTABV(JT+2)
 201       JSE = JS  + LQSTA(JT+21)
 202       JTA = JT  + LQBTIS
 203       JTE = JTA + NQTSYS
 204
 205       IF (KSE.GT.JTA .AND. KSA.LT.JTE)    GO TO 94
 206       IF (KSE.GT.JSA .AND. KSA.LT.JSE)    GO TO 95
 207    36 CONTINUE
 208 #endif
 209    39 IF (JQSTOR.GE.16)            GO TO 93
 210
 211 C----              Initialize divisions 1 + 2 + system
 212
 213    41 NQOFFT(JQSTOR+1) = KQT
 214       NQOFFS(JQSTOR+1) = KQS
 215       NQALLO(JQSTOR+1) = IFLSPL
 216       CALL VZERO (IQTABV(KQT+1),NQTSYS)
 217       CALL VBLANK (IQDN1(KQT+1), 40)
 218       NQSTOR = NQSTOR + 1
 219
 220       LQ(KQS+NDATA-1) = IQNIL
 221       LQ(KQS+NDATA)   = IQNIL
 222
 223       NDATA = NDATA - 2
 224       LQSTA(KQT+21) = NDATA
 225
 226       JQDVLL = 2
 227       JQDVSY = 20
 228       LQSTA(KQT+20)  = NDATA
 229       LQEND(KQT+20)  = NDATA
 230       NQDMAX(KQT+20) = NDATA
 231       IQMODE(KQT+20) = 1
 232       IQKIND(KQT+20) = ISHFTL (1, 23)
 233       IQRNO(KQT+20)  = 9437183
 234       IQDN1(KQT+20)  = NAMESY(1)
 235       IQDN2(KQT+20)  = NAMESY(2)
 236
 237       LQSTA(KQT+2)  = NDATA - NSYS
 238       LQEND(KQT+2)  = LQSTA(KQT+2)
 239       NQDMAX(KQT+2) = NDATA
 240       IQMODE(KQT+2) = 1
 241       IQKIND(KQT+2) = MSBIT1 (2, 21)
 242       IQRCU(KQT+2)  = 3
 243       IQRTO(KQT+2)  = ISHFTL (3,20)
 244       IQRNO(KQT+2)  = 9437183
 245       IQDN1(KQT+2)  = NAMEDV
 246       IQDN2(KQT+2)  = IQNUM(3)
 247
 248       LQSTA(KQT+1)  = NQLINK + 1
 249       LQEND(KQT+1)  = LQSTA(KQT+1)
 250       NQDMAX(KQT+1) = NDATA
 251       IQKIND(KQT+1) = MSBIT1 (1, 21)
 252       IQRCU(KQT+1)  = 3
 253       IQRTO(KQT+1)  = ISHFTL (3,20)
 254       IQRNO(KQT+1)  = 9437183
 255       IQDN1(KQT+1)  = NAMEDV
 256       IQDN2(KQT+1)  = IQNUM(2)
 257
 258       CALL UCOPY (IQCUR,IQTABV(KQT+1),16)
 259       CALL VFILL (IFENCE,NFEND,IQNIL)
 260       IF (NQLINK.NE.0)  CALL VZERO (LV,NQLINK)
 261
 262 C--                Return IXSTOR
 263
 264       IF (JQSTOR.EQ.0)  THEN
 265           IF (IXSTOR(1).EQ.0)      GO TO 71
 266         ENDIF
 267       IDN = ISHFTL (JQSTOR,26)
 268       IXSTOR(1) = IDN
 269
 270 C----              Create system link table bank
 271
 272    71 JQDIVI = JQDVSY
 273       CALL MZLIFT (-7,LSYS,0,2,MMSYSL,0)
 274       LQSYSS(KQT+1) = LSYS
 275
 276       NALL   = LOCF(IQTDUM(1)) - LOCF(LQSYSS(1))
 277       NSTR   = LOCF(LQSYSR(1)) - LOCF(LQSYSS(1))
 278
 279       LOCAR  = LOCF (LQSYSS(KQT+1)) - LQSTOR
 280       LOCARE = LOCAR + NALL
 281
 282 C--                Working space
 283
 284       IQ(KQS+LSYS+1) = 11
 285       IQ(KQS+LSYS+2) = 1
 286       IQ(KQS+LSYS+3) = 1 + NQLINK
 287       IQ(KQS+LSYS+4) = NQSTRU
 288       IQ(KQS+LSYS+5) = NAMWSP
 289       IQ(KQS+LSYS+6) = IQBLAN
 290
 291 C--                System link area
 292
 293       IQ(KQS+LSYS+7) = LOCAR
 294       IQ(KQS+LSYS+8) = LOCARE
 295       IQ(KQS+LSYS+9) = NSTR
 296       IQ(KQS+LSYS+10)= NAMELA(1)
 297       IQ(KQS+LSYS+11)= NAMELA(2)
 298
 299 C--                Range of possible values for an origin-link
 300
 301       IQTABV(KQT+13) = MIN (1, LOCAR)
 302       IQTABV(KQT+14) = MAX (LQSTA(KQT+21), LOCARE)
 303
 304 #include "zebra/qtrace99.inc"
 305       RETURN
 306
 307 C------            Error conditions
 308
 309 #if (!defined(CERNLIB_QSINGLST))&&(defined(CERNLIB_QDEBUG))
 310    95 NQCASE = 1
 311    94 NQCASE = NQCASE - 2
 312       NQFATA = 3
 313       IQUEST(20) = JSTO - 1
 314       IQUEST(21) = NQPNAM(JT+1)
 315       IQUEST(22) = NQPNAM(JT+2)
 316 #endif
 317
 318    96 NQCASE = NQCASE + 3
 319    93 NQCASE = NQCASE + 1
 320    92 NQCASE = NQCASE + 1
 321    91 NQCASE = NQCASE + 1
 322       NQFATA = NQFATA + 9
 323       IQUEST(11) = NQSNAM(1)
 324       IQUEST(12) = NQSNAM(2)
 325       IQUEST(13) = NFEND
 326       IQUEST(14) = NQSTRU
 327       IQUEST(15) = NQLINK
 328       IQUEST(16) = LQ2END
 329       IQUEST(17) = NDATAT
 330       IQUEST(18) = NQMINR
 331       IQUEST(19) = NWF
 332 #include "zebra/qtofatal.inc"
 333       END
 334 *      ==================================================
 335 #include "zebra/qcardl.inc"