From 890529017a307e2bd5df790ea83c51e8694d2703 Mon Sep 17 00:00:00 2001 From: Daniel Price Date: Fri, 20 Dec 2024 16:18:19 +1100 Subject: [PATCH] (mpi) hangs in testsuite with checks on single thread fixed --- src/tests/test_derivs.F90 | 16 +++++++-------- src/tests/utils_testsuite.f90 | 37 +++++++++++++++++++++++++++-------- 2 files changed, 37 insertions(+), 16 deletions(-) diff --git a/src/tests/test_derivs.F90 b/src/tests/test_derivs.F90 index cd24aa515..156fc43c6 100644 --- a/src/tests/test_derivs.F90 +++ b/src/tests/test_derivs.F90 @@ -208,12 +208,12 @@ subroutine test_derivs(ntests,npass,string) if (id==master .and. periodic .and. index(kernelname,'cubic') > 0) then call get_neighbour_stats(trialmean,actualmean,maxtrial,maxactual,nrhocalc,nactual) realneigh = 4./3.*pi*(hfact*radkern)**3 - call checkval(actualmean,real(int(realneigh)),tiny(0.),nfailed(11),'mean nneigh') - call checkval(maxactual,int(realneigh),0,nfailed(12),'max nneigh') + call checkval(actualmean,real(int(realneigh)),tiny(0.),nfailed(11),'mean nneigh',thread_id=id) + call checkval(maxactual,int(realneigh),0,nfailed(12),'max nneigh',thread_id=id) nexact = 2*nptot - call checkval(nrhocalc,nexact,0,nfailed(13),'n density calcs') + call checkval(nrhocalc,nexact,0,nfailed(13),'n density calcs',thread_id=id) nexact = nptot*int(realneigh) - call checkval(nactual,nexact,0,nfailed(14),'total nneigh') + call checkval(nactual,nexact,0,nfailed(14),'total nneigh',thread_id=id) endif ! !--check that the timestep bin has been set @@ -407,13 +407,13 @@ subroutine test_derivs(ntests,npass,string) realneigh = 4./3.*pi*(hfact*radkern)**3 if (testall) then nexact = nptot ! should be no iterations here - call checkval(nrhocalc,nexact,0,nfailed(17),'n density calcs') + call checkval(nrhocalc,nexact,0,nfailed(17),'n density calcs',thread_id=id) endif if (index(kernelname,'cubic') > 0) then - call checkval(actualmean,real(int(realneigh)),tiny(0.),nfailed(15),'mean nneigh') - call checkval(maxactual,int(realneigh),0,nfailed(16),'max nneigh') + call checkval(actualmean,real(int(realneigh)),tiny(0.),nfailed(15),'mean nneigh',thread_id=id) + call checkval(maxactual,int(realneigh),0,nfailed(16),'max nneigh',thread_id=id) nexact = nptot*int(realneigh) - call checkval(nactual,nexact,0,nfailed(18),'total nneigh') + call checkval(nactual,nexact,0,nfailed(18),'total nneigh',thread_id=id) endif endif ! diff --git a/src/tests/utils_testsuite.f90 b/src/tests/utils_testsuite.f90 index c1f8e383a..36279b3d0 100644 --- a/src/tests/utils_testsuite.f90 +++ b/src/tests/utils_testsuite.f90 @@ -292,7 +292,7 @@ subroutine checkval1_r4(xi,val,tol,ndiff,label,thread_id) real :: errtmp ndiff = 0 - call print_testinfo(trim(label)) + call print_testinfo(trim(label),present(thread_id)) erri = abs(xi-val) if (abs(val) > smallval) erri = erri/abs(val) @@ -327,7 +327,7 @@ subroutine checkval1_r8(xi,val,tol,ndiff,label,thread_id) real(kind=8) :: erri ndiff = 0 - call print_testinfo(trim(label)) + call print_testinfo(trim(label),present(thread_id)) erri = abs(xi-val) if (abs(val) > smallval) erri = erri/abs(val) @@ -381,7 +381,7 @@ subroutine checkval1_int(ix,ival,itol,ndiff,label,thread_id) integer :: erri ndiff = 0 - call print_testinfo(trim(label)) + call print_testinfo(trim(label),present(thread_id)) erri = abs(ix-ival) if (erri > itol) ndiff = 1 @@ -407,23 +407,37 @@ end subroutine checkval1_int ! checks a single, integer*8 value !+ !---------------------------------------------------------------- -subroutine checkval1_int8(ix,ival,itol,ndiff,label) +subroutine checkval1_int8(ix,ival,itol,ndiff,label,thread_id) integer(kind=8), intent(in) :: ix integer(kind=8), intent(in) :: ival integer, intent(in) :: itol integer, intent(out) :: ndiff character(len=*), intent(in) :: label + integer, intent(in), optional :: thread_id integer(kind=8) :: erri integer :: itmp ndiff = 0 - call print_testinfo(trim(label)) + call print_testinfo(trim(label),present(thread_id)) erri = abs(ix-ival) if (erri > itol) ndiff = 1 itmp = int(erri) - call printresult(1,ndiff,itmp,itol) + + if (present(thread_id) .or. nprocs==1) then + if (ndiff == 0) then + if (itol==0) then + write(*,"(a,i11,a,i12,a)") 'OK [got',ix,' should be',ival,']' + else + write(*,"(a,i11,a,i12,a,i5,a)") 'OK [got',ix,' should be',ival,', tol = ',itol,']' + endif + else + call printerr(label,int(ix),int(ival),itmp,itol) + endif + else + call printresult(1,ndiff,itmp,itol) + endif end subroutine checkval1_int8 @@ -808,12 +822,19 @@ end subroutine printerr_logical ! formatting for initial test information !+ !---------------------------------------------------------------- -subroutine print_testinfo(string) +subroutine print_testinfo(string,always) character(len=*), intent(in) :: string + logical, intent(in), optional :: always character(len=20) :: fmtstring integer :: ndots,istart + logical :: do_print - if (id==master) then + do_print = (id==master) ! by default only print on master MPI thread + if (present(always)) then + do_print = (id==master) .or. always ! override this when thread_id=id passed to checkval routines + endif + + if (do_print) then istart = 20 ndots = -1 do while(ndots < 2 .and. istart < 60)