Lorenz's changes

src/elpa_init.F90

 module init_elpa
 
   private
-  public :: elpa_init, initDone
+  public :: elpa_init, elpa_initialized, elpa_uninit
 
   logical :: initDone = .false.
 
   contains
 
   subroutine elpa_init()
-
     implicit none
-
-    ! must be done by all task using ELPA !!!
-
     initDone = .true.
-
   end subroutine
 
+  function elpa_initialized() result(state)
+    logical :: state
+    state = initDone
+  end function
+
+  subroutine elpa_uninit()
+  end subroutine
 
 end module init_elpa

src/elpa_options.c

+#include <stdlib.h>
+#include <string.h>
+#include <search.h>
+
+#define nelements(x) (sizeof(x)/sizeof(x[0]))
+
+/* Incomplete forward declaration of configuration structure */
+typedef struct elpa_config_struct elpa_config_t;
+
+/* Function pointer type for the cardinality */
+typedef int (*cardinality_t)();
+
+/* Function pointer type to enumerate all possible options */
+typedef const int (*enumerate_int_option_t)(unsigned int n);
+
+/* Function pointer type check validity of option */
+typedef int (*valid_int_option_t)(int value);
+
 typedef struct {
-	int set;
-	char *name;
-	char **options;
-} elpa_option_t;
-
-elpa_option_t elpa_options[] = {
-	{"useQR", {"yes", "no"}},
-	{"useGPU", {"yes", "no"}},
-	{"solver", {"elpa1", "elpa2"}},
+	const char *name;
+	cardinality_t cardinality;
+	enumerate_int_option_t enumerate_option;
+	valid_int_option_t valid_int_option;
+} elpa_int_option_t;
+
+/** OPTIONS **/
+
+/* QR */
+int qr_cardinality() {
+	return 2;
+}
+
+const int qr_enumerate_option(unsigned int n) {
+	return n;
+}
+
+int qr_valid_option(int value) {
+	return value >= 0 && value < qr_cardinality();
+}
+
+/* Solver */
+enum solver_type {
+	ELPA_SOLVER_ELPA1,
+	ELPA_SOLVER_ELPA2,
+	NUM_ELPA_SOLVERS,
+};
+
+int solver_cardinality() {
+	return NUM_ELPA_SOLVERS;
+}
+
+const int solver_enumerate_option(unsigned int n) {
+	return n;
+}
+
+int solver_valid_option(int value) {
+	return value >= 0 && value < solver_cardinality();
+}
+
+
+/** END OF OPTIONS **/
+
+
+elpa_int_option_t elpa_int_options[] = {
+	{"qr", qr_cardinality, qr_enumerate_option, qr_valid_option},
+	{"solver", solver_cardinality, solver_enumerate_option, solver_valid_option},
+};
+
+struct elpa_config_struct {
+	int integer_options[nelements(elpa_int_options)];
+	int integer_options[nelements(elpa_int_options)];
+};
+
+int compar(const void *key, const void *member) {
+	const char *name = (const char *) key;
+	elpa_int_option_t *option = (elpa_int_option_t *) member;
+
+	int l1 = strlen(option->name);
+	int l2 = strlen(name);
+	if (l1 != l2) {
+		return 1;
+	}
+	if (strncmp(name, option->name, l1) == 0) {
+		return 0;
+	} else {
+		return 1;
+	}
+}
+
+int find_int_option(const char *name) {
+	elpa_int_option_t *option;
+	size_t nmembers = nelements(elpa_int_options);
+	option = lfind((const void*) name, (const void *) &elpa_int_options, &nmembers, sizeof(elpa_int_option_t), compar);
+	if (option) {
+		return (option - &elpa_int_options[0]) / sizeof(elpa_int_option_t);
+	} else {
+		return -1;
+	}
+}
+
+int* get_int_option(elpa_config_t *config, const char *name) {
+	int n = find_int_option(name);
+	if (n > 0) {
+		return &(config->integer_options[n]);
+	} else {
+		return NULL;
+	}
+}
+
+int set_int_option(elpa_config_t *config, const char *name, int value) {
+	int n = find_int_option(name);
+	if (n > 0) {
+		config->integer_options[n] = value;
+		return 1;
+	} else {
+		return 0;
+	}
 }

