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

*
* $Id$
*
* $Log$
* Revision 1.2  1996/04/18 16:13:09  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 MZSDIV (IXDIVP,IFLAGP)

C-    Set current store JQSTOR and maybe division JQDIVI from IXDIVP
C-    IFLAG = -ve :  store only
C-           else :  set also JQDIVI:
C-                   to the division if a specific single division,
C-                   or JQDIVI = 0 if no such given, 
C-                with these restrictions:
C-            > 0 :  IXDIVP may not be a compound or generic index
C-            = 4 :  specific single division required, =0 not allowed
C-    system called, could be user called

#include "zebra/zstate.inc"
#include "zebra/mqsys.inc"
C--------------    END CDE                             --------------
      DIMENSION    IXDIVP(9), IFLAGP(9)
#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
      DIMENSION    NAMESR(2)
      DATA  NAMESR / 4HMZSD, 4HIV   /
#endif
#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
      DATA  NAMESR / 6HMZSDIV /
#endif
#if !defined(CERNLIB_QTRHOLL)
      CHARACTER    NAMESR*8
      PARAMETER   (NAMESR = 'MZSDIV  ')
#endif

#include "zebra/q_jbyt.inc"


      IXIN  = IXDIVP(1)
      IFLAG = IFLAGP(1)
      JSTO  = JBYT (IXIN,27,4)
      IF (JSTO.NE.JQSTOR)          GO TO 41
      IF (IFLAG.LT.0)              GO TO 48

   21 JDIV = JBYT (IXIN,1,26)
#if defined(CERNLIB_B32)
      JCOM = JBYT (IXIN,31,2)
#endif
#if defined(CERNLIB_B36)
      JCOM = JBYT (IXIN,31,6)
#endif
#if defined(CERNLIB_B48)
      JCOM = JBYT (IXIN,31,18)
#endif
#if defined(CERNLIB_B60)
      JCOM = JBYT (IXIN,31,30)
#endif
#if defined(CERNLIB_B64)
      JCOM = JBYT (IXIN,31,34)
#endif
      IF   (JCOM-1)          22, 31, 91

C--                SINGLE DIVISION INDEX

   22 IF (JDIV.GE.25)              GO TO 92
      IF (JDIV.GE.21)              GO TO 24
      IF (JDIV.GT.JQDVLL)  THEN
          IF (JDIV.LT.JQDVSY)      GO TO 92
        ENDIF
      IF (JDIV.EQ.0)  THEN
          IF (IFLAG.EQ.4)          GO TO 94
        ENDIF
      JQDIVI = JDIV
      RETURN

   24 IF (JDIV.EQ.24)              GO TO 26
      IF (IFLAG.GT.0)              GO TO 93
      JQDIVI = 0
      RETURN

   26 JQDIVI = JQDVSY
      RETURN

C--                COMPOUND INDEX

   31 IF (IFLAG.GT.0)              GO TO 93
      IF (JDIV.GE.16777216)        GO TO 92
      JQDIVI = 0
      RETURN

C----              SWITCH ZEBRA STORE

   41 IF (JSTO.GT.NQSTOR)          GO TO 91
      JQSTOR = JSTO
      JQDIVR = 0
      KQT = NQOFFT(JQSTOR+1)
      KQS = NQOFFS(JQSTOR+1)

      DO 44  J=1,12
   44 IQCUR(J) = IQTABV(KQT+J)
      NQLOGM = NQLOGL
      IF (IFLAG.GE.0)              GO TO 21
   48 JQDIVI = 0
      RETURN

C------            ERROR CONDITIONS

   94 NQCASE = 1
   93 NQCASE = NQCASE + 1
   92 NQCASE = NQCASE + 1
      NQFATA = 1
      IQUEST(14) = JDIV
   91 NQCASE = NQCASE + 1
      NQFATA = NQFATA + 3
      IQUEST(11) = IXIN
      IQUEST(12) = IFLAG
      IQUEST(13) = JSTO
#include "zebra/qtrace.inc"
#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:09 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 MZSDIV (IXDIVP,IFLAGP)
	14
	15	C- Set current store JQSTOR and maybe division JQDIVI from IXDIVP
	16	C- IFLAG = -ve : store only
	17	C- else : set also JQDIVI:
	18	C- to the division if a specific single division,
	19	C- or JQDIVI = 0 if no such given,
	20	C- with these restrictions:
	21	C- > 0 : IXDIVP may not be a compound or generic index
	22	C- = 4 : specific single division required, =0 not allowed
	23	C- system called, could be user called
	24
	25	#include "zebra/zstate.inc"
	26	#include "zebra/mqsys.inc"
	27	C-------------- END CDE --------------
	28	DIMENSION IXDIVP(9), IFLAGP(9)
	29	#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
	30	DIMENSION NAMESR(2)
	31	DATA NAMESR / 4HMZSD, 4HIV /
	32	#endif
	33	#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
	34	DATA NAMESR / 6HMZSDIV /
	35	#endif
	36	#if !defined(CERNLIB_QTRHOLL)
	37	CHARACTER NAMESR*8
	38	PARAMETER (NAMESR = 'MZSDIV ')
	39	#endif
	40
	41	#include "zebra/q_jbyt.inc"
	42
	43
	44	IXIN = IXDIVP(1)
	45	IFLAG = IFLAGP(1)
	46	JSTO = JBYT (IXIN,27,4)
	47	IF (JSTO.NE.JQSTOR) GO TO 41
	48	IF (IFLAG.LT.0) GO TO 48
	49
	50	21 JDIV = JBYT (IXIN,1,26)
	51	#if defined(CERNLIB_B32)
	52	JCOM = JBYT (IXIN,31,2)
	53	#endif
	54	#if defined(CERNLIB_B36)
	55	JCOM = JBYT (IXIN,31,6)
	56	#endif
	57	#if defined(CERNLIB_B48)
	58	JCOM = JBYT (IXIN,31,18)
	59	#endif
	60	#if defined(CERNLIB_B60)
	61	JCOM = JBYT (IXIN,31,30)
	62	#endif
	63	#if defined(CERNLIB_B64)
	64	JCOM = JBYT (IXIN,31,34)
65	#endif
66	IF (JCOM-1) 22, 31, 91
67
68	C-- SINGLE DIVISION INDEX
69
70	22 IF (JDIV.GE.25) GO TO 92
71	IF (JDIV.GE.21) GO TO 24
72	IF (JDIV.GT.JQDVLL) THEN
73	IF (JDIV.LT.JQDVSY) GO TO 92
74	ENDIF
75	IF (JDIV.EQ.0) THEN
76	IF (IFLAG.EQ.4) GO TO 94
77	ENDIF
78	JQDIVI = JDIV
79	RETURN
80
81	24 IF (JDIV.EQ.24) GO TO 26
82	IF (IFLAG.GT.0) GO TO 93
83	JQDIVI = 0
84	RETURN
85
86	26 JQDIVI = JQDVSY
87	RETURN
88
89	C-- COMPOUND INDEX
90
91	31 IF (IFLAG.GT.0) GO TO 93
92	IF (JDIV.GE.16777216) GO TO 92
93	JQDIVI = 0
94	RETURN
95
96	C---- SWITCH ZEBRA STORE
97
98	41 IF (JSTO.GT.NQSTOR) GO TO 91
99	JQSTOR = JSTO
100	JQDIVR = 0
101	KQT = NQOFFT(JQSTOR+1)
102	KQS = NQOFFS(JQSTOR+1)
103
104	DO 44 J=1,12
105	44 IQCUR(J) = IQTABV(KQT+J)
106	NQLOGM = NQLOGL
107	IF (IFLAG.GE.0) GO TO 21
108	48 JQDIVI = 0
109	RETURN
110
111	C------ ERROR CONDITIONS
112
113	94 NQCASE = 1
114	93 NQCASE = NQCASE + 1
115	92 NQCASE = NQCASE + 1
116	NQFATA = 1
117	IQUEST(14) = JDIV
118	91 NQCASE = NQCASE + 1
119	NQFATA = NQFATA + 3
120	IQUEST(11) = IXIN
121	IQUEST(12) = IFLAG
122	IQUEST(13) = JSTO
123	#include "zebra/qtrace.inc"
124	#include "zebra/qtofatal.inc"
125	END
126	* ==================================================
127	#include "zebra/qcardl.inc"