]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/rz/rzpurg.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / rz / rzpurg.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.2 1996/04/24 17:27:05 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:26 mclareni
10* Zebra
11*
12*
13#include "zebra/pilot.h"
14 SUBROUTINE RZPURG(NKEEP)
15*
16************************************************************************
17*
18* Purge cycles in the CWD
19* Input:
20* NKEEP Number of cycles which must be kept for the given key
21* If NKEEP < 1 then NKEEP is taken to be 1 and only the highest
22* cycle is kept
23*
24* Called by <USER>
25*
26* Author : R.Brun DD/US/PD
27* Written : 06.04.86
28* Last mod: 11.12.88
29* : 04.03.94 S.Banerjee (Change in cycle structure)
30*
31************************************************************************
32#include "zebra/rzcl.inc"
33#include "zebra/rzclun.inc"
34#include "zebra/rzk.inc"
35#include "zebra/rzcycle.inc"
36*
37*-----------------------------------------------------------------------
38*
39#include "zebra/q_jbit.inc"
40#include "zebra/q_jbyt.inc"
41
42 IQUEST(1)=0
43 NK=NKEEP
44 IF(NK.LT.1)NK=1
45*
46* Check if write permission
47*
48 IF(LQRS.EQ.0)GO TO 999
49 IFLAG=1
50 CALL RZMODS('RZPURG',IFLAG)
51 IF(IFLAG.NE.0)GO TO 999
52*
53 LK=IQ(KQSP+LCDIR+KLK)
54 LC=IQ(KQSP+LCDIR+KLC)
55 LE=IQ(KQSP+LCDIR+KLE)
56 NKEYS =IQ(KQSP+LCDIR+KNKEYS)
57 NWKEY =IQ(KQSP+LCDIR+KNWKEY)
58 IF(NKEYS.EQ.0)GO TO 999
59*
60 NPUOLD=0
61 IF(LPURG.NE.0)THEN
62 NPURG=IQ(KQSP+LPURG+1)
63 DO 5 I=1,NPURG
64 NPUOLD=NPUOLD+IQ(KQSP+LPURG+2*I+1)-IQ(KQSP+LPURG+2*I)+1
65 5 CONTINUE
66 ENDIF
67*
68 DO 20 IK=1,NKEYS
69 LKC=LK+(NWKEY+1)*(IK-1)
70 LCYC=IQ(KQSP+LCDIR+LKC)
71 NC=0
72 10 NC=NC+1
73 IF (KVSCYC.EQ.0) THEN
74 LCOLD = JBYT(IQ(KQSP+LCDIR+LCYC+KPPCYC), 1,16)
75 ELSE
76 LCOLD = IQ(KQSP+LCDIR+LCYC+KPPCYC)
77 ENDIF
78*
79* Check for first cycle to be kept
80*
81 LKEEP=LCOLD
82 IF(LKEEP.NE.0)THEN
83 12 IF(JBIT(IQ(KQSP+LCDIR+LKEEP+KFLCYC),5).EQ.0)THEN
84 IF (KVSCYC.EQ.0) THEN
85 LKEEP = JBYT(IQ(KQSP+LCDIR+LKEEP+KPPCYC),1,16)
86 ELSE
87 LKEEP = IQ(KQSP+LCDIR+LKEEP+KPPCYC)
88 ENDIF
89 IF(LKEEP.NE.0)GO TO 12
90 ENDIF
91 ENDIF
92 IF(NC.EQ.NK)THEN
93 IF (KVSCYC.EQ.0) THEN
94 CALL SBYT(LKEEP,IQ(KQSP+LCDIR+LCYC+KPPCYC),1,16)
95 ELSE
96 IQ(KQSP+LCDIR+LCYC+KPPCYC) = LKEEP
97 ENDIF
98 ENDIF
99 IF(NC.GT.NK)THEN
100 IF(JBIT(IQ(KQSP+LCDIR+LCYC+KFLCYC),5).NE.0)THEN
101 IF (KVSCYC.EQ.0) THEN
102 CALL SBYT(LKEEP,IQ(KQSP+LCDIR+LCYC+KPPCYC),1,16)
103 ELSE
104 IQ(KQSP+LCDIR+LCYC+KPPCYC) = LKEEP
105 ENDIF
106 GO TO 15
107 ENDIF
108 IF (KVSCYC.EQ.0) THEN
109 IR1 = JBYT(IQ(KQSP+LCDIR+LCYC+KFRCYC),17,16)
110 IP1 = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,16)
111 NW = JBYT(IQ(KQSP+LCDIR+LCYC+KNWCYC), 1,20)
112 IR2 = JBYT(IQ(KQSP+LCDIR+LCYC+KSRCYC),17,16)
113 ELSE
114 IR1 = IQ(KQSP+LCDIR+LCYC+KFRCYC)
115 IP1 = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,20)
116 NW = IQ(KQSP+LCDIR+LCYC+KNWCYC)
117 IR2 = IQ(KQSP+LCDIR+LCYC+KSRCYC)
118 ENDIF
119 IRL =0
120 NWL =0
121*
122* Mark all records that can be purged in first pass
123*
124 NLEFT=LREC-IP1+1
125 NW1=NW
126 IF(NW1.GE.NLEFT)NW1=NLEFT
127 IF(IR2.NE.0)THEN
128 NR=(NW-NW1-1)/LREC+1
129 IF(NR.GT.1)THEN
130 CALL RZPURF(NR-1,IR2)
131 ENDIF
132 IRL=IR2+NR-1
133 NWL=NW-NW1-(NR-1)*LREC
134 ENDIF
135 IF(NW1.EQ.LREC)THEN
136 CALL RZPURF(1,IR1)
137 IR1=0
138 ENDIF
139 IF(NWL.EQ.LREC)THEN
140 CALL RZPURF(1,IRL)
141 IRL=0
142 ENDIF
143 IRLOUT=IQ(KQSP+LCDIR+KRLOUT)
144 IF(IRL.EQ.IRLOUT.AND.NWL+1.EQ.IQ(KQSP+LCDIR+KIP1))THEN
145 CALL RZPURF(1,IRL)
146 ENDIF
147 IQ(KQSP+LCDIR+LCYC )=-1
148 IQ(KQSP+LCDIR+LCYC+1)=IR1
149 IQ(KQSP+LCDIR+LCYC+2)=IRL
150 ENDIF
151*
152 15 IF(LCOLD.NE.0.AND.LCOLD.NE.LCYC)THEN
153 LCYC=LCOLD
154 GO TO 10
155 ENDIF
156 20 CONTINUE
157*
158* Now loop on all purged cycles to find complete records
159* purged
160*
161 DO 70 LKC=LC,LE-KLCYCL+1,KLCYCL
162 IF(IQ(KQSP+LCDIR+LKC).NE.-1)GO TO 70
163 IR1=IQ(KQSP+LCDIR+LKC+1)
164 IRL=IQ(KQSP+LCDIR+LKC+2)
165 IF(IR1.NE.0)THEN
166 DO 30 LKC1=LC,LE-KLCYCL+1,KLCYCL
167 IF(IQ(KQSP+LCDIR+LKC1).EQ.-1)GO TO 30
168 IF (KVSCYC.EQ.0) THEN
169 KR1 = JBYT(IQ(KQSP+LCDIR+LKC1+KFRCYC),17,16)
170 KP1 = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,16)
171 NW = JBYT(IQ(KQSP+LCDIR+LKC1+KNWCYC), 1,20)
172 KR2 = JBYT(IQ(KQSP+LCDIR+LKC1+KSRCYC),17,16)
173 ELSE
174 KR1 = IQ(KQSP+LCDIR+LKC1+KFRCYC)
175 KP1 = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,20)
176 NW = IQ(KQSP+LCDIR+LKC1+KNWCYC)
177 KR2 = IQ(KQSP+LCDIR+LKC1+KSRCYC)
178 ENDIF
179 KRL =0
180 NLEFT=LREC-KP1+1
181 NW1=NW
182 IF(NW1.GE.NLEFT)NW1=NLEFT
183 IF(KR2.NE.0)THEN
184 NR=(NW-NW1-1)/LREC+1
185 KRL=KR2+NR-1
186 ENDIF
187 IF(KR1.EQ.IR1.OR.KRL.EQ.IR1)GO TO 40
188 30 CONTINUE
189 CALL RZPURF(1,IR1)
190 ENDIF
191*
192 40 IF(IRL.NE.0)THEN
193 DO 50 LKC1=LC,LE-KLCYCL+1,KLCYCL
194 IF(IQ(KQSP+LCDIR+LKC1).EQ.-1)GO TO 50
195 IF (KVSCYC.EQ.0) THEN
196 KR1 = JBYT(IQ(KQSP+LCDIR+LKC1+KFRCYC),17,16)
197 KP1 = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,16)
198 NW = JBYT(IQ(KQSP+LCDIR+LKC1+KNWCYC), 1,20)
199 KR2 = JBYT(IQ(KQSP+LCDIR+LKC1+KSRCYC),17,16)
200 ELSE
201 KR1 = IQ(KQSP+LCDIR+LKC1+KFRCYC)
202 KP1 = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,20)
203 NW = IQ(KQSP+LCDIR+LKC1+KNWCYC)
204 KR2 = IQ(KQSP+LCDIR+LKC1+KSRCYC)
205 ENDIF
206 KRL =0
207 NLEFT=LREC-KP1+1
208 NW1=NW
209 IF(NW1.GE.NLEFT)NW1=NLEFT
210 IF(KR2.NE.0)THEN
211 NR=(NW-NW1-1)/LREC+1
212 KRL=KR2+NR-1
213 ENDIF
214 IF(KR1.EQ.IRL.OR.KRL.EQ.IRL)GO TO 70
215 50 CONTINUE
216 CALL RZPURF(1,IRL)
217 ENDIF
218 70 CONTINUE
219*
220* Garbage collection on cycles area + relocation
221*
222 LKC3=LE-KLCYCL+1
223 80 IF(LKC3.LT.LC)GO TO 200
224 IF(IQ(KQSP+LCDIR+LKC3).EQ.-1)THEN
225 LKC3=LKC3+KLCYCL
226 LKC2=LKC3-2*KLCYCL
227 90 IF(IQ(KQSP+LCDIR+LKC2).NE.-1)THEN
228 LKC2=LKC2+KLCYCL
229 LKC1=LKC2-2*KLCYCL
230 IF(LKC1.LT.LC)LKC1=LC
231 100 IF(IQ(KQSP+LCDIR+LKC1).EQ.-1)THEN
232 IF(LKC1.GT.LC)LKC1=LKC1+KLCYCL
233 ELSE
234 IF(LKC1.GT.LC)THEN
235 LKC1=LKC1-KLCYCL
236 GO TO 100
237 ENDIF
238 ENDIF
239*
240 NPUSH=LKC3-LKC2
241 DO 110 LKC=LC,LKC2-KLCYCL,KLCYCL
242 IF(IQ(KQSP+LCDIR+LKC).NE.-1)THEN
243 IF (KVSCYC.EQ.0) THEN
244 LCOLD = JBYT(IQ(KQSP+LCDIR+LKC+KPPCYC),1,16)
245 ELSE
246 LCOLD = IQ(KQSP+LCDIR+LKC+KPPCYC)
247 ENDIF
248 IF(LCOLD.GE.LKC1.AND.LCOLD.LT.LKC2)THEN
249 LCOLD=LCOLD+NPUSH
250 IF (KVSCYC.EQ.0) THEN
251 CALL SBYT(LCOLD,IQ(KQSP+LCDIR+LKC+KPPCYC),1,16)
252 ELSE
253 IQ(KQSP+LCDIR+LKC+KPPCYC) = LCOLD
254 ENDIF
255 ENDIF
256 ENDIF
257 110 CONTINUE
258*
259 DO 120 IK=1,NKEYS
260 LCYC=IQ(KQSP+LCDIR+LK+(NWKEY+1)*(IK-1))
261 IF(LCYC.GE.LKC1.AND.LCYC.LT.LKC2)THEN
262 IQ(KQSP+LCDIR+LK+(NWKEY+1)*(IK-1))=
263 + IQ(KQSP+LCDIR+LK+(NWKEY+1)*(IK-1))+NPUSH
264 ENDIF
265 120 CONTINUE
266*
267 CALL UCOPY2(IQ(KQSP+LCDIR+LKC1),IQ(KQSP+LCDIR+LKC1+NPUSH),
268 + LKC2-LKC1)
269 LKC3=LKC1+NPUSH
270 LKC2=LKC1-KLCYCL
271 IF(LKC1.NE.LC)GO TO 90
272 LC=LC+NPUSH
273 GO TO 200
274*
275 ELSE
276 LKC2=LKC2-KLCYCL
277 IF(LKC2.GE.LC)GO TO 90
278 ENDIF
279 ELSE
280 LKC3=LKC3-KLCYCL
281 GO TO 80
282 ENDIF
283*
284* Reset internal pointers
285*
286 200 CONTINUE
287*
288 NPUNEW=0
289 IF(LPURG.NE.0)THEN
290 NPURG=IQ(KQSP+LPURG+1)
291 DO 210 I=1,NPURG
292 NPUNEW=NPUNEW+IQ(KQSP+LPURG+2*I+1)-IQ(KQSP+LPURG+2*I)+1
293 210 CONTINUE
294 ENDIF
295 NPU=NPUNEW-NPUOLD
296 IQUEST( 9)=IQ(KQSP+LCDIR+KQUOTA)-IQ(KQSP+LCDIR+KRUSED)+NPU
297 IQUEST(11)=(LC-IQ(KQSP+LCDIR+KLC))/KLCYCL
298 IQUEST(12)=NPU*LREC
299 IQUEST(13)=NPU
300*
301 IQ(KQSP+LCDIR+KRUSED)=IQ(KQSP+LCDIR+KRUSED)-NPU
302 NWP=NPU*LREC
303 NMEGA=NWP/1000000
304 IQ(KQSP+LCDIR+KMEGA)=IQ(KQSP+LCDIR+KMEGA)-NMEGA
305 NWP=NWP-1000000*NMEGA
306 IQ(KQSP+LCDIR+KWUSED)=IQ(KQSP+LCDIR+KWUSED)-NWP
307 IQ(KQSP+LCDIR+KNFREE)=IQ(KQSP+LCDIR+KNFREE)+LC-IQ(KQSP+LCDIR+KLC)
308 IQ(KQSP+LCDIR+KLC)=LC
309*
310 999 RETURN
311 END