Changes to MPI_INIT in ELPA OpenMP version

If ELPA is compiled with OpenMP the MPI_INIT_THREAD with
level THREAD_MULIPLE must be called. This is changed in the test
programs

ELPA_development_version_OpenMP/test/read_real.F90

@@ -39,6 +39,7 @@
 !    the original distribution, the GNU Lesser General Public License.
 !
 !
+#include "config-f90.h"
 program read_real
 
 !-------------------------------------------------------------------------------
@@ -76,11 +77,27 @@ 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"
+      stop
+   endif
+
+#endif
    call mpi_comm_rank(mpi_comm_world,myid,mpierr)
    call mpi_comm_size(mpi_comm_world,nprocs,mpierr)
 
@@ -268,7 +285,7 @@ program read_real
    deallocate(tmp1)
    deallocate(tmp2)
    deallocate(ev)
-
+   call blacs_gridexit(my_blacs_ctxt)
    call mpi_finalize(mpierr)
 
 end

ELPA_development_version_OpenMP/test/read_real_gen.F90

@@ -39,6 +39,7 @@
 !    the original distribution, the GNU Lesser General Public License.
 !
 !
+#include "config-f90.h"
 program read_real_gen
 
 !-------------------------------------------------------------------------------
@@ -78,11 +79,27 @@ 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"
+      stop
+   endif
+
+#endif
+
    call mpi_comm_rank(mpi_comm_world,myid,mpierr)
    call mpi_comm_size(mpi_comm_world,nprocs,mpierr)
 
@@ -391,7 +408,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)
 
 

ELPA_development_version_OpenMP/test/test_complex.F90

@@ -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,21 @@ 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"
+      stop
+   endif
+
+#endif
+   
    call mpi_comm_rank(mpi_comm_world,myid,mpierr)
    call mpi_comm_size(mpi_comm_world,nprocs,mpierr)
    STATUS = 0
@@ -349,7 +362,7 @@ program test_complex
    deallocate(tmp1)
    deallocate(tmp2)
    deallocate(ev)
-
+   call blacs_gridexit(my_blacs_ctxt)
    call mpi_finalize(mpierr)
    call EXIT(STATUS)
 end

ELPA_development_version_OpenMP/test/test_complex2.F90

@@ -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,20 @@ 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"
+      stop
+   endif
+
+#endif
    call mpi_comm_rank(mpi_comm_world,myid,mpierr)
    call mpi_comm_size(mpi_comm_world,nprocs,mpierr)
 
@@ -358,7 +371,7 @@ program test_complex2
    deallocate(tmp1)
    deallocate(tmp2)
    deallocate(ev)
-
+   call blacs_gridexit(my_blacs_ctxt)
    call mpi_finalize(mpierr)
    call EXIT(STATUS)
 end

ELPA_development_version_OpenMP/test/test_complex_gen.F90

@@ -39,6 +39,7 @@
 !    the original distribution, the GNU Lesser General Public License.
 !
 !
+#include "config-f90.h"
 program test_complex_gen
 
 !-------------------------------------------------------------------------------
@@ -88,11 +89,27 @@ 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"
+      stop
+   endif
+
+#endif  
    call mpi_comm_rank(mpi_comm_world,myid,mpierr)
    call mpi_comm_size(mpi_comm_world,nprocs,mpierr)
 
@@ -371,6 +388,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

ELPA_development_version_OpenMP/test/test_real.F90

@@ -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,21 @@ 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"
+      stop
+   endif
+
+#endif
    call mpi_comm_rank(mpi_comm_world,myid,mpierr)
    call mpi_comm_size(mpi_comm_world,nprocs,mpierr)
 
@@ -347,7 +360,7 @@ program test_real
    deallocate(tmp1)
    deallocate(tmp2)
    deallocate(ev)
-
+   call blacs_gridexit(my_blacs_ctxt)
    call mpi_finalize(mpierr)
 
    call EXIT(STATUS)

ELPA_development_version_OpenMP/test/test_real2.F90

@@ -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,20 @@ 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"
+      stop
+   endif
+
+#endif  
    call mpi_comm_rank(mpi_comm_world,myid,mpierr)
    call mpi_comm_size(mpi_comm_world,nprocs,mpierr)
 
@@ -379,7 +392,7 @@ program test_real2
    deallocate(tmp1)
    deallocate(tmp2)
    deallocate(ev)
-
+   call blacs_gridexit(my_blacs_ctxt)
    call mpi_finalize(mpierr)
    call EXIT(STATUS)
 end

ELPA_development_version_OpenMP/test/test_real_gen.F90

@@ -361,5 +361,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