From 6ce953addbc0e265cef013e4fc6dc3006a3614d8 Mon Sep 17 00:00:00 2001 From: Andreas Marek Date: Mon, 3 Apr 2017 07:40:30 +0200 Subject: [PATCH] Template for solve_tridi C-interface --- Makefile.am | 2 + src/elpa_c_interface.F90 | 75 +++---------------- src/elpa_solve_tridi_c_interface_template.X90 | 41 ++++++++++ 3 files changed, 55 insertions(+), 63 deletions(-) create mode 100644 src/elpa_solve_tridi_c_interface_template.X90 diff --git a/Makefile.am b/Makefile.am index 6a6a5837..6619ffde 100644 --- a/Makefile.am +++ b/Makefile.am @@ -56,6 +56,7 @@ EXTRA_libelpa@SUFFIX@_private_la_DEPENDENCIES = \ src/elpa1_c_interface_template.X90 \ src/elpa2_c_interface_template.X90 \ src/elpa_driver_c_interface_template.X90 \ + src/elpa_solve_tridi_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 \ @@ -979,6 +980,7 @@ EXTRA_DIST = \ src/elpa1_c_interface_template.X90 \ src/elpa2_c_interface_template.X90 \ src/elpa_driver_c_interface_template.X90 \ + src/elpa_solve_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 \ diff --git a/src/elpa_c_interface.F90 b/src/elpa_c_interface.F90 index 669337f1..04613d81 100644 --- a/src/elpa_c_interface.F90 +++ b/src/elpa_c_interface.F90 @@ -647,40 +647,12 @@ !c> *\result success int 1 on success, else 0 !c> */ !c> int elpa_solve_tridi_double(int na, int nev, double *d, double *e, double *q, int ldq, int nblk, int matrixCols, int mpi_comm_rows, int mpi_comm_cols, int wantDebug); - function elpa_solve_tridi_wrapper_double(na, nev, d, e, q, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug) & - result(success) bind(C,name="elpa_solve_tridi_double") - - use, intrinsic :: iso_c_binding - use elpa1_auxiliary, only : elpa_solve_tridi_double - - implicit none - integer(kind=c_int) :: success - integer(kind=c_int), value, intent(in) :: na, nev, ldq, nblk, matrixCols, mpi_comm_cols, mpi_comm_rows - integer(kind=c_int), value :: wantDebug - real(kind=c_double) :: d(1:na), e(1:na) -#ifdef USE_ASSUMED_SIZE - real(kind=c_double) :: q(ldq,*) -#else - real(kind=c_double) :: q(1:ldq, 1:matrixCols) -#endif - logical :: successFortran, wantDebugFortran - - if (wantDebug .ne. 0) then - wantDebugFortran = .true. - else - wantDebugFortran = .false. - endif - - successFortran = elpa_solve_tridi_double(na, nev, d, e, q, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, & - wantDebugFortran) - - if (successFortran) then - success = 1 - else - success = 0 - endif - - end function +#define REALCASE 1 +#define DOUBLE_PRECISION 1 +#include "precision_macros.h" +#include "elpa_solve_tridi_c_interface_template.X90" +#undef DOUBLE_PRECISION +#undef REALCASE #ifdef WANT_SINGLE_PRECISION_REAL @@ -703,35 +675,12 @@ !c> \result success int 1 on success, else 0 !c> */ !c> int elpa_solve_tridi_single(int na, int nev, float *d, float *e, float *q, int ldq, int nblk, int matrixCols, int mpi_comm_rows, int mpi_comm_cols, int wantDebug); - function elpa_solve_tridi_wrapper_single(na, nev, d, e, q, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug) & - result(success) bind(C,name="elpa_solve_tridi_single") - - use, intrinsic :: iso_c_binding - use elpa1_auxiliary, only : elpa_solve_tridi_single - - implicit none - integer(kind=c_int) :: success - integer(kind=c_int), value, intent(in) :: na, nev, ldq, nblk, matrixCols, mpi_comm_cols, mpi_comm_rows - integer(kind=c_int), value :: wantDebug - real(kind=c_float) :: d(1:na), e(1:na), q(1:ldq, 1:matrixCols) - logical :: successFortran, wantDebugFortran - - if (wantDebug .ne. 0) then - wantDebugFortran = .true. - else - wantDebugFortran = .false. - endif - - successFortran = elpa_solve_tridi_single(na, nev, d, e, q, ldq, nblk, matrixCols, mpi_comm_rows, & - mpi_comm_cols, wantDebugFortran) - - if (successFortran) then - success = 1 - else - success = 0 - endif - - end function +#define REALCASE 1 +#define SINGLE_PRECISION 1 +#include "precision_macros.h" +#include "elpa_solve_tridi_c_interface_template.X90" +#undef SINGLE_PRECISION +#undef REALCASE #endif /* WANT_SINGLE_PRECISION_REAL */ diff --git a/src/elpa_solve_tridi_c_interface_template.X90 b/src/elpa_solve_tridi_c_interface_template.X90 new file mode 100644 index 00000000..0c3932bc --- /dev/null +++ b/src/elpa_solve_tridi_c_interface_template.X90 @@ -0,0 +1,41 @@ + function elpa_solve_tridi_wrapper_& + &PRECISION& + & (na, nev, d, e, q, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug) & + result(success) bind(C,name="elpa_solve_tridi_& + &PRECISION& + &") + + use, intrinsic :: iso_c_binding + use elpa1_auxiliary, only : elpa_solve_tridi_& + &PRECISION + + implicit none + integer(kind=c_int) :: success + integer(kind=c_int), value, intent(in) :: na, nev, ldq, nblk, matrixCols, mpi_comm_cols, mpi_comm_rows + integer(kind=c_int), value :: wantDebug + real(kind=C_DATATYPE_KIND) :: d(1:na), e(1:na) +#ifdef USE_ASSUMED_SIZE + real(kind=C_DATATYPE_KIND) :: q(ldq,*) +#else + real(kind=C_DATATYPE_KIND) :: q(1:ldq, 1:matrixCols) +#endif + logical :: successFortran, wantDebugFortran + + if (wantDebug .ne. 0) then + wantDebugFortran = .true. + else + wantDebugFortran = .false. + endif + + successFortran = elpa_solve_tridi_& + &PRECISION& + & (na, nev, d, e, q, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, & + wantDebugFortran) + + if (successFortran) then + success = 1 + else + success = 0 + endif + end function + -- GitLab