5 * Revision 1.6 1998/09/25 09:33:38 mclareni
6 * Modifications for the Mklinux port flagged by CERNLIB_PPC
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
11 * Revision 1.4 1997/09/02 15:16:12 mclareni
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.
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.
22 * Revision 1.1.1.1 1996/03/06 10:47:24 mclareni
26 #include "zebra/pilot.h"
27 SUBROUTINE RZIODO(LUNRZ,JREC,IREC1,IBUF,IRW)
29 **********************************************************************
31 * To read/write a block from disk or memory
33 * LUNRZ Logical unit number for disk (LUN>0)
36 * IBUF ADDRESS OF BUFFER TO BE READ/WRITTEN ON IREC
40 * Called by RZCOP1,RZDELT,RZDFIR,RZFILE,RZFREE,RZLLOK,RZLOCK
41 * RZMAKE,RZMDIR,RZOUT,RZREAD,RZSAVE,RZOPEN
43 * Author : R.Brun DD/US/PD
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
50 ************************************************************************
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"
63 *-----------------------------------------------------------------------
66 #include "zebra/q_jbyt.inc"
71 RZXIO(IRW) = RZXIO(IRW) + JREC
76 #if defined(CERNLIB_DEBUG)
77 C 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
80 10010 FORMAT(' RZIODO. Potential Record Length Problem LUN =',I6,
81 + ' IREC =',I6,' IZRECL =',I6,' JREC =',I6)
86 IQUEST(1) = JBYT(IQ(KQSP+LTOP),7,7)
91 #if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
95 IF(IRW.EQ.2.AND.IMODEX.NE.0) CALL VXINVB(IBUF,JREC)
98 CALL JUMPX2(IBUF,IOWAY)
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)
105 IF(IMODEX.NE.0) CALL VXINVB(IBUF,JREC)
116 #if defined(CERNLIB_QMUIX)
117 *-* Case of File striping
119 if(nstrip(lunrz).gt.0)then
120 call rzstrir(lunrz,irec)
124 #if defined(CERNLIB_QMVDS)
125 CALL READ_ASS(LUNRZ,IREC,ISTAT,IBUF)
126 IF(ISTAT.EQ.1)GO TO 20
128 #if (!defined(CERNLIB_QMVDS))&&(!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCV64))
129 READ (UNIT=LUNRZ,REC=IREC,ERR=20,IOSTAT=ISTAT)IBUF
131 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
133 * Exchange mode on Cray and Convex - read JREC/2 64 bit
134 * words (=JREC 32 bit words)
137 CALL RZIPHD(LUNRZ,JREC/2,IREC,ITEST,ISTAT)
138 IF(ISTAT.NE.0) GOTO 20
140 #if defined(CERNLIB_QMCV64)
142 * Unpack 32 bit words to 64 bit words
144 CALL UPAK32(ITEST,IBUF,JREC)
146 #if defined(CERNLIB_QMCRY)
148 * Unpack 32 bit words to 64 bit words
150 CALL UNPACK(ITEST,32,IBUF,JREC)
152 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
157 READ(UNIT=LUNRZ,REC=IREC,ERR=20,IOSTAT=ISTAT)IBUF
164 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
169 CALL CFSEEK(LUNRZ-1000,MEDIUM,IZRECL/2,IREC-1,
172 CALL CFGET(LUNRZ-1000,MEDIUM,JREC,NWTAK,ITEST,
174 IF(ISTAT.NE.0) GOTO 20
176 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
181 #if defined(CERNLIB_QMCRY)
182 CALL UNPACK(ITEST,32,IBUF,JREC)
184 #if defined(CERNLIB_QMCV64)
185 CALL UPAK32(ITEST,IBUF,JREC)
187 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
190 #if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMVDS)
192 * C I/O not supported
196 #if defined(CERNLIB_QMUIX)
197 *-* Case of File striping
199 if(nstrip(lunrz-1000).gt.0)then
200 call rzstrir(lunrz-1000,irec)
204 #if (!defined(CERNLIB_QMVDS))&&(!defined(CERNLIB_QMIBM))
205 CALL CFSEEK(LUNRZ-1000,MEDIUM,IZRECL,IREC-1,ISTAT)
207 CALL CFGET(LUNRZ-1000,MEDIUM,JREC,NWTAK,IBUF,
209 IF(ISTAT.NE.0) GOTO 20
211 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
215 #if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
217 * Byte swap if exchange mode
219 IF(IMODEX.NE.0) CALL VXINVB(IBUF,JREC)
225 #if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
227 * Byte swap if exchange mode
229 IF(IMODEX.NE.0) CALL VXINVB(IBUF,JREC)
232 #if defined(CERNLIB_QMVDS)
233 CALL WRITE_ASS(LUNRZ,IREC,ISTAT,IBUF)
234 IF(ISTAT.EQ.1)GO TO 20
236 #if (!defined(CERNLIB_QMVDS))&&(!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCV64))
237 WRITE(UNIT=LUNRZ,REC=IREC,ERR=20,IOSTAT=ISTAT)IBUF
239 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
245 #if defined(CERNLIB_QMCRY)
246 CALL PACK(IBUF,32,ITEST,JREC)
248 #if defined(CERNLIB_QMCV64)
249 CALL PACK32(IBUF,ITEST,JREC)
251 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
252 CALL RZOPHD(LUNRZ,IZRECL/2,IREC,ITEST,ISTAT)
253 IF(ISTAT.NE.0) GOTO 20
255 WRITE(UNIT=LUNRZ,REC=IREC,ERR=20,IOSTAT=ISTAT)
260 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
266 #if defined(CERNLIB_QMCRY)
267 CALL PACK(IBUF,32,ITEST,JREC)
269 #if defined(CERNLIB_QMCV64)
270 CALL PACK32(IBUF,ITEST,JREC)
272 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
274 CALL CFSEEK(LUNRZ-1000,MEDIUM,IZRECL/2,IREC-1,
276 IF(ISTAT.NE.0) GOTO 20
277 CALL CFPUT(LUNRZ-1000,MEDIUM,JREC/2,ITEST,ISTAT)
278 IF(ISTAT.NE.0) GOTO 20
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
286 #if defined(CERNLIB_QMIBM)||defined(CERNLIB_QMVDS)
288 * C I/O not supported
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
299 #if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
303 IF(IMODEX.NE.0) CALL VXINVB(IBUF,JREC)
308 #if defined(CERNLIB_QMVAX)
311 #if defined(CERNLIB_QMCRY)
314 IF(NERR.LT.100)GO TO 10
316 WRITE(IQLOG,1000)IREC,LUNRZ,ISTAT
317 1000 FORMAT(' RZIODO. Error at record =',I5,' LUN =',I6,
321 KOF=IQ(KQSP+LRZ0-2*LUNRZ-1)+IQ(KQSP+LRZ0-2*LUNRZ)*(IREC-1)
323 CALL UCOPY(IQ(KOF),IBUF,JREC)
325 CALL UCOPY(IBUF,IQ(KOF),JREC)