Skip to content

GitLab

Commit 50d0ec4b authored by Andreas Marek's avatar Andreas Marek
Browse files

Lorenz's changes

parent 38d3081b
Hide whitespace changes
Inline Side-by-side
Showing with 247 additions and 506 deletions
src/elpa_init.F90
View file @ 50d0ec4b
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
View file @ 50d0ec4b
#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
View file @ 50d0ec4b
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
View file @ 50d0ec4b
......@@ -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
character(len=8) :: task_suffix