Skip to content

GitLab

Commit bb404e4a authored by Andreas Marek's avatar Andreas Marek
Browse files

Template for ELPA 2stage C-interface

parent 74b2a795
Hide whitespace changes
Inline Side-by-side
Showing with 154 additions and 318 deletions
Makefile.am
View file @ bb404e4a
......@@ -54,6 +54,7 @@ EXTRA_libelpa@SUFFIX@_private_la_DEPENDENCIES = \
src/elpa1_template.X90 \
src/elpa2_template.X90 \
src/elpa1_c_interface_template.X90 \
src/elpa2_c_interface_template.X90 \
src/elpa2_bandred_template.X90 \
src/elpa2_symm_matrix_allreduce_real_template.X90 \
src/elpa2_trans_ev_band_to_full_template.X90 \
......@@ -975,6 +976,7 @@ EXTRA_DIST = \
src/elpa1_template.X90 \
src/elpa2_template.X90 \
src/elpa1_c_interface_template.X90 \
src/elpa2_c_interface_template.X90 \
src/elpa2_tridiag_band_template.X90 \
src/elpa2_trans_ev_band_to_full_template.X90 \
src/elpa2_trans_ev_tridi_to_band_template.X90 \
......
src/elpa2_c_interface_template.X90 0 → 100644
View file @ bb404e4a
function solve_elpa2_evp_&
&MATH_DATATYPE&
&_wrapper_&
&PRECISION&
& (na, nev, a, lda, ev, q, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, mpi_comm_all, &
#if REALCASE == 1
THIS_REAL_ELPA_KERNEL_API, useQR, &
#endif
#if COMPLEXCASE == 1
THIS_COMPLEX_ELPA_KERNEL_API, &
#endif
useGPU) result(success) bind(C,name="elpa_solve_evp_&
&MATH_DATATYPE&
&_2stage_&
&PRECISION&
&_precision")
use, intrinsic :: iso_c_binding
use elpa2
implicit none
integer(kind=c_int) :: success
integer(kind=c_int), value, intent(in) :: na, nev, lda, ldq, nblk, matrixCols, mpi_comm_cols, mpi_comm_rows, &
mpi_comm_all
integer(kind=c_int), value, intent(in) :: useGPU
#if REALCASE == 1
integer(kind=c_int), value, intent(in) :: THIS_REAL_ELPA_KERNEL_API, useQR
#endif
#if COMPLEXCASE == 1
integer(kind=c_int), value, intent(in) :: THIS_COMPLEX_ELPA_KERNEL_API
#endif
real(kind=C_DATATYPE_KIND) :: ev(1:na)
#if REALCASE == 1
#ifdef USE_ASSUMED_SIZE
real(kind=C_DATATYPE_KIND) :: a(lda,*), q(ldq,*)
#else
real(kind=C_DATATYPE_KIND) :: a(1:lda,1:matrixCols), q(1:ldq,1:matrixCols)
#endif
#endif /* REALCASE */
#if COMPLEXCASE == 1
#ifdef USE_ASSUMED_SIZE
complex(kind=C_DATATYPE_KIND) :: a(lda,*), q(ldq,*)
#else
complex(kind=C_DATATYPE_KIND) :: a(1:lda,1:matrixCols), q(1:ldq,1:matrixCols)
#endif
#endif /* COMPLEXCASE */
logical :: successFortran, useQRFortran
#if REALCASE == 1
if (useQR .eq. 0) then
useQRFortran =.false.
else
useQRFortran = .true.
endif
#endif
successFortran = elpa_solve_evp_&
&MATH_DATATYPE&
&_2stage_&
&PRECISION&
& (na, nev, a, lda, ev, q, ldq, nblk, matrixCols, mpi_comm_rows, &
mpi_comm_cols, mpi_comm_all, &
#if REALCASE == 1
THIS_REAL_ELPA_KERNEL_API, useQRFortran, &
#endif
#if COMPLEXCASE == 1
THIS_COMPLEX_ELPA_KERNEL_API, &
#endif
useGPU == 1)
if (successFortran) then
success = 1
else
success = 0
endif
end function
src/elpa2_utilities.F90
View file @ bb404e4a
......@@ -668,19 +668,17 @@ module ELPA2_utilities
function elpa_number_of_real_kernels() result(number)
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
implicit none
integer :: number
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("elpa_number_of_real_kernels")
#endif
number = number_of_real_kernels
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("elpa_number_of_real_kernels")
#endif
return
end function
......@@ -688,19 +686,17 @@ module ELPA2_utilities
function elpa_number_of_complex_kernels() result(number)
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
implicit none
integer :: number
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("elpa_number_of_complex_kernels")
#endif
number = number_of_complex_kernels
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("elpa_number_of_complex_kernels")
#endif
return
end function
......@@ -708,23 +704,21 @@ module ELPA2_utilities
function elpa_real_kernel_is_available(THIS_ELPA_REAL_KERNEL) result(available)
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
implicit none
integer, intent(in) :: THIS_ELPA_REAL_KERNEL
logical :: available
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("elpa_real_kernel_is_available")
#endif
available = .false.
if (AVAILABLE_REAL_ELPA_KERNELS(THIS_ELPA_REAL_KERNEL) .eq. 1) then
available = .true.
endif
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("elpa_real_kernel_is_available")
#endif
return
end function
......@@ -732,23 +726,21 @@ module ELPA2_utilities
function elpa_complex_kernel_is_available(THIS_ELPA_COMPLEX_KERNEL) result(available)
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
implicit none
integer, intent(in) :: THIS_ELPA_COMPLEX_KERNEL
logical :: available
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("elpa_real_kernel_is_available")
#endif
available = .false.
if (AVAILABLE_COMPLEX_ELPA_KERNELS(THIS_ELPA_COMPLEX_KERNEL) .eq. 1) then
available = .true.
endif
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("elpa_real_kernel_is_available")
#endif
return
end function
......@@ -756,22 +748,20 @@ module ELPA2_utilities
function elpa_real_kernel_name(THIS_ELPA_REAL_KERNEL) result(name)
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
implicit none
integer, intent(in) :: THIS_ELPA_REAL_KERNEL
character(35) :: name
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("elpa_real_kernel_name")
#endif
if (AVAILABLE_REAL_ELPA_KERNELS(THIS_ELPA_REAL_KERNEL) .eq. 1) then
name = trim(REAL_ELPA_KERNEL_NAMES(THIS_ELPA_REAL_KERNEL))
endif
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("elpa_real_kernel_name")
#endif
return
end function
......@@ -779,22 +769,20 @@ module ELPA2_utilities
function elpa_complex_kernel_name(THIS_ELPA_COMPLEX_KERNEL) result(name)
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
implicit none
integer, intent(in) :: THIS_ELPA_COMPLEX_KERNEL
character(35) :: name
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("elpa_complex_kernel_name")
#endif
if (AVAILABLE_COMPLEX_ELPA_KERNELS(THIS_ELPA_COMPLEX_KERNEL) .eq. 1) then
name = trim(COMPLEX_ELPA_KERNEL_NAMES(THIS_ELPA_COMPLEX_KERNEL))
endif
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("elpa_complex_kernel_name")
#endif
return
end function
......@@ -802,15 +790,15 @@ module ELPA2_utilities
subroutine print_available_real_kernels
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
use precision
implicit none
integer(kind=ik) :: i
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("print_available_real_kernels")
#endif
do i=1, number_of_real_kernels
if (AVAILABLE_REAL_ELPA_KERNELS(i) .eq. 1) then
......@@ -821,23 +809,21 @@ module ELPA2_utilities
write(*,*) " At the moment the following kernel would be choosen:"
write(*,*) elpa_get_actual_real_kernel_name()
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("print_available_real_kernels")
#endif
end subroutine print_available_real_kernels
subroutine query_available_real_kernels
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
implicit none
integer :: i
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("query_available_real_kernels")
#endif
do i=1, number_of_real_kernels
if (AVAILABLE_REAL_ELPA_KERNELS(i) .eq. 1) then
......@@ -848,23 +834,21 @@ module ELPA2_utilities
write(error_unit,*) " At the moment the following kernel would be choosen:"
write(error_unit,*) elpa_get_actual_real_kernel_name()
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("query_available_real_kernels")
#endif
end subroutine query_available_real_kernels
subroutine print_available_complex_kernels
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
use precision
implicit none
integer(kind=ik) :: i
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("print_available_complex_kernels")
#endif
do i=1, number_of_complex_kernels
if (AVAILABLE_COMPLEX_ELPA_KERNELS(i) .eq. 1) then
......@@ -875,23 +859,21 @@ module ELPA2_utilities
write(*,*) " At the moment the following kernel would be choosen:"
write(*,*) elpa_get_actual_complex_kernel_name()
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("print_available_complex_kernels")
#endif
end subroutine print_available_complex_kernels
subroutine query_available_complex_kernels
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
implicit none
integer :: i
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("query_available_complex_kernels")
#endif
do i=1, number_of_complex_kernels
if (AVAILABLE_COMPLEX_ELPA_KERNELS(i) .eq. 1) then
......@@ -902,25 +884,22 @@ module ELPA2_utilities
write(error_unit,*) " At the moment the following kernel would be choosen:"
write(error_unit,*) elpa_get_actual_complex_kernel_name()
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("query_available_complex_kernels")
#endif
end subroutine query_available_complex_kernels
function elpa_get_actual_real_kernel() result(actual_kernel)
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
use precision
implicit none
integer(kind=ik) :: actual_kernel
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("elpa_get_actual_real_kernel")
#endif
! if kernel is not choosen via api
! check whether set by environment variable
......@@ -941,15 +920,15 @@ module ELPA2_utilities
! endif
!#endif
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("elpa_get_actual_real_kernel")
#endif
end function elpa_get_actual_real_kernel
function elpa_get_actual_real_kernel_name() result(actual_kernel_name)
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
use precision
implicit none
......@@ -957,30 +936,26 @@ module ELPA2_utilities
character(35) :: actual_kernel_name
integer(kind=ik) :: actual_kernel
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("elpa_get_actual_real_kernel_name")
#endif
actual_kernel = elpa_get_actual_real_kernel()
actual_kernel_name = REAL_ELPA_KERNEL_NAMES(actual_kernel)
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("elpa_get_actual_real_kernel_name")
#endif
end function elpa_get_actual_real_kernel_name
function elpa_get_actual_complex_kernel() result(actual_kernel)
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
use precision
implicit none
integer(kind=ik) :: actual_kernel
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("elpa_get_actual_complex_kernel")
#endif
! if kernel is not choosen via api
......@@ -1003,80 +978,74 @@ module ELPA2_utilities
!#endif
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("elpa_get_actual_complex_kernel")
#endif
end function elpa_get_actual_complex_kernel
function elpa_get_actual_complex_kernel_name() result(actual_kernel_name)
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
use precision
implicit none
character(35) :: actual_kernel_name
integer(kind=ik) :: actual_kernel
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("elpa_get_actual_complex_kernel_name")
#endif
actual_kernel = elpa_get_actual_complex_kernel()
actual_kernel_name = COMPLEX_ELPA_KERNEL_NAMES(actual_kernel)
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("elpa_get_actual_complex_kernel_name")
#endif
end function elpa_get_actual_complex_kernel_name
function check_allowed_real_kernels(THIS_REAL_ELPA_KERNEL) result(err)
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
use precision
implicit none
integer(kind=ik), intent(in) :: THIS_REAL_ELPA_KERNEL
logical :: err
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("check_allowed_real_kernels")
#endif
err = .false.
if (AVAILABLE_REAL_ELPA_KERNELS(THIS_REAL_ELPA_KERNEL) .ne. 1) err=.true.
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("check_allowed_real_kernels")
#endif
end function check_allowed_real_kernels
function check_allowed_complex_kernels(THIS_COMPLEX_ELPA_KERNEL) result(err)
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
use precision
implicit none
integer(kind=ik), intent(in) :: THIS_COMPLEX_ELPA_KERNEL
logical :: err
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("check_allowed_complex_kernels")
#endif
err = .false.
if (AVAILABLE_COMPLEX_ELPA_KERNELS(THIS_COMPLEX_ELPA_KERNEL) .ne. 1) err=.true.
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("check_allowed_complex_kernels")
#endif
end function check_allowed_complex_kernels
function qr_decomposition_via_environment_variable(useQR) result(isSet)
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
use precision
implicit none
......@@ -1084,9 +1053,7 @@ module ELPA2_utilities
logical :: isSet
CHARACTER(len=255) :: ELPA_QR_DECOMPOSITION
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("qr_decomposition_via_environment_variable")
#endif
isSet = .false.
......@@ -1102,15 +1069,15 @@ module ELPA2_utilities
isSet = .true.
endif
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("qr_decomposition_via_environment_variable")
#endif
end function qr_decomposition_via_environment_variable
function real_kernel_via_environment_variable() result(kernel)
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
use precision
implicit none
......@@ -1118,9 +1085,7 @@ module ELPA2_utilities
CHARACTER(len=255) :: REAL_KERNEL_ENVIRONMENT
integer(kind=ik) :: i
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("real_kernel_via_environment_variable")
#endif
#if defined(HAVE_ENVIRONMENT_CHECKING)
call get_environment_variable("REAL_ELPA_KERNEL",REAL_KERNEL_ENVIRONMENT)
......@@ -1135,15 +1100,15 @@ module ELPA2_utilities
endif
enddo
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("real_kernel_via_environment_variable")
#endif
end function real_kernel_via_environment_variable
function complex_kernel_via_environment_variable() result(kernel)
#ifdef HAVE_DETAILED_TIMINGS
use timings
#else
use timings_dummy
#endif
use precision
implicit none
......@@ -1152,9 +1117,7 @@ module ELPA2_utilities
CHARACTER(len=255) :: COMPLEX_KERNEL_ENVIRONMENT
integer(kind=ik) :: i
#ifdef HAVE_DETAILED_TIMINGS
call timer%start("complex_kernel_via_environment_variable")
#endif
#if defined(HAVE_ENVIRONMENT_CHECKING)
call get_environment_variable("COMPLEX_ELPA_KERNEL",COMPLEX_KERNEL_ENVIRONMENT)
......@@ -1169,9 +1132,7 @@ module ELPA2_utilities
endif
enddo
#ifdef HAVE_DETAILED_TIMINGS
call timer%stop("complex_kernel_via_environment_variable")
#endif
end function
!-------------------------------------------------------------------------------
......
src/elpa_c_interface.F90
View file @ bb404e4a
......@@ -307,79 +307,19 @@
!c> *
!c> * \result int: 1 if error occured, otherwise 0
!c> */
#undef DOUBLE_PRECISION_REAL
#define DOUBLE_PRECISION_REAL 1
#ifdef DOUBLE_PRECISION_REAL
#define REALCASE 1
#define DOUBLE_PRECISION 1
#if DOUBLE_PRECISION == 1
!c> int elpa_solve_evp_real_2stage_double_precision(int na, int nev, double *a, int lda, double *ev, double *q, int ldq, int nblk, int matrixCols, int mpi_comm_rows, int mpi_comm_cols, int mpi_comm_all, int THIS_REAL_ELPA_KERNEL_API, int useQR, int useGPU);
#else
!c> int elpa_solve_evp_real_2stage_single_precision(int na, int nev, float *a, int lda, float *ev, float *q, int ldq, int nblk, int matrixCols, int mpi_comm_rows, int mpi_comm_cols, int mpi_comm_all, int THIS_REAL_ELPA_KERNEL_API, int useQR, int useGPU);
#endif
#ifdef DOUBLE_PRECISION_REAL
function solve_elpa2_evp_real_wrapper_double(na, nev, a, lda, ev, q, ldq, nblk, &
matrixCols, mpi_comm_rows, mpi_comm_cols, mpi_comm_all, &
THIS_REAL_ELPA_KERNEL_API, useQR, useGPU) &
result(success) bind(C,name="elpa_solve_evp_real_2stage_double_precision")
#else
function solve_elpa2_evp_real_wrapper_single(na, nev, a, lda, ev, q, ldq, nblk, &
matrixCols, mpi_comm_rows, mpi_comm_cols, mpi_comm_all, &
THIS_REAL_ELPA_KERNEL_API, useQR, useGPU) &
result(success) bind(C,name="elpa_solve_evp_real_2stage_double_precision")
result(success) bind(C,name="elpa_solve_evp_real_2stage_single_precision")
#endif
use, intrinsic :: iso_c_binding
use elpa2
implicit none
integer(kind=c_int) :: success
integer(kind=c_int), value, intent(in) :: na, nev, lda, ldq, nblk, matrixCols, mpi_comm_cols, mpi_comm_rows, &
mpi_comm_all
integer(kind=c_int), value, intent(in) :: THIS_REAL_ELPA_KERNEL_API, useQR, useGPU
#ifdef DOUBLE_PRECISION_REAL
real(kind=c_double) :: ev(1:na)
#ifdef USE_ASSUMED_SIZE
real(kind=c_double) :: a(lda,*), q(ldq,*)
#else
real(kind=c_double) :: a(1:lda,1:matrixCols), q(1:ldq,1:matrixCols)
#endif
#else /* SINGLE_PRECISION */
real(kind=c_float) :: ev(1:na)
#ifdef USE_ASSUMED_SIZE
real(kind=c_float) :: a(1:lda,*), q(1:ldq,*)
#else
real(kind=c_float) :: a(1:lda,1:matrixCols), q(1:ldq,1:matrixCols)
#endif
#endif
logical :: successFortran, useQRFortran
if (useQR .eq. 0) then
useQRFortran =.false.
else
useQRFortran = .true.
endif