src/elpa_t.F90

 module elpa_type
  use iso_c_binding
+ use init_elpa
 
  private
 
- public :: elpa_create, elpa_t
+ public :: elpa_init, elpa_initialized, elpa_uninit, elpa_create, elpa_t, C_INT, C_DOUBLE, C_FLOAT
 
  type :: elpa_t
-   integer(kind=c_int) :: mpi_comm_rows, mpi_comm_cols, mpi_comm_global
+   private
+   integer(kind=c_int) :: mpi_comm_parent, mpi_comm_rows, mpi_comm_cols
    integer(kind=c_int) :: na, nev, local_nrows, local_ncols, nblk
-
-   integer(kind=c_int) :: real_kernel, complex_kernel
-
-   integer(kind=c_int) :: useQR, useGPU
-   character(6)        :: solver
-   character(8)        :: timings
    contains
-     generic, public :: set_option => elpa_set_option_string, elpa_set_option_integer
-     procedure, private :: elpa_set_option_string, elpa_set_option_integer
-     generic, public :: get_option => elpa_get_option_string, elpa_get_option_integer
-     procedure, private :: elpa_get_option_string, elpa_get_option_integer
+     generic, public :: set => elpa_set_string, elpa_set_integer
+     generic, public :: get => elpa_get_string, elpa_get_integer
 
-     procedure :: get_communicators => get_communicators
-     procedure :: solve_real_double => elpa_solve_real_double
+     procedure, private :: elpa_set_string, elpa_set_integer
+     procedure, private :: elpa_get_string, elpa_get_integer
 
+     procedure, public :: get_communicators => get_communicators
+     procedure, public :: solve => elpa_solve_real_double
  end type elpa_t
 
  contains
 
-   function elpa_create(na, nev, local_nrows, local_ncols, nblk) result(elpa)
-     use precision
-     use init_elpa
-     use elpa2_utilities, only : DEFAULT_REAL_ELPA_KERNEL, DEFAULT_COMPLEX_ELPA_KERNEL
-     implicit none
+   function elpa_create(self, na, nev, local_nrows, local_ncols, nblk, mpi_comm_parent, process_row, process_col) result(success)
+      use precision
+      use init_elpa
+      use elpa_mpi
+      use elpa_utilities, only : error_unit
+      use elpa2_utilities, only : DEFAULT_REAL_ELPA_KERNEL, DEFAULT_COMPLEX_ELPA_KERNEL
+      use elpa1, only : elpa_get_communicators
+      implicit none
 
       integer(kind=ik), intent(in) :: na, nev, local_nrows, local_ncols, nblk
-      type(elpa_t) :: elpa
+      integer, intent(in) :: mpi_comm_parent, process_row, process_col
+      type(elpa_t), intent(out) :: self
+      integer :: mpierr
 
-      ! check whether init has ever been called
-      if (.not.(initDone))  then
-        print *,"ERROR: you must call elpa_init() once before creating instances of ELPA"
-        stop
-      endif
+      logical :: success
 
-      elpa%na          = na
-      elpa%nev         = nev
-      elpa%local_nrows = local_nrows
-      elpa%local_ncols = local_ncols
-      elpa%nblk        = nblk
+      success = .true.
 
-      ! some default values
-      elpa%solver         = "2stage"
-      elpa%real_kernel    = DEFAULT_REAL_ELPA_KERNEL
-      elpa%complex_kernel = DEFAULT_COMPLEX_ELPA_KERNEL
+      ! check whether init has ever been called
+      if (.not.(elpa_initialized())) then
+        write(error_unit, *) "elpa_create(): you must call elpa_init() once before creating instances of ELPA"
+        success = .false.
+        return
+      endif
 
