[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / mq / mzvolm.F

*
* $Id$
*
* $Log$
* Revision 1.2  1996/04/18 16:12:08  mclareni
* Incorporate changes from J.Zoll for version 3.77
*
* Revision 1.1.1.1  1996/03/06 10:47:19  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
      FUNCTION MZVOLM (IXSTOR,LHEADP,CHOPT)

C-    Run through d/s to calculate space occupied, user called

#include "zebra/zstate.inc"
#include "zebra/zunit.inc"
#include "zebra/zvfaut.inc"
#include "zebra/mqsys.inc"
#include "zebra/mzcn.inc"
#include "zebra/mzcwk.inc"
C--------------    End CDE                             --------------
      DIMENSION    LHEADP(9)
      CHARACTER    *(*) CHOPT
#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
      DIMENSION    NAMESR(2)
      DATA  NAMESR / 4HMZVO, 4HLM   /
#endif
#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
      DATA  NAMESR / 6HMZVOLM /
#endif
#if !defined(CERNLIB_QTRHOLL)
      CHARACTER    NAMESR*8
      PARAMETER   (NAMESR = 'MZVOLM  ')
#endif

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


#include "zebra/qtrace.inc"
      NWVOL = 0
      LHEAD = LHEADP(1)
      IF (LHEAD.EQ.0)              GO TO 999

#include "zebra/qstore.inc"

#if defined(CERNLIB_QDEBUG)
      IF (IQVSTA.NE.0)       CALL ZVAUTX
      CALL MZCHLS (-7,LHEAD)
      IF (IQFOUL.NE.0)             GO TO 92
#endif
#if !defined(CERNLIB_QDEBUG)
      IQNS = IQ(KQS+LHEAD-2)
#endif

      CALL UOPTC (CHOPT,'L',IQUEST)
      IOPTH  = IQUEST(1)
#if defined(CERNLIB_QDEVZE)
      IF (NQDEVZ.NE.0)
     +WRITE (IQLOG,9814) LHEAD,IOPTH
 9814 FORMAT (1X/' DEVZE MZVOLM.   LHEAD,IOPTH='
     F,I6,6I4)
#endif

      LEV  = LQWKTB + 3
      LEVE = LEV + NQWKTB - 10
      LQ(LEV-2) = 0
      LQ(LEV-1) = 0
      LQ(LEV)   = LHEAD

      LCUR = LHEAD
      LX   = LHEAD - 1 + IOPTH
      LAST = LHEAD - IQNS
      IQ(KQS+LCUR) = MSBIT1 (IQ(KQS+LCUR),IQSYSX)
      GO TO 24

C--                Mark bank

   20 LAST = LCUR - IQ(KQS+LCUR-2)
      IQ(KQS+LNEW) = MSBIT0 (IQ(KQS+LNEW),IQSYSX)
      NWVOL  = NWVOL + 10 + JBYT (IQ(KQS+LNEW),19,4) +
     +                      IQ(KQS+LNEW-1) + IQ(KQS+LNEW-3)

C----              Look at next link

   24 IF (LX.LT.LAST)              GO TO 41
      LNEW = LQ(KQS+LX)
      LX   = LX - 1
      IF (LNEW.EQ.0)               GO TO 24

#if defined(CERNLIB_QDEBUG)
      CALL MZCHLS (-7,LNEW)
      IF (IQFOUL.NE.0)             GO TO 94
#endif
      IF (JBIT(IQ(KQS+LNEW),IQSYSX).NE.0)   GO TO 24

C----              New bank LNEW, push down

      LQ(LEV+1) = LX
      LQ(LEV+2) = LCUR

      LEV = LEV + 3
      IF (LEV.GE.LEVE)             GO TO 91
      LQ(LEV)   = LNEW
#if defined(CERNLIB_QDEVZE)
      IF (NQDEVZ.GE.11)
     +WRITE (IQLOG,9831) LEV,LCUR,LX+1,LNEW
 9831 FORMAT (' DEVZE MZVOLM,  Down:   LEV,LCUR,LX+1,LNEW=',6I8)
#endif

C--                Move to end of linear structure

   32 LCUR = LNEW
      IQ(KQS+LCUR) = MSBIT1 (IQ(KQS+LCUR),IQSYSX)
      LNEW = LQ(KQS+LCUR)
      IF (LNEW.EQ.0)               GO TO 36
#if defined(CERNLIB_QDEVZE)
      IF (NQDEVZ.GE.11)
     +WRITE (IQLOG,9833) LCUR,LNEW
 9833 FORMAT (' DEVZE MZVOLM,  Along:  LCUR,LNEW=',6I8)
#endif
#if defined(CERNLIB_QDEBUG)
      CALL MZCHLS (-7,LNEW)
      IF (IQFOUL.NE.0)             GO TO 93
      IF (JBIT(IQ(KQS+LNEW),IQSYSX).NE.0)  GO TO 36
      IF (LQ(KQS+LNEW+2).NE.LCUR)          GO TO 95
      GO TO 32

   36 CONTINUE
#endif
#if !defined(CERNLIB_QDEBUG)
      IF (JBIT(IQ(KQS+LNEW),IQSYSX).EQ.0)  GO TO 32

   36 IQNS = IQ(KQS+LCUR-2)
#endif
      LAST = LCUR - IQNS
      LX   = LCUR - 1
      GO TO 24

C----              Bank at LCUR has no further secondaries
C--                     step back in the linear structure

   41 LNEW = LCUR
      IF (LCUR.EQ.LQ(LEV))         GO TO 46
      LCUR = LQ(KQS+LCUR+2)
      LX   = LCUR - 1
#if defined(CERNLIB_QDEVZE)
      IF (NQDEVZ.GE.11)
     +WRITE (IQLOG,9841) LCUR,LNEW
 9841 FORMAT (' DEVZE MZVOLM,  Back:   LCUR,LNEW=',6I8)
#endif
      GO TO 20

C--                Start of linear structure reached, pop up

   46 LEV  = LEV - 3
      LX   = LQ(LEV+1)
      LCUR = LQ(LEV+2)
#if defined(CERNLIB_QDEVZE)
      IF (NQDEVZ.GE.11)
     +WRITE (IQLOG,9846) LEV,LCUR,LX
 9846 FORMAT (' DEVZE MZVOLM,  Up:     LEV,LCUR,LX=',6I8)
#endif
      IF (LCUR.NE.0)               GO TO 20

C----              Done, mark header bank

   61 IQ(KQS+LHEAD) = MSBIT0 (IQ(KQS+LHEAD),IQSYSX)
      NWVOL  = NWVOL + 10 + JBYT (IQ(KQS+LHEAD),19,4) +
     +                      IQ(KQS+LHEAD-1) + IQ(KQS+LHEAD-3)
#include "zebra/qtrace99.inc"
      MZVOLM = NWVOL
      RETURN

C------            Error conditions

#if defined(CERNLIB_QDEBUG)
   95 NQCASE = 2
      NQFATA = 1
      IQUEST(14) = LQ(KQS+LNEW+2)
      GO TO 93

   94 NQCASE = 1
      NQFATA = 1
      IQUEST(14) = LX+1 - LCUR
   93 NQCASE = NQCASE + 1
      NQFATA = NQFATA + 2
      IQUEST(12) = LNEW
      IQUEST(13) = LCUR
   92 NQCASE = NQCASE + 1
#endif
   91 NQCASE = NQCASE + 1
      NQFATA = NQFATA + 1
      IQUEST(11) = LHEAD
#include "zebra/qtofatal.inc"
      MZVOLM = 0
      END
*      ==================================================
#include "zebra/qcardl.inc"
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.2 1996/04/18 16:12:08 mclareni
	6	* Incorporate changes from J.Zoll for version 3.77
	7	*
	8	* Revision 1.1.1.1 1996/03/06 10:47:19 mclareni
	9	* Zebra
	10	*
	11	*
	12	#include "zebra/pilot.h"
	13	FUNCTION MZVOLM (IXSTOR,LHEADP,CHOPT)
	14
	15	C- Run through d/s to calculate space occupied, user called
	16
	17	#include "zebra/zstate.inc"
	18	#include "zebra/zunit.inc"
	19	#include "zebra/zvfaut.inc"
	20	#include "zebra/mqsys.inc"
	21	#include "zebra/mzcn.inc"
	22	#include "zebra/mzcwk.inc"
	23	C-------------- End CDE --------------
	24	DIMENSION LHEADP(9)
	25	CHARACTER () CHOPT
	26	#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
	27	DIMENSION NAMESR(2)
	28	DATA NAMESR / 4HMZVO, 4HLM /
	29	#endif
	30	#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
	31	DATA NAMESR / 6HMZVOLM /
	32	#endif
	33	#if !defined(CERNLIB_QTRHOLL)
	34	CHARACTER NAMESR*8
	35	PARAMETER (NAMESR = 'MZVOLM ')
	36	#endif
	37
	38	#include "zebra/q_jbit.inc"
	39	#include "zebra/q_jbyt.inc"
	40	#include "zebra/q_sbit0.inc"
	41	#include "zebra/q_sbit1.inc"
	42
	43
	44	#include "zebra/qtrace.inc"
	45	NWVOL = 0
	46	LHEAD = LHEADP(1)
	47	IF (LHEAD.EQ.0) GO TO 999
	48
	49	#include "zebra/qstore.inc"
	50
	51	#if defined(CERNLIB_QDEBUG)
	52	IF (IQVSTA.NE.0) CALL ZVAUTX
	53	CALL MZCHLS (-7,LHEAD)
	54	IF (IQFOUL.NE.0) GO TO 92
	55	#endif
	56	#if !defined(CERNLIB_QDEBUG)
	57	IQNS = IQ(KQS+LHEAD-2)
	58	#endif
	59
	60	CALL UOPTC (CHOPT,'L',IQUEST)
	61	IOPTH = IQUEST(1)
	62	#if defined(CERNLIB_QDEVZE)
	63	IF (NQDEVZ.NE.0)
	64	+WRITE (IQLOG,9814) LHEAD,IOPTH
65	9814 FORMAT (1X/' DEVZE MZVOLM. LHEAD,IOPTH='
66	F,I6,6I4)
67	#endif
68
69	LEV = LQWKTB + 3
70	LEVE = LEV + NQWKTB - 10
71	LQ(LEV-2) = 0
72	LQ(LEV-1) = 0
73	LQ(LEV) = LHEAD
74
75	LCUR = LHEAD
76	LX = LHEAD - 1 + IOPTH
77	LAST = LHEAD - IQNS
78	IQ(KQS+LCUR) = MSBIT1 (IQ(KQS+LCUR),IQSYSX)
79	GO TO 24
80
81	C-- Mark bank
82
83	20 LAST = LCUR - IQ(KQS+LCUR-2)
84	IQ(KQS+LNEW) = MSBIT0 (IQ(KQS+LNEW),IQSYSX)
85	NWVOL = NWVOL + 10 + JBYT (IQ(KQS+LNEW),19,4) +
86	+ IQ(KQS+LNEW-1) + IQ(KQS+LNEW-3)
87
88	C---- Look at next link
89
90	24 IF (LX.LT.LAST) GO TO 41
91	LNEW = LQ(KQS+LX)
92	LX = LX - 1
93	IF (LNEW.EQ.0) GO TO 24
94
95	#if defined(CERNLIB_QDEBUG)
96	CALL MZCHLS (-7,LNEW)
97	IF (IQFOUL.NE.0) GO TO 94
98	#endif
99	IF (JBIT(IQ(KQS+LNEW),IQSYSX).NE.0) GO TO 24
100
101	C---- New bank LNEW, push down
102
103	LQ(LEV+1) = LX
104	LQ(LEV+2) = LCUR
105
106	LEV = LEV + 3
107	IF (LEV.GE.LEVE) GO TO 91
108	LQ(LEV) = LNEW
109	#if defined(CERNLIB_QDEVZE)
110	IF (NQDEVZ.GE.11)
111	+WRITE (IQLOG,9831) LEV,LCUR,LX+1,LNEW
112	9831 FORMAT (' DEVZE MZVOLM, Down: LEV,LCUR,LX+1,LNEW=',6I8)
113	#endif
114
115	C-- Move to end of linear structure
116
117	32 LCUR = LNEW
118	IQ(KQS+LCUR) = MSBIT1 (IQ(KQS+LCUR),IQSYSX)
119	LNEW = LQ(KQS+LCUR)
120	IF (LNEW.EQ.0) GO TO 36
121	#if defined(CERNLIB_QDEVZE)
122	IF (NQDEVZ.GE.11)
123	+WRITE (IQLOG,9833) LCUR,LNEW
124	9833 FORMAT (' DEVZE MZVOLM, Along: LCUR,LNEW=',6I8)
125	#endif
126	#if defined(CERNLIB_QDEBUG)
127	CALL MZCHLS (-7,LNEW)
128	IF (IQFOUL.NE.0) GO TO 93
129	IF (JBIT(IQ(KQS+LNEW),IQSYSX).NE.0) GO TO 36
130	IF (LQ(KQS+LNEW+2).NE.LCUR) GO TO 95
131	GO TO 32
132
133	36 CONTINUE
134	#endif
135	#if !defined(CERNLIB_QDEBUG)
136	IF (JBIT(IQ(KQS+LNEW),IQSYSX).EQ.0) GO TO 32
137
138	36 IQNS = IQ(KQS+LCUR-2)
139	#endif
140	LAST = LCUR - IQNS
141	LX = LCUR - 1
142	GO TO 24
143
144	C---- Bank at LCUR has no further secondaries
145	C-- step back in the linear structure
146
147	41 LNEW = LCUR
148	IF (LCUR.EQ.LQ(LEV)) GO TO 46
149	LCUR = LQ(KQS+LCUR+2)
150	LX = LCUR - 1
151	#if defined(CERNLIB_QDEVZE)
152	IF (NQDEVZ.GE.11)
153	+WRITE (IQLOG,9841) LCUR,LNEW
154	9841 FORMAT (' DEVZE MZVOLM, Back: LCUR,LNEW=',6I8)
155	#endif
156	GO TO 20
157
158	C-- Start of linear structure reached, pop up
159
160	46 LEV = LEV - 3
161	LX = LQ(LEV+1)
162	LCUR = LQ(LEV+2)
163	#if defined(CERNLIB_QDEVZE)
164	IF (NQDEVZ.GE.11)
165	+WRITE (IQLOG,9846) LEV,LCUR,LX
166	9846 FORMAT (' DEVZE MZVOLM, Up: LEV,LCUR,LX=',6I8)
167	#endif
168	IF (LCUR.NE.0) GO TO 20
169
170	C---- Done, mark header bank
171
172	61 IQ(KQS+LHEAD) = MSBIT0 (IQ(KQS+LHEAD),IQSYSX)
173	NWVOL = NWVOL + 10 + JBYT (IQ(KQS+LHEAD),19,4) +
174	+ IQ(KQS+LHEAD-1) + IQ(KQS+LHEAD-3)
175	#include "zebra/qtrace99.inc"
176	MZVOLM = NWVOL
177	RETURN
178
179	C------ Error conditions
180
181	#if defined(CERNLIB_QDEBUG)
182	95 NQCASE = 2
183	NQFATA = 1
184	IQUEST(14) = LQ(KQS+LNEW+2)
185	GO TO 93
186
187	94 NQCASE = 1
188	NQFATA = 1
189	IQUEST(14) = LX+1 - LCUR
190	93 NQCASE = NQCASE + 1
191	NQFATA = NQFATA + 2
192	IQUEST(12) = LNEW
193	IQUEST(13) = LCUR
194	92 NQCASE = NQCASE + 1
195	#endif
196	91 NQCASE = NQCASE + 1
197	NQFATA = NQFATA + 1
198	IQUEST(11) = LHEAD
199	#include "zebra/qtofatal.inc"
200	MZVOLM = 0
201	END
202	* ==================================================
203	#include "zebra/qcardl.inc"