Get a unused temporary filename Calls posix ‘tempnam’ - not recommended, but we have no security concerns for this application and use here is temporary. Works with MinGW
function get_temp_filename() result(tempfile)
!
use iso_c_binding, only: c_ptr, C_NULL_PTR, c_f_pointer
integer, parameter :: MAX_FILENAME_LENGTH = 32768
character(:), allocatable :: tempfile
type(c_ptr) :: c_tempfile_ptr
character(len=1), pointer :: c_tempfile(:)
interface
function c_tempnam(dir,pfx) result(tmp) bind(c,name="tempnam")
import
type(c_ptr), intent(in), value :: dir
type(c_ptr), intent(in), value :: pfx
type(c_ptr) :: tmp
end function c_tempnam
subroutine c_free(ptr) BIND(C,name="free")
import
type(c_ptr), value :: ptr
end subroutine c_free
end interface
c_tempfile_ptr = c_tempnam(C_NULL_PTR, C_NULL_PTR)
call c_f_pointer(c_tempfile_ptr,c_tempfile,[MAX_FILENAME_LENGTH])
tempfile = f_string(c_tempfile)
call c_free(c_tempfile_ptr)
end function get_temp_filename