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 @@
! the original distribution, the GNU Lesser General Public License.
!
!
#include "config-f90.h"
program read_real
!-------------------------------------------------------------------------------
......@@ -76,11 +77,28 @@ program read_real
real*8, allocatable :: a(:,:), z(:,:), tmp1(:,:), tmp2(:,:), as(:,:), ev(:)
character*256 filename
#ifdef WITH_OPENMP
integer :: omp_get_max_threads, required_mpi_thread_level, provided_mpi_thread_level
#endif
!-------------------------------------------------------------------------------
! MPI Initialization
#ifndef WITH_OPENMP
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_size(mpi_comm_world,nprocs,mpierr)
......@@ -268,7 +286,7 @@ program read_real
deallocate(tmp1)
deallocate(tmp2)
deallocate(ev)
call blacs_gridexit(my_blacs_ctxt)
call mpi_finalize(mpierr)
end
......
......@@ -39,6 +39,7 @@
! the original distribution, the GNU Lesser General Public License.
!
!
#include "config-f90.h"
program read_real_gen
!-------------------------------------------------------------------------------
......@@ -78,11 +79,28 @@ program read_real_gen
character(256) :: filename, fmttype
real*8 ttt0, ttt1
#ifdef WITH_OPENMP
integer :: omp_get_max_threads, required_mpi_thread_level, provided_mpi_thread_level
#endif
!-------------------------------------------------------------------------------
! MPI Initialization
#ifndef WITH_OPENMP
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_size(mpi_comm_world,nprocs,mpierr)
......@@ -391,7 +409,7 @@ program read_real_gen
err = maxval(abs(tmp1))
call mpi_allreduce(err,errmax,1,MPI_REAL8,MPI_MAX,MPI_COMM_WORLD,mpierr)
if(myid==0) print *,'Error Orthogonality:',errmax
call blacs_gridexit(my_blacs_ctxt)
call mpi_finalize(mpierr)
......
......@@ -89,7 +89,7 @@ program test_complex
integer :: iseed(4096) ! Random seed, size should be sufficient for every generator
integer :: STATUS
#ifdef WITH_OPENMP
integer :: omp_get_max_threads
integer :: omp_get_max_threads, required_mpi_thread_level, provided_mpi_thread_level
#endif
logical :: write_to_file
!-------------------------------------------------------------------------------
......@@ -126,8 +126,22 @@ program test_complex
endif
!-------------------------------------------------------------------------------
! MPI Initialization
#ifndef WITH_OPENMP
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_size(mpi_comm_world,nprocs,mpierr)
STATUS = 0
......@@ -349,7 +363,7 @@ program test_complex
deallocate(tmp1)
deallocate(tmp2)
deallocate(ev)
call blacs_gridexit(my_blacs_ctxt)
call mpi_finalize(mpierr)
call EXIT(STATUS)
end
......
......@@ -91,7 +91,7 @@ program test_complex2
integer :: STATUS
#ifdef WITH_OPENMP
integer :: omp_get_max_threads
integer :: omp_get_max_threads, required_mpi_thread_level, provided_mpi_thread_level
#endif
logical :: write_to_file
!-------------------------------------------------------------------------------
......@@ -129,7 +129,21 @@ program test_complex2
!-------------------------------------------------------------------------------
! MPI Initialization
#ifndef WITH_OPENMP
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_size(mpi_comm_world,nprocs,mpierr)
......@@ -358,7 +372,7 @@ program test_complex2
deallocate(tmp1)
deallocate(tmp2)
deallocate(ev)
call blacs_gridexit(my_blacs_ctxt)
call mpi_finalize(mpierr)
call EXIT(STATUS)
end
......
......@@ -39,6 +39,7 @@
! the original distribution, the GNU Lesser General Public License.
!
!
#include "config-f90.h"
program test_complex_gen
!-------------------------------------------------------------------------------
......@@ -88,11 +89,28 @@ program test_complex_gen
integer :: iseed(4096) ! Random seed, size should be sufficient for every generator
real*8 ttt0, ttt1
#ifdef WITH_OPENMP
integer :: omp_get_max_threads, required_mpi_thread_level, provided_mpi_thread_level
#endif
!-------------------------------------------------------------------------------
! MPI Initialization
#ifndef WITH_OPENMP
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_size(mpi_comm_world,nprocs,mpierr)
......@@ -371,6 +389,6 @@ program test_complex_gen
err = maxval(abs(tmp1))
call mpi_allreduce(err,errmax,1,MPI_REAL8,MPI_MAX,MPI_COMM_WORLD,mpierr)
if(myid==0) print *,'Error Orthogonality:',errmax
call blacs_gridexit(my_blacs_ctxt)
call mpi_finalize(mpierr)
end
......@@ -88,7 +88,7 @@ program test_real
integer :: STATUS
#ifdef WITH_OPENMP
integer :: omp_get_max_threads
integer :: omp_get_max_threads, required_mpi_thread_level, provided_mpi_thread_level
#endif
logical :: write_to_file
!-------------------------------------------------------------------------------
......@@ -125,8 +125,22 @@ program test_real
endif
!-------------------------------------------------------------------------------
! MPI Initialization
#ifndef WITH_OPENMP
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_size(mpi_comm_world,nprocs,mpierr)
......@@ -347,7 +361,7 @@ program test_real
deallocate(tmp1)
deallocate(tmp2)
deallocate(ev)
call blacs_gridexit(my_blacs_ctxt)
call mpi_finalize(mpierr)
call EXIT(STATUS)
......
......@@ -87,7 +87,7 @@ program test_real2
integer :: iseed(4096) ! Random seed, size should be sufficient for every generator
integer :: STATUS
#ifdef WITH_OPENMP
integer :: omp_get_max_threads
integer :: omp_get_max_threads, required_mpi_thread_level, provided_mpi_thread_level
#endif
logical :: write_to_file
!-------------------------------------------------------------------------------
......@@ -124,7 +124,21 @@ program test_real2
!-------------------------------------------------------------------------------
! MPI Initialization
#ifndef WITH_OPENMP
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_size(mpi_comm_world,nprocs,mpierr)
......@@ -379,7 +393,7 @@ program test_real2
deallocate(tmp1)
deallocate(tmp2)
deallocate(ev)
call blacs_gridexit(my_blacs_ctxt)
call mpi_finalize(mpierr)
call EXIT(STATUS)
end
......
......@@ -88,7 +88,22 @@ program test_real_gen
!-------------------------------------------------------------------------------
! MPI Initialization
#ifndef WITH_OPENMP
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_size(mpi_comm_world,nprocs,mpierr)
......@@ -361,5 +376,6 @@ program test_real_gen
call mpi_allreduce(err,errmax,1,MPI_REAL8,MPI_MAX,MPI_COMM_WORLD,mpierr)
if(myid==0) print *,'Error Orthogonality:',errmax
call blacs_gridexit(my_blacs_ctxt)
call mpi_finalize(mpierr)
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