Skip to content
GitLab
Commit 2ec31d9f authored by Andreas Marek's avatar Andreas Marek
Browse files

Fortran interfaces for Scalapack routines

parent c95d2a2e
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
!>
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment