MINICERN/packlib/zebra/mqs/mzxrup.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:13:14  mclareni
   6 * Incorporate changes from J.Zoll for version 3.77
   7 *
   8 * Revision 1.1.1.1  1996/03/06 10:47:22  mclareni
   9 * Zebra
  10 *
  11 *
  12 #include "zebra/pilot.h"
  13       SUBROUTINE MZXRUP
  14
  15 C-    Derive IQRCU from IQRTO and IQRNO for current store
  16
  17 #include "zebra/mqsys.inc"
  18 C--------------    END CDE                             --------------
  19
  20 #include "zebra/q_jbit.inc"
  21 #include "zebra/q_jbyt.inc"
  22 #include "zebra/q_sbit1.inc"
  23 #include "zebra/q_jbytet.inc"
  24
  25 C----              Loop all divisions
  26
  27       JDVFR = 1
  28    21 IF (JDVFR.EQ.JQDVLL+1)  JDVFR = JQDVSY
  29       MASKTO = IQRTO(KQT+JDVFR)
  30       MASKNO = IQRNO(KQT+JDVFR)
  31       MASKCU = JBYT (MASKTO,1,20)
  32
  33       IF (JBIT(MASKTO,24).EQ.1)  MASKCU = MSBIT1(MASKCU,JQDVSY)
  34
  35       IF (JBYT(MASKTO,21,3).EQ.0)  GO TO 47
  36
  37 C--                Find divisions for generic
  38
  39       JDVTO = 1
  40    31 IF (JDVTO.EQ.JQDVLL+1)  JDVTO = JQDVSY
  41
  42       IF (JBIT(MASKNO,JDVTO).EQ.0)                   GO TO 37
  43       IF (JBYTET(IQKIND(KQT+JDVTO),MASKTO,1,23).EQ.0)   GO TO 37
  44       MASKCU = MSBIT1 (MASKCU,JDVTO)
  45    37 JDVTO = JDVTO + 1
  46       IF (JDVTO.LE.20)             GO TO 31
  47
  48    47 IQRCU(KQT+JDVFR) = MASKCU
  49       JDVFR = JDVFR + 1
  50       IF (JDVFR.LE.20)             GO TO 21
  51 C!    IX = MSBYT (0,JQSTOR,27,4)
  52 C!    CALL MZXRPR (IX)
  53       RETURN
  54       END
  55 *      ==================================================
  56 #include "zebra/qcardl.inc"