[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / mqg / mzrelb.F

*
* $Id$
*
* $Log$
* Revision 1.3  1996/04/24 17:26:32  mclareni
* Extend the include file cleanup to dzebra, rz and tq, and also add
* dependencies in some cases.
*
* Revision 1.2  1996/04/18 16:12:37  mclareni
* Incorporate changes from J.Zoll for version 3.77
*
* Revision 1.1.1.1  1996/03/06 10:47:20  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
      SUBROUTINE MZRELB

C-    Relocator for links in banks

#include "zebra/zstate.inc"
#include "zebra/zunit.inc"
#include "zebra/mqsys.inc"
#include "zebra/mzcn.inc"
#include "zebra/mzct.inc"
C--------------    End CDE                             --------------
#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
      DIMENSION    NAMESR(2)
      DATA  NAMESR / 4HMZRE, 4HLB   /
#endif
#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
      DATA  NAMESR / 6HMZRELB /
#endif
#if !defined(CERNLIB_QTRHOLL)
      CHARACTER    NAMESR*8
      PARAMETER   (NAMESR = 'MZRELB  ')
#endif

#if !defined(CERNLIB_QDEBUG)
#include "zebra/q_jbyt.inc"
#endif


#include "zebra/qtrace.inc"

      LFIXLO = LQ(LQTA-1)
      LFIXRE = LQ(LQTA)
      LFIXHI = LQ(LQTE)
      JHIGO  = (LQTE-LQTA) / 4
      NENTR  = JHIGO - 1

      IF (NENTR.EQ.0)  THEN
          LADTB1 = LQ(LQTA+1)
          NRLTB2 = LQ(LQTA+2)
          IFLTB3 = LQ(LQTA+3)
        ENDIF

      LMRNX  = LQMTA
   12 LMR    = LMRNX
      IF (LMR.GE.LQMTE)            GO TO  999
      LMRNX  = LMRNX + 8

#if defined(CERNLIB_QDEVZE)
      IF (NQDEVZ.GE.11)
     +WRITE (IQLOG,9813) (LQ(J+LMR-1),J=1,8)
 9813 FORMAT (1X/' DEVZE MZRELB.  DIV, ACT,   NSH, LF, LL, LTA, LTB'
     F,', NFREE'/14X,2I5,6I7)
#endif

      IACT   = LQ(LMR+1)
      IF (IACT.LE.0)               GO TO 12
      IF (IACT.EQ.4)               GO TO 12
      LSTOP  = LQ(LMR+4)
      IF (IACT.EQ.3)               GO TO 14
      LN     = LQ(LMR+3)
      LDEAD  = LSTOP
      GO TO 19

   14 LSEC   = LQRTA + LQ(LMR+5) - 4

C------            Next bank,  check if dead group

   16 LSEC   = LSEC + 4
      LNX    = LQ(LSEC)
      LDEAD  = LQ(LSEC+1)

   17 LN = LNX
      IF (LN.GE.LSTOP)             GO TO 12
      IF (LN.EQ.LDEAD)             GO TO 16

C--                Next bank,  alive

   19 CONTINUE

#if defined(CERNLIB_QDEBUG)
      CALL MZCHLN (-7,LN)
      IF (IQFOUL.NE.0)             GO TO 91
      LNX = IQNX
      IF (IQND.LT.0)               GO TO 17
      LS  = IQLS
      LX  = LS + 3
      L2  = LS - IQNS
      L1  = LS - IQNL
#endif
#if defined(CERNLIB_QDEVZE)
      IF (NQDEVZ.GE.11)   WRITE (IQLOG,9819) LN, IQID,IQNL,IQNS,IQND
 9819 FORMAT (1X/' DEVZE MZRELB.  Do bank at LN =',I7
     F,'  ID,NL,NS,ND= ',A4,3I7)
#endif
#if !defined(CERNLIB_QDEBUG)
      NST = JBYT (LQ(KQS+LN),1,16) - 11
      IF (NST.LT.0)  THEN
          LNX = LN + NST + 11
          GO TO 17
        ELSE
          LS  = LN + NST
          LX  = LS + 3
          L2  = LS - IQ(KQS+LS-2)
          L1  = LS - IQ(KQS+LS-3)
          LNX = LS + IQ(KQS+LS-1) + 9
        ENDIF
#endif
      IF   (NENTR)           66, 46, 26

C--------------    2 OR MORE RELOCATION INTERVALS       -------------

C----              Next link

   24 LQ(KQS+L1)= 0

   25 L1 = L1 + 1
      IF (L1.EQ.LX)                GO TO 17
   26 LFIRST= LQ(KQS+L1)
   27 LINK  = LQ(KQS+L1)
      IF (LINK.EQ.0)               GO TO 25

#if defined(CERNLIB_QDEVZE)
      IF (NQDEVZ.GE.11)   WRITE (IQLOG,9827) LINK,L1
 9827 FORMAT (16X,'Link =',I7,' from L1 =',I7)
#endif
      IF (IQFLIO.EQ.0)  THEN
          IF (LINK.LT.LFIXLO)      GO TO 25
          IF (LINK.GE.LFIXHI)      GO TO 25
          IF (LINK.LT.LFIXRE)      GO TO 24
        ELSE
          IF (LINK.LT.LFIXRE)      GO TO 24
          IF (LINK.GE.LFIXHI)      GO TO 24
        ENDIF

C--                Binary search in relocator table

      JLOW = 0
      JHI  = JHIGO

   29 JEX = (JHI+JLOW) / 2
      IF (JEX.EQ.JLOW)             GO TO 31
      IF (LINK.GE.LQ(LQTA+4*JEX))  GO TO 30
      JHI  = JEX
      GO TO 29

   30 JLOW = JEX
      GO TO 29

C--                Relocate

   31 JTB = LQTA + 4*JLOW

#if defined(CERNLIB_QDEVZE)
      IF (NQDEVZ.GE.11)
     +WRITE (IQLOG,9831) JLOW, (LQ(JTB+J-1),J=1,4)
 9831 FORMAT (50X,'Entry',I5,',',4I7)
#endif
      IF (LINK.GE.LQ(JTB+1))             GO TO 33
      LQ(KQS+L1) = LINK + LQ(JTB+2)
      GO TO 25

C----              Link into dead area

   33 IF   (LQ(JTB+3))       25, 24, 34

C--                Bridge structural link

   34 IF (L1.LT.L2)                GO TO 24
      IF (LS+1-L1)           36, 24, 35
   35 CONTINUE

#if defined(CERNLIB_QDEBUG)
      CALL MZCHLS (-7,LINK)
      IF (IQFOUL.NE.0)             GO TO 92
#endif
      LINK = LQ(KQS+LINK)
      LQ(KQS+L1) = LINK
      IF (LINK.NE.LFIRST)          GO TO 27
      GO TO 24

C--                Reverse bridging of s-link

   36 LINK = LQ(KQS+LINK+2)
      LQ(KQS+L1) = LINK
      GO TO 27

C--------------    1 RELOCATION INTERVAL ONLY           -------------

C----              Next link

   44 LQ(KQS+L1)= 0

   45 L1 = L1 + 1
      IF (L1.EQ.LX)                GO TO 17
   46 LFIRST= LQ(KQS+L1)
   47 LINK  = LQ(KQS+L1)
      IF (LINK.EQ.0)               GO TO 45

#if defined(CERNLIB_QDEVZE)
      IF (NQDEVZ.GE.11)   WRITE (IQLOG,9827) LINK,L1
#endif
      IF (IQFLIO.EQ.0)  THEN
          IF (LINK.LT.LFIXLO)      GO TO 45
          IF (LINK.GE.LFIXHI)      GO TO 45
          IF (LINK.LT.LFIXRE)      GO TO 44
          IF (LINK.GE.LADTB1)      GO TO 53
        ELSE
          IF (LINK.LT.LFIXRE)      GO TO 44
          IF (LINK.GE.LADTB1)      GO TO 44
        ENDIF

C--                Relocate

      LQ(KQS+L1) = LINK + NRLTB2
      GO TO 45

C----              Link into dead area

   53 IF   (IFLTB3)           45, 44, 54

C--                Bridge structural link

   54 IF (L1.LT.L2)                GO TO 44
      IF (LS+1-L1)           56, 44, 55
   55 CONTINUE

#if defined(CERNLIB_QDEBUG)
      CALL MZCHLS (-7,LINK)
      IF (IQFOUL.NE.0)             GO TO 92
#endif
      LINK = LQ(KQS+LINK)
      LQ(KQS+L1) = LINK
      IF (LINK.NE.LFIRST)          GO TO 47
      GO TO 44

C--                Reverse bridging of s-link

   56 LINK = LQ(KQS+LINK+2)
      LQ(KQS+L1) = LINK
      GO TO 47

C--------------    NO RELOCATION INTERVAL               -------------

C----              Next link

   64 LQ(KQS+L1)= 0

   65 L1 = L1 + 1
      IF (L1.EQ.LX)                GO TO 17
   66 LINK  = LQ(KQS+L1)
      IF (LINK.EQ.0)               GO TO 65

#if defined(CERNLIB_QDEVZE)
      IF (NQDEVZ.GE.11)   WRITE (IQLOG,9827) LINK,L1
#endif
      IF (LINK.LT.LFIXLO)          GO TO 65
      IF (LINK.GE.LFIXHI)          GO TO 65
      GO TO 64

C------            Error conditions
#if defined(CERNLIB_QDEBUG)
   92 NQCASE = 1
      NQFATA = 2
      LN     = LS
      IQUEST(12) = L1
      IQUEST(13) = LINK
   91 NQCASE = NQCASE + 1
      NQFATA = NQFATA + 1
      IQUEST(11) = LN
      IF (IQFLIO.NE.0)             GO TO 98
#include "zebra/qtofatal.inc"

   98 IQUEST(9) = NQCASE
      IQUEST(10)= NQFATA
      NQCASE = 0
      NQFATA = 0
      IQFLIO = -7
#endif
#include "zebra/qtrace99.inc"
      RETURN
      END
*      ==================================================
#include "zebra/qcardl.inc"
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.3 1996/04/24 17:26:32 mclareni
	6	* Extend the include file cleanup to dzebra, rz and tq, and also add
	7	* dependencies in some cases.
	8	*
	9	* Revision 1.2 1996/04/18 16:12:37 mclareni
	10	* Incorporate changes from J.Zoll for version 3.77
	11	*
	12	* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
	13	* Zebra
	14	*
	15	*
	16	#include "zebra/pilot.h"
	17	SUBROUTINE MZRELB
	18
	19	C- Relocator for links in banks
	20
	21	#include "zebra/zstate.inc"
	22	#include "zebra/zunit.inc"
	23	#include "zebra/mqsys.inc"
	24	#include "zebra/mzcn.inc"
	25	#include "zebra/mzct.inc"
	26	C-------------- End CDE --------------
	27	#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
	28	DIMENSION NAMESR(2)
	29	DATA NAMESR / 4HMZRE, 4HLB /
	30	#endif
	31	#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
	32	DATA NAMESR / 6HMZRELB /
	33	#endif
	34	#if !defined(CERNLIB_QTRHOLL)
	35	CHARACTER NAMESR*8
	36	PARAMETER (NAMESR = 'MZRELB ')
	37	#endif
	38
	39	#if !defined(CERNLIB_QDEBUG)
	40	#include "zebra/q_jbyt.inc"
	41	#endif
	42
	43
	44	#include "zebra/qtrace.inc"
	45
	46	LFIXLO = LQ(LQTA-1)
	47	LFIXRE = LQ(LQTA)
	48	LFIXHI = LQ(LQTE)
	49	JHIGO = (LQTE-LQTA) / 4
	50	NENTR = JHIGO - 1
	51
	52	IF (NENTR.EQ.0) THEN
	53	LADTB1 = LQ(LQTA+1)
	54	NRLTB2 = LQ(LQTA+2)
	55	IFLTB3 = LQ(LQTA+3)
	56	ENDIF
	57
	58	LMRNX = LQMTA
	59	12 LMR = LMRNX
	60	IF (LMR.GE.LQMTE) GO TO 999
	61	LMRNX = LMRNX + 8
	62
	63	#if defined(CERNLIB_QDEVZE)
	64	IF (NQDEVZ.GE.11)
65	+WRITE (IQLOG,9813) (LQ(J+LMR-1),J=1,8)
66	9813 FORMAT (1X/' DEVZE MZRELB. DIV, ACT, NSH, LF, LL, LTA, LTB'
67	F,', NFREE'/14X,2I5,6I7)
68	#endif
69
70	IACT = LQ(LMR+1)
71	IF (IACT.LE.0) GO TO 12
72	IF (IACT.EQ.4) GO TO 12
73	LSTOP = LQ(LMR+4)
74	IF (IACT.EQ.3) GO TO 14
75	LN = LQ(LMR+3)
76	LDEAD = LSTOP
77	GO TO 19
78
79	14 LSEC = LQRTA + LQ(LMR+5) - 4
80
81	C------ Next bank, check if dead group
82
83	16 LSEC = LSEC + 4
84	LNX = LQ(LSEC)
85	LDEAD = LQ(LSEC+1)
86
87	17 LN = LNX
88	IF (LN.GE.LSTOP) GO TO 12
89	IF (LN.EQ.LDEAD) GO TO 16
90
91	C-- Next bank, alive
92
93	19 CONTINUE
94
95	#if defined(CERNLIB_QDEBUG)
96	CALL MZCHLN (-7,LN)
97	IF (IQFOUL.NE.0) GO TO 91
98	LNX = IQNX
99	IF (IQND.LT.0) GO TO 17
100	LS = IQLS
101	LX = LS + 3
102	L2 = LS - IQNS
103	L1 = LS - IQNL
104	#endif
105	#if defined(CERNLIB_QDEVZE)
106	IF (NQDEVZ.GE.11) WRITE (IQLOG,9819) LN, IQID,IQNL,IQNS,IQND
107	9819 FORMAT (1X/' DEVZE MZRELB. Do bank at LN =',I7
108	F,' ID,NL,NS,ND= ',A4,3I7)
109	#endif
110	#if !defined(CERNLIB_QDEBUG)
111	NST = JBYT (LQ(KQS+LN),1,16) - 11
112	IF (NST.LT.0) THEN
113	LNX = LN + NST + 11
114	GO TO 17
115	ELSE
116	LS = LN + NST
117	LX = LS + 3
118	L2 = LS - IQ(KQS+LS-2)
119	L1 = LS - IQ(KQS+LS-3)
120	LNX = LS + IQ(KQS+LS-1) + 9
121	ENDIF
122	#endif
123	IF (NENTR) 66, 46, 26
124
125	C-------------- 2 OR MORE RELOCATION INTERVALS -------------
126
127	C---- Next link
128
129	24 LQ(KQS+L1)= 0
130
131	25 L1 = L1 + 1
132	IF (L1.EQ.LX) GO TO 17
133	26 LFIRST= LQ(KQS+L1)
134	27 LINK = LQ(KQS+L1)
135	IF (LINK.EQ.0) GO TO 25
136
137	#if defined(CERNLIB_QDEVZE)
138	IF (NQDEVZ.GE.11) WRITE (IQLOG,9827) LINK,L1
139	9827 FORMAT (16X,'Link =',I7,' from L1 =',I7)
140	#endif
141	IF (IQFLIO.EQ.0) THEN
142	IF (LINK.LT.LFIXLO) GO TO 25
143	IF (LINK.GE.LFIXHI) GO TO 25
144	IF (LINK.LT.LFIXRE) GO TO 24
145	ELSE
146	IF (LINK.LT.LFIXRE) GO TO 24
147	IF (LINK.GE.LFIXHI) GO TO 24
148	ENDIF
149
150	C-- Binary search in relocator table
151
152	JLOW = 0
153	JHI = JHIGO
154
155	29 JEX = (JHI+JLOW) / 2
156	IF (JEX.EQ.JLOW) GO TO 31
157	IF (LINK.GE.LQ(LQTA+4*JEX)) GO TO 30
158	JHI = JEX
159	GO TO 29
160
161	30 JLOW = JEX
162	GO TO 29
163
164	C-- Relocate
165
166	31 JTB = LQTA + 4*JLOW
167
168	#if defined(CERNLIB_QDEVZE)
169	IF (NQDEVZ.GE.11)
170	+WRITE (IQLOG,9831) JLOW, (LQ(JTB+J-1),J=1,4)
171	9831 FORMAT (50X,'Entry',I5,',',4I7)
172	#endif
173	IF (LINK.GE.LQ(JTB+1)) GO TO 33
174	LQ(KQS+L1) = LINK + LQ(JTB+2)
175	GO TO 25
176
177	C---- Link into dead area
178
179	33 IF (LQ(JTB+3)) 25, 24, 34
180
181	C-- Bridge structural link
182
183	34 IF (L1.LT.L2) GO TO 24
184	IF (LS+1-L1) 36, 24, 35
185	35 CONTINUE
186
187	#if defined(CERNLIB_QDEBUG)
188	CALL MZCHLS (-7,LINK)
189	IF (IQFOUL.NE.0) GO TO 92
190	#endif
191	LINK = LQ(KQS+LINK)
192	LQ(KQS+L1) = LINK
193	IF (LINK.NE.LFIRST) GO TO 27
194	GO TO 24
195
196	C-- Reverse bridging of s-link
197
198	36 LINK = LQ(KQS+LINK+2)
199	LQ(KQS+L1) = LINK
200	GO TO 27
201
202	C-------------- 1 RELOCATION INTERVAL ONLY -------------
203
204	C---- Next link
205
206	44 LQ(KQS+L1)= 0
207
208	45 L1 = L1 + 1
209	IF (L1.EQ.LX) GO TO 17
210	46 LFIRST= LQ(KQS+L1)
211	47 LINK = LQ(KQS+L1)
212	IF (LINK.EQ.0) GO TO 45
213
214	#if defined(CERNLIB_QDEVZE)
215	IF (NQDEVZ.GE.11) WRITE (IQLOG,9827) LINK,L1
216	#endif
217	IF (IQFLIO.EQ.0) THEN
218	IF (LINK.LT.LFIXLO) GO TO 45
219	IF (LINK.GE.LFIXHI) GO TO 45
220	IF (LINK.LT.LFIXRE) GO TO 44
221	IF (LINK.GE.LADTB1) GO TO 53
222	ELSE
223	IF (LINK.LT.LFIXRE) GO TO 44
224	IF (LINK.GE.LADTB1) GO TO 44
225	ENDIF
226
227	C-- Relocate
228
229	LQ(KQS+L1) = LINK + NRLTB2
230	GO TO 45
231
232	C---- Link into dead area
233
234	53 IF (IFLTB3) 45, 44, 54
235
236	C-- Bridge structural link
237
238	54 IF (L1.LT.L2) GO TO 44
239	IF (LS+1-L1) 56, 44, 55
240	55 CONTINUE
241
242	#if defined(CERNLIB_QDEBUG)
243	CALL MZCHLS (-7,LINK)
244	IF (IQFOUL.NE.0) GO TO 92
245	#endif
246	LINK = LQ(KQS+LINK)
247	LQ(KQS+L1) = LINK
248	IF (LINK.NE.LFIRST) GO TO 47
249	GO TO 44
250
251	C-- Reverse bridging of s-link
252
253	56 LINK = LQ(KQS+LINK+2)
254	LQ(KQS+L1) = LINK
255	GO TO 47
256
257	C-------------- NO RELOCATION INTERVAL -------------
258
259	C---- Next link
260
261	64 LQ(KQS+L1)= 0
262
263	65 L1 = L1 + 1
264	IF (L1.EQ.LX) GO TO 17
265	66 LINK = LQ(KQS+L1)
266	IF (LINK.EQ.0) GO TO 65
267
268	#if defined(CERNLIB_QDEVZE)
269	IF (NQDEVZ.GE.11) WRITE (IQLOG,9827) LINK,L1
270	#endif
271	IF (LINK.LT.LFIXLO) GO TO 65
272	IF (LINK.GE.LFIXHI) GO TO 65
273	GO TO 64
274
275	C------ Error conditions
276	#if defined(CERNLIB_QDEBUG)
277	92 NQCASE = 1
278	NQFATA = 2
279	LN = LS
280	IQUEST(12) = L1
281	IQUEST(13) = LINK
282	91 NQCASE = NQCASE + 1
283	NQFATA = NQFATA + 1
284	IQUEST(11) = LN
285	IF (IQFLIO.NE.0) GO TO 98
286	#include "zebra/qtofatal.inc"
287
288	98 IQUEST(9) = NQCASE
289	IQUEST(10)= NQFATA
290	NQCASE = 0
291	NQFATA = 0
292	IQFLIO = -7
293	#endif
294	#include "zebra/qtrace99.inc"
295	RETURN
296	END
297	* ==================================================
298	#include "zebra/qcardl.inc"