GetFileInfoQQ causing 'Too many open files' error

[sjb]

I have created the following to list the contents of a directory. The subroutine, get_directory_contents, returns an array of character strings, which are the names of all of the files/directories within the directory, given the path of the directory in question. The subroutine uses GetFileInfoQQ, and is based heavily on the example in Intel's documentation for that function. This seems to work correctly. See the following example.

program directory_contents
  use ifcore
  implicit none

  integer :: length, i
  character(len=80) folder
  character (len=:), dimension (:), allocatable :: file_list


  write (*, '(a)') ' Enter path of folder to view contents: '

  length = getstrqq(folder)
  
  do while (length > 0)
     call get_directory_contents(trim(folder), file_list)

     do i = 1, size(file_list,1)
        write(*,*) file_list(i)
     enddo

     length = getstrqq(folder)
  enddo
  
  deallocate(file_list)
contains

! subroutine to list the contents of a directory
  subroutine get_directory_contents(folder, file_list)
    use ifport
    implicit none
    character (len=*), intent(in) :: folder
    character (len=:), dimension(:), allocatable, intent (out) :: file_list

    character (len=80) :: files
    integer (kind=int_ptr_kind()) :: handle
    integer (4) :: length

    integer :: len_filename, max_len_filename, no_files, istat
    character (len=:), allocatable :: filename
    type (file$info) :: info

    write(files, '(2a)') trim(folder), '/*'

    max_len_filename = 0
    no_files = 0

    handle = file$first

! run through files once to get number of files and length of
! longest filename
    do while (.true.)
       length = getfileinfoqq(files, info, handle)
       if ((handle .eq. file$last) .or. &
            (handle .eq. file$error)) then
          select case (getlasterrorqq( ))
          case (err$nomem)
             write (*,*) 'Out of memory'
          case (err$noent)
             exit
          case default
             write (*,*) 'Invalid file or path name'
          end select
       end if

       if (info%name=='.' .or. info%name=='..') cycle

       len_filename = len_trim(info%name)
       max_len_filename = max(max_len_filename, len_filename)
       no_files = no_files + 1

    end do

! allocate file list and filename as required
    allocate (character(len=max_len_filename) :: file_list(no_files), stat=istat)
    if (istat/=0) then
       stop 'Error allocating file list.'
    end if

    allocate (character(len=max_len_filename) :: filename, stat=istat)
    if (istat/=0) then
       stop 'Error allocating filename.'
    end if

    handle = file$first
    no_files = 0

! now actually get the list of files
    do while (.true.)
       length = getfileinfoqq(files, info, handle)
       if ((handle .eq. file$last) .or. &
            (handle .eq. file$error)) then
          select case (getlasterrorqq( ))
          case (err$nomem)
             write (*,*) 'out of memory'
          case (err$noent)
             exit
          case default
             write (*,*) 'invalid file or path name'
          end select
       end if

       if (info%name=='.' .or. info%name=='..') cycle

       filename = trim(info%name)

! update the number of files and assign
       no_files = no_files + 1
       if (no_files>size(file_list,1)) then
          stop 'Length for file list was allocated incorrectly.'
       end if
       file_list(no_files) = filename

    enddo

    deallocate(filename)

  end subroutine get_directory_contents
end program directory_contents

The problem is that it doesn't seem to be closing files properly. In the example above, you can repeatedly enter directory paths to list the contents of that directory: if I check the number of files open in the process after each iteration of the loop, I see the number of open files steadily increasing. For example, it looks something like the following in my shell:

[sjb@computer ~]$ pidof directory_contents
27754
[sjb@computer ~]$ ls /proc/27754/fd/ | wc -l
3
[sjb@computer ~]$ ls /proc/27754/fd/ | wc -l
13
[sjb@computer ~]$ ls /proc/27754/fd/ | wc -l
45
[sjb@computer ~]$ ls /proc/27754/fd/ | wc -l
219

In my real code, this eventually reaches the open-file limit of the operating system, which means that when I try to open another file, this fails with the error message, 'too many open files.'

I'm aware of the following caveat in the documentation: 

GETFILEINFOQQ must be called with the handle until GETFILEINFOQQ sets handle to FILE$LAST, or system resources may be lost.

However, the subroutine does seem to be making it to the FILE$LAST handle. Is there something else that I'm doing wrong here?

Other possibly relevant details:

• I'm compiling with ifort 18.0.1
• This is being compiled on a GNU/Linux cluster
• The operating system is Red Hat Enterprise Linux Server 7.5 (Maipo)