Commit 844a4c7c authored by Pavel Kus's avatar Pavel Kus

back transformation handled by cannons algorihtm for all cases

parent 4e4a7074
......@@ -60,8 +60,7 @@ libelpa@SUFFIX@_private_la_SOURCES = \
src/elpa2/qr/elpa_pdgeqrf.F90 \
src/elpa1/elpa1.F90 \
src/elpa2/elpa2.F90 \
src/elpa_generalized/cannon_forw.c \
src/elpa_generalized/cannon_back_real_double.c \
src/elpa_generalized/cannon.c \
#src/elpa_generalized/test_c_bindings.c \
src/helpers/matrix_plot.F90 \
src/elpa_index.c
......@@ -745,6 +744,7 @@ EXTRA_DIST = \
src/elpa2/qr/qr_utils_template.F90 \
src/elpa2/redist_band.F90 \
src/elpa_generalized/cannon_forw_template.c \
src/elpa_generalized/cannon_back_template.c \
src/elpa_index.h \
src/fortran_constants.h \
src/general/map_global_to_local.F90 \
......
......@@ -8,17 +8,18 @@
#ifdef WITH_MPI
#include <mpi.h>
int numroc_(int*, int*, int*, int*, int*);
//***********************************************************************************************************
#define REALCASE 1
#define DOUBLE_PRECISION 1
#include "../general/precision_macros.h"
#include "cannon_forw_template.c"
#include "cannon_back_template.c"
#undef DOUBLE_PRECISION
#undef REALCASE
//***********************************************************************************************************
/*
!f> interface
!f> subroutine cannons_reduction_d(A, U, local_rows, local_cols, a_desc, Res, toStore, row_comm, col_comm) &
......@@ -35,14 +36,31 @@ int numroc_(int*, int*, int*, int*, int*);
void cannons_reduction_c_d(double* A, double* U, int local_rows, int local_cols, int* a_desc,
double *Res, int ToStore, int row_comm, int col_comm);
/*
!f> interface
!f> subroutine cannons_triang_rectangular_d(U, B, local_rows, local_cols, u_desc, b_desc, Res, row_comm, col_comm) &
!f> bind(C, name="cannons_triang_rectangular_c_d")
!f> use, intrinsic :: iso_c_binding
!f> real(c_double) :: U(local_rows, local_cols), B(local_rows, local_cols), Res(local_rows, local_cols)
!f> integer(kind=c_int) :: u_desc(9), b_desc(9)
!f> integer(kind=c_int),value :: local_rows, local_cols
!f> integer(kind=c_int),value :: row_comm, col_comm
!f> end subroutine
!f> end interface
*/
void cannons_triang_rectangular_c_d(double* U, double* B, int local_rows, int local_cols,
int* u_desc, int* b_desc, double *Res, int row_comm, int col_comm);
//***********************************************************************************************************
#define REALCASE 1
#define SINGLE_PRECISION 1
#include "../general/precision_macros.h"
#include "cannon_forw_template.c"
#include "cannon_back_template.c"
#undef SINGLE_PRECISION
#undef REALCASE
//***********************************************************************************************************
/*
!f> interface
!f> subroutine cannons_reduction_f(A, U, local_rows, local_cols, a_desc, Res, toStore, row_comm, col_comm) &
......@@ -59,14 +77,31 @@ void cannons_reduction_c_d(double* A, double* U, int local_rows, int local_cols,
void cannons_reduction_c_f(float* A, float* U, int local_rows, int local_cols, int* a_desc,
float *Res, int ToStore, int row_comm, int col_comm);
/*
!f> interface
!f> subroutine cannons_triang_rectangular_f(U, B, local_rows, local_cols, u_desc, b_desc, Res, row_comm, col_comm) &
!f> bind(C, name="cannons_triang_rectangular_c_f")
!f> use, intrinsic :: iso_c_binding
!f> real(c_float) :: U(local_rows, local_cols), B(local_rows, local_cols), Res(local_rows, local_cols)
!f> integer(kind=c_int) :: u_desc(9), b_desc(9)
!f> integer(kind=c_int),value :: local_rows, local_cols
!f> integer(kind=c_int),value :: row_comm, col_comm
!f> end subroutine
!f> end interface
*/
void cannons_triang_rectangular_c_f(float* U, float* B, int local_rows, int local_cols,
int* u_desc, int* b_desc, float *Res, int row_comm, int col_comm);
//***********************************************************************************************************
#define COMPLEXCASE 1
#define DOUBLE_PRECISION 1
#include "../general/precision_macros.h"
#include "cannon_forw_template.c"
#include "cannon_back_template.c"
#undef DOUBLE_PRECISION
#undef COMPLEXCASE
//***********************************************************************************************************
/*
!f> interface
!f> subroutine cannons_reduction_dc(A, U, local_rows, local_cols, a_desc, Res, toStore, row_comm, col_comm) &
......@@ -83,14 +118,30 @@ void cannons_reduction_c_f(float* A, float* U, int local_rows, int local_cols, i
void cannons_reduction_c_dc(double complex* A, double complex* U, int local_rows, int local_cols, int* a_desc,
double complex *Res, int ToStore, int row_comm, int col_comm);
/*
!f> interface
!f> subroutine cannons_triang_rectangular_dc(U, B, local_rows, local_cols, u_desc, b_desc, Res, row_comm, col_comm) &
!f> bind(C, name="cannons_triang_rectangular_c_dc")
!f> use, intrinsic :: iso_c_binding
!f> complex(c_double) :: U(local_rows, local_cols), B(local_rows, local_cols), Res(local_rows, local_cols)
!f> integer(kind=c_int) :: u_desc(9), b_desc(9)
!f> integer(kind=c_int),value :: local_rows, local_cols
!f> integer(kind=c_int),value :: row_comm, col_comm
!f> end subroutine
!f> end interface
*/
void cannons_triang_rectangular_c_dc(double complex* U, double complex* B, int local_rows, int local_cols,
int* u_desc, int* b_desc, double complex *Res, int row_comm, int col_comm);
//***********************************************************************************************************
#define COMPLEXCASE 1
#define SINGLE_PRECISION 1
#include "../general/precision_macros.h"
#include "cannon_forw_template.c"
#include "cannon_back_template.c"
#undef SINGLE_PRECISION
#undef COMPLEXCASE
//***********************************************************************************************************
/*
!f> interface
!f> subroutine cannons_reduction_fc(A, U, local_rows, local_cols, a_desc, Res, toStore, row_comm, col_comm) &
......@@ -107,26 +158,62 @@ void cannons_reduction_c_dc(double complex* A, double complex* U, int local_rows
void cannons_reduction_c_fc(float complex* A, float complex* U, int local_rows, int local_cols, int* a_desc,
float complex *Res, int ToStore, int row_comm, int col_comm);
/*
!f> interface
!f> subroutine cannons_triang_rectangular_fc(U, B, local_rows, local_cols, u_desc, b_desc, Res, row_comm, col_comm) &
!f> bind(C, name="cannons_triang_rectangular_c_fc")
!f> use, intrinsic :: iso_c_binding
!f> complex(c_float) :: U(local_rows, local_cols), B(local_rows, local_cols), Res(local_rows, local_cols)
!f> integer(kind=c_int) :: u_desc(9), b_desc(9)
!f> integer(kind=c_int),value :: local_rows, local_cols
!f> integer(kind=c_int),value :: row_comm, col_comm
!f> end subroutine
!f> end interface
*/
void cannons_triang_rectangular_c_fc(float complex* U, float complex* B, int local_rows, int local_cols,
int* u_desc, int* b_desc, float complex *Res, int row_comm, int col_comm);
#else
// Just because of the Intel preprocessor
// TODO do something with it
// ideally the build system, which is generating fortran interfaces, should respect ifdefs and not
// generate interface for non-MPI case
void cannons_reduction_c_d(double* A, double* U, int local_rows, int local_cols, int* a_desc,
double *Res, int ToStore, int row_comm, int col_comm)
{
}
void cannons_triang_rectangular_c_d(double* U, double* B, int local_rows, int local_cols,
int* u_desc, int* b_desc, double *Res, int row_comm, int col_comm)
{
}
void cannons_reduction_c_f(float* A, float* U, int local_rows, int local_cols, int* a_desc,
float *Res, int ToStore, int row_comm, int col_comm)
{
}
void cannons_triang_rectangular_c_f(float* U, float* B, int local_rows, int local_cols,
int* u_desc, int* b_desc, float *Res, int row_comm, int col_comm)
{
}
void cannons_reduction_c_dc(double complex* A, double complex* U, int local_rows, int local_cols, int* a_desc,
double complex *Res, int ToStore, int row_comm, int col_comm)
{
}
void cannons_triang_rectangular_c_dc(double complex* U, double complex* B, int local_rows, int local_cols,
int* u_desc, int* b_desc, double complex *Res, int row_comm, int col_comm)
{
}
void cannons_reduction_c_fc(float complex* A, float complex* U, int local_rows, int local_cols, int* a_desc,
float complex *Res, int ToStore, int row_comm, int col_comm)
{
}
void cannons_triang_rectangular_c_fc(float complex* U, float complex* B, int local_rows, int local_cols,
int* u_desc, int* b_desc, float complex *Res, int row_comm, int col_comm)
{
}
#endif
......@@ -72,14 +72,12 @@
!TODO tunable parameter?
BuffLevelInt = 1
call self%timer_start("cannons_reduction")
! BEWARE! even though tmp is output from the routine, it has to be zero on input!
tmp = 0.0_rck
call cannons_reduction_&
&ELPA_IMPL_SUFFIX&
&(a, b, self%local_nrows, self%local_ncols, &
sc_desc, tmp, BuffLevelInt, mpi_comm_rows, mpi_comm_cols)
&(a, b, self%local_nrows, self%local_ncols, sc_desc, tmp, BuffLevelInt, mpi_comm_rows, mpi_comm_cols)
call self%timer_stop("cannons_reduction")
a(1:self%local_nrows, 1:self%local_ncols) = tmp(1:self%local_nrows, 1:self%local_ncols)
......@@ -149,9 +147,6 @@
call self%timer_start("transform_back_generalized()")
call self%get("cannon_for_generalized",use_cannon,error)
#if !defined(REALCASE) || !defined(DOUBLE_PRECISION)
use_cannon = 0
#endif
#if !defined(WITH_MPI)
use_cannon = 0
......@@ -166,12 +161,13 @@
if(error .NE. ELPA_OK) return
if(use_cannon == 1) then
#if defined(REALCASE) && defined(DOUBLE_PRECISION)
call cannons_triang_rectangular(b, q, self%local_nrows, self%local_ncols, &
sc_desc, sc_desc_ev, tmp, mpi_comm_rows, mpi_comm_cols);
call self%timer_start("cannons_triang_rectangular")
call cannons_triang_rectangular_&
&ELPA_IMPL_SUFFIX&
&(b, q, self%local_nrows, self%local_ncols, sc_desc, sc_desc_ev, tmp, mpi_comm_rows, mpi_comm_cols);
call self%timer_stop("cannons_triang_rectangular")
q(1:self%local_nrows, 1:self%local_ncols) = tmp(1:self%local_nrows, 1:self%local_ncols)
#endif
else
call self%timer_start("scalapack multiply inv(U) * Q")
#ifdef WITH_MPI
......
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