]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/rz/rziodo.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Added protection. In case IROT=0 the address Q(LQ(JROTM-IROT)) should not
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / rz / rziodo.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.6 1998/09/25 09:33:38 mclareni
6* Modifications for the Mklinux port flagged by CERNLIB_PPC
7*
8* Revision 1.5 1998/03/13 16:51:18 mclareni
9* Put the record length warning behind a CERNLIB_DEBUG flag to avoid spurious warnings
10*
11* Revision 1.4 1997/09/02 15:16:12 mclareni
12* WINNT corrections
13*
14* Revision 1.3 1997/05/14 08:33:39 couet
15* - Bug fixed by S.O'Neale. atlas problems with cernlib 97a, with rfio/cio
16* the record was not correct in rziodo. Now rzfdir.F rest the correct one.
17*
18* Revision 1.2 1996/04/24 17:26:56 mclareni
19* Extend the include file cleanup to dzebra, rz and tq, and also add
20* dependencies in some cases.
21*
22* Revision 1.1.1.1 1996/03/06 10:47:24 mclareni
23* Zebra
24*
25*
26#include "zebra/pilot.h"
27 SUBROUTINE RZIODO(LUNRZ,JREC,IREC1,IBUF,IRW)
28*
29**********************************************************************
30*
31* To read/write a block from disk or memory
32*
33* LUNRZ Logical unit number for disk (LUN>0)
34* JREC Record length
35* IREC RECORD NUMBER
36* IBUF ADDRESS OF BUFFER TO BE READ/WRITTEN ON IREC
37* IRW =1 TO READ
38* IRW =2 TO WRITE
39*
40* Called by RZCOP1,RZDELT,RZDFIR,RZFILE,RZFREE,RZLLOK,RZLOCK
41* RZMAKE,RZMDIR,RZOUT,RZREAD,RZSAVE,RZOPEN
42*
43* Author : R.Brun DD/US/PD
44* Written : 01.04.86
45* Last mod: 10.06.94 Implement File striping for PIAF (R.Brun)
46* New routine RZSTRIR called
47* Last mod: 26.10.93 IQUEST(1) = 101 in case of READ error,
48* 102 in case of WRITE error
49*
50************************************************************************
51*
52#include "zebra/zunit.inc"
53#include "zebra/rzcl.inc"
54#include "zebra/rzclun.inc"
55#include "zebra/rzbuff.inc"
56#include "zebra/rzcount.inc"
57#if defined(CERNLIB_QMUIX)
58#include "zebra/rzcstr.inc"
59#endif
60 DIMENSION IBUF(JREC)
61 PARAMETER (MEDIUM=0)
62*
63*-----------------------------------------------------------------------
64*
65
66#include "zebra/q_jbyt.inc"
67
68*
69* I/O statistics
70*
71 RZXIO(IRW) = RZXIO(IRW) + JREC
72
73 IREC=IREC1
74 IF(LUNRZ.GT.0)THEN
75 NERR=0
76#if defined(CERNLIB_DEBUG)
77C Too many false alarms occur if we leave this in production code.
78 IF ( IREC.GT.2 .AND. IZRECL.NE.JREC ) THEN
79 WRITE(IQLOG,10010) LUNRZ,IREC,IZRECL,JREC
8010010 FORMAT(' RZIODO. Potential Record Length Problem LUN =',I6,
81 + ' IREC =',I6,' IZRECL =',I6,' JREC =',I6)
82 END IF
83#endif
84 IF(IMODEH.NE.0) THEN
85*
86 IQUEST(1) = JBYT(IQ(KQSP+LTOP),7,7)
87 IQUEST(2) = JREC
88 IQUEST(4) = IREC
89 IOWAY = IRW - 1
90*
91#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
92*
93* Byte swap
94*
95 IF(IRW.EQ.2.AND.IMODEX.NE.0) CALL VXINVB(IBUF,JREC)
96#endif
97 CALL JUMPST(LUNRZ)
98 CALL JUMPX2(IBUF,IOWAY)
99
100 IF(IQUEST(1).NE.0) IQUEST(1) = 100 + IRW
101#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
102*
103* Byte swap
104*
105 IF(IMODEX.NE.0) CALL VXINVB(IBUF,JREC)
106#endif
107 ELSE
108*
109* Read a record
110*
111 10 IF (IRW.EQ.1)THEN
112*
113* Fortran I/O
114*
115 IF(IMODEC.EQ.0) THEN
116#if defined(CERNLIB_QMUIX)
117*-* Case of File striping
118*
119 if(nstrip(lunrz).gt.0)then
120 call rzstrir(lunrz,irec)
121 endif
122*
123#endif
124#if defined(CERNLIB_QMVDS)
125 CALL READ_ASS(LUNRZ,IREC,ISTAT,IBUF)
126 IF(ISTAT.EQ.1)GO TO 20
127#endif
128#if (!defined(CERNLIB_QMVDS))&&(!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCV64))
129 READ (UNIT=LUNRZ,REC=IREC,ERR=20,IOSTAT=ISTAT)IBUF
130#endif
131#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
132*
133* Exchange mode on Cray and Convex - read JREC/2 64 bit
134* words (=JREC 32 bit words)
135*
136 IF(IMODEX.NE.0) THEN
137 CALL RZIPHD(LUNRZ,JREC/2,IREC,ITEST,ISTAT)
138 IF(ISTAT.NE.0) GOTO 20
139#endif
140#if defined(CERNLIB_QMCV64)
141*
142* Unpack 32 bit words to 64 bit words
143*
144 CALL UPAK32(ITEST,IBUF,JREC)
145#endif
146#if defined(CERNLIB_QMCRY)
147*
148* Unpack 32 bit words to 64 bit words
149*
150 CALL UNPACK(ITEST,32,IBUF,JREC)
151#endif
152#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
153*
154* Native mode
155*
156 ELSE
157 READ(UNIT=LUNRZ,REC=IREC,ERR=20,IOSTAT=ISTAT)IBUF
158 ENDIF
159#endif
160*
161* C I/O
162*
163 ELSE
164#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
165 IF(IMODEX.NE.0) THEN
166*
167* Exchange mode?
168*
169 CALL CFSEEK(LUNRZ-1000,MEDIUM,IZRECL/2,IREC-1,
170 + ISTAT)
171 NWTAK = JREC / 2
172 CALL CFGET(LUNRZ-1000,MEDIUM,JREC,NWTAK,ITEST,
173 + ISTAT)
174 IF(ISTAT.NE.0) GOTO 20
175#endif
176#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
177*
178* Unpack
179*
180#endif
181#if defined(CERNLIB_QMCRY)
182 CALL UNPACK(ITEST,32,IBUF,JREC)
183#endif
184#if defined(CERNLIB_QMCV64)
185 CALL UPAK32(ITEST,IBUF,JREC)
186#endif
187#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
188 ELSE
189#endif
190#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMVDS)
191*
192* C I/O not supported
193*
194 ISTAT = 99
195#endif
196#if defined(CERNLIB_QMUIX)
197*-* Case of File striping
198*
199 if(nstrip(lunrz-1000).gt.0)then
200 call rzstrir(lunrz-1000,irec)
201 endif
202*
203#endif
204#if (!defined(CERNLIB_QMVDS))&&(!defined(CERNLIB_QMIBM))
205 CALL CFSEEK(LUNRZ-1000,MEDIUM,IZRECL,IREC-1,ISTAT)
206 NWTAK = JREC
207 CALL CFGET(LUNRZ-1000,MEDIUM,JREC,NWTAK,IBUF,
208 + ISTAT)
209 IF(ISTAT.NE.0) GOTO 20
210#endif
211#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
212 ENDIF
213#endif
214 ENDIF
215#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
216*
217* Byte swap if exchange mode
218*
219 IF(IMODEX.NE.0) CALL VXINVB(IBUF,JREC)
220#endif
221*
222* Write
223*
224 ELSE
225#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
226*
227* Byte swap if exchange mode
228*
229 IF(IMODEX.NE.0) CALL VXINVB(IBUF,JREC)
230#endif
231 IF(IMODEC.EQ.0) THEN
232#if defined(CERNLIB_QMVDS)
233 CALL WRITE_ASS(LUNRZ,IREC,ISTAT,IBUF)
234 IF(ISTAT.EQ.1)GO TO 20
235#endif
236#if (!defined(CERNLIB_QMVDS))&&(!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCV64))
237 WRITE(UNIT=LUNRZ,REC=IREC,ERR=20,IOSTAT=ISTAT)IBUF
238#endif
239#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
240 IF(IMODEX.NE.0) THEN
241*
242* Pack
243*
244#endif
245#if defined(CERNLIB_QMCRY)
246 CALL PACK(IBUF,32,ITEST,JREC)
247#endif
248#if defined(CERNLIB_QMCV64)
249 CALL PACK32(IBUF,ITEST,JREC)
250#endif
251#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
252 CALL RZOPHD(LUNRZ,IZRECL/2,IREC,ITEST,ISTAT)
253 IF(ISTAT.NE.0) GOTO 20
254 ELSE
255 WRITE(UNIT=LUNRZ,REC=IREC,ERR=20,IOSTAT=ISTAT)
256 + IBUF
257 ENDIF
258#endif
259 ELSE
260#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
261 IF(IMODEX.NE.0) THEN
262*
263* Pack
264*
265#endif
266#if defined(CERNLIB_QMCRY)
267 CALL PACK(IBUF,32,ITEST,JREC)
268#endif
269#if defined(CERNLIB_QMCV64)
270 CALL PACK32(IBUF,ITEST,JREC)
271#endif
272#if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
273 JREC = JREC / 2
274 CALL CFSEEK(LUNRZ-1000,MEDIUM,IZRECL/2,IREC-1,
275 + ISTAT)
276 IF(ISTAT.NE.0) GOTO 20
277 CALL CFPUT(LUNRZ-1000,MEDIUM,JREC/2,ITEST,ISTAT)
278 IF(ISTAT.NE.0) GOTO 20
279 ELSE
280 CALL CFSEEK(LUNRZ-1000,MEDIUM,IZRECL,IREC-1,ISTAT)
281 IF(ISTAT.NE.0) GOTO 20
282 CALL CFPUT(LUNRZ-1000,MEDIUM,JREC,IBUF,ISTAT)
283 IF(ISTAT.NE.0) GOTO 20
284 ENDIF
285#endif
286#if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMVDS)
287*
288* C I/O not supported
289*
290 ISTAT = 99
291#endif
292#if (!defined(CERNLIB_QMVDS))&&(!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QMIBM))
293 CALL CFSEEK(LUNRZ-1000,MEDIUM,IZRECL,IREC-1,ISTAT)
294 IF(ISTAT.NE.0) GOTO 20
295 CALL CFPUT(LUNRZ-1000,MEDIUM,JREC,IBUF,ISTAT)
296 IF(ISTAT.NE.0) GOTO 20
297#endif
298 ENDIF
299#if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
300*
301* Byte swap back
302*
303 IF(IMODEX.NE.0) CALL VXINVB(IBUF,JREC)
304#endif
305 ENDIF
306 RETURN
307 20 NERR=NERR+1
308#if defined(CERNLIB_QMVAX)
309 CALL LIB$WAIT(0.1)
310#endif
311#if defined(CERNLIB_QMCRY)
312 IC = SLEEPF(1)
313#endif
314 IF(NERR.LT.100)GO TO 10
315 IQUEST(1)=100+IRW
316 WRITE(IQLOG,1000)IREC,LUNRZ,ISTAT
317 1000 FORMAT(' RZIODO. Error at record =',I5,' LUN =',I6,
318 + ' IOSTAT =',I6)
319 ENDIF
320 ELSE
321 KOF=IQ(KQSP+LRZ0-2*LUNRZ-1)+IQ(KQSP+LRZ0-2*LUNRZ)*(IREC-1)
322 IF (IRW.EQ.1)THEN
323 CALL UCOPY(IQ(KOF),IBUF,JREC)
324 ELSE
325 CALL UCOPY(IBUF,IQ(KOF),JREC)
326 ENDIF
327 ENDIF
328*
329 END