MINICERN/packlib/zebra/mqs/mzxref.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:13:12  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 MZXREF (IXFRP,IXTOP,CHOPT)
  14
  15 C-    Set cross-reference division IXFR pointing to IXTO
  16
  17 #include "zebra/mqsys.inc"
  18 C--------------    END CDE                             --------------
  19       DIMENSION    IXFRP(9), IXTOP(9)
  20       CHARACTER    *(*)  CHOPT
  21 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  22       DIMENSION    NAMESR(2)
  23       DATA  NAMESR / 4HMZXR, 4HEF   /
  24 #endif
  25 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  26       DATA  NAMESR / 6HMZXREF /
  27 #endif
  28 #if !defined(CERNLIB_QTRHOLL)
  29       CHARACTER    NAMESR*8
  30       PARAMETER   (NAMESR = 'MZXREF  ')
  31 #endif
  32
  33 #include "zebra/q_jbyt.inc"
  34 #include "zebra/q_sbit0.inc"
  35 #include "zebra/q_sbit1.inc"
  36
  37
  38       IXFR = IXFRP(1)
  39       IXTO = IXTOP(1)
  40
  41 #include "zebra/qtrace.inc"
  42
  43       CALL UOPTC (CHOPT,'ARC',IQUEST)
  44       MODE = IQUEST(1)
  45       IF (IQUEST(2).NE.0)  MODE=-1
  46       IF (IQUEST(3).NE.0)  MODE=-2
  47
  48 C-        MODE  +1 Add, 0 set, -1 Remove, -2 Contained
  49
  50       CALL MZSDIV (IXFR,0)
  51       IF (JQDIVI.EQ.0)             GO TO 91
  52       IF (MODE.EQ.-2)              GO TO 27
  53
  54       JST = JBYT (IXTO,27,6)
  55       IF (JST-16.EQ.JQSTOR)        GO TO 31
  56       IF    (JST.NE.JQSTOR)        GO TO 92
  57
  58 C--                SINGLE DIVISION INDEX
  59
  60       JDV = JBYT (IXTO,1,26)
  61       IF (JDV.GE.25)               GO TO 93
  62       IF (JDV.EQ.0)                GO TO 93
  63       IQUEST(1) = JDV
  64       NBI = 1
  65       GO TO 34
  66
  67 C--                CONTAINED DIVISION
  68
  69    27 IQRCU(KQT+JQDIVI) = 0
  70       IQRTO(KQT+JQDIVI) = 0
  71       IQRNO(KQT+JQDIVI) = 0
  72       GO TO 999
  73
  74 C--                COMPOSITE INDEX
  75
  76    31 CALL UBITS (IXTO,26,IQUEST,NBI)
  77
  78       IF (NBI.EQ.0)                GO TO 93
  79       IF (IQUEST(NBI).GE.25)       GO TO 93
  80
  81    34 IF (MODE.NE.0)               GO TO 41
  82       IQRTO(KQT+JQDIVI) = 0
  83       IQRNO(KQT+JQDIVI) = 9437183
  84
  85    41 DO 49  JBI=1,NBI
  86       JDV = IQUEST(JBI)
  87       IF (MODE.LT.0)               GO TO 47
  88
  89 C--       add
  90       IQRTO(KQT+JQDIVI) = MSBIT1 (IQRTO(KQT+JQDIVI),JDV)
  91       IF (JDV.GE.21 .AND. JDV.LT.24)   GO TO 49
  92       IQRNO(KQT+JQDIVI) = MSBIT1 (IQRNO(KQT+JQDIVI),JDV)
  93       GO TO 49
  94
  95 C--       remove
  96    47 IQRTO(KQT+JQDIVI) = MSBIT0 (IQRTO(KQT+JQDIVI),JDV)
  97       IQRNO(KQT+JQDIVI) = MSBIT0 (IQRNO(KQT+JQDIVI),JDV)
  98    49 CONTINUE
  99       CALL MZXRUP
 100 #include "zebra/qtrace99.inc"
 101       RETURN
 102
 103 C------            ERROR CONDITIONS
 104
 105    93 NQCASE = 1
 106    92 NQCASE = NQCASE + 1
 107    91 NQCASE = NQCASE + 1
 108       NQFATA = 3
 109       IQUEST(11) = IXFR
 110       IQUEST(12) = IXTO
 111       IQUEST(13) = MODE
 112 #include "zebra/qtofatal.inc"
 113       END
 114 *      ==================================================
 115 #include "zebra/qcardl.inc"