Commit f91c0b4b authored by Lorenz Huedepohl's avatar Lorenz Huedepohl

Initial version of new ELPA API

This attempt at a new, more flexible API for ELPA should hopefully
result in less ABI/API breaking changes in the future.

The new API features a generic key/value system for options that can be
extended without changing any exported symbols or function signatures,
so that new, optional features do not influence existing usage of ELPA.

We hope this makes life easier for users of ELPA - at least in the long
run when they migrated to this newest of ABI changes :)

Example usage (explicit documentation to be done in a future commit):

   if (elpa_init(20170403) /= ELPA_OK) then
     error stop "ELPA API version not supported"
   endif

   e = elpa_create(na, nev, na_rows, na_cols, nblk, mpi_comm_world, my_prow, my_pcol, success)

   call e%set("solver", ELPA_SOLVER_2STAGE)
   call e%set("real_kernel", ELPA_2STAGE_REAL_GENERIC)

   call e%solve(a, ev, z, success)

   call e%destroy()

   call elpa_uninit()
parent 5e313282
......@@ -17,7 +17,6 @@ libelpa@SUFFIX@_public_la_SOURCES = \
src/elpa1_auxiliary.F90 \
src/elpa1_utilities.F90 \
src/elpa2_utilities.F90 \
src/elpa_init.F90 \
src/elpa_t.F90 \
src/elpa_utilities.F90
......@@ -45,7 +44,8 @@ libelpa@SUFFIX@_private_la_SOURCES = \
src/elpa_qr/qr_utils.F90 \
src/elpa_qr/elpa_qrkernels.F90 \
src/elpa_qr/elpa_pdlarfb.F90 \
src/elpa_qr/elpa_pdgeqrf.F90
src/elpa_qr/elpa_pdgeqrf.F90 \
src/elpa_options.c
EXTRA_libelpa@SUFFIX@_private_la_DEPENDENCIES = \
src/elpa_reduce_add_vectors.X90 \
......@@ -301,7 +301,7 @@ BUILT_SOURCES = $(generated_headers)
# install public Fortran modules files in the include/ dir
elpa_includedir = $(includedir)/elpa@SUFFIX@-@PACKAGE_VERSION@
nobase_elpa_include_HEADERS = $(wildcard modules/*)
nobase_elpa_include_HEADERS += elpa/elpa.h elpa/elpa_kernel_constants.h elpa/elpa_generated.h
nobase_elpa_include_HEADERS += elpa/elpa.h elpa/elpa_kernel_constants.h elpa/elpa_solver_constants.h elpa/elpa_constants.h elpa/elpa_generated.h
dist_man_MANS = \
man/solve_evp_real.3 \
......
#include <elpa/elpa_kernel_constants.h>
#ifndef ELPA_H
#define ELPA_H
#include <limits.h>
#include <elpa/elpa_constants.h>
#include <elpa/elpa_generated.h>
#endif
#define ELPA_INVALID_INT INT_MIN
#define ELPA_C_ERROR 0
#define ELPA_C_OK 1
#ifdef ELPA_H
#define ELPA_ERROR ELPA_C_ERROR
#define ELPA_OK ELPA_C_OK
#endif
#include <elpa/elpa_kernel_constants.h>
#include <elpa/elpa_solver_constants.h>
This diff is collapsed.
#define ELPA_C_SOLVER_1STAGE 1
#define ELPA_C_SOLVER_2STAGE 2
#define ELPA_C_NUMBER_OF_SOLVERS 2
#ifdef ELPA_H
#define ELPA_SOLVER_1STAGE ELPA_C_SOLVER_1STAGE
#define ELPA_SOLVER_2STAGE ELPA_C_SOLVER_2STAGE
#define ELPA_NUMBER_OF_SOLVERS ELPA_C_NUMBER_OF_SOLVERS
#endif
This diff is collapsed.
module init_elpa
private
public :: elpa_init, elpa_initialized, elpa_uninit
logical :: initDone = .false.
contains
subroutine elpa_init()
implicit none
initDone = .true.
end subroutine
function elpa_initialized() result(state)
logical :: state
state = initDone
end function
subroutine elpa_uninit()
end subroutine
end module init_elpa
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <search.h>
#include <elpa/elpa.h>
#define nelements(x) (sizeof(x)/sizeof(x[0]))
/* Incomplete forward declaration of configuration structure */
typedef struct elpa_config_struct elpa_config_t;
typedef struct elpa_options_struct* elpa_options_t;
/* Function pointer type for the cardinality */
typedef int (*cardinality_t)();
......@@ -14,105 +18,170 @@ typedef int (*cardinality_t)();
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 int (*valid_int_t)(elpa_options_t options, int value);
typedef struct {
const char *name;
cardinality_t cardinality;
enumerate_int_option_t enumerate_option;
valid_int_option_t valid_int_option;
const char *name;
int default_value;
cardinality_t cardinality;
enumerate_int_option_t enumerate_option;
valid_int_t valid;
} elpa_int_option_t;
/** OPTIONS **/
/* QR */
int qr_cardinality() {
return 2;
return 2;
}
const int qr_enumerate_option(unsigned int n) {
return n;
return n;
}
int qr_valid_option(int value) {
return value >= 0 && value < qr_cardinality();
int qr_valid(elpa_options_t options, int value) {
if (value >= 0 && value < qr_cardinality()) {
return ELPA_OK;
} else {
return ELPA_ERROR;
}
}
/* Solver */
enum solver_type {
ELPA_SOLVER_ELPA1,
ELPA_SOLVER_ELPA2,
NUM_ELPA_SOLVERS,
};
/* Solver */
int solver_cardinality() {
return NUM_ELPA_SOLVERS;
return ELPA_NUMBER_OF_SOLVERS;
}
const int solver_enumerate_option(unsigned int n) {
return n;
return n+1;
}
int solver_valid_option(int value) {
return value >= 0 && value < solver_cardinality();
int solver_valid(elpa_options_t options, int value) {
if (value >= 1 && value <= solver_cardinality()) {
return ELPA_OK;
} else {
return ELPA_ERROR;
}
}
/* Real Kernel */
int real_kernel_cardinality() {
return ELPA_2STAGE_NUMBER_OF_REAL_KERNELS;
}
const int real_kernel_enumerate_option(unsigned int n) {
return n+1;
}
int real_kernel_valid(elpa_options_t options, int value) {
if (value >= 1 && value <= real_kernel_cardinality()) {
return ELPA_OK;
} else {
return ELPA_ERROR;
}
}
/* Complex Kernel */
int complex_kernel_cardinality() {
return ELPA_2STAGE_NUMBER_OF_COMPLEX_KERNELS;
}
const int complex_kernel_enumerate_option(unsigned int n) {
return n+1;
}
int complex_kernel_valid(elpa_options_t options, int value) {
if (value >= 1 && value <= complex_kernel_cardinality()) {
return ELPA_OK;
} else {
return ELPA_ERROR;
}
}
/** 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},
{"qr", 0, qr_cardinality, qr_enumerate_option, qr_valid},
{"solver", ELPA_SOLVER_1STAGE, solver_cardinality, solver_enumerate_option, solver_valid},
{"real_kernel", ELPA_2STAGE_REAL_DEFAULT, real_kernel_cardinality, real_kernel_enumerate_option, real_kernel_valid},
{"complex_kernel", ELPA_2STAGE_COMPLEX_DEFAULT, complex_kernel_cardinality, complex_kernel_enumerate_option, complex_kernel_valid},
};
struct elpa_config_struct {
int integer_options[nelements(elpa_int_options)];
int integer_options[nelements(elpa_int_options)];
struct elpa_options_struct {
int int_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;
elpa_options_t elpa_allocate_options() {
elpa_options_t options = (elpa_options_t) calloc(1, sizeof(struct elpa_options_struct));
int i;
for (i = 0; i < nelements(elpa_int_options); i++) {
options->int_options[i] = elpa_int_options[i].default_value;
}
return options;
}
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;
}
void elpa_free_options(elpa_options_t options) {
free(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;
}
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]);
} else {
return -1;
}
}
int get_int_option(elpa_options_t options, const char *name, int *success) {
int n = find_int_option(name);
if (n >= 0) {
if (success != NULL) {
*success = ELPA_OK;
}
return options->int_options[n];
} else {
if (success != NULL) {
*success = ELPA_ERROR;
} else {
fprintf(stderr, "ELPA: No such option '%s' and you did not check for errors, returning ELPA_INVALID_INT!\n", name);
}
return ELPA_INVALID_INT;
}
}
int set_int_option(elpa_options_t options, const char *name, int value) {
int n = find_int_option(name);
int res = ELPA_ERROR;
if (n >= 0) {
res = elpa_int_options[n].valid(options, value);
if (res == ELPA_OK) {
options->int_options[n] = value;
}
}
return res;
}
This diff is collapsed.
......@@ -48,6 +48,7 @@
! Author: Andreas Marek, MPCDF
#include "config-f90.h"
#include <elpa/elpa_solver_constants.h>
module ELPA_utilities
......@@ -69,7 +70,6 @@ module ELPA_utilities
integer, parameter :: error_unit = 0
#endif
!******
contains
......
......@@ -49,7 +49,7 @@ module elpa_mpi_stubs
public
integer(kind=ik), parameter :: MPI_COMM_SELF=1, MPI_COMM_WORLD=1
integer(kind=ik), parameter :: MPI_COMM_SELF=1, MPI_COMM_WORLD=1, MPI_SUCCESS=0
contains
function MPI_WTIME() result(time)
......
......@@ -232,7 +232,7 @@ int main(int argc, char** argv) {
#endif
useGPU = 0;
bandwidth = -1;
THIS_COMPLEX_ELPA_KERNEL_API = ELPA2_COMPLEX_KERNEL_GENERIC;
THIS_COMPLEX_ELPA_KERNEL_API = ELPA_2STAGE_COMPLEX_GENERIC;
#ifdef DOUBLE_PRECISION_COMPLEX
success = elpa_solve_evp_complex_2stage_double_precision(na, nev, a, na_rows, ev, z, na_rows, nblk, na_cols, mpi_comm_rows, mpi_comm_cols, my_mpi_comm_world, THIS_COMPLEX_ELPA_KERNEL_API, useGPU, bandwidth);
#else
......
......@@ -219,7 +219,7 @@ int main(int argc, char** argv) {
useGPU =0 ;
useQr = 0;
bandwidth = -1;
THIS_REAL_ELPA_KERNEL_API = ELPA2_REAL_KERNEL_GENERIC;
THIS_REAL_ELPA_KERNEL_API = ELPA_2STAGE_REAL_GENERIC;
#ifdef DOUBLE_PRECISION_REAL
success = elpa_solve_evp_real_2stage_double_precision(na, nev, a, na_rows, ev, z, na_rows, nblk, na_cols, mpi_comm_rows, mpi_comm_cols, my_mpi_comm_world, THIS_REAL_ELPA_KERNEL_API, useQr, useGPU, bandwidth);
#else
......
......@@ -206,7 +206,7 @@ int main(int argc, char** argv) {
mpierr = MPI_Barrier(MPI_COMM_WORLD);
#endif
useGPU = 0;
THIS_COMPLEX_ELPA_KERNEL_API = ELPA2_COMPLEX_KERNEL_GENERIC;
THIS_COMPLEX_ELPA_KERNEL_API = ELPA_2STAGE_COMPLEX_GENERIC;
success = elpa_solve_evp_complex_double(na, nev, a, na_rows, ev, z, na_rows, nblk, na_cols, mpi_comm_rows, mpi_comm_cols, my_mpi_comm_world, THIS_COMPLEX_ELPA_KERNEL_API, useGPU, "1stage");
if (success != 1) {
......@@ -236,7 +236,7 @@ int main(int argc, char** argv) {
mpierr = MPI_Barrier(MPI_COMM_WORLD);
#endif
useGPU =0;
THIS_COMPLEX_ELPA_KERNEL_API = ELPA2_COMPLEX_KERNEL_GENERIC;
THIS_COMPLEX_ELPA_KERNEL_API = ELPA_2STAGE_COMPLEX_GENERIC;
success = elpa_solve_evp_complex_double(na, nev, a, na_rows, ev, z, na_rows, nblk, na_cols, mpi_comm_rows, mpi_comm_cols, my_mpi_comm_world, THIS_COMPLEX_ELPA_KERNEL_API, useGPU, "2stage");
if (success != 1) {
......@@ -265,7 +265,7 @@ int main(int argc, char** argv) {
mpierr = MPI_Barrier(MPI_COMM_WORLD);
#endif
useGPU = 0;
THIS_COMPLEX_ELPA_KERNEL_API = ELPA2_COMPLEX_KERNEL_GENERIC;
THIS_COMPLEX_ELPA_KERNEL_API = ELPA_2STAGE_COMPLEX_GENERIC;
success = elpa_solve_evp_complex_double(na, nev, a, na_rows, ev, z, na_rows, nblk, na_cols, mpi_comm_rows, mpi_comm_cols, my_mpi_comm_world, THIS_COMPLEX_ELPA_KERNEL_API, useGPU, "auto");
if (success != 1) {
......
......@@ -229,7 +229,7 @@ int main(int argc, char** argv) {
#endif
useQr = 0;
useGPU =0;
THIS_REAL_ELPA_KERNEL_API = ELPA2_REAL_KERNEL_GENERIC;
THIS_REAL_ELPA_KERNEL_API = ELPA_2STAGE_REAL_GENERIC;
success = elpa_solve_evp_real_double(na, nev, a, na_rows, ev, z, na_rows, nblk, na_cols, mpi_comm_rows, mpi_comm_cols, my_mpi_comm_world, THIS_REAL_ELPA_KERNEL_API, useQr, useGPU, "2stage");
......@@ -260,7 +260,7 @@ int main(int argc, char** argv) {
#endif
useQr = 0;
useGPU = 0;
THIS_REAL_ELPA_KERNEL_API = ELPA2_REAL_KERNEL_GENERIC;
THIS_REAL_ELPA_KERNEL_API = ELPA_2STAGE_REAL_GENERIC;
success = elpa_solve_evp_real_double(na, nev, a, na_rows, ev, z, na_rows, nblk, na_cols, mpi_comm_rows, mpi_comm_cols, my_mpi_comm_world, THIS_REAL_ELPA_KERNEL_API, useQr, useGPU, "auto");
......
......@@ -63,12 +63,12 @@ module assert
end module
program test_interface
use precision
use assert
use mod_setup_mpi
use elpa_mpi
use elpa_type
use assert
use mod_blacs_infrastructure
implicit none
......@@ -82,6 +82,9 @@ program test_interface
integer :: my_prow, my_pcol ! local MPI task position (my_prow, my_pcol) in the grid (0..np_cols -1, 0..np_rows -1)
integer :: mpierr
! blacs
integer :: my_blacs_ctxt, sc_desc(9), info
! The Matrix
real(kind=C_DOUBLE), allocatable :: a(:,:)
! eigenvectors
......@@ -89,9 +92,9 @@ program test_interface
! eigenvalues
real(kind=C_DOUBLE), allocatable :: ev(:)
logical :: success
integer :: success
character(len=8) :: solver
integer :: solver
integer(kind=C_INT) :: qr
......@@ -119,6 +122,9 @@ program test_interface
my_prow = mod(myid, np_cols)
my_pcol = myid / np_cols
call set_up_blacs_descriptor(na, nblk, my_prow, my_pcol, np_rows, np_cols, &
na_rows, na_cols, sc_desc, my_blacs_ctxt, info)
allocate(a (na_rows,na_cols))
allocate(z (na_rows,na_cols))
allocate(ev(na))
......@@ -127,33 +133,34 @@ program test_interface
z(:,:) = 0.0
ev(:) = 0.0
call elpa_init()
if (elpa_init(20170403) /= ELPA_OK) then
error stop "ELPA API version not supported"
endif
e = elpa_create(na, nev, na_rows, na_cols, nblk, mpi_comm_world, my_prow, my_pcol, success)
assert(success == ELPA_OK)
qr = e%get("qr", success)
print *, "qr =", qr
assert(success == ELPA_OK)
solver = e%get("solver", success)
print *, "solver =", solver
assert(success == ELPA_OK)
success = elpa_create(e, na, nev, na_rows, na_cols, nblk, mpi_comm_world, my_prow, my_pcol)
assert(success)
call e%set("solver", ELPA_SOLVER_2STAGE, success)
assert(success == ELPA_OK)
success = e%get("QR", qr)
assert(success)
print *,"At the moment QR is set to: ", qr
call e%set("real_kernel", ELPA_2STAGE_REAL_GENERIC, success)
assert(success == ELPA_OK)
success = e%get("solver", solver)
assert(success)
print *,"At the moment solver is set to: ", trim(solver)
call e%set("complex_kernel", ELPA_2STAGE_COMPLEX_GENERIC, success)
assert(success == ELPA_OK)
! set some options
success = e%set("solver","2stage")
assert(success)
success = e%set("real_kernel",1)
assert(success)
success = e%set("timings","balanced")
assert(success)
success = e%set("use_qr",0)
assert(success)
success = e%set("use_gpu",0)
assert(success)
call e%solve(a, ev, z, success)
assert(success == ELPA_OK)
success = e%solve(a, ev, z)
assert(success)
call e%destroy()
call elpa_uninit()
......@@ -161,6 +168,8 @@ program test_interface
deallocate(z)
deallocate(ev)
#ifdef WITH_MPI
call mpi_finalize(mpierr)
#endif
end program
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