Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
elpa
elpa
Commits
a4d30cfb
Commit
a4d30cfb
authored
Aug 10, 2017
by
Pavel Kus
Browse files
more single/double real/complex
parent
6f4f00e5
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
src/elpa1/elpa_cholesky_template.F90
View file @
a4d30cfb
...
...
@@ -49,22 +49,13 @@
use
precision
use
elpa_abstract_impl
implicit
none
#include "../general/precision_kinds.F90"
class
(
elpa_abstract_impl_t
),
intent
(
inout
)
::
obj
integer
(
kind
=
ik
)
::
na
,
lda
,
nblk
,
matrixCols
,
mpi_comm_rows
,
mpi_comm_cols
#if REALCASE == 1
#ifdef USE_ASSUMED_SIZE
real
(
kind
=
REAL_DATATYPE
)
::
a
(
obj
%
local_nrows
,
*
)
#else
real
(
kind
=
REAL_DATATYPE
)
::
a
(
obj
%
local_nrows
,
obj
%
local_ncols
)
#endif
#endif
#if COMPLEXCASE == 1
#ifdef USE_ASSUMED_SIZE
complex
(
kind
=
COMPLEX_DATATYPE
)
::
a
(
obj
%
local_nrows
,
*
)
MATH_DATATYPE
(
kind
=
rck
)
::
a
(
obj
%
local_nrows
,
*
)
#else
complex
(
kind
=
COMPLEX_DATATYPE
)
::
a
(
obj
%
local_nrows
,
obj
%
local_ncols
)
#endif
MATH_DATATYPE
(
kind
=
rck
)
::
a
(
obj
%
local_nrows
,
obj
%
local_ncols
)
#endif
integer
(
kind
=
ik
)
::
my_prow
,
my_pcol
,
np_rows
,
np_cols
,
mpierr
integer
(
kind
=
ik
)
::
l_cols
,
l_rows
,
l_col1
,
l_row1
,
l_colx
,
l_rowx
...
...
@@ -72,12 +63,7 @@
integer
(
kind
=
ik
)
::
lcs
,
lce
,
lrs
,
lre
integer
(
kind
=
ik
)
::
tile_size
,
l_rows_tile
,
l_cols_tile
#if REALCASE == 1
real
(
kind
=
REAL_DATATYPE
),
allocatable
::
tmp1
(:),
tmp2
(:,:),
tmatr
(:,:),
tmatc
(:,:)
#endif
#if COMPLEXCASE == 1
complex
(
kind
=
COMPLEX_DATATYPE
),
allocatable
::
tmp1
(:),
tmp2
(:,:),
tmatr
(:,:),
tmatc
(:,:)
#endif
MATH_DATATYPE
(
kind
=
rck
),
allocatable
::
tmp1
(:),
tmp2
(:,:),
tmatr
(:,:),
tmatc
(:,:)
logical
::
wantDebug
logical
::
success
integer
(
kind
=
ik
)
::
istat
,
debug
...
...
@@ -256,16 +242,8 @@
call
obj
%
timer
%
start
(
"blas"
)
if
(
l_cols
-
l_colx
+1
>
0
)
&
#if REALCASE == 1
call
PRECISION_TRSM
(
'L'
,
'U'
,
'T'
,
'N'
,
nblk
,
l_cols
-
l_colx
+1
,
CONST_1_0
,
tmp2
,
ubound
(
tmp2
,
dim
=
1
),
&
a
(
l_row1
,
l_colx
),
lda
)
#endif
#if COMPLEXCASE == 1
call
PRECISION_TRSM
(
'L'
,
'U'
,
'C'
,
'N'
,
nblk
,
l_cols
-
l_colx
+1
,
CONST_COMPLEX_PAIR_1_0
,
&
tmp2
,
ubound
(
tmp2
,
dim
=
1
),
a
(
l_row1
,
l_colx
),
lda
)
#endif
call
PRECISION_TRSM
(
'L'
,
'U'
,
BLAS_TRANS_OR_CONJ
,
'N'
,
nblk
,
l_cols
-
l_colx
+1
,
ONE
,
tmp2
,
&
ubound
(
tmp2
,
dim
=
1
),
a
(
l_row1
,
l_colx
),
lda
)
call
obj
%
timer
%
stop
(
"blas"
)
endif
...
...
@@ -282,14 +260,8 @@
call
obj
%
timer
%
start
(
"mpi_communication"
)
if
(
l_cols
-
l_colx
+1
>
0
)
&
call
MPI_Bcast
(
tmatc
(
l_colx
,
i
),
l_cols
-
l_colx
+1
,
&
#if REALCASE == 1
MPI_REAL_PRECISION
,
&
#endif
#if COMPLEXCASE == 1
MPI_COMPLEX_PRECISION
,
&
#endif
prow
(
n
,
nblk
,
np_rows
),
mpi_comm_rows
,
mpierr
)
call
MPI_Bcast
(
tmatc
(
l_colx
,
i
),
l_cols
-
l_colx
+1
,
MPI_MATH_DATATYPE_PRECISION
,
&
prow
(
n
,
nblk
,
np_rows
),
mpi_comm_rows
,
mpierr
)
call
obj
%
timer
%
stop
(
"mpi_communication"
)
#endif /* WITH_MPI */
...
...
@@ -310,18 +282,9 @@
lre
=
min
(
l_rows
,(
i
+1
)
*
l_rows_tile
)
if
(
lce
<
lcs
.or.
lre
<
lrs
)
cycle
call
obj
%
timer
%
start
(
"blas"
)
#if REALCASE == 1
call
PRECISION_GEMM
(
'N'
,
'T'
,
lre
-
lrs
+1
,
lce
-
lcs
+1
,
nblk
,
-
CONST_1_0
,
&
call
PRECISION_GEMM
(
'N'
,
BLAS_TRANS_OR_CONJ
,
lre
-
lrs
+1
,
lce
-
lcs
+1
,
nblk
,
-
ONE
,
&
tmatr
(
lrs
,
1
),
ubound
(
tmatr
,
dim
=
1
),
tmatc
(
lcs
,
1
),
ubound
(
tmatc
,
dim
=
1
),
&
CONST_1_0
,
a
(
lrs
,
lcs
),
lda
)
#endif
#if COMPLEXCASE == 1
call
PRECISION_GEMM
(
'N'
,
'C'
,
lre
-
lrs
+1
,
lce
-
lcs
+1
,
nblk
,
-
CONST_COMPLEX_PAIR_1_0
,
&
tmatr
(
lrs
,
1
),
ubound
(
tmatr
,
dim
=
1
),
tmatc
(
lcs
,
1
),
ubound
(
tmatc
,
dim
=
1
),
&
CONST_COMPLEX_PAIR_1_0
,
a
(
lrs
,
lcs
),
lda
)
#endif
ONE
,
a
(
lrs
,
lcs
),
lda
)
call
obj
%
timer
%
stop
(
"blas"
)
enddo
...
...
@@ -351,8 +314,3 @@
&_&
&PRECISION&
&"
)
#undef REALCASE
#undef COMPLEXCASE
#undef DOUBLE_PRECISION
#undef SINGLE_PRECISION
src/elpa1/elpa_invert_trm.F90
View file @
a4d30cfb
...
...
@@ -58,34 +58,19 @@
use
elpa_mpi
use
elpa_abstract_impl
implicit
none
#include "../general/precision_kinds.F90"
class
(
elpa_abstract_impl_t
),
intent
(
inout
)
::
obj
integer
(
kind
=
ik
)
::
na
,
lda
,
nblk
,
matrixCols
,
mpi_comm_rows
,
mpi_comm_cols
#if REALCASE == 1
#ifdef USE_ASSUMED_SIZE
real
(
kind
=
REAL_DATATYPE
)
::
a
(
obj
%
local_nrows
,
*
)
MATH_DATATYPE
(
kind
=
rck
)
::
a
(
obj
%
local_nrows
,
*
)
#else
real
(
kind
=
REAL_DATATYPE
)
::
a
(
obj
%
local_nrows
,
obj
%
local_ncols
)
#endif
#endif
#if COMPLEXCASE == 1
#ifdef USE_ASSUMED_SIZE
complex
(
kind
=
COMPLEX_DATATYPE
)
::
a
(
obj
%
local_nrows
,
*
)
#else
complex
(
kind
=
COMPLEX_DATATYPE
)
::
a
(
obj
%
local_nrows
,
obj
%
local_ncols
)
#endif
MATH_DATATYPE
(
kind
=
rck
)
::
a
(
obj
%
local_nrows
,
obj
%
local_ncols
)
#endif
integer
(
kind
=
ik
)
::
my_prow
,
my_pcol
,
np_rows
,
np_cols
,
mpierr
integer
(
kind
=
ik
)
::
l_cols
,
l_rows
,
l_col1
,
l_row1
,
l_colx
,
l_rowx
integer
(
kind
=
ik
)
::
n
,
nc
,
i
,
info
,
ns
,
nb
#if REALCASE == 1
real
(
kind
=
REAL_DATATYPE
),
allocatable
::
tmp1
(:),
tmp2
(:,:),
tmat1
(:,:),
tmat2
(:,:)
#endif
#if COMPLEXCASE == 1
complex
(
kind
=
COMPLEX_DATATYPE
),
allocatable
::
tmp1
(:),
tmp2
(:,:),
tmat1
(:,:),
tmat2
(:,:)
#endif
MATH_DATATYPE
(
kind
=
rck
),
allocatable
::
tmp1
(:),
tmp2
(:,:),
tmat1
(:,:),
tmat2
(:,:)
logical
::
wantDebug
logical
::
success
integer
(
kind
=
ik
)
::
istat
,
debug
...
...
@@ -211,13 +196,7 @@
endif
#ifdef WITH_MPI
call obj%timer%start("
mpi_communication
")
call MPI_Bcast(tmp1, nb*(nb+1)/2, &
#if REALCASE == 1
MPI_REAL_PRECISION, &
#endif
#if COMPLEXCASE == 1
MPI_COMPLEX_PRECISION, &
#endif
call MPI_Bcast(tmp1, nb*(nb+1)/2, MPI_MATH_DATATYPE_PRECISION, &
pcol(n, nblk, np_cols), mpi_comm_cols, mpierr)
call obj%timer%stop("
mpi_communication
")
#endif /* WITH_MPI */
...
...
@@ -229,13 +208,7 @@
call obj%timer%start("
blas
")
if (l_cols-l_colx+1>0) &
call PRECISION_TRMM ('L', 'U', 'N', 'N', nb, l_cols-l_colx+1, &
#if REALCASE == 1
CONST_1_0, &
#endif
#if COMPLEXCASE == 1
CONST_COMPLEX_PAIR_1_0, &
#endif
call PRECISION_TRMM('L', 'U', 'N', 'N', nb, l_cols-l_colx+1, ONE, &
tmp2, ubound(tmp2,dim=1), a(l_row1,l_colx), lda)
call obj%timer%stop("
blas
")
if (l_colx<=l_cols) tmat2(1:nb,l_colx:l_cols) = a(l_row1:l_row1+nb-1,l_colx:l_cols)
...
...
@@ -252,13 +225,7 @@
do i=1,nb
#ifdef WITH_MPI
call obj%timer%start("
mpi_communication
")
call MPI_Bcast(tmat1(1,i), l_row1-1, &
#if REALCASE == 1
MPI_REAL_PRECISION, &
#endif
#if COMPLEXCASE == 1
MPI_COMPLEX_PRECISION, &
#endif
call MPI_Bcast(tmat2(1,i), l_row1-1, MPI_MATH_DATATYPE_PRECISION, &
pcol(n, nblk, np_cols), mpi_comm_cols, mpierr)
call obj%timer%stop("
mpi_communication
")
...
...
@@ -268,13 +235,7 @@
#ifdef WITH_MPI
call obj%timer%start("
mpi_communication
")
if (l_cols-l_col1+1>0) &
call MPI_Bcast(tmat2(1,l_col1), (l_cols-l_col1+1)*nblk, &
#if REALCASE == 1
MPI_REAL_PRECISION, &
#endif
#if COMPLEXCASE == 1
MPI_COMPLEX_PRECISION, &
#endif
call MPI_Bcast(tmat2(1,l_col1), (l_cols-l_col1+1)*nblk, MPI_MATH_DATATYPE_PRECISION, &
prow(n, nblk, np_rows), mpi_comm_rows, mpierr)
call obj%timer%stop("
mpi_communication
")
...
...
@@ -282,20 +243,8 @@
call obj%timer%start("
blas
")
if (l_row1>1 .and. l_cols-l_col1+1>0) &
call PRECISION_GEMM('N', 'N', l_row1-1, l_cols-l_col1+1, nb, &
#if REALCASE == 1
-CONST_1_0, &
#endif
#if COMPLEXCASE == 1
-CONST_COMPLEX_PAIR_1_0, &
#endif
tmat1, ubound(tmat1,dim=1), tmat2(1,l_col1), ubound(tmat2,dim=1), &
#if REALCASE == 1
CONST_1_0, &
#endif
#if COMPLEXCASE == 1
CONST_COMPLEX_PAIR_1_0, &
#endif
call PRECISION_GEMM('N', 'N', l_row1-1, l_cols-l_col1+1, nb, -ONE, &
tmat1, ubound(tmat1,dim=1), tmat2(1,l_col1), ubound(tmat2,dim=1), ONE, &
a(1,l_col1), lda)
call obj%timer%stop("
blas
")
...
...
@@ -315,7 +264,3 @@
&
_
&
&
PRECISION
&
&
")
#undef REALCASE
#undef COMPLEXCASE
#undef DOUBLE_PRECISION
#undef SINGLE_PRECISION
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment