c
c $Id: fortran.F,v 1.1 2005/03/31 13:13:00 baud Exp $
c
c $Log: fortran.F,v $
c Revision 1.1  2005/03/31 13:13:00  baud
c imported from CASTOR
c
c Revision 1.2  1999/07/20 12:47:58  jdurand
c 20-JUL-1999 Jean-Damien Durand
c   Timeouted version of RFIO. Using netread_timeout() and netwrite_timeout
c   on all control and data sockets.
c
c
c  Copyright (C) 1990,1991 by CERN/CN/SW/DC
c  All rights reserved
c
c fortran.F     remote file I/O - C callable server fortran interface
c
c       fopn_us(int *unit, char *file, int *filen, int *append, int *irc)
c       fopn_ud(int *unit, char *file, int *filen, int *lrecl, int *irc)
c       fwr_us(int *unit, char *buf, int *nwrit, int *irc)
c       fwr_ud(int *unit, char *buf, int *nrec, int *nwrit, int *irc)
c	frd_us(int *unit, char *buf, int *nwant, int *irc)
c	frd_ud(int *unit, char *buf, int *nrec, int *nwant, int *irc)
c       fcls_f(int *unit, int *irc);
c       frdc(int *unit, char *buf, int *nwant, int *ngot, int *irc)
c
c
	subroutine fopn_us(unit, file, filen, append, irc)
c
	implicit        none
	integer  	unit
	character*256   file
	integer		filen
	integer         append
	integer         irc
c
	character*80    SCCSID
	data SCCSID /
     +  "@(#)fortran.F	3.5 09/24/92 CERN CN-SW/DC F. Hemmer"/
c
c
#if (defined(ultrix) && defined(mips))
c	this helps getfilep in getting the fp.Apparently the binding which is
c	done by a fortran main program at runtime is not done when a subroutine
c	is called from a C program.This command forces it . AK 14/02/92
c	It is a temporary solution till a better one is found.
c
	write(*,*)
c
#endif
c
	if (append .eq. 0) then
	 open(unit=unit,file=file(1:filen),iostat=irc,
     +   FORM='UNFORMATTED',ACCESS='SEQUENTIAL')
	else
#if defined(sun) || defined(sgi) || defined(hpux) || ( defined(ultrix) && defined(mips) )
	 open(unit=unit,file=file(1:filen),iostat=irc,
     +   FORM='UNFORMATTED',ACCESS='APPEND')
#endif /* sun || sgi || hpux || ( ultrix && mips ) */
#if defined(apollo)
	 open(unit=unit,file=file(1:filen),iostat=irc,
     +   FORM='UNFORMATTED',ACCESS='SEQUENTIAL',STATUS='APPEND')
#endif /* apollo */
#if defined(_AIX)
	 open(unit=unit,file=file(1:filen),iostat=irc,
     +   FORM='UNFORMATTED',ACCESS='SEQUENTIAL',STATUS='OLD')
#if defined(_IBMESA)
 1	 read(unit=unit,end=2)
	 go to 1
 2	 backspace unit
#endif
#endif /* AIX */
#if defined(CRAY)
	 open(unit=unit,file=file(1:filen),iostat=irc,FORM='UNFORMATTED',
     +   ACCESS='SEQUENTIAL', POSITION='APPEND')
#endif /* CRAY */
	endif
	end
c
	subroutine fopn_ud(unit, file, filen, lrecl, irc)
	implicit        none
	integer  	unit
	character*256   file
	integer		filen	
	integer         lrecl
	integer         irc
c
#if defined(sgi)
	lrecl=(lrecl+3)/4
#endif /* sgi */
	open(unit=unit,file=file(1:filen),iostat=irc,FORM='UNFORMATTED',
     +  ACCESS='DIRECT',RECL=lrecl)
	end
c
	subroutine fcls_f(unit, irc)
	implicit        none
	integer  	unit
	integer         irc
c
	close(unit=unit,iostat=irc)
	end
c
	subroutine fwr_us(unit, buf, nwrit, irc)
	implicit        none
	integer         unit
	integer         nwrit
	character*1     buf(nwrit)
	integer         irc
c
	write(unit,iostat=irc) buf
	end
c
	subroutine fwr_ud(unit, buf, nrec, nwrit, irc)
	implicit        none
	integer         nwrit
	integer         unit
	character*1     buf(nwrit)
	integer         nrec
	integer         irc
c
	write(unit,rec=nrec,iostat=irc) buf
	end
c
	subroutine frd_us(unit, buf, nwant, irc)
	implicit        none
	integer         unit
	integer         nwant
	character*1     buf(nwant)
	integer         irc
c
	read(unit,iostat=irc) buf
	end
c
	subroutine frd_ud(unit, buf, nrec, nwant, irc)
	implicit        none
	integer         unit
	integer         nwant
	character*1     buf(nwant)
	integer         nrec
	integer         irc
c
	read(unit,rec=nrec,iostat=irc) buf
	end
c
	subroutine frdc(unit, buf, nwant, ngot, irc)
	implicit        none
	integer         unit
	integer         nwant
	character*1     buf(nwant)
	integer         ngot
	integer         irc
	integer         count
#if defined(CRAY)
	integer		ubc
c
	count = (nwant+7)/8
	call read(unit,buf,count,irc,ubc)
	ngot = count*8 - ubc/8
	end
#else
c
	count = nwant
	call readf(unit,buf(1),count,irc)
	ngot = count
	end
#endif /* CRAY	*/ 
