c...........................................................................
c     Source code for a ZIO emulator. Uses Fortran Input/Output extensions 
c     DEC-ALPHA version
c     J. Manickam 9.20.95
c     Includes entries for 
c     ZOP
c     ZCL
c     ZWR
c     ZRD
c.........................
c     Usage Notes:
c     Uses unformatted read/writes with a recordtype 'stream'. This has
c     the free field format similar to direct access. However it treats the
c     file as a sequential file. There is a function 'seek' which allows a
c     preposition of the read so that this can be made to look like ZIO
c     The file name can be specified as in a typical OPEN call
c...........................................................................
c     
      subroutine zop(ioc,name,nsize,idisk,icode,ilab)
      character*(80) name
ccccc      character*(8) name
      write(*,'("IN zop: file name =",a80)') name
c
      open(unit=ioc,file=name,form='unformatted',recordtype='stream',
     $     status='unknown',access='append')
      return
      end
c...................................................................
      subroutine zcl(ioc,ierr)
c...................................................................
c     
      close(ioc)
      return
      end
c...................................................................
      subroutine zwr(ioc,a,nwords,nadres,lgivup,irr)
c...................................................................
c     
cccc      dimension a(1)
      real*8 a(1)
      external fseek, ftell
      integer*4 iocs,noffsets,fseek, ftell
      common /ziomax/nwmax
      nbytes = 8
      iocs = ioc
c     check on location
      ncurr = ftell(iocs)
      ncurr = 0
      ipos = 0
ccc      ierr = fseek(ioc, ipos, ipos)
ccc      write(6, 101)nadres, nwords, ierr
 101  format(' nadres, nwords, ierr: \t' ,  i5, 2x, i5, 2x, i5)
      noffsets = nadres * nbytes
      ipos = 0
      ierr = fseek(iocs, noffsets, ipos)
ccc      write(6, 101)nadres, nwords, ierr
      write(ioc)(a(i),i=1,nwords)
      if((nadres+nwords-1) .gt. nwmax)nwmax = nadres+nwords-1
c     
c     Error checks
c     
      if(ierr .eq. 0) return

c        write error code
         write(6,100)ierr
 100     format(' Error in ZWR, error code = ', i4, 
     $        ' Check man 3f perror ')
         stop
         end
c...................................................................
         subroutine zrd(ioc,a,nwords,nadres,lgivup,irr)
c...................................................................
c     
      external fseek, ftell
      integer*4 iocs,noffsets,fseek, ftell
cccc      dimension a(1)
      real*8 a(1)
      common /ziomax/nwmax
      ntest = nadres + nwords - 1
ccc      if(ntest.gt.nwmax)go to 200
      nbytes = 8
      iocs = ioc
c     check on location
      ncurr = ftell(icos)
      ncurr = 0
      ipos = 0
      noffsets = nadres * nbytes
      ierr = fseek(iocs,noffsets,ipos)
      read(ioc)(a(i),i=1,nwords)
c     
c     Error checks
c     
      if(ierr .eq. 0) return

c        write error code
         write(6,100)ierr
 100     format(' Error in ZWR, error code = ', i4, 
     $        ' Check man 3f perror ')
         stop
 200     write(6,110)ntest,nwmax
 110     format(' Trying to read past end of file in: ',i3,2x,i7,
     $        ' > ',i7)
         stop
         end