*
* $Id: szopen.F,v 1.1.1.1 1996/03/08 15:44:27 mclareni Exp $
*
* $Log: szopen.F,v $
* Revision 1.1.1.1 1996/03/08 15:44:27 mclareni
* Cspack
*
*
#include "cspack/pilot.h"
SUBROUTINE SZOPEN(LUN,FILEN,LRECL,CHOPT,IRC)
CHARACTER*(*) FILEN
CHARACTER*80 FNAME,CHNAME
CHARACTER*80 MVSDSN
CHARACTER*12 CHFORM
CHARACTER*8 CHSTAT,CHREC,CHTYPE
CHARACTER*80 FILEDEF
CHARACTER*1 MODE
#include "cspack/czsock.inc"
*
* JBYTES: conversion factor for open statement
* RECL = lrecl / jbytes
*
* On most machines, the record length is specified in bytes
* except VAX: bytes for formatted files, 4-byte words otherwise
* SGI: 4-byte words
* DECS: 4-byte words
*
#if defined(CERNLIB_SGI)||defined(CERNLIB_DECS)
PARAMETER (JBYTES=4)
#endif
#if (!defined(CERNLIB_SGI))&&(!defined(CERNLIB_DECS))
PARAMETER (JBYTES=1)
#endif
#if defined(CERNLIB_IBM)
CHARACTER*10 CHACTN
#endif
#if defined(CERNLIB_IBMMVS)
CHARACTER*3 CHRECFM
LOGICAL OPN,EXS
#endif
#if defined(CERNLIB_IBMVM)
CHARACTER*20 CHGIME
CHARACTER*80 CHLINE
#endif
LOGICAL IEXIST
#include "cspack/quest.inc"
*
* Open file on unit LUN.
* CHOPT: C - respect case
* D - D/A file, LRECL must be specified if N is also given
* I - open for input
* O - open for output
*--> L - reLative organisation (VAX only) <-- Not yet implemented!
* R - RZ file
* P - PAM file format
* F - formatted file (default=unformatted)
* N - new file
* V - variable length records (do not specify RECFM=variable on VAX)
*
* Return codes: 28 - file already exists & New specified
* 1 - open failed - IOSTAT in IQUEST(1)
*
#include "cspack/czopts.inc"
IF((IOPTI.EQ.0).AND.(IOPTO.EQ.0)) IOPTI=1
IRC = 0
LF = LENOCC(FILEN)
FNAME = FILEN(1:LF)
#if defined(CERNLIB_IBMVM)
*
* Crack <user.addr>fn.ft
*
IF((INDEX(FNAME(1:LF),'<').NE.0).OR.
+ (INDEX(FNAME(1:LF),'[').NE.0)) THEN
CALL CTRANS('[','<',FNAME,1,LF)
CALL CTRANS(']','>',FNAME,1,LF)
ISTART = INDEX(FNAME(1:LF),'<') + 1
IEND = INDEX(FNAME(1:LF),'>') - 1
ICOL = INDEX(FNAME(1:LF),':')
*
* SFS?
*
IF(ICOL.EQ.0) THEN
CHGIME = FNAME(ISTART:IEND)
IDOT = INDEX(CHGIME,'.')
IF(IDOT.NE.0) CHGIME(IDOT:IDOT) = ' '
LCHG = IEND - ISTART + 1
ELSE
CHGIME = FNAME(1:ICOL) // FNAME(ISTART:IEND)
LCHG = IEND - ISTART + 1 + ICOL
ENDIF
CALL VMCMS(CHGIME(1:LCHG)//' (QUIET NONOTICE STACK)',IRC)
IF(IRC.GT.4) RETURN
CALL VMRTRM(CHLINE,LENGTH)
MODE = CHLINE(1:1)
FNAME = FILEN(IEND+2:LF) // ' ' // MODE
LF = LF + 2
ENDIF
IF(INDEX(FNAME(1:LF),'/').EQ.0) THEN
FNAME = '/'//FILEN(1:LF)
LF = LF + 1
ENDIF
DO 1 I=1,LF
1 IF(FNAME(I:I).EQ.'.') FNAME(I:I) = ' '
*
* If file exists, find full name and hence file mode
*
INQUIRE(FILE=FNAME(1:LF),EXIST=IEXIST,NAME=CHNAME)
LMODE = LENOCC(CHNAME)
IF(IEXIST) MODE = CHNAME(LMODE:LMODE)
#endif
#if defined(CERNLIB_UNIX)
IF(IOPTC.EQ.0) CALL CUTOL(FNAME)
#endif
#if defined(CERNLIB_IBM)
CHACTN = 'READWRITE'
IF(IOPTI.NE.0) CHACTN = 'READ'
IF(IOPTO.NE.0) CHACTN = 'WRITE'
#endif
#if defined(CERNLIB_IBMMVS)
CALL XZMVSD(FILEN(1:LF),MVSDSN,LF,ICUT,IRC)
FNAME = MVSDSN
FNAME(1:1) = '/'
#endif
CHSTAT = 'UNKNOWN'
IF(IOPTN.NE.0) THEN
CHSTAT = 'NEW'
IOPTO = 1
#if !defined(CERNLIB_VAXVMS)
INQUIRE(FILE=FNAME(1:LF),EXIST=IEXIST)
IF(IEXIST) THEN
IRC = 28
RETURN
ENDIF
#endif
ENDIF
IF(IOPTI.NE.0) CHSTAT = 'OLD'
#if defined(CERNLIB_APOLLO)
IF(IOPTO.EQ.0) CHSTAT = 'READONLY'
#endif
CHFORM = 'UNFORMATTED'
*
* LRECL on VAX is in words for unformatted files, but bytes otherwise
*
NBYTES = 4
IF(IOPTF.NE.0) THEN
CHFORM = 'FORMATTED'
NBYTES = 1
ENDIF
CHREC = 'FIXED'
IF(IOPTP.NE.0) IOPTV = 1
IF(IOPTV.NE.0) CHREC = 'VARIABLE'
LCHREC = LENOCC(CHREC)
IF(IOPTD.EQ.0) THEN
#if defined(CERNLIB_IBMMVS)
ITRK = 10
ISECOND = 10
IDIR = 0
IF ( INDEX(FNAME,'(') .NE. 0 ) IDIR = 28
CHRECFM = 'FB'
IF(IOPTP.NE.0) CHRECFM = 'VBS'
IF(IOPTV.NE.0) CHRECFM = 'VB'
IF(IOPTP.NE.0) LRECL = -1
IBLKSIZE = 4000
IF(IOPTP.NE.0) IBLKSIZE = 6232
*------------------------------ check file existence
INQUIRE ( FILE='/'//FNAME(1:LF), IOSTAT=ISTAT
+, EXIST=EXS, OPENED=OPN, NUMBER=LUNOLD )
IF (IRC .NE. 0) GO TO 110
IF((.NOT. EXS ).AND.(IOPTI.NE.0)) GOTO 150
*------------------------- ---- input dataset exists not
IF ( .NOT. EXS ) THEN
*------------------------------ define dataset parameters
CALL FILEINF ( ISTAT,'DEVICE' , '33XX' , 'TRK' , ITRK ,
+ 'SECOND' , ISECOND , 'DIR' , IDIR ,
+ 'RECFM' , CHRECFM , 'LRECL' , LRECL ,
+ 'BLKSIZE', IBLKSIZE )
IF (ISTAT .NE. 0) GO TO 120
ELSE
*------------------------------ dataset is an old one
IF (OPN) THEN
*------------------------------ dataset is open
CLOSE(UNIT=LUNOLD,STATUS='KEEP',IOSTAT=ISTAT)
IF (ISTAT .NE. 0) GO TO 140
ENDIF
ENDIF
IF (IOPTD .EQ. 0) THEN
*------------------------------ open dataset
OPEN(LUN,FILE='/'//FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
+ ACTION=CHACTN,IOSTAT=ISTAT)
IF (ISTAT .NE. 0) GO TO 130
ELSE
*------------------------------ open dataset, accsess = direct
OPEN(LUN,FILE='/'//FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
+ RECL=LRECL,ACCESS='DIRECT',
+ ACTION=CHACTN,IOSTAT=ISTAT)
IF (ISTAT .NE. 0) GO TO 130
ENDIF
RETURN
*------------------------------ error handling
110 WRITE(6,*) 'SZOPEN - INQUIRE ERROR - IOSTAT = ',ISTAT
GO TO 99
120 WRITE(6,*) 'SZOPEN - FILEINF ERROR - ISTAT = ',ISTAT
GO TO 99
130 WRITE(6,*) 'SZOPEN - OPEN ERROR - IOSTAT = ',ISTAT
GO TO 99
140 WRITE(6,*) 'SZOPEN - CLOSE ERROR - IOSTAT = ',ISTAT
GO TO 99
150 WRITE(6,*) 'SZOPEN - INPUT DATASET NOT ON DISK '
GO TO 99
#endif
#if defined(CERNLIB_IBMVM)
IF(IOPTP.NE.0) THEN
*
* PAM file - issue FILEDEF then open by UNIT
* (Open by name uses different style DDNAME)
*
WRITE(FILEDEF,8001) LUN,FNAME(1:LF)
8001 FORMAT('FILEDEF ',I3,' DISK ',A,
+ ' (RECFM VBS LRECL 32756 BLOCK 800 PERM)')
LENF = LENOCC(FILEDEF)
CALL CTRANS('.',' ',FILEDEF,1,LENF)
CALL CTRANS('/',' ',FILEDEF,1,LENF)
CALL VMCMS(FILEDEF(1:LENF),IRC)
CALL VMCMS('Q FILEDEF',IRC)
OPEN(LUN,FORM=CHFORM,STATUS=CHSTAT, ERR=99,IOSTAT=ISTAT)
RETURN
ELSE
LENF = LENOCC(FILEDEF)
CALL CTRANS('.',' ',FILEDEF,1,LENF)
*
* Only call FILEINF for new files...
*
IF(IOPTN.NE.0) THEN
CALL FILEINF(IRC,'RECFM','F','LRECL',LRECL)
ELSE
IF(MODE.EQ.'4') CALL FILEINF(IRC,'RECFM','U')
ENDIF
ENDIF
#endif
#if defined(CERNLIB_IBMVM)
OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
+ ACTION=CHACTN,ERR=99,IOSTAT=ISTAT)
#endif
#if (!defined(CERNLIB_VAXVMS))&&(!defined(CERNLIB_IBM))
OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
+ ERR=99,IOSTAT=ISTAT)
#endif
#if defined(CERNLIB_VAXVMS)
INQUIRE(FILE=FNAME(1:LF),EXIST=IEXIST,RECORDTYPE=CHTYPE)
IF(IEXIST.AND.CHTYPE(1:8).EQ.'VARIABLE') IOPTV = 1
IF(IOPTO.EQ.0) THEN
*
* Add READONLY so that files in other people's directories
* can be accessed...
*
IF((IOPTN.EQ.0).AND.(IOPTV.EQ.0)) THEN
OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
+ BUFFERCOUNT=127,RECORDTYPE=CHREC(1:LCHREC),
+ RECL=LRECL/NBYTES,IOSTAT=ISTAT,ERR=99,READONLY)
ELSEIF((IOPTN.NE.0).AND.(IOPTV.EQ.0)) THEN
OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
+ BUFFERCOUNT=127,RECORDTYPE=CHREC(1:LCHREC), RECL=
+ LRECL/NBYTES,IOSTAT=ISTAT,ERR=99,READONLY)
ELSE
OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
+ BUFFERCOUNT=127,IOSTAT=ISTAT,ERR=99,READONLY)
ENDIF
ELSE
IF((IOPTN.EQ.0).AND.(IOPTV.EQ.0)) THEN
OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
+ BUFFERCOUNT=127,RECORDTYPE=CHREC(1:LCHREC), RECL=
+ LRECL/NBYTES,IOSTAT=ISTAT, ERR=99)
ELSEIF((IOPTN.NE.0).AND.(IOPTV.EQ.0)) THEN
OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
+ BUFFERCOUNT=127,RECORDTYPE=CHREC(1:LCHREC), RECL=
+ LRECL/NBYTES,IOSTAT=ISTAT, ERR=99)
ELSE
OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,
+ BUFFERCOUNT=127,IOSTAT=ISTAT, ERR=99)
* + SHARED,BUFFERCOUNT=127, IOSTAT=ISTAT, ERR=99)
ENDIF
ENDIF
#endif
*
* Direct-access files...
*
ELSE
#if defined(CERNLIB_IBMVM)
CALL FILEINF(ISTAT,'MAXREC',2)
IF(ISTAT.NE.0)GO TO 99
OPEN(UNIT=LUN,FILE=FNAME(1:LF),FORM='UNFORMATTED', RECL=LRECL,
+ ACTION=CHACTN,ACCESS='DIRECT',STATUS=CHSTAT,IOSTAT=ISTAT)
IF(ISTAT.NE.0)GO TO 99
CLOSE(LUN)
CALL FILEINF(ISTAT,'MAXREC',16777215)
IF(ISTAT.NE.0)GO TO 99
CHSTAT = 'OLD'
#endif
#if !defined(CERNLIB_VAXVMS)
OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,ERR=99,
+ RECL=LRECL/JBYTES,
#endif
#if defined(CERNLIB_IBMVM)
+ ACTION=CHACTN,
#endif
#if !defined(CERNLIB_VAXVMS)
+ ACCESS='DIRECT',IOSTAT=ISTAT)
#endif
#if defined(CERNLIB_VAXVMS)
IF(IOPTO.EQ.0) THEN
OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,ERR=99,
+ SHARED,READONLY,
+ RECL=LRECL/NBYTES,
+ ACCESS='DIRECT',IOSTAT=ISTAT)
ELSE
OPEN(LUN,FILE=FNAME(1:LF),FORM=CHFORM,STATUS=CHSTAT,ERR=99,
+ SHARED,
+ RECL=LRECL/NBYTES,
+ ACCESS='DIRECT',IOSTAT=ISTAT)
ENDIF
#endif
ENDIF
RETURN
99 IRC = 1
IQUEST(1) = ISTAT
IF(LUNCZ.GE.0)
+ WRITE(LUNCZ,*) 'SZOPEN. IOSTAT from OPEN = ',ISTAT
END