-      elpa%useQR          = 0
-      elpa%useGPU         = 0
-      elpa%timings        = "none"
+      self%na          = na
+      self%nev         = nev
+      self%local_nrows = local_nrows
+      self%local_ncols = local_ncols
+      self%nblk        = nblk
+
+      self%mpi_comm_parent = mpi_comm_parent
+      mpierr = elpa_get_communicators(mpi_comm_parent, process_row, process_col, self%mpi_comm_rows, self%mpi_comm_cols)
+      if (mpierr /= MPI_SUCCESS) then
+        write(error_unit, *) "elpa_create(): error constructing row and column communicators"
+        success = .false.
+        return
+      endif
 
     end function
 
-    function elpa_set_option_string(self, keyword, value) result(success)
+    function elpa_set_string(self, keyword, value) result(success)
       use iso_c_binding
       use elpa1, only : elpa_print_times
       implicit none
       class(elpa_t)            :: self
       character(*), intent(in) :: keyword
       character(*), intent(in) :: value
-      integer(kind=c_int)      :: success
-
-      success = 0
-
-      if (trim(keyword) .eq. "solver") then
-        if (trim(value) .eq. "1stage") then
-          self%solver = "1stage"
-          success = 1
-        else if (trim(value) .eq. "2stage") then
-          self%solver = "2stage"
-          success = 1
-        else if (trim(value) .eq. "auto") then
-          self%solver = "auto "
-          success = 1
-        else
-          print *," not allowed key/value pair: ",trim(keyword),"/",trim(value)
-          success = 0
-        endif
-      else if (trim(keyword) .eq. "timings") then
-        if (trim(value) .eq. "balanced") then
-          elpa_print_times = .true.
-          success = 1
-        else if (trim(value) .eq. "detailed") then
-          print *,"detailed timings not yet implemented"
-          elpa_print_times = .false.
-          success = 1
-        else if (trim(value) .eq. "none") then
-          elpa_print_times = .false.
-          success = 1
-        else
-          print *," not allowed key/value pair: ",trim(keyword),"/",trim(value)
-          success = 0
-        endif
-      else
-        print *," not allowed key/value pair: ",trim(keyword),"/",trim(value)
-        success = 0
-      endif
+      logical                  :: success
 
-    end function elpa_set_option_string
+      success = .false.
+    end function elpa_set_string
 
-    function elpa_set_option_integer(self, keyword, value) result(success)
+    function elpa_set_integer(self, keyword, value) result(success)
       use iso_c_binding
       use elpa2_utilities, only : check_allowed_real_kernels, check_allowed_complex_kernels
       implicit none
       class(elpa_t)                   :: self
       character(*), intent(in)        :: keyword
       integer(kind=c_int), intent(in) :: value
-      integer(kind=c_int)             :: success
+      logical                         :: success
 
-      success = 0
+      success = .false.
+    end function elpa_set_integer
 
-      if (trim(keyword) .eq. "real_kernel") then
-        if (.not.(check_allowed_real_kernels(value))) then
-          self%real_kernel = value
-          success = 1
-        else
-          print *,"Setting this real_kernel is not possible"
-          success = 0
-        endif
-      else if (trim(keyword) .eq. "complex_kernel" ) then
-        if (.not.(check_allowed_complex_kernels(value))) then
-          self%complex_kernel = value
-          success = 1
-        else
-          print *,"Setting this complex_kernel is not possible"
-          success = 0
-        endif
-      else if (trim(keyword) .eq. "use_qr") then
-        if (value .eq. 1) then
-          self%useQr = 1
-          success = 1
-        else if (value .eq. 0) then
-          self%useQr = 0
-          success = 1
-        else
-          print *," not allowed key/value pair: ",trim(keyword),"/",value
-          success = 0
-        endif
-      else if (trim(keyword) .eq. "use_gpu") then
-        if (value .eq. 1) then
-          self%useGPU = 1
-          success = 1
-        else if (value .eq. 0) then
-          self%useGPU = 0
-          success = 1
-        else
-          print *," not allowed key/value pair: ",trim(keyword),"/",value
-          success = 0
-        endif
-      else
-        print *," not allowed key/value pair: ",trim(keyword),"/",value
-        success = 0
-      endif
-
-    end function elpa_set_option_integer
-
-    function elpa_get_option_string(self, keyword, value) result(success)
+    function elpa_get_string(self, keyword, value) result(success)
       use iso_c_binding
       use elpa1, only : elpa_print_times
       implicit none
       class(elpa_t)               :: self
       character(*), intent(in)    :: keyword
       character(*), intent(inout) :: value
