c...........................................................................
c     Source code for a ZIO emulator. Uses Fortran Input/Output extensions 
c     Available under UNICOS. See UNICOS I/O Technical Note Sec. 4.4 pp. 55-58
c     J. Manickam 9.16.91
c     Includes entries for 
c     ZOP
c     ZCL
c     ZWR
c     ZRD
c.........................
c     Usage Notes:
c     a) The word addressable (WA) I/O routines are in:
c     libf     on the CRAY-2
c     libio    on CX/CEA systems.
c     b) Since the WA  routines of UNICOS identify
c     disk file by only one parameter, either a unit number, n, which 
c     implies a file called FORT.n, or a filename, eg. "TEST.OUT", we
c     have to choose one of these alternatives. We choose FORT.n. This 
c     means that the variable 'name' in the ZOP call is irrelevant.
c...........................................................................
c     
      subroutine zop(ioc,name,nsize,idisk,icode,ilab)
c     
      logical unitok, unitop
      istats = 0
      nblks = 10
 10   inquire(unit=ioc,exist=unitok,opened=unitop)
      if(unitok .and. unitop)then
c     unit number already assigned .
         write(0,'(''Error , file already opened to ioc '',i3)')ioc
         stop
      endif

      call wopen(ioc,nblks,istats,ierr)
c     
c     Error checks
c     
      if(ierr .eq. 0) return
c     
      if(ierr .eq. -1) then
c        invalid unit number
         write(0,'( ''Error in the unit number in a WOPEN call'')')
         stop
      endif
c     
      if(ierr .eq. -2) then
c        number of files exceeds limit
         write(0,'('' Number of files exceeds limit in a WOPEN call'')')
         stop
      endif
c     
      if(ierr .eq. -6) then
c        invalid file name
         write(0,'('' Error in file name in a WOPEN call'')')
         stop
      endif
c        unknown error code
         write(0,'('' Unknown error code in a WOPEN call'')')
         stop
         end
c...................................................................
         subroutine zcl(ioc,ierr)
c...................................................................
c     
         call  wclose(ioc,ierr)
c     
c     Error checks
c     
      if(ierr .eq. 0) return
c     
      if(ierr .eq. -1) then
c        invalid unit number
         write(0,'( ''Invalid unit number in a WCLOSE call'')')
         stop
      endif
c     
      if(ierr .eq. -6) then
c        invalid file name
         write(0,'( ''Invalid file name in a WCLOSE call'')')
         stop
      endif
c        unknown error code
         write(0,'('' Unknown error code in a WCLOSE call'')')
         stop
         end
c...................................................................
         subroutine zwr(ioc,a,nwords,nadres,lgivup,irr)
c...................................................................
c     
         dimension a(1)
c     For compatability with the CTSS call increment nadres
         nadrs1 = nadres + 1
         call  putwa(ioc,a(1),nadrs1,nwords,ierr)
c     
c     Error checks
c     
      if(ierr .ge. 0) return
c     
      if(ierr .ge. -2) then
c        invalid unit number
         write(0,'( ''Invalid unit number in a PUTWA call'')')
         stop
      endif
c     
      if(ierr .eq. -4) then
c        invalid file name
         write(0,'( ''Word address .LE. 0  in PUTWA'')')
         stop
      endif
c     
      if(ierr .eq. -5) then
c        invalid file name
         write(0,'( ''Requested word count greater than max.  in PUTWA''
     $  )')
         stop
      endif
c     
      if(ierr .eq. -6) then
c        invalid file name
         write(0,'( ''Invalid file name in a PUTWA call'')')
         stop
      endif
c     
      if(ierr .eq. -7) then
c        invalid file name
         write(0,'( ''User word count less than or equal to zero in 
     $ PUTWA'')')
         stop
      endif
c        unknown error code
         write(0,'('' Unknown error code in a PUTWA call'')')
         stop
         end
c...................................................................
         subroutine zrd(ioc,a,nwords,nadres,lgivup,irr)
c...................................................................
c     
         dimension a(1)
c     For compatability with the CTSS call increment nadres
         nadrs1 = nadres + 1
         call  getwa(ioc,a(1),nadrs1,nwords,ierr)
c     
c     Error checks
c     
      if(ierr .ge. 0) return
c     
      if(ierr .eq. -1) then
c        invalid unit number
         write(0,'( ''Invalid unit number in a GETWA call'')')
         stop
      endif
c     
      if(ierr .eq. -2) then
c        invalid unit number
         write(0,'( ''No. of files exceeds memory size  in a 
     $ GETWA call'')')
         stop
      endif
c     
      if(ierr .eq. -3) then
c        invalid unit number
         write(0,'( '' Attempt to read past end of DATA in a 
     $ GETWA call'',/,'' ** returned values may be invalid **'')')
         return
      endif
c     
      if(ierr .eq. -4) then
c        invalid file name
         write(0,'( ''Word address .LE. 0  in GETWA'')')
         stop
      endif
c     
      if(ierr .eq. -5) then
c        invalid file name
         write(0,'( ''Requested word count greater than max.  in 
     $ GETWA'')')
         stop
      endif
c     
      if(ierr .eq. -6) then
c        invalid file name
         write(0,'( ''Invalid file name in a GETWA call'')')
         stop
      endif
c     
      if(ierr .eq. -7) then
c        invalid file name
         write(0,'( ''User word count less than or equal to zero in 
     $ GETWA'')')
         stop
      endif
c        unknown error code
         write(0,'('' Unknown error code in a GETWA call'')')
         stop
         end