C	ISAMFILE.FOR
C
C	ISAM_FILE contains the utility routines to do indexed and 
C	sequential I/O to data base files.
C
C************************************************************************
C
C	OPEN_ISAM opens ISAM files for shared reading & writing.
C
C		Argument list
C	    name	type	I/O	meaning
C	----------------------------------------------------------------
C	     chan	I*4	 I	Fortran I/O channel
C	     file	char     I	File to open
C	     count	I*4	 I	Multi-buffer count
C	     iof	I*4	 O	Error flag
C
C************************************************************************
C
	subroutine  open_isam (chan, file, count, iof)

	include		'($FORIOSDEF)'

	character	buffer * (*), key * (*), file * (*)
	integer		ios, lock_counter, chan, count

	open (unit 	   =  chan,
     .	      file	   =  file,
     .	      access	   = 'KEYED',
     .	      organization = 'INDEXED',
     .	      type	   = 'OLD',
     .	      buffercount  =  count,
     .	      iostat	   =  ios,
     .	      shared)

	iof = ios

	return
C
C************************************************************************
C
C	READ_ISAM performs a keyed read on a record in an ISAM file.
C
C		Argument list
C	    name	type	I/O	meaning
C	----------------------------------------------------------------
C	    chan	I*4	 I	Fortran I/O channel
C	    key		char	 I	The ISAM read key
C	    keyid	I*4	 I	Key indicator
C	    buffer	char	 O	data buffer	
C	    iof		I*4	 O	Error flag	0  ok
C
C************************************************************************
C

	entry  read_isam (chan, key, keyid, buffer, iof)

	lock_counter = 0
	buffer = ' '
200	read (chan, key=key, keyid=keyid, iostat=ios) buffer

	iof = ios
	if (ios .eq. FOR$IOS_ATTACCNON) then
	    continue
	else if (ios .eq. FOR$IOS_SPERECLOC) then	! record locked
	    lock_counter = lock_counter + 1
	    if (lock_counter .gt. 50) then
		type *,'The database is locked,  ',
     .		       'Please try again later'
	    else
		go to 200
	    endif
	else if (ios .ne. 0) then
	    call geterr (i, j, k, l)
	endif

	return
C
C************************************************************************
C
C	READ_ISAM_FIRST reads the first record in an ISAM file.
C
C		Argument list
C	    name	type	I/O	meaning
C	----------------------------------------------------------------
C	    chan	I*4	 I	Fortran I/O channel
C	    keyid	I*4	 I	Key indicator
C	    buffer	char	 O	data buffer	
C	    iof		I*4	 O	Error flag	0  ok
C
C************************************************************************
C

	entry  read_isam_first (chan, keyid, buffer, iof)

	lock_counter = 0
	buffer = ' '
500	read (chan, keyge = ' ', keyid=keyid, iostat=ios) buffer

	iof = ios
	if (ios .eq. FOR$IOS_ATTACCNON) then		! empty file
	    continue

	else if (ios .eq. FOR$IOS_SPERECLOC) then	! record locked
	    lock_counter = lock_counter + 1
	    if (lock_counter .gt. 50) then
		type *,'The system is busy,  ',
     .		       'Please try again later'
	    else
		go to 500
	    endif

	else if (ios .ne. 0) then
	    call geterr (i, j, k, l)
	endif

	return
C
C************************************************************************
C
C	READ_ISAM_NEXT reads the next sequential record in an ISAM file.
C
C		Argument list
C	    name	type	I/O	meaning
C	----------------------------------------------------------------
C	    chan	I*4	 I	Fortran I/O channel
C	    buffer	char	 O	data buffer	
C	    iof		I*4	 O	Error flag	0  ok
C
C************************************************************************
C

	entry  read_isam_next (chan, buffer, iof)

	lock_counter = 0
	buffer = ' '
600	read (chan, iostat=ios) buffer

	iof = ios
	if (ios .eq. FOR$IOS_ENDDURREA .or. ios .lt. 0) then	! end of file
	    ios = FOR$IOS_ENDDURREA

	else if (ios .eq. FOR$IOS_SPERECLOC) then		! record locked
	    lock_counter = lock_counter + 1
	    if (lock_counter .gt. 50) then
		type *,'The system is busy,  Please try again later'
	    else
		go to 600
	    endif

	else if (ios .ne. 0) then
	    call geterr (i, j, k, l)
	endif

	return
C
C************************************************************************
C
C	REWRITE_ISAM rewrites an isam record.
C
C		Argument list
C	    name	type	I/O	meaning
C	----------------------------------------------------------------
C	    chan	I*4	 I	Fortran I/O channel
C	    buffer	char	 I	data buffer	
C	    iof		I*4	 O	Error flag	0  ok
C
C************************************************************************
C

	entry  rewrite_isam (chan, buffer, iof)

	rewrite (chan, iostat=ios) buffer

	iof = ios
	if (ios .eq. FOR$IOS_INCKEYCHG) then
	    type *,'This key value already exists'
	else if (ios .ne. 0) then
	    call geterr (i, j, k, l)
	endif

	return
C
C************************************************************************
C
C	WRITE_ISAM writes an isam record.
C
C		Argument list
C	    name	type	I/O	meaning
C	----------------------------------------------------------------
C	    chan	I*4	 I	Fortran I/O channel
C	    buffer	char	 I	data buffer	
C	    iof		I*4	 O	Error flag	0  ok
C
C************************************************************************
C

	entry  write_isam (chan, buffer, iof)

	write (chan, iostat=ios) buffer

	iof = ios
	if (ios .eq. FOR$IOS_INCKEYCHG) then
	    type *,'This key value already exists'
	else if (ios .ne. 0) then
	    call geterr (i, j, k, l)
	endif

	return
	end