Commit 05ca1675 authored by Andreas Marek's avatar Andreas Marek

Disentangle 64bit integer blas from MPI

parent 043ddf39
......@@ -87,7 +87,7 @@ gnu-gnu-nompi-noopenmp-ilp64:
when: on_success
expire_in: 2 month
script:
- ./ci_test_scripts/run_ci_tests.sh -c "CC=\"gcc\" CFLAGS=\"-O3 -mavx\" FC=\"gfortran\" FCFLAGS=\"-O3 -mavx\" SCALAPACK_LDFLAGS=\"$MKL_GFORTRAN_SCALAPACK_LDFLAGS_NOMPI_NOOMP_ILP64 \" SCALAPACK_FCFLAGS=\"$MKL_GFORTRAN_SCALAPACK_FCFLAGS_NOMPI_NOOMP_ILP64 \" --enable-option-checking=fatal --with-mpi=no --disable-openmp --disable-gpu --enable-avx --disable-avx2 --disable-avx512 --enable-64bit-integer-support || { cat config.log; exit 1; }" -j 8 -t $MPI_TASKS -m $MATRIX_SIZE -n $NUMBER_OF_EIGENVECTORS -b $BLOCK_SIZE -s $SKIP_STEP -i $INTERACTIVE_RUN -S $SLURM
- ./ci_test_scripts/run_ci_tests.sh -c "CC=\"gcc\" CFLAGS=\"-O3 -mavx\" FC=\"gfortran\" FCFLAGS=\"-O3 -mavx\" SCALAPACK_LDFLAGS=\"$MKL_GFORTRAN_SCALAPACK_LDFLAGS_NOMPI_NOOMP_ILP64 \" SCALAPACK_FCFLAGS=\"$MKL_GFORTRAN_SCALAPACK_FCFLAGS_NOMPI_NOOMP_ILP64 \" --enable-option-checking=fatal --with-mpi=no --disable-openmp --disable-gpu --enable-avx --disable-avx2 --disable-avx512 --enable-64bit-integer-math-support || { cat config.log; exit 1; }" -j 8 -t $MPI_TASKS -m $MATRIX_SIZE -n $NUMBER_OF_EIGENVECTORS -b $BLOCK_SIZE -s $SKIP_STEP -i $INTERACTIVE_RUN -S $SLURM
# gnu-gnu-ilp64-nompi-openmp
......@@ -98,7 +98,7 @@ gnu-gnu-nompi-openmp-ilp64:
when: on_success
expire_in: 2 month
script:
- ./ci_test_scripts/run_ci_tests.sh -c "CC=\"gcc\" CFLAGS=\"-O3 -mavx\" FC=\"gfortran\" FCFLAGS=\"-O3 -mavx\" SCALAPACK_LDFLAGS=\"$MKL_GFORTRAN_SCALAPACK_LDFLAGS_NOMPI_OMP_ILP64 \" SCALAPACK_FCFLAGS=\"$MKL_GFORTRAN_SCALAPACK_FCFLAGS_NOMPI_OMP_ILP64 \" --enable-option-checking=fatal --with-mpi=no --enable-openmp --disable-gpu --enable-avx --disable-avx2 --disable-avx512 --enable-64bit-integer-support || { cat config.log; exit 1; }" -j 8 -t $MPI_TASKS -m $MATRIX_SIZE -n $NUMBER_OF_EIGENVECTORS -b $BLOCK_SIZE -s $SKIP_STEP -i $INTERACTIVE_RUN -S $SLURM
- ./ci_test_scripts/run_ci_tests.sh -c "CC=\"gcc\" CFLAGS=\"-O3 -mavx\" FC=\"gfortran\" FCFLAGS=\"-O3 -mavx\" SCALAPACK_LDFLAGS=\"$MKL_GFORTRAN_SCALAPACK_LDFLAGS_NOMPI_OMP_ILP64 \" SCALAPACK_FCFLAGS=\"$MKL_GFORTRAN_SCALAPACK_FCFLAGS_NOMPI_OMP_ILP64 \" --enable-option-checking=fatal --with-mpi=no --enable-openmp --disable-gpu --enable-avx --disable-avx2 --disable-avx512 --enable-64bit-integer-math-support || { cat config.log; exit 1; }" -j 8 -t $MPI_TASKS -m $MATRIX_SIZE -n $NUMBER_OF_EIGENVECTORS -b $BLOCK_SIZE -s $SKIP_STEP -i $INTERACTIVE_RUN -S $SLURM
# python tests
......
......@@ -348,7 +348,7 @@ ilp64_no_omp_tests = [
'SCALAPACK_LDFLAGS=\\"$MKL_GFORTRAN_SCALAPACK_LDFLAGS_NOMPI_NOOMP_ILP64 \\" '
'SCALAPACK_FCFLAGS=\\"$MKL_GFORTRAN_SCALAPACK_FCFLAGS_NOMPI_NOOMP_ILP64 \\" '
'--enable-option-checking=fatal --with-mpi=no --disable-openmp '
'--disable-gpu --enable-avx --disable-avx2 --disable-avx512 --enable-64bit-integer-support || { cat config.log; exit 1; }'
'--disable-gpu --enable-avx --disable-avx2 --disable-avx512 --enable-64bit-integer-math-support || { cat config.log; exit 1; }'
'" -j 8 -t $MPI_TASKS -m $MATRIX_SIZE -n $NUMBER_OF_EIGENVECTORS -b $BLOCK_SIZE '
'-s $SKIP_STEP -i $INTERACTIVE_RUN -S $SLURM',
"\n",
......@@ -366,7 +366,7 @@ ilp64_no_omp_tests = [
'SCALAPACK_LDFLAGS=\\"$MKL_GFORTRAN_SCALAPACK_LDFLAGS_NOMPI_OMP_ILP64 \\" '
'SCALAPACK_FCFLAGS=\\"$MKL_GFORTRAN_SCALAPACK_FCFLAGS_NOMPI_OMP_ILP64 \\" '
'--enable-option-checking=fatal --with-mpi=no --enable-openmp '
'--disable-gpu --enable-avx --disable-avx2 --disable-avx512 --enable-64bit-integer-support || { cat config.log; exit 1; }'
'--disable-gpu --enable-avx --disable-avx2 --disable-avx512 --enable-64bit-integer-math-support || { cat config.log; exit 1; }'
'" -j 8 -t $MPI_TASKS -m $MATRIX_SIZE -n $NUMBER_OF_EIGENVECTORS -b $BLOCK_SIZE '
'-s $SKIP_STEP -i $INTERACTIVE_RUN -S $SLURM',
"\n",
......
......@@ -213,21 +213,21 @@ dnl first long int
AC_CHECK_SIZEOF([long int])
size_of_long_int="${ac_cv_sizeof_long_int}"
dnl then 64bit
dnl then 64bit blas
AC_MSG_CHECKING(whether 64bit integers should be used for math libraries (BLAS/LAPACK/SCALAPACK))
AC_ARG_ENABLE([64bit-integer-support],
AS_HELP_STRING([--64bit-integer-support],
AC_ARG_ENABLE([64bit-integer-math-support],
AS_HELP_STRING([--64bit-integer-math-support],
[allows to link against the 64bit integer versions of the math libraries BLAS, LAPACK, and SCALAPACK]),
[
if test x"$enableval" = x"yes"; then
enable_64bit_integer_support=yes
enable_64bit_integer_math_support=yes
else
enable_64bit_integer_support=no
enable_64bit_integer_math_support=no
fi
],
[enable_64bit_integer_support="no"])
AC_MSG_RESULT([$enable_64bit_integer_support])
if test x"${enable_64bit_integer_support}" = x"yes"; then
[enable_64bit_integer_math_support="no"])
AC_MSG_RESULT([$enable_64bit_integer_math_support])
if test x"${enable_64bit_integer_math_support}" = x"yes"; then
if test x"${enable_legacy}" = x"yes"; then
AC_MSG_ERROR([You cannot both enable 64bit integer support and the legacy interface!])
fi
......@@ -242,9 +242,32 @@ if test x"${enable_64bit_integer_support}" = x"yes"; then
AC_MSG_ERROR([The C data-type "long int" is only ${size_of_long_int} bytes; Needed is 8 bytes])
fi
AC_DEFINE([HAVE_64BIT_INTEGER_SUPPORT], [1], [allow to link against the 64bit integer versions of math libraries])
AC_DEFINE([HAVE_64BIT_INTEGER_MATH_SUPPORT], [1], [allow to link against the 64bit integer versions of math libraries])
fi
AM_CONDITIONAL([HAVE_64BIT_INTEGER_SUPPORT],[test x"$enable_64bit_integer_support" = x"yes"])
AM_CONDITIONAL([HAVE_64BIT_INTEGER_MATH_SUPPORT],[test x"$enable_64bit_integer_math_support" = x"yes"])
dnl then 64bit blas
AC_MSG_CHECKING(whether 64bit integers should be used for the MPI library)
AC_ARG_ENABLE([64bit-integer-mpi-support],
AS_HELP_STRING([--64bit-integer-mpi-support],
[allows to link against the 64bit integer versions of the MPI library]),
[
if test x"$enableval" = x"yes"; then
enable_64bit_integer_mpi_support=yes
else
enable_64bit_integer_mpi_support=no
fi
],
[enable_64bit_integer_mpi_support="no"])
AC_MSG_RESULT([$enable_64bit_integer_mpi_support])
if test x"${enable_64bit_integer_mpi_support}" = x"yes"; then
if test x"${enable_legacy}" = x"yes"; then
AC_MSG_ERROR([You cannot both enable 64bit integer support and the legacy interface!])
fi
AC_DEFINE([HAVE_64BIT_INTEGER_MPI_SUPPORT], [1], [allow to link against the 64bit integer versions of the MPI library])
fi
AM_CONDITIONAL([HAVE_64BIT_INTEGER_MPI_SUPPORT],[test x"$enable_64bit_integer_mpi_support" = x"yes"])
AC_MSG_CHECKING(whether C compiler can use _Generic )
......
......@@ -171,8 +171,10 @@
#endif
integer(kind=ik) :: lr_end
integer(kind=ik) :: na_cols
integer(kind=BLAS_KIND) :: na_colsBLAS
#if COMPLEXCASE == 1
integer(kind=ik) :: na_rows
integer(kind=BLAS_KIND) :: na_rowsBLAS
#endif
logical, intent(in) :: wantDebug
......@@ -256,11 +258,13 @@
if (useGPU) then
#ifdef WITH_MPI
#if COMPLEXCASE == 1
na_rows = numroc(int(na,kind=MPI_KIND), int(nblk,kind=MPI_KIND), &
int(my_prow,kind=MPI_KIND), 0_MPI_KIND, int(np_rows,kind=MPI_KIND))
na_rowsBLAS = numroc(int(na,kind=BLAS_KIND), int(nblk,kind=BLAS_KIND), &
int(my_prow,kind=BLAS_KIND), 0_BLAS_KIND, int(np_rows,kind=BLAS_KIND))
na_rows = int(na_rowsBLAS,kind=c_int)
#endif
na_cols = numroc(int(na,kind=MPI_KIND), int(nblk,kind=MPI_KIND), &
int(my_pcol,kind=MPI_KIND), 0_MPI_KIND, int(np_cols,kind=MPI_KIND))
na_colsBLAS = numroc(int(na,kind=BLAS_KIND), int(nblk,kind=BLAS_KIND), &
int(my_pcol,kind=BLAS_KIND), 0_BLAS_KIND, int(np_cols,kind=BLAS_KIND))
na_cols = int(na_colsBLAS,kind=c_int)
#else
#if COMPLEXCASE == 1
na_rows = na
......
......@@ -64,7 +64,7 @@ subroutine qr_pdlarfb_1dcomm_&
! local scalars
integer(kind=ik) :: localsize,offset,baseoffset
integer(kind=ik) :: mpirank, mpiprocs
integer(kind=BLAS_KIND) :: mpirankMPI, mpiprocsMPI, mpierr
integer(kind=MPI_KIND) :: mpirankMPI, mpiprocsMPI, mpierr
if (idx .le. 1) return
......
This diff is collapsed.
......@@ -54,16 +54,24 @@
// Author: Valeriy Manin (Bergische Universität Wuppertal)
// integreated into the ELPA library Pavel Kus, Andeas Marek (MPCDF)
#ifdef HAVE_64BIT_INTEGER_SUPPORT
#ifdef HAVE_64BIT_INTEGER_MATH_SUPPORT
#define C_INT_TYPE_PTR long int*
#define C_INT_TYPE long int
#define FORTRAN_INT_TYPE c_int64_t
#define BLAS_KIND c_int64_t
#else
#define C_INT_TYPE_PTR int*
#define C_INT_TYPE int
#define FORTRAN_INT_TYPE c_int
#define BLAS_KIND c_int
#endif
#ifdef HAVE_64BIT_INTEGER_MPI_SUPPORT
#define C_INT_MPI_TYPE_PTR long int*
#define C_INT_MPI_TYPE long int
#define MPI_KIND c_int64_t
#else
#define C_INT_MPI_TYPE_PTR int*
#define C_INT_MPI_TYPE int
#define MPI_KIND c_int
#endif
// it seems, that we need those two levels of indirection to correctly expand macros
#define cannons_triang_rectangular_impl_expand2(SUFFIX) cannons_triang_rectangular_##SUFFIX
......@@ -88,6 +96,7 @@ void cannons_triang_rectangular_impl(math_type* U, math_type* B, C_INT_TYPE np_r
C_INT_TYPE na, nb, nblk, width, na_rows, na_cols, nb_cols, cols_in_buffer_U_my_initial, cols_in_buffer_U, rows_in_buffer_U, Size_receive_U_now, rows_in_buffer_U_now, cols_in_buffer_U_now, rows_in_buffer_U_my_initial;
C_INT_MPI_TYPE Size_receive_U_nowMPI, Size_receive_UMPI, Size_receive_BMPI;
C_INT_TYPE i, j, Size_send_U, Size_receive_U, Size_send_B, Size_receive_B, intNumber, Buf_rows, Buf_cols_U, Buf_cols_B, curr_rows, num_of_iters, cols_in_buffer, rows_in_block, curr_col_loc, cols_in_block, num_of_blocks_in_U_buffer, col_of_origin_U, b_rows_mult, b_cols_mult;
math_type *Buf_to_send_U, *Buf_to_receive_U, *Buf_to_send_B, *Buf_to_receive_B, *Buf_U, *PosBuff;
......@@ -241,9 +250,10 @@ void cannons_triang_rectangular_impl(math_type* U, math_type* B, C_INT_TYPE np_r
{
if(where_to_send_U != my_pcol) // if I need to send and receive on this step
{
MPI_Sendrecv(Buf_to_send_U, Size_send_U, MPI_MATH_DATATYPE_PRECISION_C, where_to_send_U, 0, Buf_U, Size_U_stored, MPI_MATH_DATATYPE_PRECISION_C, from_where_to_receive_U, 0, row_comm, &status);
MPI_Get_count(&status, MPI_MATH_DATATYPE_PRECISION_C, &Size_receive_U_now);
Size_receive_U = Size_receive_U + Size_receive_U_now - 2; // we need only number of elements, so exclude information about cols_in_buffer_U and rows_in_buffer_U
MPI_Sendrecv(Buf_to_send_U, (C_INT_MPI_TYPE) Size_send_U, MPI_MATH_DATATYPE_PRECISION_C, (C_INT_MPI_TYPE) where_to_send_U, 0, Buf_U, (C_INT_MPI_TYPE) Size_U_stored, MPI_MATH_DATATYPE_PRECISION_C, (C_INT_MPI_TYPE) from_where_to_receive_U, 0, row_comm, &status);
MPI_Get_count(&status, MPI_MATH_DATATYPE_PRECISION_C, &Size_receive_U_nowMPI);
Size_receive_U_now = (C_INT_TYPE) Size_receive_U_nowMPI;
Size_receive_U = Size_receive_U + Size_receive_U_now - 2; // we need only number of elements, so exclude information about cols_in_buffer_U and rows_in_buffer_
cols_in_buffer_U_now = Buf_U[Size_receive_U_now - 2];
cols_in_buffer_U = cols_in_buffer_U + cols_in_buffer_U_now;
......@@ -309,8 +319,10 @@ void cannons_triang_rectangular_impl(math_type* U, math_type* B, C_INT_TYPE np_r
{
if(my_prow > 0)
{
MPI_Sendrecv(Buf_to_send_U, Size_send_U, MPI_MATH_DATATYPE_PRECISION_C, where_to_send_U, 0, Buf_to_receive_U, Size_U_stored, MPI_MATH_DATATYPE_PRECISION_C, from_where_to_receive_U, 0, row_comm, &status);
MPI_Get_count(&status, MPI_MATH_DATATYPE_PRECISION_C, &Size_receive_U);
MPI_Sendrecv(Buf_to_send_U, (C_INT_MPI_TYPE) Size_send_U, MPI_MATH_DATATYPE_PRECISION_C, (C_INT_MPI_TYPE) where_to_send_U, 0, Buf_to_receive_U, (C_INT_MPI_TYPE) Size_U_stored, MPI_MATH_DATATYPE_PRECISION_C, (C_INT_MPI_TYPE) from_where_to_receive_U, 0, row_comm, &status);
MPI_Get_count(&status, MPI_MATH_DATATYPE_PRECISION_C, &Size_receive_UMPI);
Size_receive_U = (C_INT_TYPE) Size_receive_UMPI;
cols_in_buffer_U = (C_INT_TYPE)Buf_to_receive_U[Size_receive_U-2];
rows_in_buffer_U = (C_INT_TYPE)Buf_to_receive_U[Size_receive_U-1];
}
......@@ -341,9 +353,11 @@ void cannons_triang_rectangular_impl(math_type* U, math_type* B, C_INT_TYPE np_r
{
// form array to send
C_LACPY("A", &na_rows, &nb_cols, B, &na_rows, Buf_to_send_B, &na_rows);
MPI_Sendrecv(Buf_to_send_B, nb_cols*na_rows, MPI_MATH_DATATYPE_PRECISION_C, where_to_send_B, 0, Buf_to_receive_B, nb_cols*Buf_rows, MPI_MATH_DATATYPE_PRECISION_C, from_where_to_receive_B, 0, col_comm, &status);
MPI_Get_count(&status, MPI_MATH_DATATYPE_PRECISION_C, &Size_receive_B); // find out how many elements I have received
MPI_Sendrecv(Buf_to_send_B, (C_INT_MPI_TYPE) (nb_cols*na_rows), MPI_MATH_DATATYPE_PRECISION_C, (C_INT_MPI_TYPE) where_to_send_B, 0, Buf_to_receive_B, (C_INT_MPI_TYPE) (nb_cols*Buf_rows), MPI_MATH_DATATYPE_PRECISION_C, (C_INT_MPI_TYPE) from_where_to_receive_B, 0, col_comm, &status);
MPI_Get_count(&status, MPI_MATH_DATATYPE_PRECISION_C, &Size_receive_BMPI); // find out how many elements I have received
Size_receive_B = (C_INT_TYPE) Size_receive_BMPI;
Size_receive_B = Size_receive_B/nb_cols; // how many rows I have received
}
else
{
......@@ -378,13 +392,11 @@ void cannons_triang_rectangular_impl(math_type* U, math_type* B, C_INT_TYPE np_r
Size_send_B = Size_receive_B;
///// shift for U ////////////////////////////////////////////////////////////
MPI_Isend(Buf_to_send_U, Size_send_U, MPI_MATH_DATATYPE_PRECISION_C, where_to_send_U, 0, row_comm, &request_U_Send);
MPI_Irecv(Buf_to_receive_U, ratio*Size_U_stored, MPI_MATH_DATATYPE_PRECISION_C, from_where_to_receive_U, 0, row_comm, &request_U_Recv);
MPI_Isend(Buf_to_send_U, (C_INT_MPI_TYPE) Size_send_U, MPI_MATH_DATATYPE_PRECISION_C, (C_INT_MPI_TYPE) where_to_send_U, 0, row_comm, &request_U_Send);
MPI_Irecv(Buf_to_receive_U, (C_INT_MPI_TYPE) (ratio*Size_U_stored), MPI_MATH_DATATYPE_PRECISION_C, (C_INT_MPI_TYPE) from_where_to_receive_U, 0, row_comm, &request_U_Recv);
///// shift for B /////////////////////////////////////////////
MPI_Isend(Buf_to_send_B, Size_send_B*nb_cols, MPI_MATH_DATATYPE_PRECISION_C, where_to_send_B, 0, col_comm, &request_B_Send);
MPI_Irecv(Buf_to_receive_B, Buf_rows*nb_cols, MPI_MATH_DATATYPE_PRECISION_C, from_where_to_receive_B, 0, col_comm, &request_B_Recv);
MPI_Isend(Buf_to_send_B, (C_INT_MPI_TYPE) (Size_send_B*nb_cols), MPI_MATH_DATATYPE_PRECISION_C, (C_INT_MPI_TYPE) where_to_send_B, 0, col_comm, &request_B_Send);
MPI_Irecv(Buf_to_receive_B, (C_INT_MPI_TYPE) (Buf_rows*nb_cols), MPI_MATH_DATATYPE_PRECISION_C, (C_INT_MPI_TYPE) from_where_to_receive_B, 0, col_comm, &request_B_Recv);
///// multiplication ////////////////////////////////////////////////////////////////////////////////////////////
cols_in_buffer_U = (C_INT_TYPE)Buf_to_send_U[Size_receive_U-2];
rows_in_buffer_U = (C_INT_TYPE)Buf_to_send_U[Size_receive_U-1];
......@@ -426,12 +438,15 @@ void cannons_triang_rectangular_impl(math_type* U, math_type* B, C_INT_TYPE np_r
MPI_Wait(&request_U_Send, &status);
MPI_Wait(&request_U_Recv, &status);
MPI_Get_count(&status, MPI_MATH_DATATYPE_PRECISION_C, &Size_receive_U); // find out how many elements I have received
MPI_Get_count(&status, MPI_MATH_DATATYPE_PRECISION_C, &Size_receive_UMPI); // find out how many elements I have received
Size_receive_U = (C_INT_TYPE) Size_receive_UMPI;
MPI_Wait(&request_B_Send, &status);
MPI_Wait(&request_B_Recv, &status);
MPI_Get_count(&status, MPI_MATH_DATATYPE_PRECISION_C, &Size_receive_B); // find out how many elements I have received
Size_receive_B = Size_receive_B/nb_cols; // how many rows I have received
MPI_Get_count(&status, MPI_MATH_DATATYPE_PRECISION_C, &Size_receive_BMPI); // find out how many elements I have received
Size_receive_B = (C_INT_TYPE) Size_receive_BMPI;
Size_receive_B = (C_INT_TYPE) Size_receive_B / nb_cols; // how many rows I have received
}
// last iteration
......@@ -483,7 +498,7 @@ void cannons_triang_rectangular_impl(math_type* U, math_type* B, C_INT_TYPE np_r
void cannons_triang_rectangular_c_impl(math_type* U, math_type* B, int local_rowsCast, int local_colsCast,
C_INT_TYPE_PTR u_desc, C_INT_TYPE_PTR b_desc, math_type *Res, C_INT_TYPE row_comm, C_INT_TYPE col_comm)
C_INT_TYPE_PTR u_desc, C_INT_TYPE_PTR b_desc, math_type *Res, C_INT_MPI_TYPE row_comm, C_INT_MPI_TYPE col_comm)
{
C_INT_TYPE local_rows, local_cols;
......@@ -494,11 +509,17 @@ void cannons_triang_rectangular_c_impl(math_type* U, math_type* B, int local_row
MPI_Comm c_col_comm = MPI_Comm_f2c(col_comm);
C_INT_TYPE my_prow, my_pcol, np_rows, np_cols;
MPI_Comm_rank(c_row_comm, &my_prow);
MPI_Comm_size(c_row_comm, &np_rows);
MPI_Comm_rank(c_col_comm, &my_pcol);
MPI_Comm_size(c_col_comm, &np_cols);
C_INT_MPI_TYPE my_prowMPI, my_pcolMPI, np_rowsMPI, np_colsMPI;
MPI_Comm_rank(c_row_comm, &my_prowMPI);
MPI_Comm_size(c_row_comm, &np_rowsMPI);
MPI_Comm_rank(c_col_comm, &my_pcolMPI);
MPI_Comm_size(c_col_comm, &np_colsMPI);
my_prow = (C_INT_TYPE) my_prowMPI;
my_pcol = (C_INT_TYPE) my_pcolMPI;
np_rows = (C_INT_TYPE) np_rowsMPI;
np_cols = (C_INT_TYPE) np_colsMPI;
// BEWARE
// in the cannons algorithm, column and row communicators are exchanged
......
This diff is collapsed.
......@@ -48,7 +48,7 @@
#include "config-f90.h"
!#ifdef HAVE_64BIT_INTEGER_SUPPORT
!#ifdef HAVE_64BIT_INTEGER_MATH_SUPPORT
!#define FORTRAN_INT_TYPE c_int64_t
!#else
!#define FORTRAN_INT_TYPE c_int
......
......@@ -561,7 +561,8 @@ module elpa_impl
process_row, process_col, mpi_string_length, &
present_np_rows, present_np_cols, np_total
integer(kind=MPI_KIND) :: mpierr, mpierr2, my_idMPI, np_totalMPI, process_rowMPI, process_colMPI
integer(kind=MPI_KIND) :: mpi_comm_rowsMPI, mpi_comm_colsMPI, np_rowsMPI, np_colsMPI
integer(kind=MPI_KIND) :: mpi_comm_rowsMPI, mpi_comm_colsMPI, np_rowsMPI, np_colsMPI, &
mpi_string_lengthMPI
character(len=MPI_MAX_ERROR_STRING) :: mpierr_string
character(*), parameter :: MPI_CONSISTENCY_MSG = &
"Provide mpi_comm_parent and EITHER process_row and process_col OR mpi_comm_rows and mpi_comm_cols. Aborting..."
......@@ -645,7 +646,8 @@ module elpa_impl
int(process_row,kind=MPI_KIND), mpi_comm_rowsMPI, mpierr)
mpi_comm_rows = int(mpi_comm_rowsMPI,kind=c_int)
if (mpierr .ne. MPI_SUCCESS) then
call MPI_ERROR_STRING(mpierr, mpierr_string, int(mpi_string_length,kind=MPI_KIND), mpierr2)
call MPI_ERROR_STRING(mpierr, mpierr_string, mpi_string_lengthMPI, mpierr2)
mpi_string_length = int(mpi_string_lengthMPI, kind=c_int)
write(error_unit,*) "MPI ERROR occured during mpi_comm_split for row communicator: ", trim(mpierr_string)
return
endif
......@@ -654,7 +656,8 @@ module elpa_impl
int(process_col,kind=MPI_KIND), mpi_comm_colsMPI, mpierr)
mpi_comm_cols = int(mpi_comm_colsMPI,kind=c_int)
if (mpierr .ne. MPI_SUCCESS) then
call MPI_ERROR_STRING(mpierr, mpierr_string, int(mpi_string_length,kind=MPI_KIND), mpierr2)
call MPI_ERROR_STRING(mpierr, mpierr_string, mpi_string_lengthMPI, mpierr2)
mpi_string_length = int(mpi_string_lengthMPI, kind=c_int)
write(error_unit,*) "MPI ERROR occured during mpi_comm_split for col communicator: ", trim(mpierr_string)
return
endif
......@@ -1086,7 +1089,8 @@ module elpa_impl
#ifdef WITH_MPI
integer :: mpi_comm_rows, mpi_comm_cols, &
mpi_string_length
integer(kind=MPI_KIND) :: mpierr, mpierr2
integer(kind=MPI_KIND) :: mpierr, mpierr2, mpi_string_lengthMPI, &
mpi_comm_rowsMPI, mpi_comm_colsMPI
character(len=MPI_MAX_ERROR_STRING) :: mpierr_string
#endif
class(elpa_impl_t) :: self
......@@ -1142,9 +1146,12 @@ module elpa_impl
! this is just for debugging ! do not leave in a relase
!write(error_unit, '(A,2I13)') "FREE comms", mpi_comm_rows, mpi_comm_cols
call mpi_comm_free(int(mpi_comm_rows,kind=MPI_KIND), mpierr)
mpi_comm_rowsMPI = int(mpi_comm_rows,kind=MPI_KIND)
call mpi_comm_free(mpi_comm_rowsMPI, mpierr)
mpi_comm_rows = int(mpi_comm_rowsMPI,kind=c_int)
if (mpierr .ne. MPI_SUCCESS) then
call MPI_ERROR_STRING(mpierr, mpierr_string, int(mpi_string_length,kind=MPI_KIND), mpierr2)
call MPI_ERROR_STRING(mpierr, mpierr_string, mpi_string_lengthMPI, mpierr2)
mpi_string_length = int(mpi_string_lengthMPI,kind=c_int)
write(error_unit,*) "MPI ERROR occured during mpi_comm_free for row communicator: ", trim(mpierr_string)
#ifdef USE_FORTRAN2008
if (present(error)) then
......@@ -1168,9 +1175,12 @@ module elpa_impl
#endif
return
endif ! error happend
call mpi_comm_free(int(mpi_comm_cols,kind=MPI_KIND), mpierr)
mpi_comm_colsMPI = int(mpi_comm_cols,kind=MPI_KIND)
call mpi_comm_free(mpi_comm_colsMPI, mpierr)
mpi_comm_cols = int(mpi_comm_colsMPI, kind=c_int)
if (mpierr .ne. MPI_SUCCESS) then
call MPI_ERROR_STRING(mpierr, mpierr_string, int(mpi_string_length,kind=MPI_KIND), mpierr2)
call MPI_ERROR_STRING(mpierr, mpierr_string, mpi_string_lengthMPI, mpierr2)
mpi_string_length = int(mpi_string_lengthMPI,kind=c_int)
write(error_unit,*) "MPI ERROR occured during mpi_comm_free for col communicator: ", trim(mpierr_string)
#ifdef USE_FORTRAN2008
if (present(error)) then
......@@ -1391,7 +1401,7 @@ module elpa_impl
#endif
integer(kind=c_int) :: error2, error3
integer :: mpi_comm_parent, mpi_string_length, np_total
integer(kind=MPI_KIND) :: mpierr, mpierr2
integer(kind=MPI_KIND) :: mpierr, mpierr2, mpi_string_lengthMPI
logical :: unfinished
integer :: i
real(kind=C_DOUBLE) :: time_spent, sendbuf(1), recvbuf(1)
......@@ -1459,7 +1469,8 @@ module elpa_impl
sendbuf(1) = time_spent
call MPI_Allreduce(sendbuf, recvbuf, 1_MPI_KIND, MPI_REAL8, MPI_SUM, int(mpi_comm_parent,kind=MPI_KIND), mpierr)
if (mpierr .ne. MPI_SUCCESS) then
call MPI_ERROR_STRING(mpierr, mpierr_string, int(mpi_string_length,kind=MPI_KIND), mpierr2)
call MPI_ERROR_STRING(mpierr, mpierr_string, mpi_string_lengthMPI, mpierr2)
mpi_string_length = int(mpi_string_lengthMPI,kind=c_int)
write(error_unit,*) "MPI ERROR occured during elpa_autotune_step: ", trim(mpierr_string)
return
endif
......
......@@ -6,6 +6,7 @@
subroutine elpa_transform_generalized_&
&ELPA_IMPL_SUFFIX&
&(self, a, b, is_already_decomposed, error)
use precision
implicit none
#include "general/precision_kinds.F90"
class(elpa_impl_t) :: self
......@@ -84,8 +85,8 @@
call cannons_reduction_&
&ELPA_IMPL_SUFFIX&
&(a, b, self%local_nrows, self%local_ncols, &
int(sc_desc,kind=BLAS_KIND), tmp, int(BuffLevelInt,kind=BLAS_KIND), &
int(mpi_comm_rows,kind=BLAS_KIND), int(mpi_comm_cols,kind=BLAS_KIND))
int(sc_desc,kind=BLAS_KIND), tmp, int(BuffLevelInt,kind=MPI_KIND), &
int(mpi_comm_rows,kind=MPI_KIND), int(mpi_comm_cols,kind=MPI_KIND))
#endif
call self%timer_stop("cannons_reduction")
......@@ -184,7 +185,7 @@
&ELPA_IMPL_SUFFIX&
&(b, q, self%local_nrows, self%local_ncols, &
int(sc_desc,kind=BLAS_KIND), int(sc_desc_ev,kind=BLAS_KIND), tmp, &
int(mpi_comm_rows,kind=BLAS_KIND), int(mpi_comm_cols,kind=BLAS_KIND) );
int(mpi_comm_rows,kind=MPI_KIND), int(mpi_comm_cols,kind=MPI_KIND) );
#endif
call self%timer_stop("cannons_triang_rectangular")
......
#ifdef HAVE_64BIT_INTEGER_SUPPORT
#ifdef HAVE_64BIT_INTEGER_MATH_SUPPORT
#define C_INT_TYPE_PTR long int*
#define C_INT_TYPE long int
#else
......
......@@ -53,13 +53,15 @@ module precision
integer, parameter :: ik = C_INT32_T
integer, parameter :: lik = C_INT64_T
#ifdef HAVE_64BIT_INTEGER_SUPPORT
#ifdef HAVE_64BIT_INTEGER_MATH_SUPPORT
integer, parameter :: BLAS_KIND = C_INT64_T
integer, parameter :: MPI_KIND = C_INT64_T
#else
integer, parameter :: BLAS_KIND = C_INT32_T
#endif
#ifdef HAVE_64BIT_INTEGER_MPI_SUPPORT
integer, parameter :: MPI_KIND = C_INT64_T
#else
integer, parameter :: MPI_KIND = C_INT32_T
#endif
end module precision
#ifdef HAVE_64BIT_INTEGER_SUPPORT
#ifdef HAVE_64BIT_INTEGER_MATH_SUPPORT
#define C_INT_TYPE_PTR long int*
#define C_INT_TYPE long int
#else
......
......@@ -104,7 +104,7 @@
#define assert_elpa_ok(x) assert(x == ELPA_OK)
#ifdef HAVE_64BIT_INTEGER_SUPPORT
#ifdef HAVE_64BIT_INTEGER_MATH_SUPPORT
#define TEST_C_INT_TYPE_PTR long int*
#define C_INT_TYPE_PTR long int*
#define TEST_C_INT_TYPE long int
......@@ -116,6 +116,17 @@
#define C_INT_TYPE int
#endif
#ifdef HAVE_64BIT_INTEGER_MPI_SUPPORT
#define TEST_C_INT_MPI_TYPE_PTR long int*
#define C_INT_MPI_TYPE_PTR long int*
#define TEST_C_INT_MPI_TYPE long int
#define C_INT_MPI_TYPE long int
#else
#define TEST_C_INT_MPI_TYPE_PTR int*
#define C_INT_MPI_TYPE_PTR int*
#define TEST_C_INT_MPI_TYPE int
#define C_INT_MPI_TYPE int
#endif
#include "test/shared/generated.h"
int main(int argc, char** argv) {
......@@ -124,11 +135,12 @@ int main(int argc, char** argv) {
/* mpi */
C_INT_TYPE myid, nprocs;
C_INT_MPI_TYPE myidMPI, nprocsMPI;
C_INT_TYPE na_cols, na_rows;
C_INT_TYPE np_cols, np_rows;
C_INT_TYPE my_prow, my_pcol;
C_INT_TYPE mpi_comm;
C_INT_TYPE provided_mpi_thread_level;
C_INT_MPI_TYPE provided_mpi_thread_level;
/* blacs */
C_INT_TYPE my_blacs_ctxt, sc_desc[9], info;
......@@ -156,8 +168,10 @@ int main(int argc, char** argv) {
}
#endif
MPI_Comm_size(MPI_COMM_WORLD, &nprocs);
MPI_Comm_rank(MPI_COMM_WORLD, &myid);
MPI_Comm_size(MPI_COMM_WORLD, &nprocsMPI);
nprocs = (C_INT_TYPE) nprocsMPI;
MPI_Comm_rank(MPI_COMM_WORLD, &myidMPI);
myid = (C_INT_TYPE) myidMPI;
#else
nprocs = 1;
......
......@@ -68,13 +68,20 @@
#include "config-f90.h"
#ifdef HAVE_64BIT_INTEGER_SUPPORT
#ifdef HAVE_64BIT_INTEGER_MATH_SUPPORT
#define TEST_INT_TYPE integer(kind=c_int64_t)
#define INT_TYPE c_int64_t
#else
#define TEST_INT_TYPE integer(kind=c_int32_t)
#define INT_TYPE c_int32_t
#endif
#ifdef HAVE_64BIT_INTEGER_MPI_SUPPORT
#define TEST_INT_MPI_TYPE integer(kind=c_int64_t)
#define INT_MPI_TYPE c_int64_t
#else
#define TEST_INT_MPI_TYPE integer(kind=c_int32_t)
#define INT_MPI_TYPE c_int32_t
#endif
program test_complex2_double_banded
......@@ -116,9 +123,10 @@ program test_complex2_double_banded
TEST_INT_TYPE :: np_rows, np_cols, na_rows, na_cols
TEST_INT_TYPE :: myid, nprocs, my_prow, my_pcol, mpi_comm_rows, mpi_comm_cols
TEST_INT_TYPE :: i, mpierr, my_blacs_ctxt, sc_desc(9), info, nprow, npcol
TEST_INT_TYPE :: i, my_blacs_ctxt, sc_desc(9), info, nprow, npcol
TEST_INT_MPI_TYPE :: mpierr
#ifdef WITH_MPI
TEST_INT_TYPE, external :: numroc
!TEST_INT_TYPE, external :: numroc
#endif
complex(kind=ck8), parameter :: CZERO = (0.0_rk8,0.0_rk8), CONE = (1.0_rk8,0.0_rk8)
real(kind=rk8), allocatable :: ev(:)
......@@ -182,7 +190,7 @@ program test_complex2_double_banded
! consistent (i.e. 0<=my_prow<np_rows, 0<=my_pcol<np_cols and every
! process has a unique (my_prow,my_pcol) pair).
call set_up_blacsgrid(mpi_comm_world, np_rows, np_cols, 'C', &
call set_up_blacsgrid(int(mpi_comm_world,kind=BLAS_KIND), np_rows, np_cols, 'C', &
my_blacs_ctxt, my_prow, my_pcol)
if (myid==0) then
......
......@@ -42,14 +42,20 @@
!
#include "config-f90.h"
#ifdef HAVE_64BIT_INTEGER_SUPPORT
#ifdef HAVE_64BIT_INTEGER_MATH_SUPPORT
#define TEST_INT_TYPE integer(kind=c_int64_t)
#define INT_TYPE c_int64_t
#else
#define TEST_INT_TYPE integer(kind=c_int32_t)
#define INT_TYPE c_int32_t
#endif
#ifdef HAVE_64BIT_INTEGER_MPI_SUPPORT
#define TEST_INT_MPI_TYPE integer(kind=c_int64_t)
#define INT_MPI_TYPE c_int64_t
#else
#define TEST_INT_MPI_TYPE integer(kind=c_int32_t)
#define INT_MPI_TYPE c_int32_t
#endif
#include "../assert.h"
program test_interface
......@@ -72,7 +78,7 @@ program test_interface
TEST_INT_TYPE :: na_cols, na_rows ! local matrix size
TEST_INT_TYPE :: np_cols, np_rows ! number of MPI processes per column/row
TEST_INT_TYPE :: my_prow, my_pcol ! local MPI task position (my_prow, my_pcol) in the grid (0..np_cols -1, 0..np_rows -1)
TEST_INT_TYPE :: mpierr
TEST_INT_MPI_TYPE :: mpierr
! blacs
TEST_INT_TYPE :: my_blacs_ctxt, sc_desc(9), info, nprow, npcol
......@@ -113,7 +119,7 @@ program test_interface
my_prow = mod(myid, np_cols)
my_pcol = myid / np_cols
call set_up_blacsgrid(mpi_comm_world, np_rows, np_cols, 'C', &
call set_up_blacsgrid(int(mpi_comm_world,kind=BLAS_KIND), np_rows, np_cols, 'C', &
my_blacs_ctxt, my_prow, my_pcol)
call set_up_blacs_descriptor(na, nblk, my_prow, my_pcol, np_rows, np_cols, &
......
......@@ -68,7 +68,7 @@
#include "config-f90.h"
#ifdef HAVE_64BIT_INTEGER_SUPPORT
#ifdef HAVE_64BIT_INTEGER_MATH_SUPPORT
#define TEST_INT_TYPE integer(kind=c_int64_t)
#define INT_TYPE c_int64_t
#else
......@@ -76,6 +76,13 @@
#define INT_TYPE c_int32_t
#endif
#ifdef HAVE_64BIT_INTEGER_MPI_SUPPORT
#define TEST_INT_MPI_TYPE integer(kind=c_int64_t)
#define INT_MPI_TYPE c_int64_t
#else
#define TEST_INT_MPI_TYPE integer(kind=c_int32_t)
#define INT_MPI_TYPE c_int32_t
#endif
program test_real2_double_banded
......@@ -118,9 +125,9 @@ program test_real2_double_banded
TEST_INT_TYPE :: np_rows, np_cols, na_rows, na_cols
TEST_INT_TYPE :: myid, nprocs, my_prow, my_pcol, mpi_comm_rows, mpi_comm_cols
TEST_INT_TYPE :: i, mpierr, my_blacs_ctxt, sc_desc(9), info, nprow, npcol
TEST_INT_TYPE, external :: numroc
TEST_INT_TYPE :: i, my_blacs_ctxt, sc_desc(9), info, nprow, npcol
TEST_INT_MPI_TYPE :: mpierr
!TEST_INT_TYPE, external :: numroc
real(kind=rk8), allocatable :: a(:,:), z(:,:), as(:,:), ev(:)
......@@ -181,7 +188,7 @@ program test_real2_double_banded
! consistent (i.e. 0<=my_prow<np_rows, 0<=my_pcol<np_cols and every
! process has a unique (my_prow,my_pcol) pair).
call set_up_blacsgrid(mpi_comm_world, np_rows, np_cols, 'C', &
call set_up_blacsgrid(int(mpi_comm_world,kind=BLAS_KIND), np_rows, np_cols, 'C', &
my_blacs_ctxt, my_prow, my_pcol)
if (myid==0) then
......
......@@ -44,14 +44,20 @@
#ifdef HAVE_64BIT_INTEGER_SUPPORT
#ifdef HAVE_64BIT_INTEGER_MATH_SUPPORT
#define TEST_INT_TYPE integer(kind=c_int64_t)
#define INT_TYPE c_int64_t
#else
#define TEST_INT_TYPE integer(kind=c_int32_t)
#define INT_TYPE c_int32_t
#endif
#ifdef HAVE_64BIT_INTEGER_MPI_SUPPORT
#define TEST_INT_MPI_TYPE integer(kind=c_int64_t)
#define INT_MPI_TYPE c_int64_t
#else
#define TEST_INT_MPI_TYPE integer(kind=c_int32_t)
#define INT_MPI_TYPE c_int32_t
#endif
#include "../assert.h"
!>
......@@ -118,9 +124,10 @@ program test_complex2_single_banded
TEST_INT_TYPE :: np_rows, np_cols, na_rows, na_cols
TEST_INT_TYPE :: myid, nprocs, my_prow, my_pcol, mpi_comm_rows, mpi_comm_cols
TEST_INT_TYPE :: i, mpierr, my_blacs_ctxt, sc_desc(9), info, nprow, npcol
TEST_INT_TYPE :: i, my_blacs_ctxt, sc_desc(9), info, nprow, npcol
TEST_INT_MPI_TYPE :: mpierr