Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
elpa
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
14
Issues
14
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
Operations
Operations
Incidents
Environments
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
elpa
elpa
Commits
2a9f9fa8
Commit
2a9f9fa8
authored
Apr 07, 2020
by
Andreas Marek
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Better checking of allocation/deallocation errors in ELPA 2
parent
b5a193e0
Changes
16
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
16 changed files
with
153 additions
and
617 deletions
+153
-617
Makefile.am
Makefile.am
+2
-2
src/elpa1/elpa1_compute_template.F90
src/elpa1/elpa1_compute_template.F90
+1
-1
src/elpa1/elpa1_template.F90
src/elpa1/elpa1_template.F90
+1
-1
src/elpa1/elpa_cholesky_template.F90
src/elpa1/elpa_cholesky_template.F90
+1
-1
src/elpa1/elpa_invert_trm.F90
src/elpa1/elpa_invert_trm.F90
+1
-1
src/elpa1/elpa_multiply_a_b.F90
src/elpa1/elpa_multiply_a_b.F90
+1
-1
src/elpa1/elpa_reduce_add_vectors.F90
src/elpa1/elpa_reduce_add_vectors.F90
+1
-1
src/elpa1/elpa_transpose_vectors.F90
src/elpa1/elpa_transpose_vectors.F90
+1
-1
src/elpa2/elpa2_bandred_template.F90
src/elpa2/elpa2_bandred_template.F90
+20
-106
src/elpa2/elpa2_compute_real_template.F90
src/elpa2/elpa2_compute_real_template.F90
+1
-9
src/elpa2/elpa2_template.F90
src/elpa2/elpa2_template.F90
+12
-57
src/elpa2/elpa2_trans_ev_band_to_full_template.F90
src/elpa2/elpa2_trans_ev_band_to_full_template.F90
+14
-84
src/elpa2/elpa2_trans_ev_tridi_to_band_template.F90
src/elpa2/elpa2_trans_ev_tridi_to_band_template.F90
+34
-193
src/elpa2/elpa2_tridiag_band_template.F90
src/elpa2/elpa2_tridiag_band_template.F90
+24
-141
src/elpa2/redist_band.F90
src/elpa2/redist_band.F90
+38
-18
src/general/error_checking.inc
src/general/error_checking.inc
+1
-0
No files found.
Makefile.am
View file @
2a9f9fa8
...
...
@@ -96,7 +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/general/error_checking
.inc
\
src/elpa1/elpa_cholesky_template.F90
\
src/elpa1/elpa_invert_trm.F90
\
src/elpa1/elpa_multiply_a_b.F90
\
...
...
@@ -724,7 +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/error_checking
.inc
\
src/general/elpa_ssr2_template.F90
\
src/general/elpa_ssmv_template.F90
\
test
/Fortran/assert.h
\
...
...
src/elpa1/elpa1_compute_template.F90
View file @
2a9f9fa8
...
...
@@ -57,7 +57,7 @@
#include "../general/sanity.F90"
#if REALCASE == 1
#include "../general/error_checking
_template.F90
"
#include "../general/error_checking
.inc
"
#endif
#if REALCASE == 1
...
...
src/elpa1/elpa1_template.F90
View file @
2a9f9fa8
...
...
@@ -53,7 +53,7 @@
#endif
#include "../general/sanity.F90"
#include "../general/error_checking
_template.F90
"
#include "../general/error_checking
.inc
"
function
elpa_solve_evp_
&
&
MATH_DATATYPE
&
...
...
src/elpa1/elpa_cholesky_template.F90
View file @
2a9f9fa8
...
...
@@ -43,7 +43,7 @@
! the original distribution, the GNU Lesser General Public License.
#include "../general/sanity.F90"
#include "../general/error_checking
_template.F90
"
#include "../general/error_checking
.inc
"
use
elpa1_compute
use
elpa_utilities
use
elpa_mpi
...
...
src/elpa1/elpa_invert_trm.F90
View file @
2a9f9fa8
...
...
@@ -51,7 +51,7 @@
! distributed along with the original code in the file "COPYING".
#include "../general/sanity.F90"
#include "../general/error_checking
_template.F90
"
#include "../general/error_checking
.inc
"
use
precision
use
elpa1_compute
...
...
src/elpa1/elpa_multiply_a_b.F90
View file @
2a9f9fa8
...
...
@@ -54,7 +54,7 @@
#include "../general/sanity.F90"
#include "../general/error_checking
_template.F90
"
#include "../general/error_checking
.inc
"
use
elpa1_compute
use
elpa_mpi
...
...
src/elpa1/elpa_reduce_add_vectors.F90
View file @
2a9f9fa8
...
...
@@ -45,7 +45,7 @@
#include "config-f90.h"
#include "../general/sanity.F90"
#include "../general/error_checking
_template.F90
"
#include "../general/error_checking
.inc
"
subroutine
elpa_reduce_add_vectors_
&
&
MATH_DATATYPE
&
...
...
src/elpa1/elpa_transpose_vectors.F90
View file @
2a9f9fa8
...
...
@@ -49,7 +49,7 @@
#include "config-f90.h"
#include "../general/sanity.F90"
#include "../general/error_checking
_template.F90
"
#include "../general/error_checking
.inc
"
#undef ROUTINE_NAME
#ifdef SKEW_SYMMETRIC_BUILD
...
...
src/elpa2/elpa2_bandred_template.F90
View file @
2a9f9fa8
...
...
@@ -327,23 +327,14 @@
if
(
which_qr_decomposition
==
1
)
then
call
qr_pqrparam_init
(
obj
,
pqrparam
(
1
:
11
),
nblk
,
'M'
,
0
,
nblk
,
'M'
,
0
,
nblk
,
'M'
,
1
,
's'
)
allocate
(
tauvector
(
na
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_real: error when allocating tauvector "
//
errorMessage
stop
1
endif
check_allocate
(
"bandred: tauvector"
,
istat
,
errorMessage
)
allocate
(
blockheuristic
(
nblk
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_real: error when allocating blockheuristic "
//
errorMessage
stop
1
endif
check_allocate
(
"bandred: blockheuristic"
,
istat
,
errorMessage
)
l_rows
=
local_index
(
na
,
my_prow
,
np_rows
,
nblk
,
-1
)
allocate
(
vmrCPU
(
max
(
l_rows
,
1
),
na
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_real: error when allocating vmrCPU "
//
errorMessage
stop
1
endif
check_allocate
(
"bandred: vmrCPU"
,
istat
,
errorMessage
)
vmrCols
=
na
...
...
@@ -365,16 +356,10 @@
work_size
=
int
(
dwork_size
(
1
))
allocate
(
work_blocked
(
work_size
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_real: error when allocating work_blocked "
//
errorMessage
stop
1
endif
check_allocate
(
"bandred: work_blocked"
,
istat
,
errorMessage
)
work_blocked
=
0.0_rk
deallocate
(
vmrCPU
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_real: error when deallocating vmrCPU "
//
errorMessage
stop
1
endif
check_deallocate
(
"bandred: vmrCPU"
,
istat
,
errorMessage
)
endif
! which_qr_decomposition
...
...
@@ -466,28 +451,13 @@
! Allocate vmr and umcCPU to their exact sizes so that they can be used in bcasts and reduces
allocate
(
vmrCPU
(
max
(
l_rows
,
1
),
2
*
n_cols
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_&
&MATH_DATATYPE&
&: error when allocating vmrCPU "
//
errorMessage
stop
1
endif
check_allocate
(
"bandred: vmrCPU"
,
istat
,
errorMessage
)
allocate
(
umcCPU
(
max
(
l_cols
,
1
),
2
*
n_cols
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_&
&MATH_DATATYPE&
&: error when allocating umcCPU "
//
errorMessage
stop
1
endif
check_allocate
(
"bandred: umcCPU"
,
istat
,
errorMessage
)
allocate
(
vr
(
l_rows
+1
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_&
&MATH_DATATYPE&
&: error when allocating vr "
//
errorMessage
stop
1
endif
check_allocate
(
"bandred: vr"
,
istat
,
errorMessage
)
endif
! use GPU
...
...
@@ -1205,12 +1175,7 @@
if
(
useGPU
)
then
#ifdef WITH_MPI
allocate
(
tmpCUDA
(
l_cols
*
n_cols
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_&
&MATH_DATATYPE&
&: error when allocating tmpCUDA "
//
errorMessage
stop
1
endif
check_allocate
(
"bandred: tmpCUDA"
,
istat
,
errorMessage
)
if
(
wantDebug
)
call
obj
%
timer
%
start
(
"mpi_communication"
)
...
...
@@ -1223,23 +1188,13 @@
if
(
allocated
(
tmpCUDA
))
then
deallocate
(
tmpCUDA
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_&
&MATH_DATATYPE&
&: error when deallocating tmpCUDA "
//
errorMessage
stop
1
endif
check_deallocate
(
"bandred: tmpCUDA"
,
istat
,
errorMessage
)
endif
else
! useGPU
allocate
(
tmpCPU
(
l_cols
,
n_cols
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_&
&MATH_DATATYPE&
&: error when allocating tmpCPU "
//
errorMessage
stop
1
endif
check_allocate
(
"bandred: tmpCPU"
,
istat
,
errorMessage
)
#ifdef WITH_MPI
if
(
wantDebug
)
call
obj
%
timer
%
start
(
"mpi_communication"
)
...
...
@@ -1250,12 +1205,7 @@
#endif /* WITH_MPI */
deallocate
(
tmpCPU
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_&
&MATH_DATATYPE&
&: error when deallocating tmpCPU "
//
errorMessage
stop
1
endif
check_deallocate
(
"bandred: tmpCPU"
,
istat
,
errorMessage
)
endif
! useGPU
endif
! l_cols > 0
...
...
@@ -1517,32 +1467,17 @@
if
(
.not.
(
useGPU
))
then
if
(
allocated
(
vr
))
then
deallocate
(
vr
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_&
&MATH_DATATYPE&
&: error when deallocating vr "
//
errorMessage
stop
1
endif
check_deallocate
(
"bandred: vr"
,
istat
,
errorMessage
)
endif
if
(
allocated
(
umcCPU
))
then
deallocate
(
umcCPU
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_&
&MATH_DATATYPE&
&: error when deallocating umcCPU "
//
errorMessage
stop
1
endif
check_deallocate
(
"bandred: umcCPU"
,
istat
,
errorMessage
)
endif
if
(
allocated
(
vmrCPU
))
then
deallocate
(
vmrCPU
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_&
&MATH_DATATYPE&
&: error when deallocating vmrCPU "
//
errorMessage
stop
1
endif
check_deallocate
(
"bandred: vmrCPU"
,
istat
,
errorMessage
)
endif
endif
!useGPU
...
...
@@ -1598,48 +1533,27 @@
if
(
allocated
(
vr
))
then
deallocate
(
vr
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_&
&MATH_DATATYPE&
&: error when deallocating vr "
//
errorMessage
stop
1
endif
check_deallocate
(
"bandred: vr"
,
istat
,
errorMessage
)
endif
if
(
allocated
(
umcCPU
))
then
deallocate
(
umcCPU
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_&
&MATH_DATATYPE&
&: error when deallocating umcCPU "
//
errorMessage
stop
1
endif
check_deallocate
(
"bandred: umcCPU"
,
istat
,
errorMessage
)
endif
if
(
allocated
(
vmrCPU
))
then
deallocate
(
vmrCPU
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_&
&MATH_DATATYPE&
&: error when deallocating vmrCPU "
//
errorMessage
stop
1
endif
check_deallocate
(
"bandred: vmrCPU"
,
istat
,
errorMessage
)
endif
#if REALCASE == 1
if
(
useQR
)
then
if
(
which_qr_decomposition
==
1
)
then
deallocate
(
work_blocked
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_real: error when deallocating work_blocked "
//
errorMessage
stop
1
endif
check_deallocate
(
"bandred: work_blocked"
,
istat
,
errorMessage
)
deallocate
(
tauvector
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"bandred_real: error when deallocating tauvector "
//
errorMessage
stop
1
endif
check_deallocate
(
"bandred: tauvector"
,
istat
,
errorMessage
)
endif
endif
#endif
...
...
src/elpa2/elpa2_compute_real_template.F90
View file @
2a9f9fa8
...
...
@@ -56,15 +56,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)
#define check_memset_cuda(file, success) call check_memset_CUDA_f(file, __LINE__, success)
#include "../general/error_checking.inc"
#endif
...
...
src/elpa2/elpa2_template.F90
View file @
2a9f9fa8
...
...
@@ -53,6 +53,7 @@
#endif
#include "elpa/elpa_simd_constants.h"
#include "../general/error_checking.inc"
function
elpa_solve_evp_
&
&
MATH_DATATYPE
&
...
...
@@ -72,7 +73,7 @@
q
)
result
(
success
)
#endif
use
matrix_plot
!
use matrix_plot
use
elpa_abstract_impl
use
elpa_utilities
use
elpa1_compute
...
...
@@ -619,7 +620,8 @@
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
(
"elpa2_template: q_dummy"
,
istat
,
errorMessage
)
q_actual
=>
q_dummy
(
1
:
matrixRows
,
1
:
matrixCols
)
endif
...
...
@@ -707,14 +709,7 @@
! tmat is needed only in full->band and band->full steps, so alocate here
! (not allocated for banded matrix on input)
allocate
(
tmat
(
nbw
,
nbw
,
num_blocks
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"solve_evp_&
&MATH_DATATYPE&
&_2stage_&
&PRECISION&
&"
//
": error when allocating tmat "
//
errorMessage
stop
1
endif
check_allocate
(
"elpa2_template: tmat"
,
istat
,
errorMessage
)
do_bandred
=
.true.
do_solve_tridi
=
.true.
...
...
@@ -751,13 +746,7 @@
! Reduction band -> tridiagonal
if
(
do_tridiag
)
then
allocate
(
e
(
na
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"solve_evp_&
&MATH_DATATYPE&
&_2stage_&
&PRECISION "
//
": error when allocating e "
//
errorMessage
stop
1
endif
check_allocate
(
"elpa2_template: e"
,
istat
,
errorMessage
)
call
obj
%
timer
%
start
(
"tridiag"
)
#ifdef HAVE_LIKWID
...
...
@@ -806,12 +795,7 @@
allocate
(
q_real
(
l_rows
,
l_cols
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"solve_evp_&
&MATH_DATATYPE&
&_2stage: error when allocating q_real"
//
errorMessage
stop
1
endif
check_allocate
(
"elpa2_template: q_real"
,
istat
,
errorMessage
)
#endif
! Solve tridiagonal system
...
...
@@ -839,12 +823,7 @@
endif
! do_solve_tridi
deallocate
(
e
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"solve_evp_&
&MATH_DATATYPE&
&_2stage: error when deallocating e "
//
errorMessage
stop
1
endif
check_deallocate
(
"elpa2_template: e"
,
istat
,
errorMessage
)
if
(
obj
%
eigenvalues_only
)
then
do_trans_to_band
=
.false.
...
...
@@ -881,12 +860,7 @@
q
(
1
:
l_rows
,
1
:
l_cols_nev
)
=
q_real
(
1
:
l_rows
,
1
:
l_cols_nev
)
deallocate
(
q_real
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"solve_evp_&
&MATH_DATATYPE&
&_2stage: error when deallocating q_real"
//
errorMessage
stop
1
endif
check_deallocate
(
"elpa2_template: q_real"
,
istat
,
errorMessage
)
#endif
endif
...
...
@@ -980,13 +954,7 @@
endif
! We can now deallocate the stored householder vectors
deallocate
(
hh_trans
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"solve_evp_&
&MATH_DATATYPE&
&_2stage_&
&PRECISION "
//
": error when deallocating hh_trans "
//
errorMessage
stop
1
endif
check_deallocate
(
"elpa2_template: hh_trans"
,
istat
,
errorMessage
)
endif
if
(
do_trans_to_full
)
then
...
...
@@ -1009,13 +977,7 @@
endif
deallocate
(
tmat
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"solve_evp_&
&MATH_DATATYPE&
&_2stage_&
&PRECISION "
//
": error when deallocating tmat"
//
errorMessage
stop
1
endif
check_deallocate
(
"elpa2_template: tmat"
,
istat
,
errorMessage
)
#ifdef HAVE_LIKWID
call
likwid_markerStopRegion
(
"trans_ev_to_full"
)
#endif
...
...
@@ -1024,14 +986,7 @@
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
(
"elpa2_template: q_dummy"
,
istat
,
errorMessage
)
endif
! restore original OpenMP settings
...
...
src/elpa2/elpa2_trans_ev_band_to_full_template.F90
View file @
2a9f9fa8
...
...
@@ -221,45 +221,20 @@
else
! useGPU
allocate
(
tmp1
(
max_local_cols
*
cwy_blocking
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"trans_ev_band_to_full_&
&MATH_DATATYPE&
&: error when allocating tmp1 "
//
errorMessage
stop
1
endif
check_allocate
(
"trans_ev_band_to_full: tmp1"
,
istat
,
errorMessage
)
allocate
(
tmp2
(
max_local_cols
*
cwy_blocking
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"trans_ev_band_to_full_&
&MATH_DATATYPE&
&: error when allocating tmp2 "
//
errorMessage
stop
1
endif
check_allocate
(
"trans_ev_band_to_full: tmp2"
,
istat
,
errorMessage
)
allocate
(
hvm
(
max_local_rows
,
cwy_blocking
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"trans_ev_band_to_full_&
&MATH_DATATYPE&
&: error when allocating hvm "
//
errorMessage
stop
1
endif
check_allocate
(
"trans_ev_band_to_full: hvm"
,
istat
,
errorMessage
)
endif
!useGPU
allocate
(
hvb
(
max_local_rows
*
cwy_blocking
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"trans_ev_band_to_full_&
&MATH_DATATYPE&
&: error when allocating hvb "
//
errorMessage
stop
1
endif
check_allocate
(
"trans_ev_band_to_full: hvb"
,
istat
,
errorMessage
)
allocate
(
tmat_complete
(
cwy_blocking
,
cwy_blocking
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"trans_ev_band_to_full_&
&MATH_DATATYPE&
&: error when allocating tmat_complete "
//
errorMessage
stop
1
endif
check_allocate
(
"trans_ev_band_to_full: tmat_complete"
,
istat
,
errorMessage
)
if
(
useGPU
)
then
successCUDA
=
cuda_host_register
(
int
(
loc
(
tmat_complete
),
kind
=
c_intptr_t
),
&
...
...
@@ -270,20 +245,10 @@
if
(
blocking_factor
>
1
)
then
allocate
(
t_tmp
(
cwy_blocking
,
nbw
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"trans_ev_band_to_full_&
&MATH_DATATYPE&
&: error when allocating t_tmp "
//
errorMessage
stop
1
endif
check_allocate
(
"trans_ev_band_to_full: t_tmp"
,
istat
,
errorMessage
)
allocate
(
t_tmp2
(
cwy_blocking
,
nbw
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"trans_ev_band_to_full_&
&MATH_DATATYPE&
&: error when allocating t_tmp2 "
//
errorMessage
stop
1
endif
check_allocate
(
"trans_ev_band_to_full: t_tmp2"
,
istat
,
errorMessage
)
endif
if
(
useGPU
)
then
...
...
@@ -512,12 +477,7 @@
enddo
! istep
deallocate
(
hvb
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"trans_ev_band_to_full_&
&MATH_DATATYPE&
&: error when deallocating hvb "
//
errorMessage
stop
1
endif
check_deallocate
(
"trans_ev_band_to_full: hvb"
,
istat
,
errorMessage
)
if
(
useGPU
)
then
successCUDA
=
cuda_free
(
hvm_dev
)
...
...
@@ -556,54 +516,24 @@
check_host_unregister_cuda
(
"trans_ev_band_to_full: tmat_complete"
,
successCUDA
)
else
! useGPU
deallocate
(
tmp1
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"trans_ev_band_to_full_&
&MATH_DATATYPE&
&: error when deallocating tmp1 "
//
errorMessage
stop
1
endif
check_deallocate
(
"trans_ev_band_to_full: tmp1"
,
istat
,
errorMessage
)
deallocate
(
tmp2
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"trans_ev_band_to_full_&
&MATH_DATATYPE&
&: error when deallocating tmp2 "
//
errorMessage
stop
1
endif
check_deallocate
(
"trans_ev_band_to_full: tmp2"
,
istat
,
errorMessage
)
deallocate
(
hvm
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"trans_ev_band_to_full_&
&MATH_DATATYPE&
&: error when deallocating hvm "
//
errorMessage
stop
1
endif
check_deallocate
(
"trans_ev_band_to_full: hvm"
,
istat
,
errorMessage
)
endif
! useGPU
deallocate
(
tmat_complete
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"trans_ev_band_to_full_&
&MATH_DATATYPE&
&: error when deallocating tmat_complete "
//
errorMessage
stop
1
endif
check_deallocate
(
"trans_ev_band_to_full: tmat_complete"
,
istat
,
errorMessage
)
if
(
blocking_factor
>
1
)
then
deallocate
(
t_tmp
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"trans_ev_band_to_full_&
&MATH_DATATYPE&
&: error when deallocating t_tmp "
//
errorMessage
stop
1
endif
check_deallocate
(
"trans_ev_band_to_full: t_tmp"
,
istat
,
errorMessage
)
deallocate
(
t_tmp2
,
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"trans_ev_band_to_full_&
&MATH_DATATYPE&
&: error when deallocating t_tmp2 "
//
errorMessage
stop
1
endif
check_deallocate
(
"trans_ev_band_to_full: t_tmp2"
,
istat
,
errorMessage
)
endif
call
obj
%
timer
%
stop
(
"trans_ev_band_to_full_&
...
...
src/elpa2/elpa2_trans_ev_tridi_to_band_template.F90
View file @
2a9f9fa8
...
...
@@ -487,12 +487,7 @@
! Determine the matrix distribution at the beginning
allocate
(
limits
(
0
:
np_rows
),
stat
=
istat
,
errmsg
=
errorMessage
)
if
(
istat
.ne.
0
)
then
print
*
,
"trans_ev_tridi_to_band_&
&MATH_DATATYPE&
&: error when allocating limits"
//
errorMessage
stop
1
endif
check_allocate
(
"trans_ev_tridi_to_band: limits"
,
istat
,
errorMessage
)