Commit b5a193e0 authored by Andreas Marek's avatar Andreas Marek

Better checking of allocation/deallocation errors in ELPA 1

parent e56cf139
......@@ -96,6 +96,7 @@ EXTRA_libelpa@SUFFIX@_private_la_DEPENDENCIES = \
src/elpa2/compute_hh_trafo.F90 \
src/elpa2/redist_band.F90 \
src/general/sanity.F90 \
src/general/error_checking_template.F90 \
src/elpa1/elpa_cholesky_template.F90 \
src/elpa1/elpa_invert_trm.F90 \
src/elpa1/elpa_multiply_a_b.F90 \
......@@ -723,6 +724,7 @@ EXTRA_DIST = \
test/shared/test_precision_kinds.F90 \
src/general/prow_pcol.F90 \
src/general/sanity.F90 \
src/general/error_checking_template.F90 \
src/general/elpa_ssr2_template.F90 \
src/general/elpa_ssmv_template.F90 \
test/Fortran/assert.h \
......
......@@ -57,15 +57,7 @@
#include "../general/sanity.F90"
#if REALCASE == 1
!cannot use __FILE__ because filename with path can be too long for gfortran (max line length)
#define check_memcpy_cuda(file, success) call check_memcpy_CUDA_f(file, __LINE__, success)
#define check_alloc_cuda(file, success) call check_alloc_CUDA_f(file, __LINE__, success)
#define check_dealloc_cuda(file, success) call check_dealloc_CUDA_f(file, __LINE__, success)
#define check_host_register_cuda(file, success) call check_host_register_CUDA_f(file, __LINE__, success)
#define check_host_unregister_cuda(file, success) call check_host_unregister_CUDA_f(file, __LINE__, success)
#define check_host_alloc_cuda(file, success) call check_host_alloc_CUDA_f(file, __LINE__, success)
#define check_host_dealloc_cuda(file, success) call check_host_dealloc_CUDA_f(file, __LINE__, success)
#include "../general/error_checking_template.F90"
#endif
#if REALCASE == 1
......
......@@ -126,10 +126,7 @@
integer(kind=ik) :: my_thread
allocate(z_p(na,0:max_threads-1), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"merge_systems: error when allocating z_p "//errorMessage
stop 1
endif
check_allocate("merge_systems: z_p",istat, errorMessage)
#endif
call obj%timer%start("merge_systems" // PRECISION_SUFFIX)
......@@ -609,22 +606,13 @@
gemm_dim_m = MIN(max_strip,MAX(1,nqcols1))
allocate(qtmp1(gemm_dim_k, gemm_dim_l), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"merge_systems: error when allocating qtmp1 "//errorMessage
stop 1
endif
check_allocate("merge_systems: qtmp1",istat, errorMessage)
allocate(ev(gemm_dim_l,gemm_dim_m), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"merge_systems: error when allocating ev "//errorMessage
stop 1
endif
check_allocate("merge_systems: ev",istat, errorMessage)
allocate(qtmp2(gemm_dim_k, gemm_dim_m), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"merge_systems: error when allocating qtmp2 "//errorMessage
stop 1
endif
check_allocate("merge_systems: qtmp2",istat, errorMessage)
qtmp1 = 0 ! May contain empty (unset) parts
qtmp2 = 0 ! Not really needed
......@@ -898,17 +886,11 @@
endif
deallocate(ev, qtmp1, qtmp2, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"merge_systems: error when deallocating ev "//errorMessage
stop 1
endif
check_deallocate("merge_systems: ev, qtmp1, qtmp2",istat, errorMessage)
endif !very outer test (na1==1 .or. na1==2)
#ifdef WITH_OPENMP
deallocate(z_p, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"merge_systems: error when deallocating z_p "//errorMessage
stop 1
endif
check_deallocate("merge_systems: z_p",istat, errorMessage)
#endif
call obj%timer%stop("merge_systems" // PRECISION_SUFFIX)
......@@ -966,10 +948,7 @@
l_cols_out = COUNT(p_col_out(1:na)==my_pcol)
allocate(qtmp(l_rows,l_cols_out), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"resort_ev: error when allocating qtmp "//errorMessage
stop 1
endif
check_allocate("resort_ev: qtmp",istat, errorMessage)
nc = 0
......@@ -1023,10 +1002,7 @@
enddo
deallocate(qtmp, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"resort_ev: error when deallocating qtmp "//errorMessage
stop 1
endif
check_deallocate("resort_ev: qtmp",istat, errorMessage)
end subroutine resort_ev_&
&PRECISION
......
......@@ -117,10 +117,7 @@ subroutine solve_tridi_&
! as fit on the respective processor column
allocate(limits(0:np_cols), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi: error when allocating limits "//errorMessage
stop 1
endif
check_allocate("solve_tridi: limits", istat, errorMessage)
limits(0) = 0
do np=0,np_cols-1
......@@ -168,10 +165,7 @@ subroutine solve_tridi_&
if (np_cols==1) then
deallocate(limits, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi: error when deallocating limits "//errorMessage
stop 1
endif
check_deallocate("solve_tridi: limits", istat, errorMessage)
call obj%timer%stop("solve_tridi" // PRECISION_SUFFIX // gpuString)
return
......@@ -182,16 +176,10 @@ subroutine solve_tridi_&
! Dense distribution scheme:
allocate(l_col(na), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi: error when allocating l_col "//errorMessage
stop 1
endif
check_allocate("solve_tridi: l_col", istat, errorMessage)
allocate(p_col(na), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi: error when allocating p_col "//errorMessage
stop 1
endif
check_allocate("solve_tridi: p_col", istat, errorMessage)
n = 0
do np=0,np_cols-1
......@@ -206,16 +194,10 @@ subroutine solve_tridi_&
! Block cyclic distribution scheme, only nev columns are set:
allocate(l_col_bc(na), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi: error when allocating l_col_bc "//errorMessage
stop 1
endif
check_allocate("solve_tridi: l_col_bc", istat, errorMessage)
allocate(p_col_bc(na), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi: error when allocating p_col_bc "//errorMessage
stop 1
endif
check_allocate("solve_tridi: p_col_bc", istat, errorMessage)
p_col_bc(:) = -1
l_col_bc(:) = -1
......@@ -241,10 +223,7 @@ subroutine solve_tridi_&
endif
deallocate(limits,l_col,p_col,l_col_bc,p_col_bc, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi: error when deallocating l_col "//errorMessage
stop 1
endif
check_deallocate("solve_tridi: limits, l_col, p_col, l_col_bc, p_col_bc", istat, errorMessage)
call obj%timer%stop("solve_tridi" // PRECISION_SUFFIX // gpuString)
return
......@@ -424,10 +403,7 @@ subroutine solve_tridi_&
if (np_rows==1 .and. nev<na .and. na>2*min_submatrix_size) ndiv = 2
allocate(limits(0:ndiv), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_col: error when allocating limits "//errorMessage
stop 1
endif
check_deallocate("solve_tridi_col: limits", istat, errorMessage)
limits(0) = 0
limits(ndiv) = na
......@@ -477,16 +453,10 @@ subroutine solve_tridi_&
! There is at maximum 1 subproblem per processor
allocate(qmat1(max_size,max_size), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_col: error when allocating qmat1 "//errorMessage
stop 1
endif
check_deallocate("solve_tridi_col: qmat1", istat, errorMessage)
allocate(qmat2(max_size,max_size), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_col: error when allocating qmat2 "//errorMessage
stop 1
endif
check_deallocate("solve_tridi_col: qmat2", istat, errorMessage)
qmat1 = 0 ! Make sure that all elements are defined
......@@ -535,20 +505,14 @@ subroutine solve_tridi_&
enddo
deallocate(qmat1, qmat2, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_col: error when deallocating qmat2 "//errorMessage
stop 1
endif
check_deallocate("solve_tridi_col: qmat1, qmat2", istat, errorMessage)
endif
! Allocate and set index arrays l_col and p_col
allocate(l_col(na), p_col_i(na), p_col_o(na), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_col: error when allocating l_col "//errorMessage
stop 1
endif
check_deallocate("solve_tridi_col: l_col, p_col_i, p_col_o", istat, errorMessage)
do i=1,na
l_col(i) = i
......@@ -586,10 +550,7 @@ subroutine solve_tridi_&
enddo
deallocate(limits, l_col, p_col_i, p_col_o, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_col: error when deallocating l_col "//errorMessage
stop 1
endif
check_deallocate("solve_tridi_col: limits, l_col, p_col_i, p_col_o", istat, errorMessage)
call obj%timer%stop("solve_tridi_col" // PRECISION_SUFFIX)
......@@ -627,10 +588,7 @@ subroutine solve_tridi_&
success = .true.
allocate(ds(nlen), es(nlen), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_single: error when allocating ds "//errorMessage
stop 1
endif
check_allocate("solve_tridi_single: ds, es", istat, errorMessage)
! Save d and e for the case that dstedc fails
......@@ -642,10 +600,7 @@ subroutine solve_tridi_&
lwork = 1 + 4*nlen + nlen**2
liwork = 3 + 5*nlen
allocate(work(lwork), iwork(liwork), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_single: error when allocating work "//errorMessage
stop 1
endif
check_allocate("solve_tridi_single: work, iwork", istat, errorMessage)
call obj%timer%start("blas")
call PRECISION_STEDC('I', int(nlen,kind=BLAS_KIND), d, e, q, int(ldq,kind=BLAS_KIND), &
work, int(lwork,kind=BLAS_KIND), int(iwork,kind=BLAS_KIND), int(liwork,kind=BLAS_KIND), &
......@@ -677,10 +632,7 @@ subroutine solve_tridi_&
end if
deallocate(work,iwork,ds,es, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_single: error when deallocating ds "//errorMessage
stop 1
endif
check_deallocate("solve_tridi_single: work, iwork, ds, es", istat, errorMessage)
! Check if eigenvalues are monotonically increasing
! This seems to be not always the case (in the IBM implementation of dstedc ???)
......@@ -700,10 +652,7 @@ subroutine solve_tridi_&
write(error_unit,'(a)') 'Still, we keep this info message just in case.'
end if
allocate(qtmp(nlen), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_single: error when allocating qtmp "//errorMessage
stop 1
endif
check_allocate("solve_tridi_single: qtmp", istat, errorMessage)
dtmp = d(i+1)
qtmp(1:nlen) = q(1:nlen,i+1)
......@@ -718,10 +667,7 @@ subroutine solve_tridi_&
d(j+1) = dtmp
q(1:nlen,j+1) = qtmp(1:nlen)
deallocate(qtmp, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_tridi_single: error when deallocating qtmp "//errorMessage
stop 1
endif
check_deallocate("solve_tridi_single: qtmp", istat, errorMessage)
endif
enddo
......
......@@ -53,6 +53,7 @@
#endif
#include "../general/sanity.F90"
#include "../general/error_checking_template.F90"
function elpa_solve_evp_&
&MATH_DATATYPE&
......@@ -381,7 +382,8 @@ function elpa_solve_evp_&
if (.not.(obj%eigenvalues_only)) then
q_actual => q(1:matrixRows,1:matrixCols)
else
allocate(q_dummy(1:matrixRows,1:matrixCols))
allocate(q_dummy(1:matrixRows,1:matrixCols), stat=istat, errmsg=errorMessage)
check_allocate("elpa1_template: q_dummy", istat, errorMessage)
q_actual => q_dummy
endif
......@@ -396,25 +398,10 @@ function elpa_solve_evp_&
l_cols_nev = local_index(nev, my_pcol, np_cols, nblk, -1) ! Local columns corresponding to nev
allocate(q_real(l_rows,l_cols), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_evp_&
&MATH_DATATYPE&
&_1stage_&
&PRECISION&
&" // ": error when allocating q_real "//errorMessage
stop 1
endif
check_allocate("elpa1_template: q_real", istat, errorMessage)
#endif
allocate(e(na), tau(na), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_evp_&
&MATH_DATATYPE&
&_1stage_&
&PRECISION&
&" // ": error when allocating e, tau "//errorMessage
stop 1
endif
check_allocate("elpa1_template: e, tau", istat, errorMessage)
! start the computations
! as default do all three steps (this might change at some point)
......@@ -564,36 +551,15 @@ function elpa_solve_evp_&
#if COMPLEXCASE == 1
deallocate(q_real, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_evp_&
&MATH_DATATYPE&
&_1stage_&
&PRECISION&
&" // ": error when deallocating q_real "//errorMessage
stop 1
endif
check_deallocate("elpa1_template: q_real", istat, errorMessage)
#endif
deallocate(e, tau, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_evp_&
&MATH_DATATYPE&
&_1stage_&
&PRECISION&
&" // ": error when deallocating e, tau "//errorMessage
stop 1
endif
check_deallocate("elpa1_template: e, tau", istat, errorMessage)
if (obj%eigenvalues_only) then
deallocate(q_dummy, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"solve_evp_&
&MATH_DATATYPE&
&_1stage_&
&PRECISION&
&" // ": error when deallocating q_dummy "//errorMessage
stop 1
endif
check_deallocate("elpa1_template: q_dummy", istat, errorMessage)
endif
#ifdef WITH_NVTX
......
......@@ -488,12 +488,9 @@
enddo ! istep=1,na,nblk
deallocate(h1, h2, hvb, hvm, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"trans_ev_&
check_deallocate("trans_ev_&
&MATH_DATATYPE&
&: error when deallocating hvm "//errorMessage
stop 1
endif
&: h1, h2, hvb, hvm", istat, errorMessage)
if (useGPU) then
!q_mat = q_dev
......@@ -542,12 +539,9 @@
check_dealloc_cuda("trans_ev", successCUDA)
else
deallocate(tmat, tmp1, tmp2, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"trans_ev_&
&MATH_DATATYPE&
&: error when deallocating hvm "//errorMessage
stop 1
endif
check_deallocate("trans_ev_&
&MATH_DATATYPE&
&: tmat, tmp1, tmp2", istat, errorMessage)
endif
......
......@@ -1047,10 +1047,7 @@ call prmat(na, useGpu, a_mat, a_dev, matrixRows, matrixCols, nblk, my_prow, my_p
#endif
deallocate(tmp, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"tridiag: error when deallocating "//errorMessage
stop 1
endif
check_deallocate("tridiag: tmp", istat, errorMessage)
if (useGPU) then
! todo: should we leave a_mat on the device for further use?
......@@ -1079,11 +1076,7 @@ call prmat(na, useGpu, a_mat, a_dev, matrixRows, matrixCols, nblk, my_prow, my_p
! distribute the arrays d_vec and e_vec to all processors
allocate(tmp_real(na), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"tridiag: error when allocating tmp_real "//errorMessage
stop 1
endif
check_allocate("tridiag: tmp_real", istat, errorMessage)
#ifdef WITH_MPI
if (wantDebug) call obj%timer%start("mpi_communication")
......@@ -1103,11 +1096,7 @@ call prmat(na, useGpu, a_mat, a_dev, matrixRows, matrixCols, nblk, my_prow, my_p
#endif /* WITH_MPI */
deallocate(tmp_real, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"tridiag: error when deallocating tmp_real "//errorMessage
stop 1
endif
check_deallocate("tridiag: tmp_real", istat, errorMessage)
if (useGPU) then
successCUDA = cuda_host_unregister(int(loc(a_mat),kind=c_intptr_t))
......@@ -1142,17 +1131,11 @@ call prmat(na, useGpu, a_mat, a_dev, matrixRows, matrixCols, nblk, my_prow, my_p
check_host_unregister_cuda("tridiag: d_vec", successCUDA)
else
deallocate(v_row, v_col, u_row, u_col, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"tridiag: error when deallocating "//errorMessage
stop 1
endif
check_deallocate("tridiag: v_row, v_col, u_row, u_col", istat, errorMessage)
endif
deallocate(vu_stored_rows, uv_stored_cols, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"tridiag: error when deallocating "//errorMessage
stop 1
endif
check_deallocate("tridiag: vu_stored_rows, uv_stored_cols", istat, errorMessage)
call obj%timer%stop("tridiag_&
&MATH_DATATYPE&
......
......@@ -43,6 +43,7 @@
! the original distribution, the GNU Lesser General Public License.
#include "../general/sanity.F90"
#include "../general/error_checking_template.F90"
use elpa1_compute
use elpa_utilities
use elpa_mpi
......@@ -145,38 +146,19 @@
l_cols = local_index(na, my_pcol, np_cols, nblk, -1) ! Local cols of a
allocate(tmp1(nblk*nblk), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"elpa_cholesky_&
&MATH_DATATYPE&: error when allocating tmp1 "//errorMessage
stop 1
endif
check_allocate("elpa_cholesky: tmp1", istat, errorMessage)
allocate(tmp2(nblk,nblk), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"elpa_cholesky_&
&MATH_DATATYPE&
&: error when allocating tmp2 "//errorMessage
stop 1
endif
check_allocate("elpa_cholesky: tmp2", istat, errorMessage)
tmp1 = 0
tmp2 = 0
allocate(tmatr(l_rows,nblk), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"elpa_cholesky_&
&MATH_DATATYPE&
&: error when allocating tmatr "//errorMessage
stop 1
endif
check_allocate("elpa_cholesky: tmatr", istat, errorMessage)
allocate(tmatc(l_cols,nblk), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"elpa_cholesky_&
&MATH_DATATYPE&
&: error when allocating tmatc "//errorMessage
stop 1
endif
check_allocate("elpa_cholesky: tmatc", istat, errorMessage)
tmatr = 0
tmatc = 0
......@@ -334,12 +316,7 @@
enddo
deallocate(tmp1, tmp2, tmatr, tmatc, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"elpa_cholesky_&
&MATH_DATATYPE&
&: error when deallocating tmp1 "//errorMessage
stop 1
endif
check_deallocate("elpa_cholesky: tmp1, tmp2, tmatr, tmatc", istat, errorMessage)
! Set the lower triangle to 0, it contains garbage (form the above matrix multiplications)
......
......@@ -51,6 +51,7 @@
! distributed along with the original code in the file "COPYING".
#include "../general/sanity.F90"
#include "../general/error_checking_template.F90"
use precision
use elpa1_compute
......@@ -129,39 +130,19 @@
l_cols = local_index(na, my_pcol, np_cols, nblk, -1) ! Local cols of a
allocate(tmp1(nblk*nblk), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"elpa_invert_trm_&
&MATH_DATATYPE&
&: error when allocating tmp1 "//errorMessage
stop 1
endif
check_allocate("elpa_invert_trm: tmp1", istat, errorMessage)
allocate(tmp2(nblk,nblk), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"elpa_invert_trm_&
&MATH_DATATYPE&
&: error when allocating tmp2 "//errorMessage
stop 1
endif
check_allocate("elpa_invert_trm: tmp2", istat, errorMessage)
tmp1 = 0
tmp2 = 0
allocate(tmat1(l_rows,nblk), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"elpa_invert_trm_&
&MATH_DATATYPE&
&: error when allocating tmat1 "//errorMessage
stop 1
endif
check_allocate("elpa_invert_trm: tmat1", istat, errorMessage)
allocate(tmat2(nblk,l_cols), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"elpa_invert_trm_&
&MATH_DATATYPE&
&: error when allocating tmat2 "//errorMessage
stop 1
endif
check_allocate("elpa_invert_trm: tmat2", istat, errorMessage)
tmat1 = 0
tmat2 = 0
......@@ -276,12 +257,7 @@
enddo
deallocate(tmp1, tmp2, tmat1, tmat2, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"elpa_invert_trm_&
&MATH_DATATYPE&
&: error when deallocating tmp1 "//errorMessage
stop 1
endif
check_deallocate("elpa_invert_trm: tmp1, tmp2, tmat1, tmat2", istat, errorMessage)
call obj%timer%stop("elpa_invert_trm_&
&MATH_DATATYPE&
......
......@@ -52,16 +52,9 @@
! Author: A. Marek, MPCDF
!cannot use __FILE__ because filename with path can be too long for gfortran (max line length)
#define check_memcpy_cuda(file, success) call check_memcpy_CUDA_f(file, __LINE__, success)
#define check_alloc_cuda(file, success) call check_alloc_CUDA_f(file, __LINE__, success)
#define check_dealloc_cuda(file, success) call check_dealloc_CUDA_f(file, __LINE__, success)
#define check_host_register_cuda(file, success) call check_host_register_CUDA_f(file, __LINE__, success)
#define check_host_unregister_cuda(file, success) call check_host_unregister_CUDA_f(file, __LINE__, success)
#define check_host_alloc_cuda(file, success) call check_host_alloc_CUDA_f(file, __LINE__, success)
#define check_host_dealloc_cuda(file, success) call check_host_dealloc_CUDA_f(file, __LINE__, success)
#include "../general/sanity.F90"
#include "../general/error_checking_template.F90"
use elpa1_compute
use elpa_mpi
......@@ -232,25 +225,17 @@
check_alloc_cuda("elpa_mult_at_b: tmp1_dev", successCUDA)
else ! useGPU
allocate(aux_mat(l_rows,nblk_mult), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"elpa_mult_at_b_&
&MATH_DATATYPE&
&: error when allocating aux_mat "//errorMessage
stop
endif
check_allocate("elpa_mult_at_b: aux_mat", istat, errorMessage)
endif ! useGPU
allocate(aux_bc(l_rows*nblk), stat=istat, errmsg=errorMessage)
call check_alloc("elpa_mult_at_b_&
&MATH_DATATYPE ", "aux_bc", istat, errorMessage)
check_allocate("elpa_mult_at_b: aux_bc", istat, errorMessage)
allocate(lrs_save(nblk), stat=istat, errmsg=errorMessage)
call check_alloc("elpa_mult_at_b_&
&MATH_DATATYPE ", "lrs_save", istat, errorMessage)
check_allocate("elpa_mult_at_b: lrs_save", istat, errorMessage)
allocate(lre_save(nblk), stat=istat, errmsg=errorMessage)
call check_alloc("elpa_mult_at_b_&
&MATH_DATATYPE ", "lre_save", istat, errorMessage)
check_allocate("elpa_mult_at_b: lre_save", istat, errorMessage)
a_lower = .false.
a_upper = .false.
......@@ -410,13 +395,7 @@