Commit b34a5a9c authored by Andreas Marek's avatar Andreas Marek

ELPA_development_version_qr: OpenMP tests return error code

If the ELPA library is compiled with OpenMP, the tests check
whether the MPI library provides the neccessary threading
level.

There has been the error, that if the required threading level
was not available the test programs aborted, put no explicit
error code was set. This is changed now.
parent 8d698104
...@@ -39,6 +39,7 @@ ...@@ -39,6 +39,7 @@
! the original distribution, the GNU Lesser General Public License. ! the original distribution, the GNU Lesser General Public License.
! !
! !
#include "config-f90.h"
program read_real program read_real
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
...@@ -76,11 +77,28 @@ program read_real ...@@ -76,11 +77,28 @@ program read_real
real*8, allocatable :: a(:,:), z(:,:), tmp1(:,:), tmp2(:,:), as(:,:), ev(:) real*8, allocatable :: a(:,:), z(:,:), tmp1(:,:), tmp2(:,:), as(:,:), ev(:)
character*256 filename character*256 filename
#ifdef WITH_OPENMP
integer :: omp_get_max_threads, required_mpi_thread_level, provided_mpi_thread_level
#endif
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! MPI Initialization ! MPI Initialization
#ifndef WITH_OPENMP
call mpi_init(mpierr) call mpi_init(mpierr)
#else
required_mpi_thread_level = MPI_THREAD_MULTIPLE
call mpi_init_thread(required_mpi_thread_level, &
provided_mpi_thread_level, mpierr)
if (required_mpi_thread_level .ne. provided_mpi_thread_level) then
print *,"MPI ERROR: MPI_THREAD_MULTIPLE is not provided on this system"
print *," ", provided_mpi_thread_level, " is available"
call EXIT(1)
stop 1
endif
#endif
call mpi_comm_rank(mpi_comm_world,myid,mpierr) call mpi_comm_rank(mpi_comm_world,myid,mpierr)
call mpi_comm_size(mpi_comm_world,nprocs,mpierr) call mpi_comm_size(mpi_comm_world,nprocs,mpierr)
...@@ -268,7 +286,7 @@ program read_real ...@@ -268,7 +286,7 @@ program read_real
deallocate(tmp1) deallocate(tmp1)
deallocate(tmp2) deallocate(tmp2)
deallocate(ev) deallocate(ev)
call blacs_gridexit(my_blacs_ctxt)
call mpi_finalize(mpierr) call mpi_finalize(mpierr)
end end
......
...@@ -39,6 +39,7 @@ ...@@ -39,6 +39,7 @@
! the original distribution, the GNU Lesser General Public License. ! the original distribution, the GNU Lesser General Public License.
! !
! !
#include "config-f90.h"
program read_real_gen program read_real_gen
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
...@@ -78,11 +79,28 @@ program read_real_gen ...@@ -78,11 +79,28 @@ program read_real_gen
character(256) :: filename, fmttype character(256) :: filename, fmttype
real*8 ttt0, ttt1 real*8 ttt0, ttt1
#ifdef WITH_OPENMP
integer :: omp_get_max_threads, required_mpi_thread_level, provided_mpi_thread_level
#endif
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! MPI Initialization ! MPI Initialization
#ifndef WITH_OPENMP
call mpi_init(mpierr) call mpi_init(mpierr)
#else
required_mpi_thread_level = MPI_THREAD_MULTIPLE
call mpi_init_thread(required_mpi_thread_level, &
provided_mpi_thread_level, mpierr)
if (required_mpi_thread_level .ne. provided_mpi_thread_level) then
print *,"MPI ERROR: MPI_THREAD_MULTIPLE is not provided on this system"
print *," ", provided_mpi_thread_level, " is available"
call EXIT(1)
stop 1
endif
#endif
call mpi_comm_rank(mpi_comm_world,myid,mpierr) call mpi_comm_rank(mpi_comm_world,myid,mpierr)
call mpi_comm_size(mpi_comm_world,nprocs,mpierr) call mpi_comm_size(mpi_comm_world,nprocs,mpierr)
...@@ -391,7 +409,7 @@ program read_real_gen ...@@ -391,7 +409,7 @@ program read_real_gen
err = maxval(abs(tmp1)) err = maxval(abs(tmp1))
call mpi_allreduce(err,errmax,1,MPI_REAL8,MPI_MAX,MPI_COMM_WORLD,mpierr) call mpi_allreduce(err,errmax,1,MPI_REAL8,MPI_MAX,MPI_COMM_WORLD,mpierr)
if(myid==0) print *,'Error Orthogonality:',errmax if(myid==0) print *,'Error Orthogonality:',errmax
call blacs_gridexit(my_blacs_ctxt)
call mpi_finalize(mpierr) call mpi_finalize(mpierr)
......
...@@ -89,7 +89,7 @@ program test_complex ...@@ -89,7 +89,7 @@ program test_complex
integer :: iseed(4096) ! Random seed, size should be sufficient for every generator integer :: iseed(4096) ! Random seed, size should be sufficient for every generator
integer :: STATUS integer :: STATUS
#ifdef WITH_OPENMP #ifdef WITH_OPENMP
integer :: omp_get_max_threads integer :: omp_get_max_threads, required_mpi_thread_level, provided_mpi_thread_level
#endif #endif
logical :: write_to_file logical :: write_to_file
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
...@@ -126,8 +126,22 @@ program test_complex ...@@ -126,8 +126,22 @@ program test_complex
endif endif
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! MPI Initialization ! MPI Initialization
#ifndef WITH_OPENMP
call mpi_init(mpierr) call mpi_init(mpierr)
#else
required_mpi_thread_level = MPI_THREAD_MULTIPLE
call mpi_init_thread(required_mpi_thread_level, &
provided_mpi_thread_level, mpierr)
if (required_mpi_thread_level .ne. provided_mpi_thread_level) then
print *,"MPI ERROR: MPI_THREAD_MULTIPLE is not provided on this system"
print *," ", provided_mpi_thread_level, " is available"
call EXIT(1)
stop 1
endif
#endif
call mpi_comm_rank(mpi_comm_world,myid,mpierr) call mpi_comm_rank(mpi_comm_world,myid,mpierr)
call mpi_comm_size(mpi_comm_world,nprocs,mpierr) call mpi_comm_size(mpi_comm_world,nprocs,mpierr)
STATUS = 0 STATUS = 0
...@@ -349,7 +363,7 @@ program test_complex ...@@ -349,7 +363,7 @@ program test_complex
deallocate(tmp1) deallocate(tmp1)
deallocate(tmp2) deallocate(tmp2)
deallocate(ev) deallocate(ev)
call blacs_gridexit(my_blacs_ctxt)
call mpi_finalize(mpierr) call mpi_finalize(mpierr)
call EXIT(STATUS) call EXIT(STATUS)
end end
......
...@@ -91,7 +91,7 @@ program test_complex2 ...@@ -91,7 +91,7 @@ program test_complex2
integer :: STATUS integer :: STATUS
#ifdef WITH_OPENMP #ifdef WITH_OPENMP
integer :: omp_get_max_threads integer :: omp_get_max_threads, required_mpi_thread_level, provided_mpi_thread_level
#endif #endif
logical :: write_to_file logical :: write_to_file
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
...@@ -129,7 +129,21 @@ program test_complex2 ...@@ -129,7 +129,21 @@ program test_complex2
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! MPI Initialization ! MPI Initialization
#ifndef WITH_OPENMP
call mpi_init(mpierr) call mpi_init(mpierr)
#else
required_mpi_thread_level = MPI_THREAD_MULTIPLE
call mpi_init_thread(required_mpi_thread_level, &
provided_mpi_thread_level, mpierr)
if (required_mpi_thread_level .ne. provided_mpi_thread_level) then
print *,"MPI ERROR: MPI_THREAD_MULTIPLE is not provided on this system"
print *," ", provided_mpi_thread_level, " is available"
call EXIT(1)
stop 1
endif
#endif
call mpi_comm_rank(mpi_comm_world,myid,mpierr) call mpi_comm_rank(mpi_comm_world,myid,mpierr)
call mpi_comm_size(mpi_comm_world,nprocs,mpierr) call mpi_comm_size(mpi_comm_world,nprocs,mpierr)
...@@ -358,7 +372,7 @@ program test_complex2 ...@@ -358,7 +372,7 @@ program test_complex2
deallocate(tmp1) deallocate(tmp1)
deallocate(tmp2) deallocate(tmp2)
deallocate(ev) deallocate(ev)
call blacs_gridexit(my_blacs_ctxt)
call mpi_finalize(mpierr) call mpi_finalize(mpierr)
call EXIT(STATUS) call EXIT(STATUS)
end end
......
...@@ -39,6 +39,7 @@ ...@@ -39,6 +39,7 @@
! the original distribution, the GNU Lesser General Public License. ! the original distribution, the GNU Lesser General Public License.
! !
! !
#include "config-f90.h"
program test_complex_gen program test_complex_gen
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
...@@ -88,11 +89,28 @@ program test_complex_gen ...@@ -88,11 +89,28 @@ program test_complex_gen
integer :: iseed(4096) ! Random seed, size should be sufficient for every generator integer :: iseed(4096) ! Random seed, size should be sufficient for every generator
real*8 ttt0, ttt1 real*8 ttt0, ttt1
#ifdef WITH_OPENMP
integer :: omp_get_max_threads, required_mpi_thread_level, provided_mpi_thread_level
#endif
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! MPI Initialization ! MPI Initialization
#ifndef WITH_OPENMP
call mpi_init(mpierr) call mpi_init(mpierr)
#else
required_mpi_thread_level = MPI_THREAD_MULTIPLE
call mpi_init_thread(required_mpi_thread_level, &
provided_mpi_thread_level, mpierr)
if (required_mpi_thread_level .ne. provided_mpi_thread_level) then
print *,"MPI ERROR: MPI_THREAD_MULTIPLE is not provided on this system"
print *," ", provided_mpi_thread_level, " is available"
call EXIT(1)
stop 1
endif
#endif
call mpi_comm_rank(mpi_comm_world,myid,mpierr) call mpi_comm_rank(mpi_comm_world,myid,mpierr)
call mpi_comm_size(mpi_comm_world,nprocs,mpierr) call mpi_comm_size(mpi_comm_world,nprocs,mpierr)
...@@ -371,6 +389,6 @@ program test_complex_gen ...@@ -371,6 +389,6 @@ program test_complex_gen
err = maxval(abs(tmp1)) err = maxval(abs(tmp1))
call mpi_allreduce(err,errmax,1,MPI_REAL8,MPI_MAX,MPI_COMM_WORLD,mpierr) call mpi_allreduce(err,errmax,1,MPI_REAL8,MPI_MAX,MPI_COMM_WORLD,mpierr)
if(myid==0) print *,'Error Orthogonality:',errmax if(myid==0) print *,'Error Orthogonality:',errmax
call blacs_gridexit(my_blacs_ctxt)
call mpi_finalize(mpierr) call mpi_finalize(mpierr)
end end
...@@ -88,7 +88,7 @@ program test_real ...@@ -88,7 +88,7 @@ program test_real
integer :: STATUS integer :: STATUS
#ifdef WITH_OPENMP #ifdef WITH_OPENMP
integer :: omp_get_max_threads integer :: omp_get_max_threads, required_mpi_thread_level, provided_mpi_thread_level
#endif #endif
logical :: write_to_file logical :: write_to_file
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
...@@ -125,8 +125,22 @@ program test_real ...@@ -125,8 +125,22 @@ program test_real
endif endif
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! MPI Initialization ! MPI Initialization
#ifndef WITH_OPENMP
call mpi_init(mpierr) call mpi_init(mpierr)
#else
required_mpi_thread_level = MPI_THREAD_MULTIPLE
call mpi_init_thread(required_mpi_thread_level, &
provided_mpi_thread_level, mpierr)
if (required_mpi_thread_level .ne. provided_mpi_thread_level) then
print *,"MPI ERROR: MPI_THREAD_MULTIPLE is not provided on this system"
print *," ", provided_mpi_thread_level, " is available"
call EXIT(1)
stop 1
endif
#endif
call mpi_comm_rank(mpi_comm_world,myid,mpierr) call mpi_comm_rank(mpi_comm_world,myid,mpierr)
call mpi_comm_size(mpi_comm_world,nprocs,mpierr) call mpi_comm_size(mpi_comm_world,nprocs,mpierr)
...@@ -347,7 +361,7 @@ program test_real ...@@ -347,7 +361,7 @@ program test_real
deallocate(tmp1) deallocate(tmp1)
deallocate(tmp2) deallocate(tmp2)
deallocate(ev) deallocate(ev)
call blacs_gridexit(my_blacs_ctxt)
call mpi_finalize(mpierr) call mpi_finalize(mpierr)
call EXIT(STATUS) call EXIT(STATUS)
......
...@@ -87,7 +87,7 @@ program test_real2 ...@@ -87,7 +87,7 @@ program test_real2
integer :: iseed(4096) ! Random seed, size should be sufficient for every generator integer :: iseed(4096) ! Random seed, size should be sufficient for every generator
integer :: STATUS integer :: STATUS
#ifdef WITH_OPENMP #ifdef WITH_OPENMP
integer :: omp_get_max_threads integer :: omp_get_max_threads, required_mpi_thread_level, provided_mpi_thread_level
#endif #endif
logical :: write_to_file logical :: write_to_file
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
...@@ -124,7 +124,21 @@ program test_real2 ...@@ -124,7 +124,21 @@ program test_real2
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! MPI Initialization ! MPI Initialization
#ifndef WITH_OPENMP
call mpi_init(mpierr) call mpi_init(mpierr)
#else
required_mpi_thread_level = MPI_THREAD_MULTIPLE
call mpi_init_thread(required_mpi_thread_level, &
provided_mpi_thread_level, mpierr)
if (required_mpi_thread_level .ne. provided_mpi_thread_level) then
print *,"MPI ERROR: MPI_THREAD_MULTIPLE is not provided on this system"
print *," ", provided_mpi_thread_level, " is available"
call EXIT(1)
stop 1
endif
#endif
call mpi_comm_rank(mpi_comm_world,myid,mpierr) call mpi_comm_rank(mpi_comm_world,myid,mpierr)
call mpi_comm_size(mpi_comm_world,nprocs,mpierr) call mpi_comm_size(mpi_comm_world,nprocs,mpierr)
...@@ -379,7 +393,7 @@ program test_real2 ...@@ -379,7 +393,7 @@ program test_real2
deallocate(tmp1) deallocate(tmp1)
deallocate(tmp2) deallocate(tmp2)
deallocate(ev) deallocate(ev)
call blacs_gridexit(my_blacs_ctxt)
call mpi_finalize(mpierr) call mpi_finalize(mpierr)
call EXIT(STATUS) call EXIT(STATUS)
end end
......
...@@ -88,7 +88,22 @@ program test_real_gen ...@@ -88,7 +88,22 @@ program test_real_gen
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! MPI Initialization ! MPI Initialization
#ifndef WITH_OPENMP
call mpi_init(mpierr) call mpi_init(mpierr)
#else
required_mpi_thread_level = MPI_THREAD_MULTIPLE
call mpi_init_thread(required_mpi_thread_level, &
provided_mpi_thread_level, mpierr)
if (required_mpi_thread_level .ne. provided_mpi_thread_level) then
print *,"MPI ERROR: MPI_THREAD_MULTIPLE is not provided on this system"
print *," ", provided_mpi_thread_level, " is available"
call EXIT(1)
stop 1
endif
#endif
call mpi_comm_rank(mpi_comm_world,myid,mpierr) call mpi_comm_rank(mpi_comm_world,myid,mpierr)
call mpi_comm_size(mpi_comm_world,nprocs,mpierr) call mpi_comm_size(mpi_comm_world,nprocs,mpierr)
...@@ -361,5 +376,6 @@ program test_real_gen ...@@ -361,5 +376,6 @@ program test_real_gen
call mpi_allreduce(err,errmax,1,MPI_REAL8,MPI_MAX,MPI_COMM_WORLD,mpierr) call mpi_allreduce(err,errmax,1,MPI_REAL8,MPI_MAX,MPI_COMM_WORLD,mpierr)
if(myid==0) print *,'Error Orthogonality:',errmax if(myid==0) print *,'Error Orthogonality:',errmax
call blacs_gridexit(my_blacs_ctxt)
call mpi_finalize(mpierr) call mpi_finalize(mpierr)
end end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment