iounits module for Fortran 77

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

Last updated 12 Oct 2008.
Back to my home page