Automatically assigns an available i/o unit number.
Back to my home page
c This is file iounits.f
c Routines for automatic allocation of i/o units.
c Yes, this is all ANSI Standard Fortran 77
c OK, except for the lower case characters.
c (c) 1996-97 Judah Milgram ... free software ... no warranty ...
c GNU Public License applies ... bugs to milgram@cgpp.com
c
c
c N.B. Things you probably will never have to adjust,
c (but who knows):
c MINNIT, MAXNIT - min and max values of dynamically assigned
c unit numbers. Change consistently in three
c places!
c STDERR - unit number you want error messages to go to.
c Change consistently in two places!
c
c USAGE:
c call ioio() initialize the io routines
c call at beginning of program
c call iounit(i) assigns a new i/o unit to i
c wherever you need one
c call frenit(i) frees i/o unit i
c when you don't need it anymore
c
c EXAMPLE
c
c call ioio() (once only at begin of program)
c call iounit(i)
c open (unit=i,file=... yadda yadda )
c do stuff: read (unit=i,... write (unit=i, ...
c close (i)
c call frenit(i)
c You can put units allocated by "iounit" in a common block so
c all subroutines can access them.
c
c **********************************************************************
subroutine ioio()
c
c It's off to work we go
c
c units(i) is .true. iff i is available as an io unit number.
integer MINNIT,MAXNIT
parameter (MINNIT=60,MAXNIT=79)
logical units(MINNIT:MAXNIT)
common /enhten/units
save /enhten/
integer i
do 100 i=MINNIT,MAXNIT
100 units(i)=.true.
end
c **********************************************************************
subroutine iounit(i)
c
c returns next available io unit.
c
c STDERR=6 might be better choice for non-Unix machines.
integer STDERR
parameter (STDERR=0)
integer MINNIT,MAXNIT
parameter (MINNIT=60,MAXNIT=79)
logical units(MINNIT:MAXNIT)
common /enhten/units
save /enhten/
integer i,ierr
logical exsts,opnd
do 200 i=MINNIT,MAXNIT
if (units(i)) then
inquire(unit=i,exist=exsts,opened=opnd,iostat=ierr)
if (exsts.and..not.opnd.and.ierr.eq.0) then
units(i) = .false.
return
endif
endif
200 continue
c Bad.
write (STDERR,'(a)') 'iounit: failed.'
stop 1
end
c **********************************************************************
subroutine frenit(i)
c
c frees i/o unit "i"
c
c STDERR=6 might be better choice for non-Unix machines.
integer STDERR
parameter (STDERR=0)
integer MINNIT,MAXNIT
parameter (MINNIT=60,MAXNIT=79)
logical units(MINNIT:MAXNIT)
common /enhten/units
save /enhten/
integer i
if (i.lt.MINNIT.or.i.gt.MAXNIT) then
write (STDERR,'(a)') 'frenit: unit out of bounds'
stop 2
endif
units(i) = .true.
return
end