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
ad1d3cc4
Commit
ad1d3cc4
authored
Jul 19, 2017
by
Pavel Kus
Browse files
more real/complex unifications in check_correctness
parent
fe4f1381
Changes
1
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
test/shared/test_check_correctness_template.X90
View file @
ad1d3cc4
...
...
@@ -54,6 +54,12 @@
real
(
kind
=
C_DATATYPE_KIND
)
::
ev
(:)
real
(
kind
=
C_DATATYPE_KIND
),
dimension
(
size
(
as
,
dim
=
1
),
size
(
as
,
dim
=
2
))
::
tmp1
,
tmp2
#ifdef DOUBLE_PRECISION_REAL
real
(
kind
=
C_DATATYPE_KIND
),
parameter
::
ZERO
=
0.0_rk8
,
ONE
=
1.0_rk8
#else
real
(
kind
=
C_DATATYPE_KIND
),
parameter
::
ZERO
=
0.0_rk4
,
ONE
=
1.0_rk4
#endif
#ifndef WITH_MPI
#ifdef DOUBLE_PRECISION_REAL
...
...
@@ -63,8 +69,6 @@
#endif
#endif
#endif /* REALCASE */
#if COMPLEXCASE == 1
...
...
@@ -73,14 +77,13 @@
complex
(
kind
=
C_DATATYPE_KIND
),
dimension
(
size
(
as
,
dim
=
1
),
size
(
as
,
dim
=
2
))
::
tmp1
,
tmp2
complex
(
kind
=
C_DATATYPE_KIND
)
::
xc
#ifdef DOUBLE_PRECISION_COMPLEX
complex
(
kind
=
C_DATATYPE_KIND
),
parameter
::
C
ZERO
=
(
0.0_rk8
,
0.0_rk8
),
C
ONE
=
(
1.0_rk8
,
0.0_rk8
)
complex
(
kind
=
C_DATATYPE_KIND
),
parameter
::
ZERO
=
(
0.0_rk8
,
0.0_rk8
),
ONE
=
(
1.0_rk8
,
0.0_rk8
)
#ifndef WITH_MPI
complex
(
kind
=
C_DATATYPE_KIND
)
::
zdotc
,
cdotc
#endif
#else /* DOUBLE_PRECISION_COMPLEX */
complex
(
kind
=
C_DATATYPE_KIND
),
parameter
::
C
ZERO
=
(
0.0_rk4
,
0.0_rk4
),
C
ONE
=
(
1.0_rk4
,
0.0_rk4
)
complex
(
kind
=
C_DATATYPE_KIND
),
parameter
::
ZERO
=
(
0.0_rk4
,
0.0_rk4
),
ONE
=
(
1.0_rk4
,
0.0_rk4
)
#ifndef WITH_MPI
complex
(
kind
=
C_DATATYPE_KIND
)
::
zdotc
,
cdotc
#endif
...
...
@@ -102,23 +105,12 @@
! tmp1 = A * Z
! as is original stored matrix, Z are the EVs
#if REALCASE == 1
#ifdef WITH_MPI
call
scal_PRECISION_GEMM
(
'N'
,
'N'
,
na
,
nev
,
na
,
CONST_1_0
,
as
,
1
,
1
,
sc_desc
,
&
z
,
1
,
1
,
sc_desc
,
CONST_0_0
,
tmp1
,
1
,
1
,
sc_desc
)
#else /* WITH_MPI */
call
PRECISION_GEMM
(
'N'
,
'N'
,
na
,
nev
,
na
,
CONST_1_0
,
as
,
na
,
z
,
na
,
CONST_0_0
,
tmp1
,
na
)
#endif /* WITH_MPI */
#endif /* REALCASE */
#if COMPLEXCASE == 1
#ifdef WITH_MPI
call
scal_PRECISION_GEMM
(
'N'
,
'N'
,
na
,
nev
,
na
,
C
ONE
,
as
,
1
,
1
,
sc_desc
,
&
z
,
1
,
1
,
sc_desc
,
C
ZERO
,
tmp1
,
1
,
1
,
sc_desc
)
call
scal_PRECISION_GEMM
(
'N'
,
'N'
,
na
,
nev
,
na
,
ONE
,
as
,
1
,
1
,
sc_desc
,
&
z
,
1
,
1
,
sc_desc
,
ZERO
,
tmp1
,
1
,
1
,
sc_desc
)
#else /* WITH_MPI */
call
PRECISION_GEMM
(
'N'
,
'N'
,
na
,
nev
,
na
,
C
ONE
,
as
,
na
,
z
,
na
,
C
ZERO
,
tmp1
,
na
)
call
PRECISION_GEMM
(
'N'
,
'N'
,
na
,
nev
,
na
,
ONE
,
as
,
na
,
z
,
na
,
ZERO
,
tmp1
,
na
)
#endif /* WITH_MPI */
#endif /* COMPLEXCASE */
! tmp2 = Zi*EVi
...
...
@@ -274,26 +266,12 @@
! tmp1 = Z**T * Z
tmp1
=
0
#if REALCASE == 1
#ifdef WITH_MPI
call
scal_PRECISION_GEMM
(
'T'
,
'N'
,
nev
,
nev
,
na
,
CONST_1_0
,
z
,
1
,
1
,
sc_desc
,
&
z
,
1
,
1
,
sc_desc
,
CONST_0_0
,
tmp1
,
1
,
1
,
sc_desc
)
#else /* WITH_MPI */
call
PRECISION_GEMM
(
'T'
,
'N'
,
nev
,
nev
,
na
,
CONST_1_0
,
z
,
na
,
&
z
,
na
,
CONST_0_0
,
tmp1
,
na
)
#endif /* WITH_MPI */
#endif /* REALCASE */
#if COMPLEXCASE == 1
#ifdef WITH_MPI
call
scal_PRECISION_GEMM
(
'C'
,
'N'
,
nev
,
nev
,
na
,
C
ONE
,
z
,
1
,
1
,
sc_desc
,
&
z
,
1
,
1
,
sc_desc
,
C
ZERO
,
tmp1
,
1
,
1
,
sc_desc
)
call
scal_PRECISION_GEMM
(
BLAS_TRANS_OR_CONJ
,
'N'
,
nev
,
nev
,
na
,
ONE
,
z
,
1
,
1
,
&
sc_desc
,
z
,
1
,
1
,
sc_desc
,
ZERO
,
tmp1
,
1
,
1
,
sc_desc
)
#else /* WITH_MPI */
call
PRECISION_GEMM
(
'C'
,
'N'
,
nev
,
nev
,
na
,
C
ONE
,
z
,
na
,
z
,
na
,
C
ZERO
,
tmp1
,
na
)
call
PRECISION_GEMM
(
BLAS_TRANS_OR_CONJ
,
'N'
,
nev
,
nev
,
na
,
ONE
,
z
,
na
,
z
,
na
,
ZERO
,
tmp1
,
na
)
#endif /* WITH_MPI */
#endif /* COMPLEXCASE */
! Initialize tmp2 to unit matrix
tmp2
=
0
...
...
@@ -323,17 +301,17 @@
#ifdef WITH_MPI
#ifdef DOUBLE_PRECISION_COMPLEX
call
pzlaset
(
'A'
,
nev
,
nev
,
C
ZERO
,
C
ONE
,
tmp2
,
1
,
1
,
sc_desc
)
call
pzlaset
(
'A'
,
nev
,
nev
,
ZERO
,
ONE
,
tmp2
,
1
,
1
,
sc_desc
)
#else
call
pclaset
(
'A'
,
nev
,
nev
,
C
ZERO
,
C
ONE
,
tmp2
,
1
,
1
,
sc_desc
)
call
pclaset
(
'A'
,
nev
,
nev
,
ZERO
,
ONE
,
tmp2
,
1
,
1
,
sc_desc
)
#endif
#else /* WITH_MPI */
#ifdef DOUBLE_PRECISION_COMPLEX
call
zlaset
(
'A'
,
nev
,
nev
,
C
ZERO
,
C
ONE
,
tmp2
,
na
)
call
zlaset
(
'A'
,
nev
,
nev
,
ZERO
,
ONE
,
tmp2
,
na
)
#else
call
claset
(
'A'
,
nev
,
nev
,
C
ZERO
,
C
ONE
,
tmp2
,
na
)
call
claset
(
'A'
,
nev
,
nev
,
ZERO
,
ONE
,
tmp2
,
na
)
#endif
#endif /* WITH_MPI */
...
...
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