I was suspicious that your process limits were less than your hardware limits, which would be easy for the Slurm scheduler to i nduce (“#SLURM --mem=0 --exclusive” is a nice way to avoid that, as it asks for all the memory a node has and makes sure no one else is on the machine) or that you were running multiple threads, each of which was doing an allocation, or that some of your nodes did not have 2T of memory, or that the backend nodes had an differen version of the compiler, … . but
the output shows none of those simple explanations appears to be the case.
Even though it did not solve an issues, just some additional minor tweeks to provide best practices since you are new to Fortran. In retrospect
I should have had you display the memory available in each iteration,
and add the status to the deallocate() as well. You almost always want
to add IMPLICIT NONE. So I included another version that is a little bit
more robust (but unlikely to help from what you reported.).
I would add a few additional compiler switches when debugging as well
ifort -qopenmp -warn all -check all -O0 -g -traceback memtest_urbanjost.f90 -o memtest_urbanjost.exe
When debugging with ifort I would add at least “-O0 -g -traceback”
which will give you the line numbers of the source code lines.
But it looks like that test eliminated a few simple explanations but did not
fully explain what the failure is. If you have a recent GCC version on
the machine as well, it might be instructive to run “gfortran -fopenmp
…” as well. Perhaps using the Compiler Explorer site and other versions
of ifort and (better yet) ifx (which has superseded ifort) might show it
is a compiler or OpenMP bug in older versions of ifort. That is looking
more likely.
program memtest
use,intrinsic :: iso_fortran_env, only : int64, real64, compiler_version, compiler_options
use omp_lib, only : omp_get_thread_num
implicit none
integer(int64) :: i, n
integer :: stat
real(real64), allocatable :: array(:)
character(len=255) :: errmsg=''
i=0
print *, "Hello from process: ", omp_get_thread_num()
print '(a)', 'This file was compiled by ', compiler_version(), &
'using the options ', compiler_options()
call execute_command_line('bash -c "free -h;ulimit -a"')
do
i = i + 10
n = i * 1024_8**3 / 8
write(*,"(A,I5,A)",advance='no') "Trying to allocate", i, "GB"
if(allocated(array)) deallocate( array ,stat=stat,errmsg=errmsg)
call checkstat()
call execute_command_line('bash -c "free -h";echo')
allocate( array(n), stat=stat,errmsg=errmsg)
call checkstat()
enddo
contains
subroutine checkstat()
if(stat.eq.0)then
write(*,"(A)") " --> OK"
else
write(*,"(A)") " --> FAILED:"//trim(errmsg)
stop
endif
end subroutine checkstat
end program