[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / mqs / mzxref.F

*
* $Id$
*
* $Log$
* Revision 1.2  1996/04/18 16:13:12  mclareni
* Incorporate changes from J.Zoll for version 3.77
*
* Revision 1.1.1.1  1996/03/06 10:47:22  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
      SUBROUTINE MZXREF (IXFRP,IXTOP,CHOPT)

C-    Set cross-reference division IXFR pointing to IXTO

#include "zebra/mqsys.inc"
C--------------    END CDE                             --------------
      DIMENSION    IXFRP(9), IXTOP(9)
      CHARACTER    *(*)  CHOPT
#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
      DIMENSION    NAMESR(2)
      DATA  NAMESR / 4HMZXR, 4HEF   /
#endif
#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
      DATA  NAMESR / 6HMZXREF /
#endif
#if !defined(CERNLIB_QTRHOLL)
      CHARACTER    NAMESR*8
      PARAMETER   (NAMESR = 'MZXREF  ')
#endif

#include "zebra/q_jbyt.inc"
#include "zebra/q_sbit0.inc"
#include "zebra/q_sbit1.inc"


      IXFR = IXFRP(1)
      IXTO = IXTOP(1)

#include "zebra/qtrace.inc"

      CALL UOPTC (CHOPT,'ARC',IQUEST)
      MODE = IQUEST(1)
      IF (IQUEST(2).NE.0)  MODE=-1
      IF (IQUEST(3).NE.0)  MODE=-2

C-        MODE  +1 Add, 0 set, -1 Remove, -2 Contained

      CALL MZSDIV (IXFR,0)
      IF (JQDIVI.EQ.0)             GO TO 91
      IF (MODE.EQ.-2)              GO TO 27

      JST = JBYT (IXTO,27,6)
      IF (JST-16.EQ.JQSTOR)        GO TO 31
      IF    (JST.NE.JQSTOR)        GO TO 92

C--                SINGLE DIVISION INDEX

      JDV = JBYT (IXTO,1,26)
      IF (JDV.GE.25)               GO TO 93
      IF (JDV.EQ.0)                GO TO 93
      IQUEST(1) = JDV
      NBI = 1
      GO TO 34

C--                CONTAINED DIVISION

   27 IQRCU(KQT+JQDIVI) = 0
      IQRTO(KQT+JQDIVI) = 0
      IQRNO(KQT+JQDIVI) = 0
      GO TO 999

C--                COMPOSITE INDEX

   31 CALL UBITS (IXTO,26,IQUEST,NBI)

      IF (NBI.EQ.0)                GO TO 93
      IF (IQUEST(NBI).GE.25)       GO TO 93

   34 IF (MODE.NE.0)               GO TO 41
      IQRTO(KQT+JQDIVI) = 0
      IQRNO(KQT+JQDIVI) = 9437183

   41 DO 49  JBI=1,NBI
      JDV = IQUEST(JBI)
      IF (MODE.LT.0)               GO TO 47

C--       add
      IQRTO(KQT+JQDIVI) = MSBIT1 (IQRTO(KQT+JQDIVI),JDV)
      IF (JDV.GE.21 .AND. JDV.LT.24)   GO TO 49
      IQRNO(KQT+JQDIVI) = MSBIT1 (IQRNO(KQT+JQDIVI),JDV)
      GO TO 49

C--       remove
   47 IQRTO(KQT+JQDIVI) = MSBIT0 (IQRTO(KQT+JQDIVI),JDV)
      IQRNO(KQT+JQDIVI) = MSBIT0 (IQRNO(KQT+JQDIVI),JDV)
   49 CONTINUE
      CALL MZXRUP
#include "zebra/qtrace99.inc"
      RETURN

C------            ERROR CONDITIONS

   93 NQCASE = 1
   92 NQCASE = NQCASE + 1
   91 NQCASE = NQCASE + 1
      NQFATA = 3
      IQUEST(11) = IXFR
      IQUEST(12) = IXTO
      IQUEST(13) = MODE
#include "zebra/qtofatal.inc"
      END
*      ==================================================
#include "zebra/qcardl.inc"
Commit	Line	Data
fe4da5cc	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"