Commit ac061bca authored by Lorenz Huedepohl's avatar Lorenz Huedepohl

Adapt legacy interface to new API

The legacy API is has been (internally) ported to use the new interface.
The intent is that users of the legacy API do not have to change their
codes.

Next step is to completely adapt the .gitlab-ci.yml file
parent 8ed932f5
This source diff could not be displayed because it is too large. You can view the blob instead.
This diff is collapsed.
......@@ -547,8 +547,8 @@ dnl Deal with --with-fixed-[real|complex]-kernel arguments
m4_foreach_w([elpa_m4_kind],[real complex],[
AC_ARG_WITH([fixed-]elpa_m4_kind[-kernel], m4_expand([AS_HELP_STRING([--with-fixed-]elpa_m4_kind[-kernel]=KERNEL,
[compile with only a single specific ]elpa_m4_kind[ kernel. Available kernels are:]
m4_expand(elpa_m4_[]elpa_m4_kind[]_kernels))]),
[fixed_]elpa_m4_kind[_kernel="$withval"],[fixed_]elpa_m4_kind[_kernel=""])
m4_foreach_w([elpa_m4_kernel],m4_expand(elpa_m4_[]elpa_m4_kind[]_kernels),[m4_bpatsubst(elpa_m4_kernel,elpa_m4_kind[]_,[]) ]))]),
[fixed_]elpa_m4_kind[_kernel="]elpa_m4_kind[_$withval"],[fixed_]elpa_m4_kind[_kernel=""])
if test -n "$fixed_[]elpa_m4_kind[]_kernel" ; then
m4_foreach_w([elpa_m4_otherkernel],m4_expand(elpa_m4_[]elpa_m4_kind[]_kernels),[
if test "$fixed_]elpa_m4_kind[_kernel" = "]elpa_m4_otherkernel[" ; then
......
......@@ -29,9 +29,9 @@ elpa/elpa_generated_fortran_interfaces.h: $(wildcard $(top_srcdir)/src/elpa2/ker
$(call extract_interface,#!f>)
src/fortran_constants.X90: $(top_srcdir)/src/fortran_constants.h
$(CPP) $(CPPFLAGS) -I$(top_builddir)/ -I$(top_srcdir)/ -I. $< -o $@_ || { rm -f $@; exit 1; }
awk '/!ELPA_C_DEFINE/ {gsub(/!ELPA_C_DEFINE/, "\n"); gsub(/NEWLINE/, "\n"); print;}' < $@_ > $@ || { rm -f $@; exit 1; }
rm $@_
@$(CPP) $(CPPFLAGS) -I$(top_builddir)/ -I$(top_srcdir)/ -I. $< -o $@_ || { rm -f $@; exit 1; }
@awk '/!ELPA_C_DEFINE/ {gsub(/!ELPA_C_DEFINE/, "\n"); gsub(/NEWLINE/, "\n"); print;}' < $@_ > $@ || { rm -f $@; exit 1; }
@rm $@_
generated_headers= config-f90.h elpa/elpa_generated.h test/shared/generated.h elpa/elpa_generated_fortran_interfaces.h src/fortran_constants.X90
......
......@@ -286,11 +286,10 @@ module ELPA1_AUXILIARY
#include "../../general/precision_macros.h"
function elpa_cholesky_real_double(na, a, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, &
wantDebug) result(success)
function elpa_cholesky_real_double(na, a, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, &
wantDebug) result(success)
#include "./elpa_cholesky_template_legacy.X90"
end function elpa_cholesky_real_double
end function
#ifdef WANT_SINGLE_PRECISION_REAL
#define REALCASE 1
......@@ -314,11 +313,10 @@ module ELPA1_AUXILIARY
!> \param wantDebug logical, more debug information on failure
!> \param succes logical, reports success or failure
function elpa_cholesky_real_single(na, a, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, &
function elpa_cholesky_real_single(na, a, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, &
wantDebug) result(success)
#include "./elpa_cholesky_template_legacy.X90"
end function elpa_cholesky_real_single
end function
#endif /* WANT_SINGLE_PRECSION_REAL */
......@@ -339,9 +337,9 @@ module ELPA1_AUXILIARY
!> \param mpi_comm_cols MPI communicator for columns
!> \param wantDebug logical, more debug information on failure
!> \result succes logical, reports success or failure
function elpa_invert_trm_real_double(na, a, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug) result(success)
function elpa_invert_trm_real_double(na, a, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug) result(success)
#include "./elpa_invert_trm_legacy.X90"
end function elpa_invert_trm_real_double
end function
#if WANT_SINGLE_PRECISION_REAL
#define REALCASE 1
......@@ -364,7 +362,7 @@ module ELPA1_AUXILIARY
!> \result succes logical, reports success or failure
function elpa_invert_trm_real_single(na, a, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug) result(success)
#include "./elpa_invert_trm_legacy.X90"
end function elpa_invert_trm_real_single
end function
#endif /* WANT_SINGLE_PRECISION_REAL */
......@@ -389,10 +387,8 @@ module ELPA1_AUXILIARY
!> \param wantDebug logical, more debug information on failure
!> \result succes logical, reports success or failure
function elpa_cholesky_complex_double(na, a, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug) result(success)
#include "./elpa_cholesky_template_legacy.X90"
end function elpa_cholesky_complex_double
end function
#ifdef WANT_SINGLE_PRECISION_COMPLEX
......@@ -416,10 +412,8 @@ module ELPA1_AUXILIARY
!> \param wantDebug logical, more debug information on failure
!> \result succes logical, reports success or failure
function elpa_cholesky_complex_single(na, a, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug) result(success)
#include "./elpa_cholesky_template_legacy.X90"
end function elpa_cholesky_complex_single
end function
#endif /* WANT_SINGLE_PRECISION_COMPLEX */
......@@ -442,9 +436,9 @@ module ELPA1_AUXILIARY
!> \param wantDebug logical, more debug information on failure
!> \result succes logical, reports success or failure
function elpa_invert_trm_complex_double(na, a, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug) result(success)
function elpa_invert_trm_complex_double(na, a, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug) result(success)
#include "./elpa_invert_trm_legacy.X90"
end function elpa_invert_trm_complex_double
end function
#ifdef WANT_SINGLE_PRECISION_COMPLEX
#define COMPLEXCASE 1
......@@ -468,7 +462,7 @@ module ELPA1_AUXILIARY
function elpa_invert_trm_complex_single(na, a, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug) result(success)
#include "./elpa_invert_trm_legacy.X90"
end function elpa_invert_trm_complex_single
end function
#endif /* WANT_SINGE_PRECISION_COMPLEX */
......
......@@ -68,7 +68,7 @@ function elpa_solve_evp_&
#endif
use iso_c_binding
use elpa_mpi
use elpa_type
use elpa
implicit none
integer(kind=c_int), intent(in) :: na, nev, lda, ldq, nblk, matrixCols, mpi_comm_rows, &
......@@ -103,7 +103,7 @@ function elpa_solve_evp_&
integer(kind=c_int) :: successInternal
type(elpa_t) :: e
class(elpa_t), pointer :: e
call timer%start("elpa_solve_evp_&
&MATH_DATATYPE&
&_1stage_&
......@@ -120,7 +120,7 @@ function elpa_solve_evp_&
return
endif
e = elpa_allocate()
e => elpa_allocate()
call e%set("na", na)
call e%set("nev", nev)
......@@ -185,7 +185,7 @@ function elpa_solve_evp_&
time_evp_solve = e%get_double("time_evp_solve")
time_evp_back = e%get_double("time_evp_back")
endif
call e%destroy()
call elpa_deallocate(e)
call elpa_uninit()
......
......@@ -43,17 +43,14 @@
! the original distribution, the GNU Lesser General Public License.
#include "../../general/sanity.X90"
use elpa_type
! use elpa1_compute
! use elpa_utilities
use elpa_mpi
use elpa
#ifdef HAVE_DETAILED_TIMINGS
use timings
use timings
#else
use timings_dummy
use timings_dummy
#endif
use precision
implicit none
use precision
implicit none
integer(kind=ik) :: na, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols
#if REALCASE == 1
......@@ -70,26 +67,12 @@
complex(kind=COMPLEX_DATATYPE) :: a(lda,matrixCols)
#endif
#endif
! integer(kind=ik) :: my_prow, my_pcol, np_rows, np_cols, mpierr
integer(kind=ik) :: nev
! integer(kind=ik) :: l_cols, l_rows, l_col1, l_row1, l_colx, l_rowx
! integer(kind=ik) :: n, nc, i, info
! integer(kind=ik) :: lcs, lce, lrs, lre
! integer(kind=ik) :: tile_size, l_rows_tile, l_cols_tile
!#if REALCASE == 1
! real(kind=REAL_DATATYPE), allocatable :: tmp1(:), tmp2(:,:), tmatr(:,:), tmatc(:,:)
!#endif
!#if COMPLEXCASE == 1
! complex(kind=COMPLEX_DATATYPE), allocatable :: tmp1(:), tmp2(:,:), tmatr(:,:), tmatc(:,:)
!#endif
integer(kind=ik) :: nev
logical, intent(in) :: wantDebug
logical :: success
integer(kind=ik) :: successInternal
! integer(kind=ik) :: istat
! character(200) :: errorMessage
type(elpa_t) :: e
class(elpa_t), pointer :: e
call timer%start("elpa_cholesky_&
&MATH_DATATYPE&
......@@ -105,7 +88,7 @@
return
endif
e = elpa_allocate()
e => elpa_allocate()
call e%set("na", na)
call e%set("nev", nev)
......@@ -131,7 +114,7 @@
else
success =.true.
endif
call e%destroy()
call elpa_deallocate(e)
call elpa_uninit()
......
......@@ -53,7 +53,7 @@
#include "../../general/sanity.X90"
use precision
use elpa_type
use elpa
! use elpa1_compute
! use elpa_utilities
use elpa_mpi
......@@ -96,7 +96,7 @@
! character(200) :: errorMessage
integer(kind=iK) :: successInternal
type(elpa_t) :: e
class(elpa_t), pointer :: e
call timer%start("elpa_invert_trm_&
&MATH_DATATYPE&
......@@ -112,7 +112,7 @@
return
endif
e = elpa_allocate()
e => elpa_allocate()
call e%set("na", na)
call e%set("local_nrows", lda)
......@@ -137,7 +137,7 @@
else
success =.true.
endif
call e%destroy()
call elpa_deallocate(e)
call elpa_uninit()
......
......@@ -54,7 +54,7 @@
#include "../../general/sanity.X90"
use elpa_type
use elpa
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
......@@ -101,7 +101,7 @@
! character(200) :: errorMessage
logical :: success
integer(kind=ik) :: successInternal
type(elpa_t) :: e
class(elpa_t), pointer :: e
call timer%start("elpa_mult_at_b_&
&MATH_DATATYPE&
......@@ -125,7 +125,7 @@
return
endif
e = elpa_allocate()
e => elpa_allocate()
call e%set("na", na)
call e%set("local_nrows", lda)
......@@ -149,7 +149,7 @@
success = .false.
return
endif
call e%destroy()
call elpa_deallocate(e)
call elpa_uninit()
......
......@@ -75,7 +75,7 @@
logical, intent(in) :: wantDebug
logical :: success
integer(kind=iK) :: successInternal
type(elpa_t) :: elpa
class(elpa_t), pointer :: obj
call timer%start("elpa_solve_tridi_&
&PRECISION&
......@@ -88,24 +88,24 @@
success = .false.
endif
elpa = elpa_allocate()
obj => elpa_allocate()
call elpa%set("na", na)
call elpa%set("nev", nev)
call elpa%set("local_nrows", ldq)
call elpa%set("local_ncols", matrixCols)
call elpa%set("nblk", nblk)
call obj%set("na", na)
call obj%set("nev", nev)
call obj%set("local_nrows", ldq)
call obj%set("local_ncols", matrixCols)
call obj%set("nblk", nblk)
call elpa%set("mpi_comm_rows", mpi_comm_rows)
call elpa%set("mpi_comm_cols", mpi_comm_cols)
call obj%set("mpi_comm_rows", mpi_comm_rows)
call obj%set("mpi_comm_cols", mpi_comm_cols)
if (elpa%setup() .ne. ELPA_OK) then
if (obj%setup() .ne. ELPA_OK) then
print *, "Cannot setup ELPA instance"
success = .false.
return
endif
call elpa%solve_tridi(d(1:na), e(1:na), q(1:ldq,1:matrixCols), successInternal)
call obj%solve_tridi(d(1:na), e(1:na), q(1:ldq,1:matrixCols), successInternal)
if (successInternal .ne. ELPA_OK) then
print *, "Cannot run solve_tridi"
......@@ -115,7 +115,7 @@
else
success =.true.
endif
call elpa%destroy()
call elpa_deallocate(obj)
call elpa_uninit()
......
......@@ -65,8 +65,8 @@
!> Synopsis: print_available_elpa2_kernels
!>
!> \author A. Marek (MPCDF)
program print_available_elpa2_kernels
program print_available_elpa2_kernels
use precision
use elpa
......@@ -74,6 +74,7 @@ program print_available_elpa2_kernels
integer(kind=ik) :: i
class(elpa_t), pointer :: e
integer :: option
if (elpa_init(CURRENT_API_VERSION) /= ELPA_OK) then
print *, "Unsupported ELPA API Version"
......@@ -108,7 +109,7 @@ program print_available_elpa2_kernels
print *, " AVX kernels are optimized for FMA (AVX2)"
#endif
print *
call e%print_options("real_kernel")
call print_options(e, "real_kernel")
print *
print *
......@@ -126,10 +127,25 @@ program print_available_elpa2_kernels
print *, " AVX kernels are optimized for FMA (AVX2)"
#endif
print *
call e%print_options("complex_kernel")
call print_options(e, "complex_kernel")
print *
print *
call elpa_deallocate(e)
contains
subroutine print_options(e, option_name)
class(elpa_t), intent(in) :: e
character(len=*), intent(in) :: option_name
integer :: i, option
do i = 0, elpa_option_cardinality(option_name) - 1
option = elpa_option_enumerate(option_name, i)
if (e%can_set(option_name, option) == ELPA_OK) then
print *, " ", elpa_int_value_to_string(option_name, option)
endif
end do
end subroutine
end program print_available_elpa2_kernels
......@@ -69,7 +69,7 @@
use timings_dummy
#endif
use iso_c_binding
use elpa_type
use elpa
use elpa_mpi
implicit none
......@@ -95,7 +95,7 @@
logical :: success
integer(kind=c_int) :: successInternal
type(elpa_t) :: e
class(elpa_t), pointer :: e
call timer%start("solve_evp_&
&MATH_DATATYPE&
......@@ -113,7 +113,7 @@
return
endif
e = elpa_allocate()
e => elpa_allocate()
call e%set("na", na)
call e%set("nev", nev)
......@@ -215,12 +215,12 @@
endif
if (elpa_print_times) then
time_evp_fwd = e%get("time_evp_fwd")
time_evp_solve = e%get("time_evp_solve")
time_evp_back = e%get("time_evp_back")
time_evp_fwd = e%get_double("time_evp_fwd")
time_evp_solve = e%get_double("time_evp_solve")
time_evp_back = e%get_double("time_evp_back")
endif
call e%destroy()
call elpa_deallocate(e)
call elpa_uninit()
......
! This file is part of ELPA.
!
! The ELPA library was originally created by the ELPA consortium,
! consisting of the following organizations:
!
! - Max Planck Computing and Data Facility (MPCDF), formerly known as
! Rechenzentrum Garching der Max-Planck-Gesellschaft (RZG),
! - Bergische Universität Wuppertal, Lehrstuhl für angewandte
! Informatik,
! - Technische Universität München, Lehrstuhl für Informatik mit
! Schwerpunkt Wissenschaftliches Rechnen ,
! - Fritz-Haber-Institut, Berlin, Abt. Theorie,
! - Max-Plack-Institut für Mathematik in den Naturwissenschaften,
! Leipzig, Abt. Komplexe Strukutren in Biologie und Kognition,
! and
! - IBM Deutschland GmbH
!
!
! More information can be found here:
! http://elpa.mpcdf.mpg.de/
!
! ELPA is free software: you can redistribute it and/or modify
! it under the terms of the version 3 of the license of the
! GNU Lesser General Public License as published by the Free
! Software Foundation.
!
! ELPA is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU Lesser General Public License for more details.
!
! You should have received a copy of the GNU Lesser General Public License
! along with ELPA. If not, see <http://www.gnu.org/licenses/>
!
! ELPA reflects a substantial effort on the part of the original
! ELPA consortium, and we ask you to respect the spirit of the
! license that we chose: i.e., please contribute any changes you
! may have back to the original ELPA library distribution, and keep
! any derivatives of ELPA under the same license that we chose for
! the original distribution, the GNU Lesser General Public License.
!
!
! ELPA2 -- 2-stage solver for ELPA
!
! 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".
!
! Author: Andreas Marek, MPCDF
#include "config-f90.h"
module elpa2_utilities_private
use elpa_utilities
use precision
implicit none
contains
function elpa_get_actual_real_kernel() result(actual_kernel)
use elpa_constants
use precision
implicit none
integer(kind=ik) :: actual_kernel
! if kernel is not choosen via api
! check whether set by environment variable
actual_kernel = real_kernel_via_environment_variable()
if (actual_kernel .eq. 0) then
! if not then set default kernel
actual_kernel = ELPA_2STAGE_REAL_DEFAULT
endif
end function elpa_get_actual_real_kernel
function elpa_get_actual_complex_kernel() result(actual_kernel)
use elpa2_constants
use precision
implicit none
integer(kind=ik) :: actual_kernel
! if kernel is not choosen via api
! check whether set by environment variable
actual_kernel = complex_kernel_via_environment_variable()
if (actual_kernel .eq. 0) then
! if not then set default kernel
actual_kernel = ELPA_2STAGE_COMPLEX_DEFAULT
endif
end function elpa_get_actual_complex_kernel
function qr_decomposition_via_environment_variable(useQR) result(isSet)
use elpa2_utilities
use precision
implicit none
logical, intent(out) :: useQR
logical :: isSet
character(len=255) :: ELPA_QR_DECOMPOSITION
isSet = .false.
#if defined(HAVE_ENVIRONMENT_CHECKING)
call get_environment_variable("ELPA_QR_DECOMPOSITION",ELPA_QR_DECOMPOSITION)
#else
stop "Internal error in elpa2_utilities_private_legacy.F90, this should not happen"
#endif
if (trim(ELPA_QR_DECOMPOSITION) .eq. "yes") then
useQR = .true.
isSet = .true.
endif
if (trim(ELPA_QR_DECOMPOSITION) .eq. "no") then
useQR = .false.
isSet = .true.
endif
end function qr_decomposition_via_environment_variable
function real_kernel_via_environment_variable(elpa) result(kernel)
use elpa_constants
use precision
implicit none
type(elpa_t) :: elpa
integer(kind=ik) :: kernel
character(len=255) :: REAL_KERNEL_ENVIRONMENT
integer(kind=ik) :: i
#if defined(HAVE_ENVIRONMENT_CHECKING)
call get_environment_variable("REAL_ELPA_KERNEL",REAL_KERNEL_ENVIRONMENT)
#else
stop "Internal error in elpa2_utilities_private_legacy.F90, this should not happen"
#endif
do i=1,size(REAL_ELPA_KERNEL_NAMES(:))
if (trim(REAL_KERNEL_ENVIRONMENT) .eq. trim(REAL_ELPA_KERNEL_NAMES(i))) then
kernel = i
exit
else
kernel = 0
endif
enddo
end function real_kernel_via_environment_variable
function complex_kernel_via_environment_variable() result(kernel)
use elpa_constants
use precision
implicit none
integer :: kernel
CHARACTER(len=255) :: COMPLEX_KERNEL_ENVIRONMENT
integer(kind=ik) :: i
#if defined(HAVE_ENVIRONMENT_CHECKING)
call get_environment_variable("COMPLEX_ELPA_KERNEL",COMPLEX_KERNEL_ENVIRONMENT)
#else
stop "Internal error in elpa2_utilities_private_legacy.F90, this should not happen"
#endif
do i=1,size(COMPLEX_ELPA_KERNEL_NAMES(:))
if (trim(COMPLEX_ELPA_KERNEL_NAMES(i)) .eq. trim(COMPLEX_KERNEL_ENVIRONMENT)) then
kernel = i
exit
else
kernel = 0
endif
enddo
end function
!-------------------------------------------------------------------------------
end module elpa2_utilities_private
This diff is collapsed.
This diff is collapsed.
......@@ -67,8 +67,8 @@ static int elpa_2stage_complex_kernel_enumerate(int i);
static int elpa_2stage_complex_kernel_is_valid(elpa_index_t index, int n, int new_value);
static const char *elpa_2stage_complex_kernel_name(int kernel);
int elpa_index_double_string_to_value(char *name, char *string, double *value);
int elpa_index_double_value_to_string(char *name, double value, const char **string);
int elpa_double_string_to_value(char *name, char *string, double *value);
int elpa_double_value_to_string(char *name, double value, const char **string);
#define BASE_ENTRY(option_name, option_description, once_value, readonly_value) \
.base = { \
......@@ -81,12 +81,12 @@ int elpa_index_double_value_to_string(char *name, double value, const char **str
}
#define INT_PARAMETER_ENTRY(option_name, option_description) \
(elpa_index_int_entry_t) { \
{ \
BASE_ENTRY(option_name, option_description, 1, 0), \
}
#define BOOL_ENTRY(option_name, option_description, default) \
(elpa_index_int_entry_t) { \
{ \
BASE_ENTRY(option_name, option_description, 0, 0), \
.default_value = default, \
.cardinality = cardinality_bool, \
......@@ -95,7 +95,7 @@ int elpa_index_double_value_to_string(char *name, double value, const char **str
}
#define INT_LIST_ENTRY(option_name, option_description, default, card_func, enumerate_func, valid_func, to_string_func) \
(elpa_index_int_entry_t) { \
{ \
BASE_ENTRY(option_name, option_description, 0, 0), \
.default_value = default, \
.cardinality = card_func, \
......@@ -105,7 +105,7 @@ int elpa_index_double_value_to_string(char *name, double value, const char **str
}
#define INT_ANY_ENTRY(option_name, option_description) \
(elpa_index_int_entry_t) { \
{ \
BASE_ENTRY(option_name, option_description, 0, 0), \
}
......@@ -135,7 +135,7 @@ static const elpa_index_int_entry_t int_entries[] = {
};
#define READONLY_DOUBLE_ENTRY(option_name, option_description) \
(elpa_index_double_entry_t) { \
{ \
BASE_ENTRY(option_name, option_description, 0, 1) \
}
......@@ -191,13 +191,13 @@ FOR_ALL_TYPES(IMPLEMENT_FIND_ENTRY)
int err; \
char *env_value = getenv(env_variable); \
if (env_value) { \
err = elpa_index_##TYPE##_string_to_value(TYPE##_entries[n].base.name, env_value, value); \
err = elpa_##TYPE##_string_to_value(TYPE##_entries[n].base.name, env_value, value); \