Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Sebastian Ohlmann
elpa
Commits
2ec31d9f
Commit
2ec31d9f
authored
Sep 23, 2019
by
Andreas Marek
Browse files
Fortran interfaces for Scalapack routines
parent
c95d2a2e
Changes
11
Hide whitespace changes
Inline
Side-by-side
Makefile.am
View file @
2ec31d9f
...
...
@@ -39,6 +39,7 @@ libelpa@SUFFIX@_private_la_SOURCES = \
src/elpa_abstract_impl.F90
\
src/helpers/mod_precision.F90
\
src/helpers/mod_blas_interfaces.F90
\
src/helpers/mod_scalapack_interfaces.F90
\
src/helpers/mod_mpi.F90
\
src/helpers/mod_mpi_stubs.F90
\
src/helpers/mod_omp.F90
\
...
...
@@ -622,7 +623,7 @@ double_instance@SUFFIX@_FCFLAGS = $(AM_FCFLAGS) $(FC_MODINC)test_modules $(FC_MO
noinst_PROGRAMS
+=
real_2stage_banded@SUFFIX@
check_SCRIPTS
+=
real_2stage_banded@SUFFIX@_default.sh
real_2stage_banded@SUFFIX@
_SOURCES
=
test
/Fortran/elpa2/real_2stage_banded.F90
real_2stage_banded@SUFFIX@
_SOURCES
=
test
/Fortran/elpa2/real_2stage_banded.F90
real_2stage_banded@SUFFIX@
_LDADD
=
$(test_program_ldadd)
real_2stage_banded@SUFFIX@
_FCFLAGS
=
$(AM_FCFLAGS)
$(FC_MODINC)
test_modules
$(FC_MODINC)
modules
...
...
src/helpers/mod_scalapack_interfaces.F90
0 → 100644
View file @
2ec31d9f
! This file is part of ELPA.
!
! The ELPA library was originally created by the ELPA consortium,
! consisting of the following organizations:
!
! - Rechenzentrum Garching der Max-Planck-Gesellschaft (RZG),
! - Bergische Universität Wuppertal, Lehrstuhl für angewandte
! Informatik,
! - Technische Universität München, Lehrstuhl für Informatik mit
! Schwerpunkt Wissenschaftliches Rechnen ,
! - Fritz-Haber-Institut, Berlin, Abt. Theorie,
! - Max-Plack-Institut für Mathematik in den Naturwissenschaften,
! Leipzig, Abt. Komplexe Strukutren in Biologie und Kognition,
! and
! - IBM Deutschland GmbH
!
!
! More information can be found here:
! http://elpa.rzg.mpg.de/
!
! ELPA is free software: you can redistribute it and/or modify
! it under the terms of the version 3 of the license of the
! GNU Lesser General Public License as published by the Free
! Software Foundation.
!
! ELPA is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU Lesser General Public License for more details.
!
! You should have received a copy of the GNU Lesser General Public License
! along with ELPA. If not, see <http://www.gnu.org/licenses/>
!
! ELPA reflects a substantial effort on the part of the original
! ELPA consortium, and we ask you to respect the spirit of the
! license that we chose: i.e., please contribute any changes you
! may have back to the original ELPA library distribution, and keep
! any derivatives of ELPA under the same license that we chose for
! the original distribution, the GNU Lesser General Public License.
!
! This file was written by A. Marek, MPCDF
#include "config-f90.h"
module
elpa_scalapack_interfaces
use
iso_c_binding
use
precision
implicit
none
public
interface
subroutine
pdgemm
(
TRANSA
,
TRANSB
,
M
,
N
,
K
,
ALPHA
,
A
,
IA
,
JA
,
DESCA
,
B
,
IB
,
JB
,
DESCB
,
BETA
,
C
,
IC
,
JC
,
DESCC
)
use
precision
implicit
none
character
::
TRANSA
,
TRANSB
integer
(
kind
=
BLAS_KIND
)
::
M
,
N
,
K
,
IA
,
JA
,
DESCA
(
*
),
IB
,
JB
,
DESCB
(
*
),
IC
,
JC
,
DESCC
(
*
)
real
(
kind
=
rk8
)
::
ALPHA
,
BETA
real
(
kind
=
rk8
)
::
A
(
*
),
B
(
*
),
C
(
*
)
end
subroutine
end
interface
interface
subroutine
pdnrm2
(
N
,
norm2
,
x
,
ix
,
jx
,
descx
,
incx
)
use
precision
implicit
none
integer
(
kind
=
BLAS_KIND
)
::
N
,
ix
,
jx
,
descx
(
*
),
incx
real
(
kind
=
rk8
)
::
norm2
,
x
(
*
)
end
subroutine
end
interface
interface
subroutine
pdlaset
(
UPLO
,
M
,
N
,
ALPHA
,
BETA
,
A
,
IA
,
JA
,
DESCA
)
use
precision
implicit
none
character
::
UPLO
integer
(
kind
=
BLAS_KIND
)
::
M
,
N
,
IA
,
JA
,
DESCA
(
*
)
real
(
kind
=
rk8
)
::
ALPHA
,
BETA
real
(
kind
=
rk8
)
::
A
(
*
)
end
subroutine
end
interface
interface
subroutine
pdtran
(
M
,
N
,
ALPHA
,
A
,
IA
,
JA
,
DESCA
,
BETA
,
C
,
IC
,
JC
,
DESCC
)
use
precision
implicit
none
integer
(
kind
=
BLAS_KIND
)
::
M
,
N
,
IA
,
JA
,
DESCA
(
*
),
IC
,
JC
,
DESCC
(
*
)
real
(
kind
=
rk8
)
::
ALPHA
,
BETA
real
(
kind
=
rk8
)
::
A
(
*
),
C
(
*
)
end
subroutine
end
interface
interface
subroutine
psgemm
(
TRANSA
,
TRANSB
,
M
,
N
,
K
,
ALPHA
,
A
,
IA
,
JA
,
DESCA
,
B
,
IB
,
JB
,
DESCB
,
BETA
,
C
,
IC
,
JC
,
DESCC
)
use
precision
implicit
none
character
::
TRANSA
,
TRANSB
integer
(
kind
=
BLAS_KIND
)
::
M
,
N
,
K
,
IA
,
JA
,
DESCA
(
*
),
IB
,
JB
,
DESCB
(
*
),
IC
,
JC
,
DESCC
(
*
)
real
(
kind
=
rk4
)
::
ALPHA
,
BETA
real
(
kind
=
rk4
)
::
A
(
*
),
B
(
*
),
C
(
*
)
end
subroutine
end
interface
interface
subroutine
psnrm2
(
N
,
norm2
,
x
,
ix
,
jx
,
descx
,
incx
)
use
precision
implicit
none
integer
(
kind
=
BLAS_KIND
)
::
N
,
ix
,
jx
,
descx
(
*
),
incx
real
(
kind
=
rk4
)
::
norm2
,
x
(
*
)
end
subroutine
end
interface
interface
subroutine
pslaset
(
UPLO
,
M
,
N
,
ALPHA
,
BETA
,
A
,
IA
,
JA
,
DESCA
)
use
precision
implicit
none
character
::
UPLO
integer
(
kind
=
BLAS_KIND
)
::
M
,
N
,
IA
,
JA
,
DESCA
(
*
)
real
(
kind
=
rk4
)
::
ALPHA
,
BETA
real
(
kind
=
rk4
)
::
A
(
*
)
end
subroutine
end
interface
interface
subroutine
pstran
(
M
,
N
,
ALPHA
,
A
,
IA
,
JA
,
DESCA
,
BETA
,
C
,
IC
,
JC
,
DESCC
)
use
precision
implicit
none
integer
(
kind
=
BLAS_KIND
)
::
M
,
N
,
IA
,
JA
,
DESCA
(
*
),
IC
,
JC
,
DESCC
(
*
)
real
(
kind
=
rk4
)
::
ALPHA
,
BETA
real
(
kind
=
rk4
)
::
A
(
*
),
C
(
*
)
end
subroutine
end
interface
interface
subroutine
pzgemm
(
TRANSA
,
TRANSB
,
M
,
N
,
K
,
ALPHA
,
A
,
IA
,
JA
,
DESCA
,
B
,
IB
,
JB
,
DESCB
,
BETA
,
C
,
IC
,
JC
,
DESCC
)
use
precision
implicit
none
character
::
TRANSA
,
TRANSB
integer
(
kind
=
BLAS_KIND
)
::
M
,
N
,
K
,
IA
,
JA
,
DESCA
(
*
),
IB
,
JB
,
DESCB
(
*
),
IC
,
JC
,
DESCC
(
*
)
complex
(
kind
=
ck8
)
::
ALPHA
,
BETA
complex
(
kind
=
ck8
)
::
A
(
*
),
B
(
*
),
C
(
*
)
end
subroutine
end
interface
interface
subroutine
pzdotc
(
N
,
DOTC
,
X
,
ix
,
jx
,
descx
,
incx
,
Y
,
iy
,
jy
,
descy
,
incy
)
use
precision
implicit
none
integer
(
kind
=
BLAS_KIND
)
::
N
,
ix
,
jx
,
descx
(
*
),
incx
,
iy
,
jy
,
descy
(
*
),
incy
complex
(
kind
=
ck8
)
::
DOTC
complex
(
kind
=
ck8
)
::
X
(
*
),
Y
(
*
)
end
subroutine
end
interface
interface
subroutine
pzlaset
(
UPLO
,
M
,
N
,
ALPHA
,
BETA
,
A
,
IA
,
JA
,
DESCA
)
use
precision
implicit
none
character
::
UPLO
integer
(
kind
=
BLAS_KIND
)
::
M
,
N
,
IA
,
JA
,
DESCA
(
*
)
complex
(
kind
=
ck8
)
::
ALPHA
,
BETA
complex
(
kind
=
ck8
)
::
A
(
*
)
end
subroutine
end
interface
interface
subroutine
pztranc
(
M
,
N
,
ALPHA
,
A
,
IA
,
JA
,
DESCA
,
BETA
,
C
,
IC
,
JC
,
DESCC
)
use
precision
implicit
none
integer
(
kind
=
BLAS_KIND
)
::
M
,
N
,
IA
,
JA
,
DESCA
(
*
),
IC
,
JC
,
DESCC
(
*
)
complex
(
kind
=
ck8
)
::
ALPHA
,
BETA
complex
(
kind
=
ck8
)
::
A
(
*
),
C
(
*
)
end
subroutine
end
interface
interface
subroutine
pcgemm
(
TRANSA
,
TRANSB
,
M
,
N
,
K
,
ALPHA
,
A
,
IA
,
JA
,
DESCA
,
B
,
IB
,
JB
,
DESCB
,
BETA
,
C
,
IC
,
JC
,
DESCC
)
use
precision
implicit
none
character
::
TRANSA
,
TRANSB
integer
(
kind
=
BLAS_KIND
)
::
M
,
N
,
K
,
IA
,
JA
,
DESCA
(
*
),
IB
,
JB
,
DESCB
(
*
),
IC
,
JC
,
DESCC
(
*
)
complex
(
kind
=
ck4
)
::
ALPHA
,
BETA
complex
(
kind
=
ck4
)
::
A
(
*
),
B
(
*
),
C
(
*
)
end
subroutine
end
interface
interface
subroutine
pcdotc
(
N
,
DOTC
,
X
,
ix
,
jx
,
descx
,
incx
,
Y
,
iy
,
jy
,
descy
,
incy
)
use
precision
implicit
none
integer
(
kind
=
BLAS_KIND
)
::
N
,
ix
,
jx
,
descx
(
*
),
incx
,
iy
,
jy
,
descy
(
*
),
incy
complex
(
kind
=
ck4
)
::
DOTC
complex
(
kind
=
ck4
)
::
X
(
*
),
Y
(
*
)
end
subroutine
end
interface
interface
subroutine
pclaset
(
UPLO
,
M
,
N
,
ALPHA
,
BETA
,
A
,
IA
,
JA
,
DESCA
)
use
precision
implicit
none
character
::
UPLO
integer
(
kind
=
BLAS_KIND
)
::
M
,
N
,
IA
,
JA
,
DESCA
(
*
)
complex
(
kind
=
ck4
)
::
ALPHA
,
BETA
complex
(
kind
=
ck4
)
::
A
(
*
)
end
subroutine
end
interface
interface
subroutine
pctranc
(
M
,
N
,
ALPHA
,
A
,
IA
,
JA
,
DESCA
,
BETA
,
C
,
IC
,
JC
,
DESCC
)
use
precision
implicit
none
integer
(
kind
=
BLAS_KIND
)
::
M
,
N
,
IA
,
JA
,
DESCA
(
*
),
IC
,
JC
,
DESCC
(
*
)
complex
(
kind
=
ck4
)
::
ALPHA
,
BETA
complex
(
kind
=
ck4
)
::
A
(
*
),
C
(
*
)
end
subroutine
end
interface
end
module
test/Fortran/test.F90
View file @
2ec31d9f
...
...
@@ -124,6 +124,8 @@ program test
#ifdef WITH_OPENMP
use
omp_lib
#endif
use
precision
implicit
none
! matrix dimensions
...
...
test/shared/test_analytic.F90
View file @
2ec31d9f
...
...
@@ -52,6 +52,8 @@ module test_analytic
#else
use
timings_dummy
#endif
use
precision
interface
prepare_matrix_analytic
module
procedure
prepare_matrix_analytic_complex_double
module
procedure
prepare_matrix_analytic_real_double
...
...
test/shared/test_analytic_template.F90
View file @
2ec31d9f
...
...
@@ -46,6 +46,8 @@
&
_
&
&
PRECISION
&
&(
na
,
a
,
nblk
,
myid
,
np_rows
,
np_cols
,
my_prow
,
my_pcol
,
print_times
)
use
precision
implicit
none
integer
(
kind
=
ik
),
intent
(
in
)
::
na
,
nblk
,
myid
,
np_rows
,
np_cols
,
my_prow
,
my_pcol
MATH_DATATYPE
(
kind
=
REAL_DATATYPE
),
intent
(
inout
)
::
a
(:,:)
...
...
@@ -121,6 +123,8 @@
&
PRECISION
&
&(
na
,
nev
,
ev
,
z
,
nblk
,
myid
,
np_rows
,
np_cols
,
my_prow
,
my_pcol
,
check_all_evals
,
&
check_eigenvectors
,
print_times
)
result
(
status
)
use
precision
implicit
none
#include "../../src/general/precision_kinds.F90"
integer
(
kind
=
ik
),
intent
(
in
)
::
na
,
nev
,
nblk
,
myid
,
np_rows
,
&
...
...
@@ -317,6 +321,8 @@
&
_
&
&
PRECISION
&
&(
na
,
i
,
j
)
result
(
element
)
use
precision
implicit
none
integer
(
kind
=
ik
),
intent
(
in
)
::
na
,
i
,
j
MATH_DATATYPE
(
kind
=
REAL_DATATYPE
)
::
element
...
...
@@ -334,6 +340,8 @@
&
_
&
&
PRECISION
&
&(
na
,
i
,
j
)
result
(
element
)
use
precision
implicit
none
integer
(
kind
=
ik
),
intent
(
in
)
::
na
,
i
,
j
MATH_DATATYPE
(
kind
=
REAL_DATATYPE
)
::
element
...
...
@@ -351,6 +359,8 @@
&
_
&
&
PRECISION
&
&(
na
,
i
)
result
(
element
)
use
precision
implicit
none
integer
(
kind
=
ik
),
intent
(
in
)
::
na
,
i
real
(
kind
=
REAL_DATATYPE
)
::
element
...
...
@@ -366,6 +376,8 @@
&
_
&
&
PRECISION
&
&(
na
,
i
,
j
,
what
)
result
(
element
)
use
precision
implicit
none
#include "../../src/general/precision_kinds.F90"
integer
(
kind
=
ik
),
intent
(
in
)
::
na
,
i
,
j
,
what
...
...
@@ -490,6 +502,8 @@
&
_
&
&
PRECISION
&
&(
myid
,
na
,
mat
,
mat_name
)
use
precision
implicit
none
#include "../../src/general/precision_kinds.F90"
integer
(
kind
=
ik
),
intent
(
in
)
::
myid
,
na
...
...
@@ -519,6 +533,8 @@
&
_
&
&
PRECISION
&
&(
myid
,
na
)
use
precision
implicit
none
#include "../../src/general/precision_kinds.F90"
integer
(
kind
=
ik
),
intent
(
in
)
::
myid
,
na
...
...
@@ -581,6 +597,8 @@
&
_
&
&
PRECISION
&
&(
myid
)
use
precision
implicit
none
integer
(
kind
=
ik
),
intent
(
in
)
::
myid
integer
(
kind
=
ik
)
::
decomposition
(
num_primes
),
i
...
...
test/shared/test_blacs_infrastructure.F90
View file @
2ec31d9f
...
...
@@ -94,6 +94,7 @@ module test_blacs_infrastructure
use
elpa_utilities
,
only
:
error_unit
use
test_util
use
precision
implicit
none
integer
(
kind
=
ik
),
intent
(
in
)
::
na
,
nblk
,
my_prow
,
my_pcol
,
np_rows
,
&
...
...
test/shared/test_check_correctness_template.F90
View file @
2ec31d9f
...
...
@@ -48,6 +48,8 @@
&
(
na
,
nev
,
as
,
z
,
ev
,
sc_desc
,
nblk
,
myid
,
np_rows
,
np_cols
,
my_prow
,
my_pcol
,
bs
)
result
(
status
)
use
elpa_blas_interfaces
use
elpa_scalapack_interfaces
implicit
none
#include "../../src/general/precision_kinds.F90"
integer
(
kind
=
ik
)
::
status
...
...
@@ -454,6 +456,7 @@ function check_correctness_evp_gen_numeric_residuals_&
&
_
&
&
PRECISION
&
&
(
na
,
a
,
as
,
na_rows
,
sc_desc
,
myid
)
result
(
status
)
use
precision
implicit
none
#include "../../src/general/precision_kinds.F90"
integer
(
kind
=
ik
)
::
status
...
...
@@ -570,6 +573,7 @@ function check_correctness_evp_gen_numeric_residuals_&
&
_
&
&
PRECISION
&
&
(
na
,
a
,
b
,
c
,
na_rows
,
sc_desc
,
myid
)
result
(
status
)
use
precision
implicit
none
#include "../../src/general/precision_kinds.F90"
integer
(
kind
=
ik
)
::
status
...
...
test/shared/test_prepare_matrix_template.F90
View file @
2ec31d9f
...
...
@@ -49,6 +49,8 @@
use
test_util
use
elpa_scalapack_interfaces
implicit
none
#include "../../src/general/precision_kinds.F90"
integer
(
kind
=
ik
),
intent
(
in
)
::
myid
,
na
,
sc_desc
(:)
...
...
@@ -182,6 +184,7 @@ subroutine prepare_matrix_random_&
&
(
na
,
myid
,
sc_desc
,
a
,
z
,
as
,
nblk
,
np_rows
,
np_cols
,
my_prow
,
my_pcol
)
use
test_util
use
precision
implicit
none
#include "../../src/general/precision_kinds.F90"
integer
(
kind
=
ik
),
intent
(
in
)
::
myid
,
na
,
sc_desc
(:)
...
...
test/shared/test_read_input_parameters.F90
View file @
2ec31d9f
...
...
@@ -206,6 +206,7 @@ module test_read_input_parameters
end
subroutine
subroutine
read_input_parameters_general
(
input_options
)
use
precision
implicit
none
type
(
input_options_t
)
::
input_options
...
...
@@ -340,6 +341,7 @@ module test_read_input_parameters
end
subroutine
subroutine
read_input_parameters_traditional_noskip
(
na
,
nev
,
nblk
,
write_to_file
)
use
precision
implicit
none
integer
(
kind
=
ik
),
intent
(
out
)
::
na
,
nev
,
nblk
...
...
@@ -351,6 +353,7 @@ module test_read_input_parameters
end
subroutine
subroutine
read_input_parameters_traditional
(
na
,
nev
,
nblk
,
write_to_file
,
skip_check_correctness
)
use
precision
implicit
none
integer
(
kind
=
ik
),
intent
(
out
)
::
na
,
nev
,
nblk
...
...
test/shared/test_setup_mpi.F90
View file @
2ec31d9f
...
...
@@ -48,6 +48,7 @@ module test_setup_mpi
subroutine
setup_mpi
(
myid
,
nprocs
)
use
test_util
use
ELPA_utilities
use
precision
implicit
none
integer
(
kind
=
ik
)
::
mpierr
...
...
test/shared/test_util.F90
View file @
2ec31d9f
...
...
@@ -43,6 +43,7 @@
#include "config-f90.h"
module
test_util
use
iso_c_binding
use
precision
#ifdef WITH_MPI
#ifdef HAVE_MPI_MODULE
use
mpi
...
...
@@ -55,12 +56,12 @@ module test_util
integer
,
parameter
::
mpi_comm_world
=
-1
#endif
integer
,
parameter
::
rk8
=
C_DOUBLE
integer
,
parameter
::
rk4
=
C_FLOAT
integer
,
parameter
::
ck8
=
C_DOUBLE_COMPLEX
integer
,
parameter
::
ck4
=
C_FLOAT_COMPLEX
integer
,
parameter
::
ik
=
C_INT32_T
integer
,
parameter
::
lik
=
C_INT64_T
!
integer, parameter :: rk8 = C_DOUBLE
!
integer, parameter :: rk4 = C_FLOAT
!
integer, parameter :: ck8 = C_DOUBLE_COMPLEX
!
integer, parameter :: ck4 = C_FLOAT_COMPLEX
!
integer, parameter :: ik = C_INT32_T
!
integer, parameter :: lik = C_INT64_T
contains
!>
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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