Commit 4c7521e0 authored by Andreas Marek's avatar Andreas Marek

Some changes for K-computer

parent e2fdf6c9
......@@ -971,6 +971,49 @@ if test x"${USE_ASSUMED_SIZE}" = x"yes" ; then
AC_DEFINE([USE_ASSUMED_SIZE],[1],[for performance reasons use assumed size Fortran arrays, even if not debuggable])
fi
enable_fortran2008_features=yes
AC_MSG_CHECKING(whether Fortran2008 features should be enabled)
AC_ARG_ENABLE([Fortran2008-features],
AS_HELP_STRING([--enable-Fortran2008-features],
[enables some Fortran 2008 features, default yes.]),
[
if test x"$enableval" = x"yes"; then
enable_fortran2008_features=yes
else
enable_fortran2008_features=no
fi
],
[])
AC_MSG_RESULT([${enable_fortran2008_features}])
AM_CONDITIONAL([USE_FORTRAN2008],[test x"$enable_fortran2008_features" = x"yes"])
if test x"${enable_fortran2008_features}" = x"yes"; then
AC_DEFINE([USE_FORTRAN2008], [1], [use some Fortran 2008 features])
fi
enable_kcomputer=no
AC_MSG_CHECKING(whether we build for K-computer)
AC_ARG_ENABLE([K-computer],
AS_HELP_STRING([--enable-K-computer],
[enable builds on K-Computer, default no.]),
[if test x"$enableval"=x"yes"; then
enable_kcomputer=yes
else
enable_kcomputer=no
fi],
[enable_kcomputer=no])
AC_MSG_RESULT([${enable_kcomputer}])
AM_CONDITIONAL([BUILD_KCOMPUTER],[test x"$enable_kcomputer" = x"yes"])
if test x"${enable_kcomputer}" = x"yes"; then
AC_DEFINE([BUILD_KCOMPUTER], [1], [build for K-Computer])
FC_MODINC="-I"
if test x"${USE_ASSUMED_SIZE}" = x"yes" ; then
AC_MSG_ERROR(on K-computer you have to switch off assumed-size arrays!)
fi
if test x"${enable_fortran2008_features}" = x"yes" ; then
AC_MSG_ERROR(on K-computer you have to switch off Fortran 2008 features!)
fi
fi
if test x"${want_single_precision}" = x"yes" ; then
AC_DEFINE([WANT_SINGLE_PRECISION_REAL],[1],[build also single-precision for real calculation])
AC_DEFINE([WANT_SINGLE_PRECISION_COMPLEX],[1],[build also single-precision for complex calculation])
......@@ -1101,4 +1144,14 @@ m4_foreach_w([elpa_m4_kind],[real complex],[
#echo "* It mainly contains bugfixes to ELPA 2017.05.001 *"
#echo "***********************************************************************"
#echo " "
make -f $srcdir/generated_headers.am generated-headers top_srcdir="$srcdir"
if test x"$enable_kcomputer" = x"yes" ; then
echo " "
echo "Important message:"
echo "On K-computer (at the moment) the automatic create of the generated"
echo "headers does not work."
echo "call: make -f ../generated_headers.am generated-headers top_srcdir=.."
echo "BEFORE triggering the build with make!"
else
make -f $srcdir/generated_headers.am generated-headers top_srcdir="$srcdir"
fi
......@@ -106,7 +106,7 @@ function elpa_solve_evp_&
character(200) :: errorMessage
integer(kind=ik) :: na, nev, lda, ldq, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, i
mpi_comm_all, check_pd, i, error
logical :: do_bandred, do_solve, do_trans_ev
......@@ -156,11 +156,27 @@ function elpa_solve_evp_&
endif
call obj%get("mpi_comm_rows",mpi_comm_rows)
call obj%get("mpi_comm_cols",mpi_comm_cols)
call obj%get("mpi_comm_parent", mpi_comm_all)
call obj%get("mpi_comm_rows",mpi_comm_rows,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call obj%get("mpi_comm_cols",mpi_comm_cols,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call obj%get("mpi_comm_parent", mpi_comm_all,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call obj%get("gpu",gpu)
call obj%get("gpu",gpu,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
if (gpu .eq. 1) then
useGPU =.true.
else
......@@ -182,7 +198,11 @@ function elpa_solve_evp_&
call obj%timer%stop("mpi_communication")
call obj%get("debug", debug)
call obj%get("debug", debug,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
wantDebug = debug == 1
do_useGPU = .false.
......@@ -204,7 +224,11 @@ function elpa_solve_evp_&
endif
else
! check whether set by environment variable
call obj%get("gpu", gpu)
call obj%get("gpu", gpu,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
do_useGPU = gpu == 1
if (do_useGPU) then
......@@ -298,7 +322,11 @@ function elpa_solve_evp_&
if (obj%eigenvalues_only) then
do_trans_ev = .false.
else
call obj%get("check_pd",check_pd)
call obj%get("check_pd",check_pd,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
if (check_pd .eq. 1) then
check_pd = 0
do i = 1, na
......
......@@ -66,7 +66,7 @@
MATH_DATATYPE(kind=rck), allocatable :: tmp1(:), tmp2(:,:), tmatr(:,:), tmatc(:,:)
logical :: wantDebug
logical :: success
integer(kind=ik) :: istat, debug
integer(kind=ik) :: istat, debug, error
character(200) :: errorMessage
call obj%timer%start("elpa_cholesky_&
......@@ -80,10 +80,22 @@
nblk = obj%nblk
matrixCols = obj%local_ncols
call obj%get("mpi_comm_rows",mpi_comm_rows )
call obj%get("mpi_comm_cols",mpi_comm_cols)
call obj%get("mpi_comm_rows",mpi_comm_rows,error )
if (error .ne. ELPA_OK) then
print *,"Problem getting option. Aborting..."
stop
endif
call obj%get("mpi_comm_cols",mpi_comm_cols,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option. Aborting..."
stop
endif
call obj%get("debug",debug)
call obj%get("debug",debug,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option. Aborting..."
stop
endif
if (debug == 1) then
wantDebug = .true.
else
......
......@@ -73,7 +73,7 @@
MATH_DATATYPE(kind=rck), allocatable :: tmp1(:), tmp2(:,:), tmat1(:,:), tmat2(:,:)
logical :: wantDebug
logical :: success
integer(kind=ik) :: istat, debug
integer(kind=ik) :: istat, debug, error
character(200) :: errorMessage
call obj%timer%start("elpa_invert_trm_&
......@@ -87,10 +87,22 @@
nblk = obj%nblk
matrixCols = obj%local_ncols
call obj%get("mpi_comm_rows",mpi_comm_rows)
call obj%get("mpi_comm_cols",mpi_comm_cols)
call obj%get("mpi_comm_rows",mpi_comm_rows,error)
if (error .ne. ELPA_OK) then
print *,"Error getting option. Aborting..."
stop
endif
call obj%get("mpi_comm_cols",mpi_comm_cols,error)
if (error .ne. ELPA_OK) then
print *,"Error getting option. Aborting..."
stop
endif
call obj%get("debug", debug)
call obj%get("debug", debug,error)
if (error .ne. ELPA_OK) then
print *,"Error getting option. Aborting..."
stop
endif
if (debug == 1) then
wantDebug = .true.
else
......
......@@ -84,7 +84,7 @@
integer(kind=ik) :: istat
character(200) :: errorMessage
logical :: success
integer(kind=ik) :: nblk, mpi_comm_rows, mpi_comm_cols, lda, ldaCols
integer(kind=ik) :: nblk, mpi_comm_rows, mpi_comm_cols, lda, ldaCols, error
call obj%timer%start("elpa_mult_at_b_&
&MATH_DATATYPE&
......@@ -98,8 +98,18 @@
ldaCols = obj%local_ncols
call obj%get("mpi_comm_rows",mpi_comm_rows)
call obj%get("mpi_comm_cols",mpi_comm_cols)
call obj%get("mpi_comm_rows",mpi_comm_rows,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option. Aborting..."
stop
endif
call obj%get("mpi_comm_cols",mpi_comm_cols,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option. Aborting..."
stop
endif
success = .true.
call obj%timer%start("mpi_communication")
......
......@@ -58,9 +58,9 @@
use elpa1_compute, solve_tridi_&
&PRECISION&
&_private_impl => solve_tridi_&
&PRECISION&
&_impl
&_private_impl => solve_tridi_&
&PRECISION&
&_impl
use precision
use elpa_abstract_impl
......@@ -77,7 +77,7 @@
logical :: wantDebug
logical :: success
integer :: debug
integer :: debug, error
call obj%timer%start("elpa_solve_tridi_public_&
&MATH_DATATYPE&
......@@ -90,10 +90,22 @@
ldq = obj%local_nrows
matrixCols = obj%local_ncols
call obj%get("mpi_comm_rows", mpi_comm_rows)
call obj%get("mpi_comm_cols", mpi_comm_cols)
call obj%get("mpi_comm_rows", mpi_comm_rows,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option. Aborting..."
stop
endif
call obj%get("mpi_comm_cols", mpi_comm_cols,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option. Aborting..."
stop
endif
call obj%get("debug",debug)
call obj%get("debug",debug,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option. Aborting..."
stop
endif
if (debug == 1) then
wantDebug = .true.
else
......
......@@ -56,9 +56,9 @@
function elpa_solve_evp_&
&MATH_DATATYPE&
&_1stage_&
&PRECISION&
& (na, nev, a, lda, ev, q, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, mpi_comm_all, &
&_1stage_&
&PRECISION&
& (na, nev, a, lda, ev, q, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, mpi_comm_all, &
useGPU) result(success)
use precision
use iso_c_binding
......@@ -70,7 +70,7 @@ function elpa_solve_evp_&
mpi_comm_cols, mpi_comm_all
real(kind=REAL_DATATYPE), intent(out) :: ev(na)
integer(kind=c_int) :: my_prow, my_pcol, mpierr
integer(kind=c_int) :: my_prow, my_pcol, mpierr,error
#if REALCASE == 1
#ifdef USE_ASSUMED_SIZE
......@@ -112,17 +112,53 @@ function elpa_solve_evp_&
e => elpa_allocate()
call e%set("na", na)
call e%set("nev", nev)
call e%set("local_nrows", lda)
call e%set("local_ncols", matrixCols)
call e%set("nblk", nblk)
call e%set("na", na,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting ..."
stop
endif
call e%set("nev", nev,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting ..."
stop
endif
call e%set("local_nrows", lda,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting ..."
stop
endif
call e%set("local_ncols", matrixCols,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting ..."
stop
endif
call e%set("nblk", nblk,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting ..."
stop
endif
call e%set("mpi_comm_parent", mpi_comm_all)
call e%set("mpi_comm_rows", mpi_comm_rows)
call e%set("mpi_comm_cols", mpi_comm_cols)
call e%set("mpi_comm_parent", mpi_comm_all,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting ..."
stop
endif
call e%set("mpi_comm_rows", mpi_comm_rows,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting ..."
stop
endif
call e%set("mpi_comm_cols", mpi_comm_cols,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting ..."
stop
endif
call e%set("timings",1)
call e%set("timings",1,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting ..."
stop
endif
if (e%setup() .ne. ELPA_OK) then
print *, "Cannot setup ELPA instance"
......@@ -162,7 +198,11 @@ function elpa_solve_evp_&
return
endif
call e%set("timings", 1)
call e%set("timings", 1,error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting ..."
stop
endif
call e%eigenvectors(a(1:lda,1:matrixCols), ev, q(1:ldq,1:matrixCols), successInternal)
......
......@@ -64,7 +64,7 @@
#endif
logical, intent(in) :: wantDebug
logical :: success
integer(kind=ik) :: successInternal
integer(kind=ik) :: successInternal, error
class(elpa_t), pointer :: e
......@@ -84,13 +84,37 @@
e => elpa_allocate()
call e%set("na", na)
call e%set("local_nrows", lda)
call e%set("local_ncols", matrixCols)
call e%set("nblk", nblk)
call e%set("na", na, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call e%set("local_nrows", lda, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call e%set("local_ncols", matrixCols, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call e%set("nblk", nblk, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call e%set("mpi_comm_rows", mpi_comm_rows)
call e%set("mpi_comm_cols", mpi_comm_cols)
call e%set("mpi_comm_rows", mpi_comm_rows, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call e%set("mpi_comm_cols", mpi_comm_cols, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
!! the elpa object needs nev to be set (in case the EVP-solver is
!! called later. Thus it is set by user, do nothing, otherwise,
......@@ -106,7 +130,11 @@
endif
if (wantDebug) then
call e%set("debug",1)
call e%set("debug",1, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
endif
call e%cholesky(a(1:lda,1:matrixCols), successInternal)
......
......@@ -88,7 +88,7 @@
logical, intent(in) :: wantDebug
logical :: success
integer(kind=iK) :: successInternal
integer(kind=iK) :: successInternal, error
class(elpa_t), pointer :: e
!call timer%start("elpa_invert_trm_&
......@@ -107,13 +107,37 @@
e => elpa_allocate()
call e%set("na", na)
call e%set("local_nrows", lda)
call e%set("local_ncols", matrixCols)
call e%set("nblk", nblk)
call e%set("na", na, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call e%set("local_nrows", lda, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call e%set("local_ncols", matrixCols, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call e%set("nblk", nblk, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call e%set("mpi_comm_rows", mpi_comm_rows)
call e%set("mpi_comm_cols", mpi_comm_cols)
call e%set("mpi_comm_rows", mpi_comm_rows, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call e%set("mpi_comm_cols", mpi_comm_cols, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
if (e%setup() .ne. ELPA_OK) then
print *, "Cannot setup ELPA instance"
......@@ -122,7 +146,11 @@
endif
if (wantDebug) then
call e%set("debug",1)
call e%set("debug",1, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
endif
call e%invert_triangular(a(1:lda,1:matrixCols), successInternal)
......
......@@ -95,7 +95,7 @@
! integer(kind=ik) :: istat
! character(200) :: errorMessage
logical :: success
integer(kind=ik) :: successInternal
integer(kind=ik) :: successInternal, error
class(elpa_t), pointer :: e
!call timer%start("elpa_mult_at_b_&
......@@ -122,13 +122,37 @@
e => elpa_allocate()
call e%set("na", na)
call e%set("local_nrows", lda)
call e%set("local_ncols", ldaCols)
call e%set("nblk", nblk)
call e%set("na", na, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call e%set("local_nrows", lda, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call e%set("local_ncols", ldaCols, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call e%set("nblk", nblk, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call e%set("mpi_comm_rows", mpi_comm_rows)
call e%set("mpi_comm_cols", mpi_comm_cols)
call e%set("mpi_comm_rows", mpi_comm_rows, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call e%set("mpi_comm_cols", mpi_comm_cols, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
if (e%setup() .ne. ELPA_OK) then
print *, "Cannot setup ELPA instance"
......
......@@ -89,14 +89,42 @@
obj => elpa_allocate()
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 obj%set("na", na, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call obj%set("nev", nev, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call obj%set("local_nrows", ldq, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call obj%set("local_ncols", matrixCols, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call obj%set("nblk", nblk, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call obj%set("mpi_comm_rows", mpi_comm_rows)
call obj%set("mpi_comm_cols", mpi_comm_cols)
call obj%set("mpi_comm_rows", mpi_comm_rows, error)
if (error .ne. ELPA_OK) then