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
c9455ca8
Commit
c9455ca8
authored
Apr 07, 2017
by
Andreas Marek
Browse files
Template for prepare_matrix
parent
c0d57a28
Changes
4
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Makefile.am
View file @
c9455ca8
...
...
@@ -490,6 +490,7 @@ libelpatest@SUFFIX@_la_SOURCES = \
test
/shared/setup_mpi.F90
\
test
/shared/blacs_infrastructure.F90
\
test
/shared/prepare_matrix.F90
\
test
/shared/prepare_matrix_template.X90
\
test
/shared/mod_output_types.F90
\
test
/shared/mod_from_c.F90
\
test
/shared/call_elpa1.c
...
...
@@ -1018,6 +1019,7 @@ EXTRA_DIST = \
src/elpa2/GPU/ev_tridi_band_gpu_c_v2_complex_template.Xcu
\
src/elpa2/GPU/ev_tridi_band_gpu_c_v2_real_template.Xcu
\
src/GPU/cuUtils_template.Xcu
\
test
/shared/prepare_matrix_template.X90
\
nvcc_wrap
\
test_project/Makefile.am
\
test_project/autogen.sh
\
...
...
generated_headers.am
View file @
c9455ca8
...
...
@@ -16,7 +16,7 @@ config-f90.h: config.h
elpa/elpa_generated.h: $(top_srcdir)/src/elpa_c_interface.F90 | elpa
$(call extract_interface,!c>)
test/shared/generated.h: $(wildcard $(top_srcdir)/test/shared/*.
F
90) | test/shared
test/shared/generated.h: $(wildcard $(top_srcdir)/test/shared/*.
*
90) | test/shared
$(call extract_interface,!c>)
elpa/elpa_generated_fortran_interfaces.h: $(wildcard $(top_srcdir)/src/elpa2/kernels/*.c) $(wildcard $(top_srcdir)/src/elpa2/kernels/*.s) | elpa
...
...
test/shared/prepare_matrix.F90
View file @
c9455ca8
...
...
@@ -64,380 +64,43 @@ module mod_prepare_matrix
#endif
contains
#define DOUBLE_PRECISION_COMPLEX 1
subroutine
prepare_matrix_complex_double
(
na
,
myid
,
sc_desc
,
a
,
z
,
as
)
#define COMPLEXCASE 1
#define DOUBLE_PRECISION 1
#include "../../src/precision_macros.h"
#include "prepare_matrix_template.X90"
#undef DOUBLE_PRECISION
#undef COMPLEXCASE
use
precision
implicit
none
integer
(
kind
=
ik
),
intent
(
in
)
::
myid
,
na
,
sc_desc
(:)
complex
(
kind
=
ck8
),
intent
(
inout
)
::
z
(:,:),
a
(:,:),
as
(:,:)
complex
(
kind
=
ck8
),
parameter
::
CONE
=
(
1.0_rk8
,
0.0_rk8
)
real
(
kind
=
rk8
)
::
xr
(
size
(
a
,
dim
=
1
),
size
(
a
,
dim
=
2
))
integer
,
allocatable
::
iseed
(:)
integer
::
n
! for getting a hermitian test matrix A we get a random matrix Z
! and calculate A = Z + Z**H
! we want different random numbers on every process
! (otherwise A might get rank deficient):
call
random_seed
(
size
=
n
)
allocate
(
iseed
(
n
))
iseed
(:)
=
myid
call
random_seed
(
put
=
iseed
)
call
random_number
(
xr
)
z
(:,:)
=
xr
(:,:)
call
RANDOM_NUMBER
(
xr
)
z
(:,:)
=
z
(:,:)
+
(
0.0_rk8
,
1.0_rk8
)
*
xr
(:,:)
a
(:,:)
=
z
(:,:)
if
(
myid
==
0
)
then
print
'(a)'
,
'| Random matrix block has been set up. (only processor 0 confirms this step)'
endif
#ifdef WITH_MPI
#ifdef DOUBLE_PRECISION_COMPLEX
call
pztranc
(
na
,
na
,
CONE
,
z
,
1
,
1
,
sc_desc
,
CONE
,
a
,
1
,
1
,
sc_desc
)
! A = A + Z**H
#else
call
pctranc
(
na
,
na
,
CONE
,
z
,
1
,
1
,
sc_desc
,
CONE
,
a
,
1
,
1
,
sc_desc
)
! A = A + Z**H
#endif
#else /* WITH_MPI */
a
=
a
+
transpose
(
conjg
(
z
))
#endif /* WITH_MPI */
if
(
myid
==
0
)
then
print
'(a)'
,
'| Random matrix block has been symmetrized'
endif
! save original matrix A for later accuracy checks
as
=
a
deallocate
(
iseed
)
end
subroutine
#ifdef DOUBLE_PRECISION_COMPLEX
!c> void prepare_matrix_complex_double_f(int na, int myid, int na_rows, int na_cols,
!c> int sc_desc[9],
!c> complex double *a, complex double *z, complex double *as);
#else
!c> void prepare_matrix_complex_single_f(int na, int myid, int na_rows, int na_cols,
!c> int sc_desc[9],
!c> complex *a, complex *z, complex *as);
#endif
#ifdef DOUBLE_PRECISION_COMPLEX
subroutine
prepare_matrix_complex_wrapper_double
&
#else
subroutine
prepare_matrix_complex_wrapper_single
&
#endif
(
na
,
myid
,
na_rows
,
na_cols
,
sc_desc
,
a
,
z
,
as
)
&
#ifdef DOUBLE_PRECISION_COMPLEX
bind
(
C
,
name
=
"prepare_matrix_complex_double_f"
)
#else
bind
(
C
,
name
=
"prepare_matrix_complex_single_f"
)
#endif
use
iso_c_binding
implicit
none
integer
(
kind
=
c_int
)
,
value
::
myid
,
na
,
na_rows
,
na_cols
integer
(
kind
=
c_int
)
::
sc_desc
(
1
:
9
)
#ifdef DOUBLE_PRECISION_COMPLEX
complex
(
kind
=
c_double
)
::
&
#else
complex
(
kind
=
c_float
)
::
&
#endif
z
(
1
:
na_rows
,
1
:
na_cols
),
a
(
1
:
na_rows
,
1
:
na_cols
),
&
as
(
1
:
na_rows
,
1
:
na_cols
)
call
prepare_matrix_complex_double
(
na
,
myid
,
sc_desc
,
a
,
z
,
as
)
end
subroutine
#ifdef WANT_SINGLE_PRECISION_COMPLEX
#undef DOUBLE_PRECISION_COMPLEX
subroutine
prepare_matrix_complex_single
(
na
,
myid
,
sc_desc
,
a
,
z
,
as
)
use
precision
implicit
none
integer
(
kind
=
ik
),
intent
(
in
)
::
myid
,
na
,
sc_desc
(:)
complex
(
kind
=
ck4
),
intent
(
inout
)
::
z
(:,:),
a
(:,:),
as
(:,:)
complex
(
kind
=
ck4
),
parameter
::
CONE
=
(
1.0_rk4
,
0.0_rk4
)
real
(
kind
=
rk4
)
::
xr
(
size
(
a
,
dim
=
1
),
size
(
a
,
dim
=
2
))
integer
,
allocatable
::
iseed
(:)
integer
::
n
! for getting a hermitian test matrix A we get a random matrix Z
! and calculate A = Z + Z**H
! we want different random numbers on every process
! (otherwise A might get rank deficient):
call
random_seed
(
size
=
n
)
allocate
(
iseed
(
n
))
iseed
(:)
=
myid
call
random_seed
(
put
=
iseed
)
call
random_number
(
xr
)
z
(:,:)
=
xr
(:,:)
call
random_number
(
xr
)
z
(:,:)
=
z
(:,:)
+
(
0.0_rk4
,
1.0_rk4
)
*
xr
(:,:)
a
(:,:)
=
z
(:,:)
if
(
myid
==
0
)
then
print
'(a)'
,
'| Random matrix block has been set up. (only processor 0 confirms this step)'
endif
#ifdef WITH_MPI
#ifdef DOUBLE_PRECISION_COMPLEX
call
pztranc
(
na
,
na
,
CONE
,
z
,
1
,
1
,
sc_desc
,
CONE
,
a
,
1
,
1
,
sc_desc
)
! A = A + Z**H
#else
call
pctranc
(
na
,
na
,
CONE
,
z
,
1
,
1
,
sc_desc
,
CONE
,
a
,
1
,
1
,
sc_desc
)
! A = A + Z**H
#endif
#else /* WITH_MPI */
a
=
a
+
transpose
(
conjg
(
z
))
#endif /* WITH_MPI */
if
(
myid
==
0
)
then
print
'(a)'
,
'| Random matrix block has been symmetrized'
endif
! save original matrix A for later accuracy checks
as
=
a
deallocate
(
iseed
)
end
subroutine
#ifdef DOUBLE_PRECISION_COMPLEX
!c> void prepare_matrix_complex_double_f(int na, int myid, int na_rows, int na_cols,
!c> int sc_desc[9],
!c> complex double *a, complex double *z, complex double *as);
#else
!c> void prepare_matrix_complex_single_f(int na, int myid, int na_rows, int na_cols,
!c> int sc_desc[9],
!c> complex *a, complex *z, complex *as);
#endif
subroutine
prepare_matrix_complex_wrapper_single
(
na
,
myid
,
na_rows
,
na_cols
,
sc_desc
,
a
,
z
,
as
)
&
#ifdef DOUBLE_PRECISION_COMPLEX
bind
(
C
,
name
=
"prepare_matrix_complex_double_f"
)
#else
bind
(
C
,
name
=
"prepare_matrix_complex_single_f"
)
#endif
use
iso_c_binding
implicit
none
integer
(
kind
=
c_int
)
,
value
::
myid
,
na
,
na_rows
,
na_cols
integer
(
kind
=
c_int
)
::
sc_desc
(
1
:
9
)
#ifdef DOUBLE_PRECISION_COMPLEX
complex
(
kind
=
c_double
)
::
&
#else
complex
(
kind
=
c_float
)
::
&
#endif
z
(
1
:
na_rows
,
1
:
na_cols
),
a
(
1
:
na_rows
,
1
:
na_cols
),
&
as
(
1
:
na_rows
,
1
:
na_cols
)
call
prepare_matrix_complex_single
(
na
,
myid
,
sc_desc
,
a
,
z
,
as
)
end
subroutine
#define COMPLEXCASE 1
#define SINGLE_PRECISION 1
#include "../../src/precision_macros.h"
#include "prepare_matrix_template.X90"
#undef SINGLE_PRECISION
#undef COMPLEXCASE
#endif /* WANT_SINGLE_PRECISION_COMPLEX */
#define DOUBLE_PRECISION_REAL 1
subroutine
prepare_matrix_real_double
(
na
,
myid
,
sc_desc
,
a
,
z
,
as
)
use
precision
implicit
none
integer
(
kind
=
ik
),
intent
(
in
)
::
myid
,
na
,
sc_desc
(:)
real
(
kind
=
rk8
),
intent
(
inout
)
::
z
(:,:),
a
(:,:),
as
(:,:)
integer
,
allocatable
::
iseed
(:)
integer
::
n
! for getting a hermitian test matrix A we get a random matrix Z
! and calculate A = Z + Z**H
! we want different random numbers on every process
! (otherwise A might get rank deficient):
call
random_seed
(
size
=
n
)
allocate
(
iseed
(
n
))
iseed
(:)
=
myid
call
random_seed
(
put
=
iseed
)
call
random_number
(
z
)
a
(:,:)
=
z
(:,:)
if
(
myid
==
0
)
then
print
'(a)'
,
'| Random matrix block has been set up. (only processor 0 confirms this step)'
endif
#ifdef WITH_MPI
#ifdef DOUBLE_PRECISION_REAL
call
pdtran
(
na
,
na
,
1.0_rk8
,
z
,
1
,
1
,
sc_desc
,
1.0_rk8
,
a
,
1
,
1
,
sc_desc
)
! A = A + Z**T
#else
call
pstran
(
na
,
na
,
1.0_rk4
,
z
,
1
,
1
,
sc_desc
,
1.0_rk4
,
a
,
1
,
1
,
sc_desc
)
! A = A + Z**T
#endif
#else /* WITH_MPI */
a
=
a
+
transpose
(
z
)
#endif /* WITH_MPI */
if
(
myid
==
0
)
then
print
'(a)'
,
'| Random matrix block has been symmetrized'
endif
! save original matrix A for later accuracy checks
as
=
a
deallocate
(
iseed
)
end
subroutine
#ifdef DOUBLE_PRECISION_REAL
!c> void prepare_matrix_real_double_f(int na, int myid, int na_rows, int na_cols,
!c> int sc_desc[9],
!c> double *a, double *z, double *as);
#else
!c> void prepare_matrix_real_single_f(int na, int myid, int na_rows, int na_cols,
!c> int sc_desc[9],
!c> float *a, float *z, float *as);
#endif
#ifdef DOUBLE_PRECISION_REAL
subroutine
prepare_matrix_real_wrapper_double
&
#else
subroutine
prepare_matrix_real_wrapper_single
&
#endif
(
na
,
myid
,
na_rows
,
na_cols
,
sc_desc
,
a
,
z
,
as
)
&
#ifdef DOUBLE_PRECISION_REAL
bind
(
C
,
name
=
"prepare_matrix_real_double_f"
)
#else
bind
(
C
,
name
=
"prepare_matrix_real_single_f"
)
#endif
use
iso_c_binding
implicit
none
integer
(
kind
=
c_int
)
,
value
::
myid
,
na
,
na_rows
,
na_cols
integer
(
kind
=
c_int
)
::
sc_desc
(
1
:
9
)
#ifdef DOUBLE_PRECISION_REAL
real
(
kind
=
c_double
)
::
z
(
1
:
na_rows
,
1
:
na_cols
),
a
(
1
:
na_rows
,
1
:
na_cols
),
&
as
(
1
:
na_rows
,
1
:
na_cols
)
#else
real
(
kind
=
c_float
)
::
z
(
1
:
na_rows
,
1
:
na_cols
),
a
(
1
:
na_rows
,
1
:
na_cols
),
&
as
(
1
:
na_rows
,
1
:
na_cols
)
#endif
call
prepare_matrix_real_double
(
na
,
myid
,
sc_desc
,
a
,
z
,
as
)
end
subroutine
#define REALCASE 1
#define DOUBLE_PRECISION 1
#include "../../src/precision_macros.h"
#include "prepare_matrix_template.X90"
#undef DOUBLE_PRECISION
#undef REALCASE
#ifdef WANT_SINGLE_PRECISION_REAL
#undef DOUBLE_PRECISION_REAL
subroutine
prepare_matrix_real_single
(
na
,
myid
,
sc_desc
,
a
,
z
,
as
)
use
precision
implicit
none
integer
(
kind
=
ik
),
intent
(
in
)
::
myid
,
na
,
sc_desc
(:)
real
(
kind
=
rk4
),
intent
(
inout
)
::
z
(:,:),
a
(:,:),
as
(:,:)
integer
,
allocatable
::
iseed
(:)
integer
::
n
! for getting a hermitian test matrix A we get a random matrix Z
! and calculate A = Z + Z**H
! we want different random numbers on every process
! (otherwise A might get rank deficient):
call
random_seed
(
size
=
n
)
allocate
(
iseed
(
n
))
iseed
(:)
=
myid
call
random_seed
(
put
=
iseed
)
call
random_number
(
z
)
a
(:,:)
=
z
(:,:)
if
(
myid
==
0
)
then
print
'(a)'
,
'| Random matrix block has been set up. (only processor 0 confirms this step)'
endif
#ifdef WITH_MPI
#ifdef DOUBLE_PRECISION_REAL
call
pdtran
(
na
,
na
,
1.0_rk8
,
z
,
1
,
1
,
sc_desc
,
1.0_rk8
,
a
,
1
,
1
,
sc_desc
)
! A = A + Z**T
#else
call
pstran
(
na
,
na
,
1.0_rk4
,
z
,
1
,
1
,
sc_desc
,
1.0_rk4
,
a
,
1
,
1
,
sc_desc
)
! A = A + Z**T
#endif
#else /* WITH_MPI */
a
=
a
+
transpose
(
z
)
#endif /* WITH_MPI */
if
(
myid
==
0
)
then
print
'(a)'
,
'| Random matrix block has been symmetrized'
endif
! save original matrix A for later accuracy checks
as
=
a
deallocate
(
iseed
)
end
subroutine
#ifdef DOUBLE_PRECISION_REAL
!c> void prepare_matrix_real_double_f(int na, int myid, int na_rows, int na_cols,
!c> int sc_desc[9],
!c> double *a, double *z, double *as);
#else
!c> void prepare_matrix_real_single_f(int na, int myid, int na_rows, int na_cols,
!c> int sc_desc[9],
!c> float *a, float *z, float *as);
#endif
#ifdef DOUBLE_PRECISION_REAL
subroutine
prepare_matrix_real_wrapper_double
&
#else
subroutine
prepare_matrix_real_wrapper_single
&
#endif
(
na
,
myid
,
na_rows
,
na_cols
,
sc_desc
,
a
,
z
,
as
)
&
#ifdef DOUBLE_PRECISION_REAL
bind
(
C
,
name
=
"prepare_matrix_real_double_f"
)
#else
bind
(
C
,
name
=
"prepare_matrix_real_single_f"
)
#endif
use
iso_c_binding
implicit
none
integer
(
kind
=
c_int
)
,
value
::
myid
,
na
,
na_rows
,
na_cols
integer
(
kind
=
c_int
)
::
sc_desc
(
1
:
9
)
#ifdef DOUBLE_PRECISION_REAL
real
(
kind
=
c_double
)
::
z
(
1
:
na_rows
,
1
:
na_cols
),
a
(
1
:
na_rows
,
1
:
na_cols
),
&
as
(
1
:
na_rows
,
1
:
na_cols
)
#else
real
(
kind
=
c_float
)
::
z
(
1
:
na_rows
,
1
:
na_cols
),
a
(
1
:
na_rows
,
1
:
na_cols
),
&
as
(
1
:
na_rows
,
1
:
na_cols
)
#endif
call
prepare_matrix_real_single
(
na
,
myid
,
sc_desc
,
a
,
z
,
as
)
end
subroutine
#define REALCASE 1
#define SINGLE_PRECISION 1
#include "../../src/precision_macros.h"
#include "prepare_matrix_template.X90"
#undef SINGLE_PRECISION
#undef REALCASE
#endif /* WANT_SINGLE_PRECISION_REAL */
...
...
test/shared/prepare_matrix_template.X90
0 → 100644
View file @
c9455ca8
subroutine prepare_matrix_&
&MATH_DATATYPE&
&_&
&PRECISION&
& (na, myid, sc_desc, a, z, as)
use precision
implicit none
integer(kind=ik), intent(in) :: myid, na, sc_desc(:)
#if REALCASE == 1
real(kind=C_DATATYPE_KIND), intent(inout) :: z(:,:), a(:,:), as(:,:)
#endif /* REALCASE */
#if COMPLEXCASE == 1
complex(kind=C_DATATYPE_KIND), intent(inout) :: z(:,:), a(:,:), as(:,:)
#ifdef DOUBLE_PRECISION_COMPLEX
complex(kind=C_DATATYPE_KIND), parameter :: CONE = (1.0_rk8, 0.0_rk8)
#else
complex(kind=C_DATATYPE_KIND), parameter :: CONE = (1.0_rk4, 0.0_rk4)
#endif
real(kind=C_DATATYPE_KIND) :: xr(size(a,dim=1), size(a,dim=2))
#endif /* COMPLEXCASE */
integer, allocatable :: iseed(:)
integer :: n
! for getting a hermitian test matrix A we get a random matrix Z
! and calculate A = Z + Z**H
! we want different random numbers on every process
! (otherwise A might get rank deficient):
call random_seed(size=n)
allocate(iseed(n))
iseed(:) = myid
call random_seed(put=iseed)
#if REALCASE == 1
call random_number(z)
a(:,:) = z(:,:)
#endif /* REALCASE */
#if COMPLEXCASE == 1
call random_number(xr)
z(:,:) = xr(:,:)
call RANDOM_NUMBER(xr)
#ifdef DOUBLE_PRECISION_COMPLEX
z(:,:) = z(:,:) + (0.0_rk8,1.0_rk8)*xr(:,:)
#else
z(:,:) = z(:,:) + (0.0_rk4,1.0_rk4)*xr(:,:)
#endif
a(:,:) = z(:,:)
#endif /* COMPLEXCASE */
if (myid == 0) then
print '(a)','| Random matrix block has been set up. (only processor 0 confirms this step)'
endif
#if REALCASE == 1
#ifdef WITH_MPI
#ifdef DOUBLE_PRECISION_REAL
call pdtran(na, na, 1.0_rk8, z, 1, 1, sc_desc, 1.0_rk8, a, 1, 1, sc_desc) ! A = A + Z**T
#else
call pstran(na, na, 1.0_rk4, z, 1, 1, sc_desc, 1.0_rk4, a, 1, 1, sc_desc) ! A = A + Z**T
#endif
#else /* WITH_MPI */
a = a + transpose(z)
#endif /* WITH_MPI */
#endif /* REALCASE */
#if COMPLEXCASE == 1
#ifdef WITH_MPI
#ifdef DOUBLE_PRECISION_COMPLEX
call pztranc(na, na, CONE, z, 1, 1, sc_desc, CONE, a, 1, 1, sc_desc) ! A = A + Z**H
#else
call pctranc(na, na, CONE, z, 1, 1, sc_desc, CONE, a, 1, 1, sc_desc) ! A = A + Z**H
#endif
#else /* WITH_MPI */
a = a + transpose(conjg(z))
#endif /* WITH_MPI */
#endif /* COMPLEXCASE */
if (myid == 0) then
print '(a)','| Random matrix block has been symmetrized'
endif
! save original matrix A for later accuracy checks
as = a
deallocate(iseed)
end subroutine
#if REALCASE == 1
#ifdef DOUBLE_PRECISION_REAL
!c> void prepare_matrix_real_double_f(int na, int myid, int na_rows, int na_cols,
!c> int sc_desc[9],
!c> double *a, double *z, double *as);
#else
!c> void prepare_matrix_real_single_f(int na, int myid, int na_rows, int na_cols,
!c> int sc_desc[9],
!c> float *a, float *z, float *as);
#endif
#endif /* REALCASE */
#if COMPLEXCASE == 1
#ifdef DOUBLE_PRECISION_COMPLEX
!c> void prepare_matrix_complex_double_f(int na, int myid, int na_rows, int na_cols,
!c> int sc_desc[9],
!c> complex double *a, complex double *z, complex double *as);
#else
!c> void prepare_matrix_complex_single_f(int na, int myid, int na_rows, int na_cols,
!c> int sc_desc[9],
!c> complex *a, complex *z, complex *as);
#endif
#endif /* COMPLEXCASE */
subroutine prepare_matrix_&
&MATH_DATATYPE&
&_wrapper_&
&PRECISION&
& (na, myid, na_rows, na_cols, sc_desc, a, z, as) &
bind(C, name="prepare_matrix_&
&MATH_DATATYPE&
&_&
&PRECISION&
&_f")
use iso_c_binding
implicit none
integer(kind=c_int) , value :: myid, na, na_rows, na_cols
integer(kind=c_int) :: sc_desc(1:9)
#if REALCASE == 1
real(kind=C_DATATYPE_KIND) :: z(1:na_rows,1:na_cols), a(1:na_rows,1:na_cols), &
as(1:na_rows,1:na_cols)
#endif
#if COMPLEXCASE == 1
complex(kind=C_DATATYPE_KIND) :: &
z(1:na_rows,1:na_cols), a(1:na_rows,1:na_cols), &
as(1:na_rows,1:na_cols)
#endif
call prepare_matrix_&
&MATH_DATATYPE&
&_&
&PRECISION&
& (na, myid, sc_desc, a, z, as)
end subroutine
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