Fortran Wiki
notopen

NOTE: F2008 supports automatic allocation of a free unit with the NEWUNIT specifier in an OPEN statement. Beware that NEWUNIT-allocated LUNs are negative, so (lun>0) cannot no longer be used to check for a valid LUN. The only invalid LUN is -1.

#ifdef TESTPRG
program testit

integer,external :: notopen

write(*,*)'check for preassigned files from unit 0 to unit 1000'
write(*,*)'(5 and 6 always return -1)'

do i10=0,1000
   if(notopen(i10,i10) .ne. i10)then
      write(*,*)'INUSE:',i10, notopen(i10,i10)
   endif
enddo

end program testit
#endif

!-------------------------------------------------------------------------------
FUNCTION NOTOPEN(ISTART,IEND)
!-------------------------------------------------------------------------------
! #(@)notopen(3f): find free FORTRAN unit number to OPEN() a file.
!
! NOTOPEN() returns a FORTRAN unit number from ISTART to IEND not
! currently associated with an I/O unit.
!
! If NOTOPEN() returns -1, then no free FORTRAN unit could be found,
! although all units were checked (except for units 5 and 6).
!
! Otherwise, notopen() returns an integer representing a
! free FORTRAN unit.  Note that NOTOPEN() assumes units 5 and 6
! are special, and will never return those values.
!
! The range 1 to 99 is standard. Many machines allow other ranges 
! and/or reserve certain units like 0 and 101 for standard input,
! standard output, ...
!
! An environment may impose a limit on the number of simultaneously 
! open files (which some compilers work around); many systems extend
! the upper limit well above 99.
!-------------------------------------------------------------------------------
! Beginning with f2008, you can probably use OPEN(NEWUNIT=...) instead
!-------------------------------------------------------------------------------

   USE ISO_FORTRAN_ENV, ONLY : ERROR_UNIT ! access computing environment

   IMPLICIT NONE

   INTEGER            :: NOTOPEN          ! function return value
   INTEGER,INTENT(IN) :: ISTART           ! unit number to start looking at
   INTEGER,INTENT(IN) :: IEND             ! last unit number to look at

   INTEGER      :: I10                    ! counter from istart to iend
   INTEGER      :: IOS                    ! iostatus from INQUIRE
   LOGICAL      :: LOPEN                  ! returned from INQUIRE

   NOTOPEN=(-1)

   DO I10=ISTART,IEND
      IF ( I10 ==5 .OR. I10 == 6 ) CYCLE  ! always skip these two units
      INQUIRE( UNIT=I10, OPENED=LOPEN, IOSTAT=IOS )
      IF( IOS == 0 )THEN                  ! no error on INQUIRE
         IF( .NOT. LOPEN )THEN            ! if unit number not in use, return it
            NOTOPEN = I10
            EXIT                          ! only need to find one, so return
         ENDIF
      ELSE
         WRITE(ERROR_UNIT,*)'*NOTOPEN*:E-R-R-O-R ON UNIT ',I10,'=',IOS
      ENDIF
   ENDDO                 

   RETURN
END FUNCTION NOTOPEN
!-------------------------------------------------------------------------------

category: code