-      integer(kind=c_int)         :: success
+      logical                     :: success
 
-      success = 0
+      success = .false.
+    end function elpa_get_string
 
-      if (trim(keyword) .eq. "solver") then
-        value = trim(self%solver)
-        success = 1
-      else if (trim(keyword) .eq. "timings") then
-        if (elpa_print_times) then
-          value = "balanced"
-          success = 1
-        else
-          ! detailed not yet implemented
-          success = 1
-        endif
-      else
-        print *," not allowed key/value pair: ",trim(keyword),"/",trim(value)
-        success = 0
-      endif
-
-    end function elpa_get_option_string
-
-    function elpa_get_option_integer(self, keyword, value) result(success)
+    function elpa_get_integer(self, keyword, value) result(success)
       use iso_c_binding
       implicit none
       class(elpa_t)                      :: self
       character(*), intent(in)           :: keyword
       integer(kind=c_int), intent(inout) :: value
-      integer(kind=c_int)                :: success
-
-      success = 0
-
-      if (trim(keyword) .eq. "real_kernel") then
-        value = self%real_kernel
-        success = 1
-      else if (trim(keyword) .eq. "complex_kernel" ) then
-        value = self%complex_kernel
-        success = 1
-      else if (trim(keyword) .eq. "use_qr") then
-        value = self%useQr
-        success = 1
-      else if (trim(keyword) .eq. "use_gpu") then
-        value =  self%useGPU
-        success = 1
-      else
-        print *," not allowed key/value pair: ",trim(keyword),"/",value
-        success = 0
-      endif
+      logical                            :: success
 
-    end function elpa_get_option_integer
+      success = .false.
+    end function elpa_get_integer
 
-    function get_communicators(self, mpi_comm_global, my_prow, my_pcol, mpi_comm_rows, mpi_comm_cols) result(mpierr)
+    subroutine get_communicators(self, mpi_comm_rows, mpi_comm_cols)
       use iso_c_binding
-      use elpa_mpi
-      use elpa1, only : elpa_get_communicators
       implicit none
-      class(elpa_t)                    :: self
+      class(elpa_t)                   :: self
 
-      integer(kind=c_int), intent(in)  :: mpi_comm_global, my_prow, my_pcol
       integer(kind=c_int), intent(out) :: mpi_comm_rows, mpi_comm_cols
-
-      integer(kind=c_int)              :: mpierr
-
-      mpierr = elpa_get_communicators(mpi_comm_global, my_prow, my_pcol, mpi_comm_rows, mpi_comm_cols)
-
-      self%mpi_comm_rows   = mpi_comm_rows
-      self%mpi_comm_cols   = mpi_comm_cols
-      self%mpi_comm_global = mpi_comm_global
-    end function
+      mpi_comm_rows = self%mpi_comm_rows
+      mpi_comm_cols = self%mpi_comm_cols
+    end subroutine
 
     function elpa_solve_real_double(self, a, ev, q) result(success)
       use elpa
 
       use iso_c_binding
       implicit none
-      class(elpa_t)                    :: self
+      class(elpa_t)                   :: self
 
       real(kind=c_double) :: a(self%local_nrows, self%local_ncols), q(self%local_nrows, self%local_ncols), &
                              ev(self%na)
-      integer(kind=c_int) :: success
-
-      logical :: successDummy
+      logical :: success
 
-      successDummy =  elpa_solve_evp_real_double(self%na, self%nev, a, self%local_nrows, ev, q,  &
-                                                 self%local_nrows,  self%nblk, self%local_ncols, &
-                                                 self%mpi_comm_rows, self%mpi_comm_cols,         &
-                                                 self%mpi_comm_global, method=trim(self%solver))
-
-      if (successDummy) then
-        success = 1
-      else
-        success = 0
-      endif
+      success = elpa_solve_evp_real_double(self%na, self%nev, a, self%local_nrows, ev, q,  &
+                                           self%local_nrows,  self%nblk, self%local_ncols, &
+                                           self%mpi_comm_rows, self%mpi_comm_cols,         &
+                                           self%mpi_comm_parent)
     end function
 
 

