MINICERN/packlib/zebra/rz/rzopen.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.7  1998/09/25 09:33:41  mclareni
   6 * Modifications for the Mklinux port flagged by CERNLIB_PPC
   7 *
   8 * Revision 1.6  1997/09/02 15:16:13  mclareni
   9 * WINNT corrections
  10 *
  11 * Revision 1.5  1997/03/14 17:21:20  mclareni
  12 * WNT mods
  13 *
  14 * Revision 1.4  1997/01/15 17:41:16  cernlib
  15 * disable section calling rzstrip
  16 *
  17 * Revision 1.3  1996/10/17 09:35:04  cernlib
  18 * make cfstat an integer function
  19 *
  20 * Revision 1.2  1996/10/16 13:02:53  cernlib
  21 * Use CFSTAT with CFIO instead of STATF (for RFIO)
  22 *
  23 * Revision 1.1.1.1  1996/03/06 10:47:25  mclareni
  24 * Zebra
  25 *
  26 *
  27 #include "zebra/pilot.h"
  28       SUBROUTINE RZOPEN(LUNIN,CHDIR,CFNAME,CHOPTT,LRECL,ISTAT)
  29 *
  30 ************************************************************************
  31 *
  32 *      Open a ZEBRA/RZ file.
  33 *
  34 * Input:
  35 *      LUNIT    Logical unit number
  36 *      CFNAME   File name
  37 *      CHOPT    Character variable specifying the option
  38 *               ' '  default, open file in readonly mode
  39 *               'L'  create file with relative organization (VAX only)
  40 *               'N'  open a new file
  41 *               'S'  open file in shared readonly mode
  42 *               'U'  open file in update mode
  43 *               'SU' open file in shared update mode
  44 *               '1'  open file read/write assume single user
  45 *               'V'  open new RZ file on VSAM file
  46 *               'W'  return in CHDIR directory name include
  47 *                    logical unit number
  48 *               'Y'  suppress LRECL consistency check
  49 *               'P'  Preserve case of file name (Unix)
  50 *               'C'  Use C I/O (Unix, VMS)
  51 *               'X'  Exchange mode file
  52 *
  53 *      *LRECL*  Record length, if zero determine LRECL from input file
  54 *
  55 * Output:
  56 *      CHDIR      Character string containing decoded logical unit number
  57 *      *LRECL*    Determined record length
  58 *      ISTAT      Status return code
  59 *      IQUEST(10) LRECL
  60 *      IQUEST(11) LUNPTR - C I/O pointer
  61 *      IQUEST(12) Exchange mode flag - set if IOPTX.ne.0
  62 *                 or if exchange mode bit is set in file
  63 *
  64 *
  65 * Called by <USER>
  66 *
  67 *  Author  : R.Brun,J.Shiers
  68 *  Written : 03.05.86
  69 *  Last mod: See below
  70 *
  71 * Changes        Date    Comments
  72 * G.Folger     96/10/16  Use CFSTAT with CFIO instead of STATF (for RFIO)
  73 * V.Fine       96/07/30  Disable using C I/O to check Fortran I/O under Windows NT
  74 * J.Shiers     95/06/20  Warning for auto-recl determination only for >8192
  75 * J.Shiers     95/05/24  Use STATF instead of INQUIRE in case of IOPTC
  76 * J.Shiers     94/09/21  Increase chopt, correct LUN string
  77 * F.Rademakers 94/08/29  Added protection in case CFOPEN fails (no read perm).
  78 *                        Return correct LUN string in case of option W and
  79 *                        C I/O. Print correct error message in case user
  80 *                        opens file with wrong LRECL.
  81 * J.Shiers     94/08/18  Increase buffer from 8192 to 8192+512
  82 *                        to permit record length determination upto 8192
  83 * R.Brun       94/06/10  Introduce file striping for PIAF
  84 *                        New routine RZSTRIP called
  85 * J.Shiers     94/05/18  Add QMDOS flag for parameter NWORD
  86 * V.Fine       94/02/07  DEC flag to use DEC Fortran and Windows/NT
  87 * A.Lomov      93/09/14  No longer force exchange mode for LINUX
  88 * J.Shiers     93/06/30  Set IQUEST(12) to IMODEX
  89 * J.Shiers     93/02/15  Set IMODEH to 0
  90 * J.Shiers     92/10/19  Alpha compatible record length determination
  91 * J.Shiers     92/07/13  QMDOS, QCFIO flags
  92 * J.Shiers     92/07/07  Translate filename to uppercase before VMQFIL
  93 * J.Shiers     92/03/03  Incorporate MVS mods as follows:
  94 * J.Shiers     92/02/26  Use VMQFIL on VM systems to determine record length
  95 * J.Shiers     92/02/21  Mods for DESY (length of prefix)
  96 * J.Shiers     91/11/27  Add ACTION=READ/READWRITE in VM open statements
  97 * J.Shiers     91/11/11  Add C I/O support
  98 * M.Marquina   91/06/26  Integrate MVS version
  99 #if defined(CERNLIB_IBMMVS)
 100 * IBMMVS changes:
 101 *    -   IUNIT auf 33XX fuer GSI
 102 *    -   VSAM Option fuer MVS   (OPT V) (VSAM Relative record dataset)
 103 *        To use this option, a dataclass RZFILE must be defined via
 104 *        SMS with appropriate parameters for default size and extends.
 105 *        at GSI we use also a dataclass RZDATA for larger files. These
 106 *        files contain a .RZDATA in their name.
 107 *        At GSI we use the following definitions for SMS :
 108 *
 109 * DATACLAS    STORCLAS    MGMTCLAS   STORGRP  RECORG SPACE
 110 *
 111 * RZFILE(def) STANDARD    USERDATA   NORMALx  VSAM RR 128,128
 112 * RZDATA      RAWDATA     RAWDATA    RAWDATA  VSAM RR 512,512
 113 *
 114 *
 115 #endif
 116 ************************************************************************
 117 #include "zebra/zunit.inc"
 118 #include "zebra/rzckey.inc"
 119 #include "zebra/rzclun.inc"
 120 #include "zebra/quest.inc"
 121 #include "zebra/rzbuff.inc"
 122 #if defined(CERNLIB_QMUIX)
 123 #include "zebra/rzcstr.inc"
 124 #endif
 125 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMAPO9)||defined(CERNLIB_QMUIX)||defined(CERNLIB_WINNT)
 126       integer cfstat,statf,info(12)
 127 #endif
 128       CHARACTER*(*) CFNAME,CHDIR,CHOPTT
 129       CHARACTER*9   SPACES
 130       CHARACTER*8   STAT
 131       CHARACTER*36  CHOPT
 132       CHARACTER*255 CHFILE
 133       LOGICAL       IEXIST
 134       CHARACTER*4   CHOPE
 135 #if defined(CERNLIB_IBMVM)
 136       CHARACTER*13  CHTIME
 137       CHARACTER*1   RECFM
 138 #endif
 139 #if defined(CERNLIB_QMVAX)
 140       CHARACTER*10  CHORG
 141 #endif
 142 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCVX)||defined(CERNLIB_QMIRT)||defined(CERNLIB_QMIBM)||defined(CERNLIB_QMSGI)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMSUN)||defined(CERNLIB_QMALT)||defined(CERNLIB_QMHPX)||defined(CERNLIB_QMIBX)
 143       PARAMETER (NWORD = 8704)
 144 #endif
 145 #if (defined(CERNLIB_QMAPO)||defined(CERNLIB_QMVAX)||defined(CERNLIB_QMNXT)||defined(CERNLIB_QMLNX))&&(!defined(CERNLIB_QMAPO9))
 146       PARAMETER (NWORD = 8704)
 147 #endif
 148 #if defined(CERNLIB_QMDOS) || defined(CERNLIB_WINNT)
 149       PARAMETER (NWORD = 8704)
 150 #endif
 151 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
 152       PARAMETER (IBYTES=8)
 153 #endif
 154 #if defined(CERNLIB_QMCRY)
 155       DIMENSION IBUFF(8704)
 156 #endif
 157 #if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMSGI)||defined(CERNLIB_QMVMI)||(defined(CERNLIB_QFDEC))
 158       PARAMETER (IBYTES=1)
 159 #endif
 160 #if (!defined(CERNLIB_QMCRY))&&(!defined(CERNLIB_QMCV64))&&(!defined(CERNLIB_QMVAX))&&(!defined(CERNLIB_QMSGI))&&(!defined(CERNLIB_QMVMI))&&(!defined(CERNLIB_QFDEC))
 161       PARAMETER (IBYTES=4)
 162 #endif
 163 #if defined(CERNLIB_QMIBM)
 164       CHARACTER*9 CHACT
 165 #endif
 166 #if defined(CERNLIB_QMIBMFVS)
 167       CHARACTER*5 CHREC
 168       CHARACTER*3 CHLUN
 169 #endif
 170 #if defined(CERNLIB_IBMMVS)
 171       CHARACTER*20   PREFIX
 172       CHARACTER*4    IUNIT, ITRK, IRECFM
 173       CHARACTER*8 cRecl
 174       CHARACTER*256  cTSO
 175       CHARACTER*20   cDataClas
 176 * dummy record for VSAM
 177       INTEGER RECORD(2048) /2048*0/
 178       INTEGER        mvsams, kdffil
 179       LOGICAL*4      EXS, OPN
 180       INTEGER*4      ISPACE(3), IDCB(2)
 181 *
 182       DATA           ISPACE / 30, 0, 0 /
 183       DATA           IDCB   / 4096, 0 /
 184       DATA           ITRK   / 'TRK' /, IRECFM / 'F' /
 185 #endif
 186 #if (defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))&&(!defined(CERNLIB_GSI))
 187       DATA           IUNIT  / 'HSM' /
 188 #endif
 189 #if (defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))&&(defined(CERNLIB_GSI))
 190       DATA           IUNIT  / '33XX' /
 191 #endif
 192 #if (defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_NEWLIB))
 193       DATA           IUNIT  / 'FAST' /
 194 #endif
 195 *
 196 *-----------------------------------------------------------------------
 197 *
 198       CHOPT=CHOPTT
 199       CALL CLTOU(CHOPT)
 200
 201       IOPT1=INDEX(CHOPT,'1')
 202       IOPTC=INDEX(CHOPT,'C')
 203       IOPTL=INDEX(CHOPT,'L')
 204       IOPTN=INDEX(CHOPT,'N')
 205       IOPTS=INDEX(CHOPT,'S')
 206       IOPTP=INDEX(CHOPT,'P')
 207       IOPTU=INDEX(CHOPT,'U')
 208       IOPTV=INDEX(CHOPT,'V')
 209       IOPTW=INDEX(CHOPT,'W')
 210       IOPTX=INDEX(CHOPT,'X')
 211       IOPTY=INDEX(CHOPT,'Y')
 212
 213       LUNIT=LUNIN
 214       IQUEST(10) = 0
 215       IQUEST(11) = 0
 216       IQUEST(12) = 0
 217       IMODEC     = IOPTC
 218       IMODEX     = IOPTX
 219
 220       LRECI      = LRECL
 221       LRECL2     = 0
 222 #if (defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))
 223 C     RZfile with Exchange mode for NonPPC-LINUX
 224 *     IMODEX     = 1
 225 #endif
 226       IMODEH     = 0
 227 #if !defined(CERNLIB_QCFIO)
 228 *SELF,IF=-QMCRY,IF=-QMVAX,IF=-QMCV64,IF=-QMAPO,IF=-QMAPO9,IF=-QMUIX,IF=-QMDOS.
 229       IF(IOPTC.NE.0) THEN
 230          WRITE(IQPRNT,*) 'RZOPEN. option C ignored - valid only ',
 231      +      'for MSDOS, Unix and VMS systems'
 232          IOPTC = 0
 233       ENDIF
 234 #endif
 235 #if !defined(CERNLIB_QMIBMFVS)
 236       CHFILE=CFNAME
 237 #endif
 238 #if (defined(CERNLIB_QMIBMFVS))&&(!defined(CERNLIB_IBMMVS))
 239       CHFILE='/'//CFNAME
 240 *
 241 *     Search all disks if filemode not specified
 242 *
 243       LCHF = LENOCC(CHFILE)
 244       CALL CTRANS('.',' ',CHFILE,1,LCHF)
 245       IF(INDEX(CHFILE(1:LCHF),' ').EQ.INDEXB(CHFILE(1:LCHF),' '))
 246      +   CHFILE = CHFILE(1:LCHF) // ' *'
 247 #endif
 248 #if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))
 249 *--   Construct MVS file name
 250 *--   Don't add prefix if the first character of file name is a dot
 251       CALL KPREFI (PREFIX, NCHPRE)
 252       IF ( CFNAME(1:1) .EQ. '.' ) THEN
 253          NCH    = LEN(CFNAME)
 254          CHFILE = '/'//CFNAME(2:NCH)
 255       ELSE
 256          CHFILE = '/'//PREFIX(1:NCHPRE)//CFNAME
 257       ENDIF
 258 #endif
 259 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCVX)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMAPO9)||defined(CERNLIB_QMUIX)||defined(CERNLIB_QMDOS)||defined(CERNLIB_QMLNX)||defined(CERNLIB_WINNT)
 260       IF(IOPTP.EQ.0)CALL CUTOL(CHFILE)
 261 #endif
 262 #if defined(CERNLIB_QMVAX)
 263       IF(IOPTL.NE.0) THEN
 264          CHORG = 'RELATIVE'
 265       ELSE
 266          CHORG = 'SEQUENTIAL'
 267       ENDIF
 268 #endif
 269       IPASS=0
 270       kstrip=0
 271    10 CONTINUE
 272       IF(IOPTN.NE.0)THEN
 273 #if !defined(CERNLIB_QMVAX)
 274          STAT='UNKNOWN'
 275 #endif
 276 #if defined(CERNLIB_QMVAX)
 277          STAT='NEW'
 278 #endif
 279          IF(LRECI.LE.0) THEN
 280             WRITE(IQPRNT,10000) LRECI
 281 10000 FORMAT(' RZOPEN. - invalid record length: ',I6)
 282             ISTAT = 1
 283             GOTO 70
 284          ELSEIF(LRECI.GE.8191) THEN
 285             WRITE(IQPRNT,10100) LRECI
 286 10100 FORMAT(' RZOPEN. record length:',I6,
 287      +       ' > maximum safe value (8191 words).')
 288             IF(LRECI.GT.8192) WRITE(IQPRNT,10200)
 289 10200 FORMAT(' RZOPEN. Automatic record length determination will not',
 290      +       ' work with this file.')
 291             WRITE(IQPRNT,10300)
 292 10300 FORMAT(' RZOPEN. You may have problems transferring your',
 293      +       ' file to other systems ',/,
 294      +       '         or writing it to tape.')
 295          ENDIF
 296       ELSE
 297 #if defined(CERNLIB_QMAPO)
 298          IF(IOPT1.EQ.0.AND.IOPTU.EQ.0)THEN
 299             STAT='READONLY'
 300          ELSE
 301             STAT='OLD'
 302          ENDIF
 303 #endif
 304 #if !defined(CERNLIB_QMAPO)
 305          STAT='OLD'
 306 #endif
 307 *
 308 *     File should already exist. Issue inquire even if IOPTC
 309 *
 310          LENF = LENOCC(CHFILE)
 311
 312 #ifndef CERNLIB_QFMSOFT
 313 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMAPO9)||defined(CERNLIB_QMUIX)||defined(CERNLIB_WINNT)
 314          IF(IOPTC.EQ.0) THEN
 315 #endif
 316 #endif
 317             INQUIRE(FILE=CHFILE,EXIST=IEXIST)
 318             ISTATF = 0
 319
 320 #ifndef CERNLIB_QFMSOFT
 321 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_QMAPO)||defined(CERNLIB_QMAPO9)||defined(CERNLIB_QMUIX)||defined(CERNLIB_WINNT)
 322          ELSE
 323             IEXIST = CFSTAT(CHFILE(1:LENF),INFO).EQ.0
 324             ISTATF = 1
 325          ENDIF
 326 #endif
 327 #endif
 328
 329          IF(.NOT.IEXIST) THEN
 330             WRITE(IQPRNT,*) 'RZOPEN. Error - input file ',
 331 #if defined(CERNLIB_IBM)
 332      +         CHFILE(2:LENF),' does not exist'
 333 #endif
 334 #if !defined(CERNLIB_IBM)
 335      +         CHFILE(1:LENF),' does not exist'
 336 #endif
 337             ISTAT = 2
 338             GOTO 70
 339          ENDIF
 340 #if defined(CERNLIB_QMVAX)
 341          IF(IOPTC.EQ.0) INQUIRE(FILE=CHFILE,ORGANIZATION=CHORG)
 342 #endif
 343          IF(LRECL.EQ.0) THEN
 344 *
 345 *     LRECL=0 was specified, try to determine correct record length
 346 *     from the file itself.
 347 *
 348 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
 349             ICOUNT = NWORD
 350             IF(IOPTC.EQ.0) THEN
 351 #endif
 352 #if defined(CERNLIB_QMAPO9)
 353                OPEN(UNIT=LUNIT,FILE=CHFILE,FORM='UNFORMATTED',
 354      +              STATUS='READONLY')
 355 #endif
 356 #if defined(CERNLIB_QMVAX)
 357                INQUIRE(FILE=CHFILE,RECL=LRECL)
 358                LRECL = LRECL / 4
 359                GOTO 40
 360 #endif
 361 #if defined(CERNLIB_QMAPO9)
 362                INQUIRE(UNIT=LUNIT,RECL=LRECL)
 363                CLOSE(UNIT=LUNIT)
 364                GOTO 40
 365 #endif
 366 #if (defined(CERNLIB_QMIBM))&&(defined(CERNLIB_IBMVM))
 367 *
 368 *     Use KERNLIB routine VMQFIL to obtain record length
 369 *     Previous method (below) does not work for VMSTAGEd files
 370 *
 371                CALL CLTOU(CHFILE(1:LCHF))
 372                CALL VMQFIL(CHFILE(2:),RECFM,LRECL,NRECS,NBLOCKS,CHTIME,
 373      +                     ISTAT,IRC)
 374                LRECL = LRECL/4
 375                GOTO 40
 376 #endif
 377 #if (defined(CERNLIB_QMIBMFVS))&&(!defined(CERNLIB_IBMVM))
 378 *
 379 *      Open file for READ to determine record length. JDS
 380 *
 381                OPEN(UNIT=LUNIT,FILE=CHFILE,FORM='UNFORMATTED',
 382      +              ACTION='READ',
 383      +              STATUS=STAT)
 384                READ(UNIT=LUNIT,NUM=LRECL) ITEST
 385                LRECL = LRECL/4
 386 *      Close...
 387                CLOSE(LUNIT)
 388                GOTO 40
 389 #endif
 390 *
 391 *     Record length is stored in file but in record # 2
 392 *     (rec # 1 is used for locks)
 393 *
 394 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
 395                IF(IMODEX.NE.0) ICOUNT = ICOUNT / 2
 396 #endif
 397 #if defined(CERNLIB_QMCRY)
 398                OPEN(LUNIT,FILE=CHFILE,FORM='UNFORMATTED',STATUS='OLD',
 399      +              RECL=IBYTES*ICOUNT,ACCESS='DIRECT')
 400 #endif
 401 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
 402             ENDIF
 403 #endif
 404 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
 405    20       NREAD  = ICOUNT
 406 #endif
 407 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
 408             IF(IOPTC.EQ.0) THEN
 409 #endif
 410 #if (defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL))&&(!defined(CERNLIB_QMAPO))
 411                OPEN(LUNIT,FILE=CHFILE,FORM='UNFORMATTED',STATUS='OLD',
 412      +              RECL=IBYTES*NREAD,ACCESS='DIRECT',IOSTAT=ISTAT)
 413                IF(ISTAT.NE.0)GOTO 60
 414 #endif
 415 #if defined(CERNLIB_QMAPO)
 416                OPEN(LUNIT,FILE=CHFILE,FORM='UNFORMATTED',
 417      +              STATUS='READONLY',RECL=IBYTES*NREAD,ACCESS='DIRECT'
 418      +              ,IOSTAT=ISTAT)
 419                IF(ISTAT.NE.0)GOTO 60
 420 #endif
 421 #if defined(CERNLIB_QMCRY)
 422                IF(IOPTX.EQ.0) THEN
 423                   CALL READ(LUNIT,ITEST,NREAD,IOS,NUS)
 424                ELSE
 425                   CALL READ(LUNIT,IBUFF,NREAD,IOS,NUS)
 426                ENDIF
 427                IF(IOS.EQ.2) THEN
 428 #endif
 429 #if defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
 430                READ(LUNIT,REC=1,IOSTAT=IOS) (ITEST(JW),JW=1,NREAD)
 431                IF(IOS.NE.0) THEN
 432                   CLOSE(LUNIT)
 433 #endif
 434 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
 435                   ICOUNT = ICOUNT * .75
 436                   GOTO 20
 437                ENDIF
 438 #endif
 439 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
 440             ELSE
 441                CALL CFOPEN(LUNPTR,0,NREAD,'r',0,CHFILE,IOS)
 442                IF (IOS .NE. 0) THEN
 443                   ISTAT = -1
 444                   GOTO 70
 445                ENDIF
 446                NWTAK = NREAD
 447 #endif
 448 #if defined(CERNLIB_QMCRY)
 449                IF(IOPTX.NE.0) THEN
 450                   CALL CFGET(LUNPTR,0,NREAD,NWTAK,IBUFF,IOS)
 451                ELSE
 452                   CALL CFGET(LUNPTR,0,NREAD,NWTAK,ITEST,IOS)
 453                ENDIF
 454 #endif
 455 #if defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
 456                CALL CFGET(LUNPTR,0,NREAD,NWTAK,ITEST,IOS)
 457 #endif
 458 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
 459                IF(IOS.NE.0) THEN
 460                   CALL CFCLOS(LUNPTR,0)
 461                   ICOUNT = ICOUNT * .75
 462                   GOTO 20
 463                ENDIF
 464             ENDIF
 465 #endif
 466 #if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
 467             IF(IOPTX.NE.0) CALL VXINVB(ITEST(1),NREAD)
 468 #endif
 469 #if defined(CERNLIB_QMCRY)
 470             IF(IOPTX.NE.0) THEN
 471                CALL UNPACK(IBUFF(1),32,ITEST(1),NREAD)
 472             ENDIF
 473 #endif
 474 #if defined(CERNLIB_QMCV64)
 475             IF(IOPTX.NE.0) THEN
 476                CALL UNPAK32(ITEST(1),ITEST(1),100)
 477 #endif
 478 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
 479 *
 480 *     Work out record length
 481 *
 482             DO 30  J=1, NWORD
 483 *
 484 *     ITEST(J+25) is the pointer in the 2nd record to the
 485 *     file descriptor block, which by definition must be
 486 *     in the same record
 487 *
 488                IF(ITEST(J+25).GT.0.AND.ITEST(J+25).LE.J) THEN
 489 *
 490 *     Possible record length
 491 *
 492                   LRC = ITEST(J+ITEST(J+25)+1)
 493                   IF(LRC.EQ.J) THEN
 494                      LE  = ITEST(J+30)
 495                      LD  = ITEST(J+24)
 496                      NRD = ITEST(J+LD)
 497 *     Does directory size match (record length)*(number of records)?
 498                      IF(NRD*LRC.NE.LE) GOTO 30
 499                      LRECL = J
 500                      IF(IOPTC.EQ.0) THEN
 501                         CLOSE(LUNIT)
 502                      ELSE
 503                         CALL CFCLOS(LUNPTR,0)
 504                      ENDIF
 505                      GOTO 40
 506                   ENDIF
 507                ENDIF
 508    30       CONTINUE
 509             IF(IOPTC.EQ.0) THEN
 510                CLOSE(LUNIT)
 511             ELSE
 512                CALL CFCLOS(LUNPTR,0)
 513             ENDIF
 514
 515 #endif
 516 #if (defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL))&&(!defined(CERNLIB_FQXISN))
 517             IF(IOPTX.EQ.0.AND.IPASS.EQ.0) THEN
 518                WRITE(IQPRNT,10400)
 519 10400 FORMAT(' RZOPEN. problems determining record length - ',
 520      +       ' trying EXCHANGE mode.')
 521                IOPTX  = 1
 522                IMODEX = 1
 523                IPASS  = 1
 524                GOTO 10
 525             ENDIF
 526 #endif
 527 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
 528             WRITE(IQPRNT,*) ' RZOPEN. Error in the input file'
 529             ISTAT = 3
 530             GOTO 70
 531 #endif
 532          ENDIF
 533       ENDIF
 534    40 CONTINUE
 535 *
 536 #if defined(CERNLIB_QMCV64)||defined(CERNLIB_QMCRY)||defined(CERNLIB_RZFRECL)
 537       IF(IOPTC.EQ.0) THEN
 538       NBYTES = IBYTES
 539 #endif
 540 #if defined(CERNLIB_QMCV64)||defined(CERNLIB_QMCRY)
 541       IF(IMODEX.NE.0) NBYTES = NBYTES / 2
 542 #endif
 543 #if (!defined(CERNLIB_QMIBMFVS))&&(!defined(CERNLIB_QMVAX))
 544       OPEN(UNIT=LUNIT,FILE=CHFILE,FORM='UNFORMATTED',
 545      +     RECL=NBYTES*LRECL,ACCESS='DIRECT',STATUS=STAT,IOSTAT=ISTAT)
 546 #endif
 547 #if (defined(CERNLIB_QMIBMFVS))&&(!defined(CERNLIB_IBMMVS))
 548 *
 549 *     CHOPT: SU  = shared,update
 550 *            S   = shared,readonly
 551 *            U   = update
 552 *            ' ' = readonly
 553 *            1   = single user read/write
 554 *
 555       CHACT = 'READ'
 556       IF(IOPTN.NE.0.OR.IOPTU.NE.0.OR.IOPT1.NE.0) CHACT = 'READWRITE'
 557       IF(IOPTN.EQ.0)THEN
 558          INQUIRE(FILE=CHFILE,EXIST=IEXIST)
 559          IF(.NOT.IEXIST) GOTO 60
 560       ENDIF
 561 *
 562       CALL FILEINF(ISTAT,'MAXREC',2)
 563       IF(ISTAT.NE.0)GOTO 60
 564       IF(IOPTN.NE.0)THEN
 565          OPEN(UNIT=LUNIT,FILE=CHFILE,FORM='UNFORMATTED',RECL=4*LRECL,
 566      +        ACTION=CHACT,
 567      +        ACCESS='DIRECT',STATUS=STAT,IOSTAT=ISTAT)
 568          IF(ISTAT.NE.0)GOTO 60
 569          CLOSE(LUNIT)
 570       ENDIF
 571       CALL FILEINF(ISTAT,'MAXREC',16777215)
 572       IF(ISTAT.NE.0)GOTO 60
 573          OPEN(UNIT=LUNIT,FILE=CHFILE,FORM='UNFORMATTED',RECL=4*LRECL,
 574      +        ACTION=CHACT,
 575      +        ACCESS='DIRECT',STATUS=STAT,IOSTAT=ISTAT)
 576 #endif
 577 #if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))
 578 *
 579 *     CHOPT: SU  = shared,update
 580 *            S   = shared,readonly
 581 *            U   = update
 582 *            ' ' = readonly
 583 *            1   = single user read/write
 584 *
 585       CHACT = 'READ'
 586       IF(IOPTN.NE.0.OR.IOPTU.NE.0.OR.IOPT1.NE.0) CHACT = 'READWRITE'
 587       IRECL = LRECL * 4
 588       IF(IRECL.LE.0) IRECL=IDCB(1)
 589
 590       IF(IOPTN.EQ.0)THEN
 591
 592 #endif
 593 #if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_GSI))
 594 *
 595 *--      open file in read/write mode, read mode only if file
 596 *--           name start with a dot (file belonging to an other userid
 597 *--           from an other group - racf protection)
 598 #endif
 599 #if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))
 600          IF ( CFNAME(1:1) .EQ. '.'         .AND.
 601 #endif
 602 #if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))&&(defined(CERNLIB_NEWLIB))
 603          IF ( CFNAME(1:1) .EQ. '.')        THEN
 604 #endif
 605 #if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))&&(!defined(CERNLIB_NEWLIB))
 606      +        CFNAME(2:5) .NE. PREFIX(1:4))THEN
 607 *SELF,IF=QMIBMFVS,IF=IBMMVS,IF=NEWLIB.
 608 *    +        CFNAME(2:7) .NE. PREFIX(1:6))THEN
 609 #endif
 610 #if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))
 611             CHACT = 'READ'
 612          ELSE
 613             CHACT = 'READWRITE'
 614          ENDIF
 615 #endif
 616 #if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))
 617
 618          OPEN ( UNIT=LUNIT, STATUS='OLD', FILE=CHFILE, ACCESS='DIRECT'
 619      +,         FORM='UNFORMATTED', IOSTAT=ISTAT
 620      +,         RECL=IRECL, ACTION=CHACT)
 621          IF (ISTAT.NE.0) THEN
 622             WRITE(IQPRNT,*) 'RZOPEN: OPEN Error file ',CHFILE,
 623      +                   ' IOSTAT= ', ISTAT
 624             GOTO 60
 625          ENDIF
 626       ENDIF
 627 *
 628       IF(IOPTN.NE.0)THEN
 629 * detect, whether file really does not exist if opt N given:
 630          INQUIRE(FILE=CHFILE,EXIST=IEXIST)
 631          IF(IEXIST) THEN
 632             WRITE(IQPRNT,*) 'RZOPEN. Warning,input file ',CHFILE
 633      +       (2:LENOCC(CHFILE)),' already exists !'
 634             STAT='UNKNOWN'
 635          ELSE
 636             STAT='NEW'
 637 *--      define file parameters
 638             IF( INDEX(CHFILE,'(') .NE. 0 ) THEN
 639                IF(IOPTV.EQ.0) THEN
 640                   ISPACE(3) = 28
 641                ELSE
 642                   WRITE(IQPRNT,*)
 643      +             'RZOPEN: No PDS allowed for VSAM files !'
 644                   ISTAT = -1
 645                   GOTO 60
 646                ENDIF
 647             ENDIF
 648             CALL FILEINF ( ISTAT, 'DEVICE', IUNIT, ITRK, ISPACE(1)
 649      +,                 'SECOND', ISPACE(2), 'DIR', ISPACE(3)
 650      +,                 'RECFM', IRECFM, 'LRECL', IRECL
 651      +,                 'BLKSIZE', IDCB(2) )
 652             IF (ISTAT.NE.0) THEN
 653                WRITE(IQPRNT,*) 'RZOPEN: FILEINF Error, ISTAT = ',ISTAT
 654                GOTO 60
 655             ENDIF
 656 *--      If VSAM, define Cluster
 657             IF(IOPTV.NE.0) THEN
 658                WRITE(cRecl,'(I6)') iRecl
 659                cDataClas = 'DATACLAS(RZFILE)'
 660                IF ( INDEX( CHFILE, '.RZDATA' ) .GT. 0 )
 661      +       cDataClas = 'DATACLAS(RZDATA)'
 662                cTSO = 'DEFINE CLUSTER(NAME('''//
 663      +           CHFILE(2:lenocc(CHFILE)) //
 664      +          ''') '//cDataClas// ' recordsize(' // cRecl // cRecl //
 665      +          ') shareoptions(2) NUMBERED UNIQUE NONSPANNED recovery)'
 666                iStat = mvsams( cTSO )
 667                IF ( iStat .NE. 0 ) THEN
 668                   WRITE(IQPRNT,*)
 669      +             'RZOPEN: Define Cluster Error, ISTAT = ', ISTAT
 670                   GOTO 60
 671                ENDIF
 672             ENDIF
 673          ENDIF
 674 *--      OPEN FILE
 675          OPEN ( UNIT=LUNIT, STATUS=STAT
 676      +,         FILE=CHFILE, ACCESS='DIRECT'
 677      +,         FORM='UNFORMATTED', IOSTAT=ISTAT
 678      +,         RECL=IRECL, ACTION='READWRITE' )
 679       ENDIF
 680 #endif
 681 #if defined(CERNLIB_QMVAX)
 682 *
 683 *     CHOPT: SU  = shared,update
 684 *            S   = shared,readonly
 685 *            U   = update
 686 *            ' ' = readonly
 687 *            1   = single user read/write
 688 *
 689       IF(IOPTS.NE.0.AND.IOPTU.NE.0)THEN
 690          OPEN(UNIT=LUNIT,FILE=CFNAME,FORM='UNFORMATTED',RECL=LRECL,
 691      +        ORGANIZATION=CHORG,
 692      +        ACCESS='DIRECT',SHARED,STATUS=STAT,IOSTAT=ISTAT)
 693       ELSEIF(IOPTS.NE.0.AND.IOPTU.EQ.0)THEN
 694          OPEN(UNIT=LUNIT,FILE=CFNAME,FORM='UNFORMATTED',RECL=LRECL,
 695      +        ORGANIZATION=CHORG,
 696      +        ACCESS='DIRECT',SHARED,READONLY,STATUS=STAT,IOSTAT=ISTAT)
 697       ELSEIF(IOPTS.EQ.0.AND.IOPTU.NE.0)THEN
 698          OPEN(UNIT=LUNIT,FILE=CFNAME,FORM='UNFORMATTED',RECL=LRECL,
 699      +        ORGANIZATION=CHORG,
 700      +        ACCESS='DIRECT',SHARED,STATUS=STAT,IOSTAT=ISTAT)
 701       ELSEIF(IOPT1.NE.0)THEN
 702          OPEN(UNIT=LUNIT,FILE=CFNAME,FORM='UNFORMATTED',RECL=LRECL,
 703      +        ORGANIZATION=CHORG,
 704      +        ACCESS='DIRECT',STATUS=STAT,IOSTAT=ISTAT)
 705       ELSEIF(IOPTS.EQ.0.AND.IOPTU.EQ.0.AND.IOPTN.EQ.0)THEN
 706          OPEN(UNIT=LUNIT,FILE=CFNAME,FORM='UNFORMATTED',RECL=LRECL,
 707      +        ORGANIZATION=CHORG,
 708      +        ACCESS='DIRECT',READONLY,STATUS=STAT,IOSTAT=ISTAT)
 709       ELSEIF(IOPTN.NE.0)THEN
 710          OPEN(UNIT=LUNIT,FILE=CFNAME,FORM='UNFORMATTED',RECL=LRECL,
 711      +        ORGANIZATION=CHORG,
 712      +        ACCESS='DIRECT',SHARED,STATUS=STAT,IOSTAT=ISTAT)
 713       ENDIF
 714 #endif
 715 #if (defined(CERNLIB_QMIBMFVS))&&(defined(CERNLIB_IBMMVS))
 716 *
 717 * --- for new datasets, do a dummy initial load
 718 *
 719       IF ((IOPTV.NE.0).AND.(STAT.EQ.'NEW')) THEN
 720          CALL RZIODO(LUNIT, irecl/4, 1, record, 2 ) ! dummy write
 721          CALL RZIODO(LUNIT, irecl/4, 1, record, 1 ) ! dummy read
 722          WRITE(IQPRNT,*)  'RZOPEN: VSAM FILE ', CHFILE(2:LENOCC(CHFILE))
 723      +,   ' succesfully created'
 724       ENDIF
 725 #endif
 726 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
 727       ELSE
 728 *     CHOPT: SU  = shared,update
 729 *            S   = shared,readonly
 730 *            U   = update
 731 *            ' ' = readonly
 732 *            1   = single user read/write
 733          CHOPE = 'r'
 734          IF(IOPTU.NE.0.OR.IOPT1.NE.0) CHOPE = 'r+'
 735          IF(IOPTN.NE.0) CHOPE = 'w+'
 736          JRECL = LRECL
 737 #endif
 738 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)
 739          IF(IMODEX.NE.0) JRECL = LRECL / 2
 740 #endif
 741 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
 742          CALL CFOPEN(LUNPTR,0,JRECL,CHOPE,0,CHFILE,ISTAT)
 743          LUNIT = 1000 + LUNPTR
 744       ENDIF
 745 #endif
 746       IF(ISTAT.NE.0)GOTO 60
 747       IF(IOPTY.NE.0)GOTO 50
 748       if(kstrip.ne.0)go to 50
 749 *
 750 *           Check consistency of LRECL
 751 *
 752       IF(IOPTN.EQ.0.AND.IPASS.EQ.0.AND.ISTAT.EQ.0)THEN
 753          IMODEX=IOPTX
 754          IZRECL=LRECL
 755          CALL RZIODO(LUNIT,50,2,ITEST,1)
 756 #if defined(CERNLIB_QMVAX)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMDOS)||(defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC))||defined(CERNLIB_WINNT)
 757          CALL VXINVB(ITEST(9),1)
 758          IF(JBIT(ITEST(9),12).NE.0)THEN
 759             IMODEX=1
 760             CALL RZIODO(LUNIT,50,2,ITEST,1)
 761          ELSE
 762             CALL VXINVB(ITEST(9),1)
 763          ENDIF
 764 #endif
 765          LB=ITEST(25)
 766 *
 767 *     Protection against bad files
 768 *
 769          IF(LB.GT.8187) THEN
 770             WRITE(IQPRNT,10500) CHFILE(1:LENOCC(CHFILE))
 771 10500       FORMAT(' RZOPEN: cannot determine record length.',
 772      +             ' File ',A,' probably not in RZ format')
 773             LRECP=-1
 774             ISTAT=2
 775 #if defined(CERNLIB_IBM)
 776             CLOSE(LUNIT)
 777 #endif
 778 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
 779             IF(IOPTC.EQ.0) THEN
 780                CLOSE(LUNIT)
 781             ELSE
 782                CALL CFCLOS(LUNIT-1000,0)
 783             ENDIF
 784 #endif
 785             GOTO 70
 786          ENDIF
 787          IF(LB.GT.48) CALL RZIODO(LUNIT,LB+6,2,ITEST,1)
 788          LRECP=ITEST(LB+1)
 789          IQUEST(1)=0
 790          IF(LRECP.NE.LRECL)THEN
 791             LRECL2=LRECL
 792             LRECL=0
 793 #if defined(CERNLIB_IBM)
 794             CLOSE(LUNIT)
 795 #endif
 796 #if defined(CERNLIB_QMCRY)||defined(CERNLIB_QMCV64)||defined(CERNLIB_RZFRECL)
 797             IF(IOPTC.EQ.0) THEN
 798                CLOSE(LUNIT)
 799             ELSE
 800                CALL CFCLOS(LUNIT-1000,0)
 801             ENDIF
 802 #endif
 803
 804 #if defined(CERNLIB_IBMMVS)
 805             IF(IPASS.EQ.0.AND.LRECI.EQ.0) THEN
 806 #endif
 807 #if !defined(CERNLIB_IBMMVS)
 808             IF(IPASS.EQ.0) THEN
 809 #endif
 810                IPASS=1
 811                GOTO 10
 812             ELSE
 813                WRITE(IQPRNT,*) 'Cannot determine record length'
 814                ISTAT = 1
 815                GOTO 70
 816             ENDIF
 817          ENDIF
 818       ENDIF
 819 *
 820       IF (IPASS.NE.0 .AND. LRECL2.NE.0) THEN
 821          WRITE(IQPRNT,10600) LRECL2,LRECL
 822 10600    FORMAT(' RZOPEN:  LRECL inconsistant - ',
 823      +          ' file was opened with LRECL = ',I6,
 824      +          ' should be LRECL = ',I6)
 825       ENDIF
 826 *
 827 *          If option 'W' build CHDIR
 828 *
 829    50 IF(IOPTW.NE.0)THEN
 830          IF (IOPTC .EQ. 0) THEN
 831             LUN = LUNIT
 832          ELSE
 833             LUN = LUNIT - 1000
 834          ENDIF
 835          IF(LUN.LT.10)WRITE(CHDIR,10700)LUN
 836          IF(LUN.GE.10)WRITE(CHDIR,10800)LUN
 837 10700    FORMAT('LUN',I1,'    ')
 838 10800    FORMAT('LUN',I2,'   ')
 839       ENDIF
 840 *
 841    60 CONTINUE
 842       IQUEST(10) = LRECL
 843       IQUEST(11) = LUNIT
 844       IQUEST(12) = IMODEX
 845 #if defined(CERNLIB_QMUIX)
 846 *-*  Fill structure if file is striped
 847       if(kstrip.ne.0.and.istat.eq.0)then
 848          if(ioptc.eq.0)then
 849             lun=lunit
 850          else
 851             lun=lunit-1000
 852          endif
 853          nstrip(lun)=nst
 854          nrstrip(lun)=nrs
 855          istrip(lun)=1
 856          islast=lun
 857          rznames(lun)=rzsfile(maxstrip)
 858       endif
 859 #endif
 860    70 CONTINUE
 861       END