MINICERN/packlib/zebra/rz/rzdelk.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:45  mclareni
   6 * Extend the include file cleanup to dzebra, rz and tq, and also add
   7 * dependencies in some cases.
   8 *
   9 * Revision 1.1.1.1  1996/03/06 10:47:23  mclareni
  10 * Zebra
  11 *
  12 *
  13 #include "zebra/pilot.h"
  14       SUBROUTINE RZDELK(KEYU,ICYCLE,CHOPT)
  15 *
  16 ************************************************************************
  17 *
  18 *       To delete one or all keys in the CWD
  19 * Input:
  20 *   KEYU    Key array of dimension NWKEY (see RZMDIR)
  21 *   ICYCLE  Cycle number of the key to be deleted
  22 *           ICYCLE > highest cycle number means delete the highest cycle
  23 *           ICYCLE = 0 means delete the lowest cycle
  24 *           ICYCLE = -1, -2,... means delete the highest cycle -1, -2,...
  25 *   CHOPT   Character variable specifying the options selected.
  26 *           default
  27 *                 Delete the explicitly specified cycle ICYCLE only.
  28 *                 If cycle ICYCLE does not exist, no action is taken.
  29 *           'C'   Delete  ALL cycles corresponding to  key (ICYCLE not used)
  30 *           'S'   Delete all cycles smaller then cycle ICYCLE.
  31 *           'K'   Delete  ALL cycles for all Keys (KEYU,ICYCLE not used )
  32 *
  33 * Called by <USER>
  34 *
  35 *  Author  : R.Brun DD/US/PD
  36 *  Written : 20.04.86
  37 *  Last mod: 16.04.93 JDS. Return codes, deletion of objects at beginning
  38 *                          of cycles structure
  39 *          : 04.03.94 S.Banerjee (Change in cycle structure)
  40 *          : 23.03.95 J.Shiers - key # in cycles block is KEY(1)
  41 *  IQUEST(1) = 0: ok
  42 *  IQUEST(1) = 1: specified object not found
  43 *  IQUEST(1) = 2: directory is empty
  44 *  IQUEST(1) = 3: no RZ control bank (LQRS=0)
  45 *  IQUEST(1) = 4: no write permission
  46 *  IQUEST(1) =11: key/cycle discrepency
  47 *
  48 ************************************************************************
  49 #include "zebra/zunit.inc"
  50 #include "zebra/rzcl.inc"
  51 #include "zebra/rzclun.inc"
  52 #include "zebra/rzk.inc"
  53 #include "zebra/rzckey.inc"
  54 #include "zebra/rzcycle.inc"
  55       CHARACTER*(*) CHOPT
  56       DIMENSION KEYU(*)
  57       DIMENSION    IOPTV(3)
  58       EQUIVALENCE (IOPTC,IOPTV(1)), (IOPTS,IOPTV(2))
  59       EQUIVALENCE (IOPTK,IOPTV(3))
  60 *
  61 *-----------------------------------------------------------------------
  62 *
  63 #include "zebra/q_jbyt.inc"
  64 *
  65       IQUEST(1) = 0
  66       IQWARN    = 0
  67       CALL UOPTC(CHOPT,'CSK',IOPTV)
  68 *
  69 *           Check if write permission
  70 *
  71       IF(LQRS.EQ.0) THEN
  72          IQUEST(1) = 3
  73          GOTO 230
  74       ENDIF
  75
  76       IFLAG=1
  77       CALL RZMODS('RZDELK',IFLAG)
  78       IF(IFLAG.NE.0) THEN
  79          IQUEST(1) = 4
  80          GOTO 230
  81       ENDIF
  82 *
  83       LD=IQ(KQSP+LCDIR+KLD)
  84       LK=IQ(KQSP+LCDIR+KLK)
  85       LF=IQ(KQSP+LCDIR+KLF)
  86       LC=IQ(KQSP+LCDIR+KLC)
  87       LE=IQ(KQSP+LCDIR+KLE)
  88       NKEYS =IQ(KQSP+LCDIR+KNKEYS)
  89       NWKEY =IQ(KQSP+LCDIR+KNWKEY)
  90       IF(NKEYS.EQ.0)GOTO 220
  91 *
  92 *     Look for cycles marked for deletion by a previous call
  93 *     Set IQUEST(2) to warn application to rebuild bit map
  94 *
  95       DO 10 LKC=LC,LE-KLCYCL+1,KLCYCL
  96          IF(IQ(KQSP+LCDIR+LKC).EQ.-1)GOTO 20
  97    10 CONTINUE
  98       GOTO 30
  99    20 IQWARN = 1
 100    30 CONTINUE
 101 *
 102       NPUOLD=0
 103       IF(LPURG.NE.0)THEN
 104          NPURG=IQ(KQSP+LPURG+1)
 105          DO 40 I=1,NPURG
 106             NPUOLD=NPUOLD+IQ(KQSP+LPURG+2*I+1)-IQ(KQSP+LPURG+2*I)+1
 107    40    CONTINUE
 108       ENDIF
 109 *
 110 *           Option K. delete all keys
 111 *
 112       IF(IOPTK.NE.0)THEN
 113          DO 50 LKC=LC,LE-KLCYCL+1,KLCYCL
 114             IF (KVSCYC.EQ.0) THEN
 115                IR1 = JBYT(IQ(KQSP+LCDIR+LKC+KFRCYC),17,16)
 116                IP1 = JBYT(IQ(KQSP+LCDIR+LKC+KORCYC), 1,16)
 117                NW  = JBYT(IQ(KQSP+LCDIR+LKC+KNWCYC), 1,20)
 118                IR2 = JBYT(IQ(KQSP+LCDIR+LKC+KSRCYC),17,16)
 119             ELSE
 120                IR1 = IQ(KQSP+LCDIR+LKC+KFRCYC)
 121                IP1 = JBYT(IQ(KQSP+LCDIR+LKC+KORCYC), 1,20)
 122                NW  = IQ(KQSP+LCDIR+LKC+KNWCYC)
 123                IR2 = IQ(KQSP+LCDIR+LKC+KSRCYC)
 124             ENDIF
 125             NLEFT=LREC-IP1+1
 126             IF(NW.LE.NLEFT)THEN
 127                NR=0
 128             ELSE
 129                NR=(NW-NLEFT-1)/LREC+1
 130             ENDIF
 131             IF(IR2.EQ.IR1+1)THEN
 132                CALL RZPURF(NR+1,IR1)
 133             ELSE
 134                CALL RZPURF(1,IR1)
 135                IF(NR.NE.0)CALL RZPURF(NR,IR2)
 136             ENDIF
 137    50    CONTINUE
 138          LF=LK
 139          LC=LE+1
 140          NRD=IQ(KQSP+LCDIR+LD)
 141          IQ(KQSP+LCDIR+KRUSED) =NRD
 142          IQ(KQSP+LCDIR+KWUSED) =NRD*LREC
 143          IQ(KQSP+LCDIR+KMEGA)  =0
 144          IQ(KQSP+LCDIR+KIP1)   =1
 145          IQ(KQSP+LCDIR+KNFREE) =LC-LF
 146          IQ(KQSP+LCDIR+KLF)    =LF
 147          IQ(KQSP+LCDIR+KLC)    =LC
 148          IQ(KQSP+LCDIR+KNKEYS) =0
 149          GOTO 240
 150       ENDIF
 151 *
 152 *           Search KEY and CYCLE
 153 *
 154       DO 60 I=1,NWKEY
 155          IKDES=(I-1)/10
 156          IKBIT1=3*I-30*IKDES-2
 157          IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).LT.3)THEN
 158             KEY(I)=KEYU(I)
 159          ELSE
 160             CALL ZHTOI(KEYU(I),KEY(I),1)
 161          ENDIF
 162    60 CONTINUE
 163       DO 80 I=1,NKEYS
 164          DO 70 K=1,NWKEY
 165             LKC=LK+(NWKEY+1)*(I-1)
 166             IF(IQ(KQSP+LCDIR+LKC+K).NE.KEY(K))GOTO 80
 167    70    CONTINUE
 168          LCYC  =IQ(KQSP+LCDIR+LKC)
 169          LCPRE =LCYC
 170          LKK   =LKC
 171          IF (KVSCYC.NE.0) THEN
 172 *           IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.I) GO TO 250
 173             IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.
 174      +          IQ(KQSP+LCDIR+LKC+1)) GO TO 250
 175          ENDIF
 176          ICTOP =JBYT(IQ(KQSP+LCDIR+LCYC+KCNCYC),21,12)
 177          KCYCLE=ICYCLE
 178          IF(KCYCLE.GT.ICTOP)KCYCLE=ICTOP
 179          GOTO 90
 180    80 CONTINUE
 181       GOTO 210
 182 *
 183 *              Do we keep this cycle ?
 184 *
 185    90 IF (KVSCYC.EQ.0) THEN
 186          LCOLD = JBYT(IQ(KQSP+LCDIR+LCYC+KPPCYC), 1,16)
 187       ELSE
 188          LCOLD = IQ(KQSP+LCDIR+LCYC+KPPCYC)
 189       ENDIF
 190       IDEL=0
 191       ICY =JBYT(IQ(KQSP+LCDIR+LCYC+KCNCYC),21,12)
 192       IF(KCYCLE.EQ.ICY.AND.IOPTS.EQ.0)IDEL=1
 193       IF(IOPTC.NE.0)IDEL=1
 194       IF(IOPTK.NE.0)IDEL=1
 195       IF(IOPTS.NE.0)THEN
 196          IF(ICY.LT.ICYCLE)IDEL=1
 197       ENDIF
 198       IF(ICYCLE.EQ.0.AND.LCOLD.EQ.0)IDEL=1
 199       IF(ICYCLE.LT.0)THEN
 200          IF(ICY.EQ.ICTOP-ICYCLE)IDEL=1
 201       ENDIF
 202 *
 203 *              Mark all records that can be purged in first pass
 204 *
 205       IF(IDEL.NE.0)THEN
 206          IF(ICY.EQ.ICTOP)THEN
 207             IQ(KQSP+LCDIR+LKK)=LCOLD
 208          ELSE
 209             IF(LCOLD.EQ.0.AND.IOPTC.NE.0)THEN
 210                IQ(KQSP+LCDIR+LKK)=0
 211                IQ(KQSP+LCDIR+LCPRE)=-1
 212             ELSE
 213                CALL SBYT(LCOLD,IQ(KQSP+LCDIR+LCPRE),1,16)
 214             ENDIF
 215          ENDIF
 216          IF (KVSCYC.EQ.0) THEN
 217             IR1  = JBYT(IQ(KQSP+LCDIR+LCYC+KFRCYC),17,16)
 218             IP1  = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,16)
 219             NW   = JBYT(IQ(KQSP+LCDIR+LCYC+KNWCYC), 1,20)
 220             IR2  = JBYT(IQ(KQSP+LCDIR+LCYC+KSRCYC),17,16)
 221          ELSE
 222             IR1  = IQ(KQSP+LCDIR+LCYC+KFRCYC)
 223             IP1  = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,20)
 224             NW   = IQ(KQSP+LCDIR+LCYC+KNWCYC)
 225             IR2  = IQ(KQSP+LCDIR+LCYC+KSRCYC)
 226          ENDIF
 227          IRL  =0
 228          NWL  =0
 229          NLEFT=LREC-IP1+1
 230          NW1=NW
 231          IF(NW1.GE.NLEFT)NW1=NLEFT
 232          IF(IR2.NE.0)THEN
 233             NR=(NW-NW1-1)/LREC+1
 234             IF(NR.GT.1) CALL RZPURF(NR-1,IR2)
 235             IRL=IR2+NR-1
 236             NWL=NW-NW1-(NR-1)*LREC
 237          ENDIF
 238          IF(NW1.EQ.LREC)THEN
 239             CALL RZPURF(1,IR1)
 240             IR1=0
 241          ENDIF
 242          IF(NWL.EQ.LREC)THEN
 243             CALL RZPURF(1,IRL)
 244             IRL=0
 245          ENDIF
 246          IRLOUT=IQ(KQSP+LCDIR+KRLOUT)
 247          IF(IRL.EQ.IRLOUT.AND.NWL+1.EQ.IQ(KQSP+LCDIR+KIP1))THEN
 248             CALL RZPURF(1,IRL)
 249             IRL=0
 250          ENDIF
 251          IQ(KQSP+LCDIR+LCYC)=-1
 252          IQ(KQSP+LCDIR+LCYC+1)=IR1
 253          IQ(KQSP+LCDIR+LCYC+2)=IRL
 254          IQ(KQSP+LCDIR+LCYC+3)=NWL
 255          IF(IR1.NE.0)CALL SBYT(NW1,IQ(KQSP+LCDIR+LCYC+3),21,12)
 256       ELSE
 257          LCPRE=LCYC
 258       ENDIF
 259 *
 260       IF(LCOLD.NE.0.AND.LCOLD.NE.LCYC)THEN
 261          IF(KCYCLE.LT.ICY.OR.IOPTS.NE.0.OR.IOPTK.NE.0.OR.IOPTC.NE.0)THEN
 262             LCYC=LCOLD
 263             GOTO 90
 264          ENDIF
 265       ENDIF
 266 *
 267 *           Now loop on all purged cycles to find complete records
 268 *           purged
 269 *
 270       DO 130 LKC=LC,LE-KLCYCL+1,KLCYCL
 271          IF(IQ(KQSP+LCDIR+LKC).NE.-1)GOTO 130
 272          IR1=IQ(KQSP+LCDIR+LKC+1)
 273          IRL=IQ(KQSP+LCDIR+LKC+2)
 274          IF(IR1.NE.0)THEN
 275             DO 100 LKC1=LC,LE-KLCYCL+1,KLCYCL
 276                IF(IQ(KQSP+LCDIR+LKC1).EQ.-1)GOTO 100
 277                IF (KVSCYC.EQ.0) THEN
 278                   KR1  = JBYT(IQ(KQSP+LCDIR+LKC1+KFRCYC),17,16)
 279                   KP1  = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,16)
 280                   NW   = JBYT(IQ(KQSP+LCDIR+LKC1+KNWCYC), 1,20)
 281                   KR2  = JBYT(IQ(KQSP+LCDIR+LKC1+KSRCYC),17,16)
 282                ELSE
 283                   KR1  = IQ(KQSP+LCDIR+LKC1+KFRCYC)
 284                   KP1  = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,20)
 285                   NW   = IQ(KQSP+LCDIR+LKC1+KNWCYC)
 286                   KR2  = IQ(KQSP+LCDIR+LKC1+KSRCYC)
 287                ENDIF
 288                KRL  =0
 289                NLEFT=LREC-KP1+1
 290                NW1=NW
 291                IF(NW1.GE.NLEFT)NW1=NLEFT
 292                IF(KR2.NE.0)THEN
 293                   NR=(NW-NW1-1)/LREC+1
 294                   KRL=KR2+NR-1
 295                ENDIF
 296                IF(KR1.EQ.IR1.OR.KRL.EQ.IR1)GOTO 110
 297   100       CONTINUE
 298             CALL RZPURF(1,IR1)
 299          ENDIF
 300 *
 301   110    IF(IRL.NE.0)THEN
 302             DO 120 LKC1=LC,LE-KLCYCL+1,KLCYCL
 303                IF(IQ(KQSP+LCDIR+LKC1).EQ.-1)GOTO 120
 304                IF (KVSCYC.EQ.0) THEN
 305                   KR1  = JBYT(IQ(KQSP+LCDIR+LKC1+KFRCYC),17,16)
 306                   KP1  = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,16)
 307                   NW   = JBYT(IQ(KQSP+LCDIR+LKC1+KNWCYC), 1,20)
 308                   KR2  = JBYT(IQ(KQSP+LCDIR+LKC1+KSRCYC),17,16)
 309                ELSE
 310                   KR1  = IQ(KQSP+LCDIR+LKC1+KFRCYC)
 311                   KP1  = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,20)
 312                   NW   = IQ(KQSP+LCDIR+LKC1+KNWCYC)
 313                   KR2  = IQ(KQSP+LCDIR+LKC1+KSRCYC)
 314                ENDIF
 315                KRL  =0
 316                NLEFT=LREC-KP1+1
 317                NW1=NW
 318                IF(NW1.GE.NLEFT)NW1=NLEFT
 319                IF(KR2.NE.0)THEN
 320                   NR=(NW-NW1-1)/LREC+1
 321                   KRL=KR2+NR-1
 322                ENDIF
 323                IF(KR1.EQ.IRL.OR.KRL.EQ.IRL)GOTO 130
 324   120       CONTINUE
 325             CALL RZPURF(1,IRL)
 326          ENDIF
 327   130 CONTINUE
 328 *
 329 *           Garbage collection on cycles area + relocation
 330 *
 331       LKC3=LE-KLCYCL+1
 332   140 IF(LKC3.LT.LC)GOTO 190
 333 *
 334 *     Found a deleted object. Now look for previous undeleted object
 335 *
 336       IF(IQ(KQSP+LCDIR+LKC3).EQ.-1)THEN
 337
 338          LKC3=LKC3+KLCYCL
 339          LKC2=LKC3-2*KLCYCL
 340 *
 341 *     First object?
 342 *
 343          IF(LKC2.LT.LC) THEN
 344             LC    = LKC3
 345             GOTO 190
 346          ENDIF
 347
 348   150    IF(IQ(KQSP+LCDIR+LKC2).NE.-1)THEN
 349             LKC2=LKC2+KLCYCL
 350             LKC1=LKC2-2*KLCYCL
 351             IF(LKC1.LT.LC)LKC1=LC
 352   160       IF(IQ(KQSP+LCDIR+LKC1).EQ.-1)THEN
 353                    IF(LKC1.GT.LC .OR.
 354      +             (LKC1.EQ.LC.AND.LKC2.NE.LC))LKC1=LKC1+KLCYCL
 355             ELSE
 356                IF(LKC1.GT.LC)THEN
 357                   LKC1=LKC1-KLCYCL
 358                   GOTO 160
 359                ENDIF
 360             ENDIF
 361 *
 362             NPUSH=LKC3-LKC2
 363 *
 364 *      Update pointers in cycles block
 365 *
 366             DO 170 LKC=LC,LKC2-KLCYCL,KLCYCL
 367                IF(IQ(KQSP+LCDIR+LKC).NE.-1)THEN
 368                   IF (KVSCYC.EQ.0) THEN
 369                      LCOLD = JBYT(IQ(KQSP+LCDIR+LKC+KPPCYC),1,16)
 370                   ELSE
 371                      LCOLD = IQ(KQSP+LCDIR+LKC+KPPCYC)
 372                   ENDIF
 373                   IF(LCOLD.GE.LKC1.AND.LCOLD.LT.LKC2)THEN
 374                      LCOLD=LCOLD+NPUSH
 375                      IF (KVSCYC.EQ.0) THEN
 376                         CALL SBYT(LCOLD,IQ(KQSP+LCDIR+LKC+KPPCYC),1,16)
 377                      ELSE
 378                         IQ(KQSP+LCDIR+LKC+KPPCYC) = LCOLD
 379                      ENDIF
 380                   ENDIF
 381                ENDIF
 382   170       CONTINUE
 383 *
 384 *      Update pointers from KEYS block to CYCLES block
 385 *
 386             DO 180 IK=1,NKEYS
 387                LCYC=IQ(KQSP+LCDIR+LK+(NWKEY+1)*(IK-1))
 388                IF(LCYC.GE.LKC1.AND.LCYC.LT.LKC2)THEN
 389                   IQ(KQSP+LCDIR+LK+(NWKEY+1)*(IK-1))=
 390      +            IQ(KQSP+LCDIR+LK+(NWKEY+1)*(IK-1))+NPUSH
 391                ENDIF
 392   180       CONTINUE
 393 *
 394 *     Squeeze out deleted cycles
 395 *
 396             CALL UCOPY2(IQ(KQSP+LCDIR+LKC1),IQ(KQSP+LCDIR+LKC1+NPUSH),
 397      +                  LKC2-LKC1)
 398             LKC3=LKC1+NPUSH
 399             LKC2=LKC1-KLCYCL
 400 *
 401 *     Only deleted objects before this block?
 402 *
 403             IF(IQ(KQSP+LCDIR+LKC2).EQ.-1.AND.LKC2.EQ.LC) THEN
 404                LC  = LKC3
 405                GOTO 190
 406             ENDIF
 407
 408             IF(LKC1.NE.LC)GOTO 150
 409             LC=LC+NPUSH
 410             GOTO 190
 411 *
 412          ELSE
 413             LKC2=LKC2-KLCYCL
 414 *
 415 *     Only deleted objects before this block?
 416 *
 417             IF(IQ(KQSP+LCDIR+LKC2).EQ.-1.AND.LKC2.EQ.LC) THEN
 418                LC  = LKC3
 419                GOTO 190
 420             ENDIF
 421
 422             IF(LKC2.GE.LC)GOTO 150
 423
 424          ENDIF
 425       ELSE
 426          LKC3=LKC3-KLCYCL
 427          GOTO 140
 428       ENDIF
 429 *
 430 *           Remove KEY from K area if only one cycle
 431 *
 432   190 CONTINUE
 433       IF(IQ(KQSP+LCDIR+LKK).EQ.0)THEN
 434          IF(LKK+NWKEY+1.LT.LF)THEN
 435             CALL UCOPY2(IQ(KQSP+LCDIR+LKK+NWKEY+1),
 436      +                  IQ(KQSP+LCDIR+LKK),LF-LKK)
 437          ENDIF
 438          LF=LF-NWKEY-1
 439          IQ(KQSP+LCDIR+KNFREE)=IQ(KQSP+LCDIR+KNFREE)+NWKEY+1
 440          IQ(KQSP+LCDIR+KLF)=LF
 441          IQ(KQSP+LCDIR+KNKEYS)=IQ(KQSP+LCDIR+KNKEYS)-1
 442          IF(IQ(KQSP+LCDIR+KNKEYS).EQ.0)LC=LE+1
 443       ENDIF
 444 *
 445 *           Reset internal pointers
 446 *
 447       NPUNEW=0
 448       IF(LPURG.NE.0)THEN
 449          NPURG=IQ(KQSP+LPURG+1)
 450          DO 200 I=1,NPURG
 451             NPUNEW=NPUNEW+IQ(KQSP+LPURG+2*I+1)-IQ(KQSP+LPURG+2*I)+1
 452   200    CONTINUE
 453       ENDIF
 454       NPU=NPUNEW-NPUOLD
 455       IQUEST( 9)=IQ(KQSP+LCDIR+KQUOTA)-IQ(KQSP+LCDIR+KRUSED)+NPU
 456       IQUEST(11)=(LC-IQ(KQSP+LCDIR+KLC))/KLCYCL
 457       IQUEST(12)=NPU*LREC
 458       IQUEST(13)=NPU
 459 *
 460       IQ(KQSP+LCDIR+KRUSED)=IQ(KQSP+LCDIR+KRUSED)-NPU
 461       NWP=NPU*LREC
 462       NMEGA=NWP/1000000
 463       IQ(KQSP+LCDIR+KMEGA)=IQ(KQSP+LCDIR+KMEGA)-NMEGA
 464       NWP=NWP-1000000*NMEGA
 465       IQ(KQSP+LCDIR+KWUSED)=IQ(KQSP+LCDIR+KWUSED)-NWP
 466       IQ(KQSP+LCDIR+KNFREE)=IQ(KQSP+LCDIR+KNFREE)+LC-IQ(KQSP+LCDIR+KLC)
 467       IQ(KQSP+LCDIR+KLC)=LC
 468       GOTO 240
 469 *
 470 *           KEY not found
 471 *
 472   210 IF(JBYT(IQ(KQSP+LTOP),15,3)-3.GE.-2) WRITE(IQLOG,10000)
 473 10000 FORMAT(' RZDELK. Key not found')
 474       IQUEST(1)=1
 475       IQUEST(2)=IQWARN
 476       RETURN
 477
 478   220 IF(JBYT(IQ(KQSP+LTOP),15,3)-3.GE.-2) WRITE(IQLOG,10100)
 479 10100 FORMAT(' RZDELK. directory is empty')
 480       IQUEST(1)=2
 481       IQUEST(2)=IQWARN
 482       RETURN
 483 *
 484   230 IQUEST(2)=IQWARN
 485       RETURN
 486
 487   240 IQUEST(2)=IQWARN
 488       RETURN
 489
 490   250 IF(JBYT(IQ(KQSP+LTOP),15,3)-3.GE.-2) WRITE(IQLOG,10100)
 491 10200 FORMAT(' RZDELK. mismatch in key/cycle pointing')
 492       IQUEST(1)=11
 493       IQUEST(2)=IQWARN
 494       RETURN
 495       END