test/Fortran/test_new_interface.F90

@@ -41,160 +41,48 @@
 !
 !
 #include "config-f90.h"
-!>
-!> Fortran test programm to demonstrates the use of
-!> ELPA 2 real case library.
-!> If "HAVE_REDIRECT" was defined at build time
-!> the stdout and stderr output of each MPI task
-!> can be redirected to files if the environment
-!> variable "REDIRECT_ELPA_TEST_OUTPUT" is set
-!> to "true".
-!>
-!> By calling executable [arg1] [arg2] [arg3] [arg4]
-!> one can define the size (arg1), the number of
-!> Eigenvectors to compute (arg2), and the blocking (arg3).
-!> If these values are not set default values (4000, 1500, 16)
-!> are choosen.
-!> If these values are set the 4th argument can be
-!> "output", which specifies that the EV's are written to
-!> an ascii file.
-!>
-!> The real ELPA 2 kernel is set as the default kernel.
-!> However, this can be overriden by setting
-!> the environment variable "REAL_ELPA_KERNEL" to an
-!> appropiate value.
-!>
-program test_real2_double_precision
 
-!-------------------------------------------------------------------------------
-! Standard eigenvalue problem - REAL version
-!
-! This program demonstrates the use of the ELPA module
-! together with standard scalapack routines
-!
-! Copyright of the original code rests with the authors inside the ELPA
-! consortium. The copyright of any additional modifications shall rest
-! with their original authors, but shall adhere to the licensing terms
-! distributed along with the original code in the file "COPYING".
-!
-!-------------------------------------------------------------------------------
-   use precision
-   use ELPA1
-   use ELPA2
+#define assert(x) if (.not.(x)) error stop "Assertion failed"
 
-   use elpa2_utilities
+program test_inteface
 
-   use mod_check_for_gpu, only : check_for_gpu
-   use elpa_utilities, only : error_unit
-#ifdef WITH_OPENMP
-   use test_util
-#endif
-
-   use mod_read_input_parameters
-   use mod_check_correctness
+   use precision
    use mod_setup_mpi
-   use mod_blacs_infrastructure
-   use mod_prepare_matrix
    use elpa_mpi
-#ifdef HAVE_REDIRECT
-  use redirect
-#endif
-#ifdef HAVE_DETAILED_TIMINGS
- use timings
-#endif
- use output_types
-
-
-  use elpa_type
-  use init_elpa
-
+   use elpa_type
 
    implicit none
 
-   !-------------------------------------------------------------------------------
-   ! Please set system size parameters below!
-   ! na:   System size
-   ! nev:  Number of eigenvectors to be calculated
-   ! nblk: Blocking factor in block cyclic distribution
-   !-------------------------------------------------------------------------------
-
-   integer(kind=ik)           :: nblk
-   integer(kind=ik)           :: na, nev
-
-   integer(kind=ik)           :: np_rows, np_cols, na_rows, na_cols
-
-   integer(kind=ik)           :: myid, nprocs, my_prow, my_pcol, mpi_comm_rows, mpi_comm_cols
-   integer(kind=ik)           :: i, mpierr, my_blacs_ctxt, sc_desc(9), info, nprow, npcol
-
-   integer(kind=ik), external :: numroc
-
-   real(kind=rk8), allocatable :: a(:,:), z(:,:), tmp1(:,:), tmp2(:,:), as(:,:), ev(:)
+   ! matrix dimensions
+   integer :: na, nev, nblk
 
-   integer(kind=ik)           :: iseed(4096) ! Random seed, size should be sufficient for every generator
-   integer(kind=ik)           :: STATUS
-#ifdef WITH_OPENMP
-   integer(kind=ik)           :: omp_get_max_threads,  required_mpi_thread_level, provided_mpi_thread_level
-#endif
-   logical                    :: successELPA, success
-   integer(kind=ik)           :: success_test
-   integer(kind=ik)           :: numberOfDevices
-   logical                    :: gpuAvailable
-   type(output_t)             :: write_to_file