]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/dzebra/dzswap.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / dzebra / dzswap.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.2 1996/04/24 17:26:18 mclareni
6* Extend the include file cleanup to dzebra, rz and tq, and also add
7* dependencies in some cases.
8*
9* Revision 1.1.1.1 1996/03/06 10:47:07 mclareni
10* Zebra
11*
12*
13*----------------------------------------------------------
14#include "zebra/pilot.h"
15 SUBROUTINE DZSWAP (IXSTOR,LSTR1,LSTR2,CHOPT)
16
17
18#include "zebra/mqsys.inc"
19#include "zebra/mzcn.inc"
20#include "zebra/qequ.inc"
21#include "zebra/zstate.inc"
22#include "zebra/zunit.inc"
23#include "zebra/storparq.inc"
24#include "zebra/dzc1.inc"
25
26 CHARACTER *(*) CHOPT
27 SAVE NAMESR
28#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
29 DIMENSION NAMESR(2)
30 DATA NAMESR / 4HZSWA, 4HP /
31#endif
32#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
33 DATA NAMESR / 6HZSWAP /
34#endif
35#if !defined(CERNLIB_QTRHOLL)
36 CHARACTER NAMESR*8
37 DATA NAMESR / 'ZSWAP ' /
38#endif
39#include "zebra/q_jbit.inc"
40#include "zebra/q_jbyt.inc"
41
42#include "zebra/qtrace.inc"
43
44 IF (IXSTOR.NE.NCHEKQ) CALL MZSDIV (IXSTOR,-1)
45
46 L1 = LSTR1
47 L2 = LSTR2
48
49 IFLAG = INDEX(CHOPT,'R')
50
51
52 IF (LQSTA(KQT+JQDVSY).EQ.LQEND(KQT+JQDVSY)) IFLAG = 0
53
54#if defined(CERNLIB_QDEVZE)
55 IF (NQDEVZ.NE.0) WRITE(IQPRNT,
56 +'(''0DEVZE ZSWAP, ENTRY:IXSTOR,LSTR1,LSTR2,IFLAG= '',Z8,3I8)')
57 + IXSTOR,L1,L2,IFLAG
58#endif
59
60 IF (L1.EQ.0 .OR. L2.EQ.0) GO TO 999
61
62 CALL MZCHLS(NCHEKQ,L1)
63 IF (IQFOUL.NE.0) THEN
64 WRITE(IQPRNT,'(''0ZSWAP - BANK1 INVALID'')')
65 GO TO 998
66 ENDIF
67
68 CALL MZCHLS(NCHEKQ,L2)
69 IF (IQFOUL.NE.0) THEN
70 WRITE(IQPRNT,'(''0ZSWAP - BANK2 INVALID'')')
71 GO TO 998
72 ENDIF
73
74 LNEXT1 = LQ(KQS+L1)
75 IF (LNEXT1.NE.0) CALL MZCHLS(NCHEKQ,LNEXT1)
76 IF (IQFOUL.NE.0) THEN
77 WRITE(IQPRNT,'(''0ZSWAP - Next of LSTR1 invalid'',2I8)')
78 + L1,LNEXT1
79 GO TO 998
80 ENDIF
81 LUP1 = LQLUP(KQS+L1)
82 IF (LUP1.NE.0) CALL MZCHLS(NCHEKQ,LUP1)
83 IF (IQFOUL.NE.0) THEN
84 WRITE(IQPRNT,'(''0ZSWAP - Origin of LSTR1 invalid'',2I8)')
85 + L1,LUP1
86 GO TO 998
87 ENDIF
88 LSUP1 = LQLORG(KQS+L1)
89 IF (LQ(KQS+LSUP1).NE.L1) THEN
90 WRITE(IQPRNT,'(''0ZSWAP - R link invalid (@r # LSTR1)'',
91 + 2I8)') L1,LQ(KQS+LSUP1)
92 GO TO 998
93 ENDIF
94
95 LNEXT2 = LQ(KQS+L2)
96 IF (LNEXT2.NE.0) CALL MZCHLS(NCHEKQ,LNEXT2)
97 IF (IQFOUL.NE.0) THEN
98 WRITE(IQPRNT,'(''0ZSWAP - Next of LSTR2 invalid'',2I8)')
99 + L2,LNEXT2
100 GO TO 998
101 ENDIF
102 LUP2 = LQLUP(KQS+L2)
103 IF (LUP2.NE.0) CALL MZCHLS(NCHEKQ,LUP2)
104 IF (IQFOUL.NE.0) THEN
105 WRITE(IQPRNT,'(''0ZSWAP - Origin of LSTR2 invalid'',2I8)')
106 + L2,LUP2
107 GO TO 998
108 ENDIF
109 LSUP2 = LQLORG(KQS+L2)
110 IF (LQ(KQS+LSUP2).NE.L2) THEN
111 WRITE(IQPRNT,'(''0ZSWAP - R link invalid (@r # LSTR2)'',
112 + 2I8)') L2,LQ(KQS+LSUP2)
113 GO TO 998
114 ENDIF
115
116#if defined(CERNLIB_QDEVZE)
117 IF (NQDEVZ.NE.0) WRITE(IQPRNT,
118 +'(''0DEVZE ZSWAP, Before SWAP ,L1,N,O,P,@P '',5I8,/,
119 + '' ZSWAP, Before SWAP ,L2,N,O,P,@P '',5I8)')
120 + L1,LQ(KQS+L1),LQLUP(KQS+L1),LQLORG(KQS+L1),
121 + LQ(KQS+LQLORG(KQS+L1)),
122 + L2,LQ(KQS+L2),LQLUP(KQS+L2),LQLORG(KQS+L2),
123 + LQ(KQS+LQLORG(KQS+L2))
124#endif
125
126 IF (LNEXT1.EQ.L2) THEN
127 LQ(KQS+L1) = LNEXT2
128 LQ(KQS+L2) = L1
129 LQLORG(KQS+L1) = L2
130 LQLORG(KQS+L2) = LSUP1
131 LQ(KQS+LSUP1) = L2
132 IF (LNEXT2.NE.0) LQLORG(KQS+LNEXT2) = L1
133 ELSEIF(L1.EQ.LNEXT2) THEN
134 LQ(KQS+L1) = L2
135 LQ(KQS+L2) = LNEXT1
136 LQLORG(KQS+L1) = LSUP2
137 LQLORG(KQS+L2) = L1
138 LQ(KQS+LSUP2) = L1
139 IF (LNEXT1.NE.0) LQLORG(KQS+LNEXT1) = L2
140 ELSE
141 LQ(KQS+L1) = LNEXT2
142 LQ(KQS+L2) = LNEXT1
143 LQLUP(KQS+L1) = LUP2
144 LQLUP(KQS+L2) = LUP1
145 LQLORG(KQS+L1) = LSUP2
146 LQLORG(KQS+L2) = LSUP1
147 LQ(KQS+LSUP1) = L2
148 LQ(KQS+LSUP2) = L1
149 IF (LNEXT1.NE.0) LQLORG(KQS+LNEXT1) = L2
150 IF (LNEXT2.NE.0) LQLORG(KQS+LNEXT2) = L1
151 ENDIF
152
153 LSTR1 = L2
154 LSTR2 = L1
155
156#if defined(CERNLIB_QDEVZE)
157 IF (NQDEVZ.NE.0) WRITE(IQPRNT,
158 +'(''0DEVZE ZSWAP, After SWAP ,LSTR1,N,O,P,@P '',5I8,/,
159 + '' ZSWAP, After SWAP ,LSTR2,N,O,P,@P '',5I8)')
160 + LSTR1,LQ(KQS+LSTR1),LQLUP(KQS+LSTR1),LQLORG(KQS+LSTR1),
161 + LQ(KQS+LQLORG(KQS+LSTR1)),
162 + LSTR2,LQ(KQS+LSTR2),LQLUP(KQS+LSTR2),LQLORG(KQS+LSTR2),
163 + LQ(KQS+LQLORG(KQS+LSTR2))
164#endif
165
166
167 IF (IFLAG.NE.0) THEN
168 LSYSB = LQSYSS(KQT+MSYLAQ)
169 IF(LSYSB.GT.0) THEN
170 CALL MZCHLS(NCHEKQ,LSYSB)
171 IF (IQFOUL.NE.0) THEN
172 WRITE(IQPRNT,
173 X '(''0ZSWAP - LINK AREA SYSTEM BANK INVALID'')')
174 GO TO 998
175 ENDIF
176
177
178 NWTAB = IQ(KQS+LSYSB+MLAUSQ)
179
180
181 LENTRY = LSYSB + KQS + MLAUSQ
182
183 DO 300 IENTRY = 1,(NWTAB-1)/NLAENQ
184
185 LLAAR1 = IQ(LENTRY+MLAADQ) + KQS
186 LLAARL = IQ(LENTRY+MLALTQ) + KQS
187 NLANS = IQ(LENTRY+MLANSQ)
188 JTEMP = JBIT(NLANS,JLATMQ)
189 NTEMP = NLATMQ*JTEMP
190 NLANS = JBYT(IQ(LENTRY+MLANSQ),JLANSQ,NLANSQ) - NTEMP
191 IF(JTEMP.EQ.1.AND.LQ(LLAAR1+MLACTQ-1).EQ.0) GO TO 300
192 DO 200 I=LLAAR1+NTEMP+NLANS , LLAARL-1
193 IF (LQ(I).EQ.L1) THEN
194 LQ(I) = L2
195 ELSEIF(LQ(I).EQ.L2) THEN
196 LQ(I) = L1
197 ENDIF
198 200 CONTINUE
199
200 LENTRY = LENTRY + NLAENQ
201 300 CONTINUE
202
203 ENDIF
204
205
206
207 IDIV1 = 1
208 IF (L1.LT.LQEND(KQT+JQDVLL)) GO TO 410
209 IF (L1.GE.LQEND(KQT+NDVMXQ)) GO TO 998
210 IDIV1 = JQDVSY
211
212 410 IF (L1.LT.LQEND(KQT+IDIV1 )) GO TO 420
213 IDIV1 = IDIV1 + 1
214 GO TO 410
215
216 420 IF (L1.LT.LQSTA(KQT+IDIV1 )) GO TO 998
217
218
219 IDIV2 = 1
220 IF (L2.LT.LQEND(KQT+JQDVLL)) GO TO 510
221 IF (L2.GE.LQEND(KQT+NDVMXQ)) GO TO 998
222 IDIV2 = JQDVSY
223
224 510 IF (L2.LT.LQEND(KQT+IDIV2 )) GO TO 520
225 IDIV2 = IDIV2 + 1
226 GO TO 510
227
228 520 IF (L2.LT.LQSTA(KQT+IDIV2 )) GO TO 998
229
230#if defined(CERNLIB_QDEVZE)
231 IF (NQDEVZ.NE.0) WRITE(IQPRNT,
232 +'(''0DEVZE ZSWAP, Divs : L1,IDIV1,L2,IDIV2= '',4I8)')
233 + L1,IDIV1,L2,IDIV2
234#endif
235
236
237 DO 1700 JQDIVI = 1,NDVMXQ
238 IF (JQDIVI.GT.JQDVLL.AND.JQDIVI.LT.JQDVSY) GO TO 1700
239
240 LN = LQSTA(KQT+JQDIVI)
241 1300 IF (LN.LT.LQEND(KQT+JQDIVI)) THEN
242 CALL MZCHLN(NCHEKQ,LN)
243 IF (IQFOUL.NE.0) THEN
244 WRITE(IQPRNT,
245 X '(''0ZSWAP - BANK INVALID AT'',I10)') LN
246 GO TO 998
247 ENDIF
248 LN = IQNX
249 IF (JBIT(IQ(KQS+IQLS),IQDROP).EQ.0) THEN
250 DO 1400 L = IQLS-IQNL+KQS , IQLS-IQNS+KQS-1
251 IF (LQ(L).EQ.L1) THEN
252 LQ(L) = L2
253 ELSEIF(LQ(L).EQ.L2) THEN
254 LQ(L) = L1
255 ENDIF
256 1400 CONTINUE
257 ENDIF
258 GO TO 1300
259 ENDIF
260 1700 CONTINUE
261
262 ENDIF
263
264 GO TO 999
265
266 998 CONTINUE
267#include "zebra/qtofatal.inc"
268
269#include "zebra/qtrace99.inc"
270 END