]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/rz/rzfile.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 / rzfile.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.5 1998/09/25 09:33:35 mclareni
6* Modifications for the Mklinux port flagged by CERNLIB_PPC
7*
8* Revision 1.4 1997/09/02 15:16:11 mclareni
9* WINNT corrections
10*
11* Revision 1.3 1997/03/14 17:21:19 mclareni
12* WNT mods
13*
14* Revision 1.2 1996/04/24 17:26:50 mclareni
15* Extend the include file cleanup to dzebra, rz and tq, and also add
16* dependencies in some cases.
17*
18* Revision 1.1.1.1 1996/03/06 10:47:23 mclareni
19* Zebra
20*
21*
22#include "zebra/pilot.h"
23 SUBROUTINE RZFILE(LUNIN,CHDIR,CHOPT)
24*
25************************************************************************
26*
27* Routine to access an already existing RZ file
28* To create a new RZ file routine RZMAKE should be used
29* Input:
30* LUNP Logical unit number associated with the RZ file. A FORTRAN
31* OPEN statement must precede the call to RZFILE.
32* Starting address of the memory area which will contain the RZ
33* information ('M' option)
34* CHDIR Character variable specifying the name of the top directory
35* to be associated with unit LUN.
36* CHOPT Character variable specifying the selected options.
37* medium
38* default
39* Disk
40* 'M' Memory mode
41* In this case space has already been allocated starting
42* at address LUNP.
43* other
44* 'U' UPDATE mode default is READ mode only
45* 'S' SHARED mode default is exclusive access
46* '1' UPDATE mode with only one user (no LOCKs required)
47* 'L' Show all locked directories and lock-ids
48* 'D' Reset LOCKing word in first record
49* 'C' C I/O
50* 'H' Hook user routine to RZIODO
51* 'X' Exchange mode file
52*
53* 'B' Rebuild bit map of file occupancy from file itself
54*
55* Called by <USER>
56*
57* Author : R.Brun DD/US/PD
58* Written : 07.04.86
59* Last mod: 22.09.94 JDS - include Z=RZCYCLE and call to RZVCYC
60* 06.07.95 JDS - return RZ file version in IQUEST(13)
61*
62************************************************************************
63*
64#include "zebra/zunit.inc"
65#include "zebra/zstate.inc"
66#include "zebra/rzcl.inc"
67#include "zebra/rzdir.inc"
68#include "zebra/rzclun.inc"
69#include "zebra/rzk.inc"
70#include "zebra/rzckey.inc"
71#include "zebra/rzcycle.inc"
72#include "zebra/rzbuff.inc"
73#if defined(CERNLIB_QMVAX)
74 CHARACTER*16 CHORG
75#endif
76 CHARACTER CHOPT*(*),CHDIR*(*)
77 CHARACTER*16 CHTOP
78 DIMENSION IOPTV(10)
79 EQUIVALENCE (IOPTM,IOPTV(1)), (IOPTU,IOPTV(2))
80 EQUIVALENCE (IOPTS,IOPTV(3)), (IOPTL,IOPTV(4))
81 EQUIVALENCE (IOPT1,IOPTV(5)), (IOPTD,IOPTV(6))
82 EQUIVALENCE (IOPTC,IOPTV(7)), (IOPTX,IOPTV(8))
83 EQUIVALENCE (IOPTB,IOPTV(9)), (IOPTH,IOPTV(10))
84*
85*-----------------------------------------------------------------------
86*
87#include "zebra/q_jbit.inc"
88#include "zebra/q_jbyt.inc"
89
90 IQUEST(1)=0
91 LOGLV = MIN(NQLOGD,4)
92 LOGLV = MAX(LOGLV,-3)
93 LUNSA = LUN
94 LUNP = LUNIN
95*
96* Save existing material (if any)
97*
98 CALL RZSAVE
99*
100 CALL UOPTC (CHOPT,'MUSL1DCXBH',IOPTV)
101#if !defined(CERNLIB_QCFIO)
102*SELF,IF=-QMCRY,IF=-QMVAX,IF=-QMCV64,IF=-QMAPO,IF=-QMAPO9,IF=-QMUIX,IF=-QMDOS.
103 IF(IOPTC.NE.0) THEN
104 WRITE(IQPRNT,*) 'RZFILE. option C ignored - valid only ',
105 + 'for MSDOS, Unix and VMS systems'
106 IOPTC = 0
107 ENDIF
108#endif
109 IRELAT=0
110 IMODEC=IOPTC
111 IMODEH=IOPTH
112 IMODEX=IOPTX
113#if (defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))
114C RZfile with Exchange mode for NonPPC-LINUX
115* IMODEX=1
116#endif
117*
118* Take LRECL and LUNP from IQUEST(10-11) in case of C I/O
119*
120 IF(IOPTC.NE.0) THEN
121 LRECP = IQUEST(10)
122 LUNP = IQUEST(11)
123 ENDIF
124*
125* Take LRECL and address of user routine from IQUEST(10-11)
126* in case of user I/O routine
127*
128 IF(IOPTH.NE.0) THEN
129 LRECP = IQUEST(10)
130 LUN = IQUEST(11)
131 LUSER = LUNIN
132 ENDIF
133*
134* Find record length (as specified in the OPEN statement)
135*
136* A, Memory option. LUN contains the buffer address
137* and the value of LUNP is the block length
138*
139 IF(IOPTM.NE.0)THEN
140 LRECP=1024
141 LUN=-99
142 ELSEIF(IOPTH.EQ.0) THEN
143*
144* B, Standard option DISK. Use information as specified
145* in the Fortran OPEN statement
146*
147#if defined(CERNLIB_QMVAX)
148 IF(IOPTC.EQ.0) THEN
149 INQUIRE(UNIT=LUNP,ORGANIZATION=CHORG)
150 IF(CHORG.EQ.'RELATIVE')IRELAT=1
151 ENDIF
152#endif
153*
154 IZRECL=LRECP
155 CALL RZIODO(LUNP,50,2,ITEST,1)
156*
157* If option X not specified, determine mode (eXchange, native)
158* from file
159*
160 IF(IOPTX.EQ.0) THEN
161#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
162 CALL VXINVB(ITEST(9),1)
163#endif
164 IF(JBIT(ITEST(9),12).NE.0)THEN
165 IMODEX=1
166#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
167 CALL RZIODO(LUNP,50,2,ITEST,1)
168 ELSE
169 CALL VXINVB(ITEST(9),1)
170#endif
171 ENDIF
172 ENDIF
173
174 IF(IQUEST(1).NE.0)GO TO 30
175 LB=ITEST(KLB)
176 IF(LB.GT.48)CALL RZIODO(LUNP,LB+6,2,ITEST,1)
177 IF(LB.GT.100)THEN
178 IF(LOGLV.GE.-1) WRITE(IQLOG,10000)
17910000 FORMAT(' RZFILE. WARNING!! Top directory is big')
180 ENDIF
181 LRECP=ITEST(LB+1)
182#if defined(CERNLIB_QMALT)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMDOS)||defined(CERNLIB_WINNT)
183 IF(IOPTC.EQ.0.AND.IOPTH.EQ.0) THEN
184 INQUIRE(UNIT=LUNP,RECL=LRECL)
185* DEC Fortran takes "longword" units
186#endif
187#if (defined(CERNLIB_QFDEC))&&(defined(CERNLIB_QMDOS))
188 IF(LRECP.NE.LRECL)THEN
189#endif
190#if (defined(CERNLIB_QMALT)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMDOS)||defined(CERNLIB_WINNT))&&(!defined(CERNLIB_QFDEC))
191 IF(LRECP.NE.LRECL/4)THEN
192#endif
193#if defined(CERNLIB_QMALT)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMDOS)||defined(CERNLIB_WINNT)
194 IQUEST(1)=1
195 IF(LOGLV.GE.-2) WRITE(IQLOG,10100)LUNP,LRECP,LRECL/4
19610100 FORMAT(' RZFILE. Unit ',I6,'RECL on file ',I5,
197 + ' incompatible with RECL in OPEN =',I5)
198 GO TO 30
199 ENDIF
200 ENDIF
201#endif
202 LUN=LUNP
203 IQUEST(1)=0
204 ENDIF
205*
206 IF(LOGLV.GE.0) WRITE(IQLOG,10200) LUN,LRECP,CHOPT
20710200 FORMAT(' RZFILE. UNIT ',I6,' Initializing with LREC=',I6,
208 +', OPT= ',A)
209 CALL MZSDIV (0,-7)
210*
211* Check if LUN not already defined
212*
213 LRZ=LQRS
214 10 IF(LRZ.NE.0)THEN
215 IF(IQ(KQSP+LRZ-5).EQ.LUN)THEN
216 IQUEST(1)=1
217 IF(LOGLV.GE.-2) WRITE(IQLOG,10300)
21810300 FORMAT(' RZFILE. Unit is already in use')
219 LUN=LUNSA
220 GO TO 30
221 ELSE
222 LRZ=LQ(KQSP+LRZ)
223 GO TO 10
224 ENDIF
225 ENDIF
226*
227* First call to RZFILE, create link area
228*
229 IF(LQRS.EQ.0)THEN
230 CALL MZLINK(JQPDVS,'RZCL',LTOP,LTOP,LFROM)
231 CALL MZBOOK (JQPDVS,LRZ0,LQRS,1,'RZ0 ',2,2,36,2,0)
232 IQ(KQSP+LRZ0-5)=0
233 ISAVE = 1
234 NHPWD = 0
235 CALL VBLANK(IHPWD,2)
236 ENDIF
237 NCHD = LEN(CHDIR)
238 IF(NCHD.GT.16)NCHD=16
239 CHTOP = CHDIR(1:NCHD)
240*
241* Create control bank
242*
243 CALL MZBOOK(JQPDVS,LTOP,LQRS,1,'RZ ',10,9,LRECP,2,0)
244*
245* Disk or memory
246*
247 IF(IOPTM.EQ.0)THEN
248 IQ(KQSP+LTOP-5) = LUN
249*
250* C I/O?
251*
252 IF(IOPTC.NE.0) CALL SBIT1(IQ(KQSP+LTOP),5)
253*
254* user I/O?
255*
256 IF(IOPTH.NE.0) THEN
257 CALL SBIT1(IQ(KQSP+LTOP),6)
258 CALL SBYT(LUSER,IQ(KQSP+LTOP),7,7)
259 ENDIF
260 ELSE
261 NMEM=IQ(KQSP+LRZ0)+1
262 IQ(KQSP+LRZ0)=NMEM
263 IQ(KQSP+LTOP-5)=-NMEM
264 IF(2*NMEM.GT.IQ(KQSP+LRZ0-1))THEN
265 CALL MZPUSH(JQPDVS,LRZ0,0,10,' ')
266 ENDIF
267 IQ(KQSP+LRZ0+2*NMEM-1)=LOCF(LUNP)-LOCF(IQ(1))+1
268 IQ(KQSP+LRZ0+2*NMEM )=LRECP
269 LUN=-NMEM
270 ENDIF
271*
272* Read 1st record of directory
273*
274 CALL RZIODO(LUN,LRECP,2,IQ(KQSP+LTOP+1),1)
275 IF(IQUEST(1).NE.0)GO TO 30
276 LD = IQ(KQSP+LTOP+KLD)
277 LB = IQ(KQSP+LTOP+KLB)
278 LREC = IQ(KQSP+LTOP+LB+1)
279 NRD = IQ(KQSP+LTOP+LD)
280#if defined(CERNLIB_FQXISN)
281*
282* Set exchange mode bit
283*
284 CALL SBIT1(IQ(KQSP+LTOP+KPW1+2),12)
285#endif
286 IMODEX=JBIT(IQ(KQSP+LTOP+KPW1+2),12)
287*
288* Increase size of control bank if required
289* and read all records for top directory
290*
291 NPUSH=NRD*LREC-LRECP
292 IF(NPUSH.NE.0)CALL MZPUSH(JQPDVS,LTOP,0,NPUSH,'I')
293 DO 20 I=2,NRD
294 CALL RZIODO(LUN,LREC,IQ(KQSP+LTOP+LD+I),
295 + IQ(KQSP+LTOP+(I-1)*LREC+1),1)
296 IF(IQUEST(1).NE.0)GO TO 30
297 20 CONTINUE
298 CALL VBLANK(IQ(KQSP+LTOP+1),4)
299 CALL UCTOH(CHDIR,IQ(KQSP+LTOP+1),4,NCHD)
300 CALL ZHTOI(IQ(KQSP+LTOP+1),IQ(KQSP+LTOP+1),4)
301 CALL SBYT(NCHD,IQ(KQSP+LTOP+KPW1+2),1,5)
302 CALL UCOPY(IQ(KQSP+LTOP+KPW1),IHPWD,2)
303 NHPWD=JBYT(IQ(KQSP+LTOP+KPW1+2),6,5)
304 IQ(KQSP+LTOP+KIRIN)=0
305 IQ(KQSP+LTOP+KIROUT)=0
306#if defined(CERNLIB_NOTNEW)
307*
308* Check that the file is not in the NEW format
309*
310 IF (IQ(KQSP+LTOP+KRZVER).NE.0) THEN
311 CALL ZFATAM
312 + (' RZFILE. file cannot be processed by this version of RZ')
313 ENDIF
314#endif
315
316 LFREE = 0
317 LUSED = 0
318 LRIN = 0
319 LPURG = 0
320 LROUT = 0
321 LCDIR = LTOP
322 NLCDIR= 1
323 NLNDIR= 1
324 NLPAT = 1
325 CHCDIR(1)=CHTOP
326 CHNDIR(1)=CHTOP
327*
328* Reset LOCKing word in record 1
329*
330 IF(IOPTD.NE.0)THEN
331 CALL RZDLOK
332 ENDIF
333*
334* Show locks
335*
336 IF(IOPTL.NE.0)THEN
337 CALL RZLLOK
338 ENDIF
339#if defined(CERNLIB_QMVAX)
340*
341* Set ORGANIZATION type
342*
343 IF(IRELAT.NE.0)THEN
344 UNLOCK(UNIT=LUN)
345 CALL SBIT1(IQ(KQSP+LTOP),4)
346 ENDIF
347#endif
348*
349* Store default LOG level
350*
351 LOGL = LOGLV + 3
352 CALL SBYT(LOGL,IQ(KQSP+LTOP),15,3)
353*
354* RZ version
355*
356 CALL RZVCYC(LTOP)
357 IQUEST(13) = IQ(KQSP+LTOP+KRZVER)
358*
359* Rebuild bit map?
360*
361 IF(IOPTB.NE.0) CALL RZVERI('//'//CHTOP(1:NCHD),'B')
362*
363* UPDATE mode only
364*
365 CALL SBIT1(IQ(KQSP+LTOP),1)
366 IF(IOPTU.NE.0.OR.IOPT1.NE.0)THEN
367*
368* Allocate free records
369*
370 CALL SBIT0(IQ(KQSP+LTOP),1)
371 CALL MZBOOK(JQPDVS,LFREE,LTOP,-2,'RZFR',0,0,21,2,0)
372 IQ(KQSP+LFREE-5)=LUN
373*
374* IF(IOPTU.EQ.0.AND.IOPT1.EQ.0)THEN
375 IF(IOPTS.EQ.0)THEN
376 CALL SBIT1(IQ(KQSP+LTOP),3)
377 CALL RZLOCK('RZFILE')
378 IF(IQUEST(1).NE.0)THEN
379 CALL SBIT1(IQ(KQSP+LTOP),1)
380 IQ1=IQUEST(1)
381 CALL MZDROP(JQPDVS,LFREE,' ')
382 LFREE=0
383 IQUEST(1)=2+IQ1
384 GO TO 30
385 ENDIF
386 ELSE
387 CALL SBIT0(IQ(KQSP+LTOP),3)
388 ENDIF
389*
390* Allocate space for used records
391*
392 CALL MZBOOK(JQPDVS,LUSED,LTOP,-3,'RZUS',0,0,21,2,0)
393 IQ(KQSP+LUSED-5)=LUN
394 ENDIF
395 IQUEST(7)=IQ(KQSP+LCDIR+KNKEYS)
396 IQUEST(8)=IQ(KQSP+LCDIR+KNWKEY)
397*
398 30 RETURN
399 END