From f92349206ba9066d54fe06a3d6d0fc5105cb8944 Mon Sep 17 00:00:00 2001 From: Ruslan Kabatsayev Date: Thu, 7 Jun 2018 12:33:41 +0300 Subject: [PATCH 1/4] Fix correctness of C bindings Main problems found in the original version are: I. C vs iso_c_binding: 1. Mismatch between float complex and float parameters in C prototypes and icba*.f90 files 2. Mismatch between passing of some arguments by pointer vs by value II. iso_c_binding vs Fortran: 1. Mismatch between real and complex parameters 2. Wrong intent for 'workev' These problems lead to UB, which, in particular, resulted in test crashes on i686 targets. This patch fixes them. --- SRC/icbacn.f90 | 76 ++++++++++++++++++++-------------------- SRC/icbazn.f90 | 82 ++++++++++++++++++++++---------------------- TESTS/icb_arpack_c.c | 2 +- arpack.h | 79 +++++++----------------------------------- arpack.hpp | 78 +---------------------------------------- 5 files changed, 93 insertions(+), 224 deletions(-) diff --git a/SRC/icbacn.f90 b/SRC/icbacn.f90 index 1425ced76..b6706afa8 100644 --- a/SRC/icbacn.f90 +++ b/SRC/icbacn.f90 @@ -6,21 +6,21 @@ subroutine cnaupd_c(ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& use :: iso_c_binding implicit none integer(kind=c_int), intent(inout) :: ido - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n - character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev - real(kind=c_float_complex), value, intent(in) :: tol - real(kind=c_float_complex), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv - real(kind=c_float_complex), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr - real(kind=c_float_complex), dimension(3*n), intent(out) :: workd - real(kind=c_float_complex), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - real(kind=c_float_complex), dimension(ncv), intent(out) :: rwork + character(kind=c_char), dimension(1), intent(in) :: bmat + integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), dimension(2), intent(in) :: which + integer(kind=c_int), value, intent(in) :: nev + real(kind=c_float), value, intent(in) :: tol + complex(kind=c_float_complex),dimension(n), intent(inout) :: resid + integer(kind=c_int), value, intent(in) :: ncv + complex(kind=c_float_complex),dimension(ldv, ncv),intent(out) :: v + integer(kind=c_int), value, intent(in) :: ldv + integer(kind=c_int), dimension(11), intent(inout) :: iparam + integer(kind=c_int), dimension(11), intent(out) :: ipntr + complex(kind=c_float_complex),dimension(3*n), intent(out) :: workd + complex(kind=c_float_complex),dimension(lworkl), intent(out) :: workl + integer(kind=c_int), value, intent(in) :: lworkl + real(kind=c_float), dimension(ncv), intent(out) :: rwork integer(kind=c_int), intent(inout) :: info call cnaupd(ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, rwork, info) @@ -32,29 +32,29 @@ subroutine cneupd_c(rvec, howmny, select, d, z, ldz, sigma, workev, & bind(c, name="cneupd_c") use :: iso_c_binding implicit none - logical(kind=c_bool), value, intent(in) :: rvec - character(kind=c_char), dimension(1), intent(in) :: howmny - logical(kind=c_bool), dimension(ncv), intent(in) :: select - real(kind=c_float_complex), dimension(nev), intent(out) :: d - real(kind=c_float_complex), dimension(n, nev), intent(out) :: z - integer(kind=c_int), value, intent(in) :: ldz - real(kind=c_float_complex), value, intent(in) :: sigma - real(kind=c_float_complex), dimension(2*ncv), intent(in) :: workev - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n - character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev - real(kind=c_float_complex), value, intent(in) :: tol - real(kind=c_float_complex), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv - real(kind=c_float_complex), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr - real(kind=c_float_complex), dimension(3*n), intent(out) :: workd - real(kind=c_float_complex), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - real(kind=c_float_complex), dimension(ncv), intent(out) :: rwork + logical(kind=c_bool), value, intent(in) :: rvec + character(kind=c_char), dimension(1), intent(in) :: howmny + logical(kind=c_bool), dimension(ncv), intent(in) :: select + complex(kind=c_float_complex),dimension(nev), intent(out) :: d + complex(kind=c_float_complex),dimension(n, nev), intent(out) :: z + integer(kind=c_int), value, intent(in) :: ldz + complex(kind=c_float_complex),value, intent(in) :: sigma + complex(kind=c_float_complex),dimension(2*ncv), intent(out) :: workev + character(kind=c_char), dimension(1), intent(in) :: bmat + integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), dimension(2), intent(in) :: which + integer(kind=c_int), value, intent(in) :: nev + real(kind=c_float), value, intent(in) :: tol + complex(kind=c_float_complex),dimension(n), intent(inout) :: resid + integer(kind=c_int), value, intent(in) :: ncv + complex(kind=c_float_complex),dimension(ldv, ncv),intent(out) :: v + integer(kind=c_int), value, intent(in) :: ldv + integer(kind=c_int), dimension(11), intent(inout) :: iparam + integer(kind=c_int), dimension(11), intent(out) :: ipntr + complex(kind=c_float_complex),dimension(3*n), intent(out) :: workd + complex(kind=c_float_complex),dimension(lworkl), intent(out) :: workl + integer(kind=c_int), value, intent(in) :: lworkl + real(kind=c_float), dimension(ncv), intent(out) :: rwork integer(kind=c_int), intent(inout) :: info call cneupd(rvec, howmny, select, d, z, ldz, sigma, workev,& bmat, n, which, nev, tol, resid, ncv, v, ldv, & diff --git a/SRC/icbazn.f90 b/SRC/icbazn.f90 index 40c14e4a9..b040fa595 100644 --- a/SRC/icbazn.f90 +++ b/SRC/icbazn.f90 @@ -5,23 +5,23 @@ subroutine znaupd_c(ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& bind(c, name="znaupd_c") use :: iso_c_binding implicit none - integer(kind=c_int), intent(inout) :: ido - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n - character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev - real(kind=c_double_complex), value, intent(in) :: tol - real(kind=c_double_complex), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv - real(kind=c_double_complex), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr - real(kind=c_double_complex), dimension(3*n), intent(out) :: workd - real(kind=c_double_complex), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - real(kind=c_double_complex), dimension(ncv), intent(out) :: rwork - integer(kind=c_int), intent(inout) :: info + integer(kind=c_int), intent(inout) :: ido + character(kind=c_char), dimension(1), intent(in) :: bmat + integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), dimension(2), intent(in) :: which + integer(kind=c_int), value, intent(in) :: nev + real(kind=c_double), value, intent(in) :: tol + complex(kind=c_double_complex), dimension(n), intent(inout) :: resid + integer(kind=c_int), value, intent(in) :: ncv + complex(kind=c_double_complex), dimension(ldv, ncv),intent(out) :: v + integer(kind=c_int), value, intent(in) :: ldv + integer(kind=c_int), dimension(11), intent(inout) :: iparam + integer(kind=c_int), dimension(11), intent(out) :: ipntr + complex(kind=c_double_complex), dimension(3*n), intent(out) :: workd + complex(kind=c_double_complex), dimension(lworkl), intent(out) :: workl + integer(kind=c_int), value, intent(in) :: lworkl + real(kind=c_double), dimension(ncv), intent(out) :: rwork + integer(kind=c_int), intent(inout) :: info call znaupd(ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, rwork, info) end subroutine znaupd_c @@ -32,30 +32,30 @@ subroutine zneupd_c(rvec, howmny, select, d, z, ldz, sigma, workev, & bind(c, name="zneupd_c") use :: iso_c_binding implicit none - logical(kind=c_bool), value, intent(in) :: rvec - character(kind=c_char), dimension(1), intent(in) :: howmny - logical(kind=c_bool), dimension(ncv), intent(in) :: select - real(kind=c_double_complex), dimension(nev), intent(out) :: d - real(kind=c_double_complex), dimension(n, nev), intent(out) :: z - integer(kind=c_int), value, intent(in) :: ldz - real(kind=c_double_complex), value, intent(in) :: sigma - real(kind=c_double_complex), dimension(2*ncv), intent(in) :: workev - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n - character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev - real(kind=c_double_complex), value, intent(in) :: tol - real(kind=c_double_complex), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv - real(kind=c_double_complex), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr - real(kind=c_double_complex), dimension(3*n), intent(out) :: workd - real(kind=c_double_complex), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - real(kind=c_double_complex), dimension(ncv), intent(out) :: rwork - integer(kind=c_int), intent(inout) :: info + logical(kind=c_bool), value, intent(in) :: rvec + character(kind=c_char), dimension(1), intent(in) :: howmny + logical(kind=c_bool), dimension(ncv), intent(in) :: select + complex(kind=c_double_complex), dimension(nev), intent(out) :: d + complex(kind=c_double_complex), dimension(n, nev), intent(out) :: z + integer(kind=c_int), value, intent(in) :: ldz + complex(kind=c_double_complex), value, intent(in) :: sigma + complex(kind=c_double_complex), dimension(2*ncv), intent(out) :: workev + character(kind=c_char), dimension(1), intent(in) :: bmat + integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), dimension(2), intent(in) :: which + integer(kind=c_int), value, intent(in) :: nev + real(kind=c_double), value, intent(in) :: tol + complex(kind=c_double_complex), dimension(n), intent(inout) :: resid + integer(kind=c_int), value, intent(in) :: ncv + complex(kind=c_double_complex), dimension(ldv, ncv),intent(out) :: v + integer(kind=c_int), value, intent(in) :: ldv + integer(kind=c_int), dimension(11), intent(inout) :: iparam + integer(kind=c_int), dimension(11), intent(out) :: ipntr + complex(kind=c_double_complex), dimension(3*n), intent(out) :: workd + complex(kind=c_double_complex), dimension(lworkl), intent(out) :: workl + integer(kind=c_int), value, intent(in) :: lworkl + real(kind=c_double), dimension(ncv), intent(out) :: rwork + integer(kind=c_int), intent(inout) :: info call zneupd(rvec, howmny, select, d, z, ldz, sigma, workev,& bmat, n, which, nev, tol, resid, ncv, v, ldv, & iparam, ipntr, workd, workl, lworkl, rwork, info) diff --git a/TESTS/icb_arpack_c.c b/TESTS/icb_arpack_c.c index 419227a25..1de96a004 100644 --- a/TESTS/icb_arpack_c.c +++ b/TESTS/icb_arpack_c.c @@ -124,7 +124,7 @@ int zn() { for (k=0; k < 3*(ncv*ncv) + 6*ncv; ++k ) workl[k] = 0; BLASINT lworkl = 3*(ncv*ncv) + 6*ncv; - double _Complex rwork[ncv]; + double rwork[ncv]; double _Complex workev[2*ncv]; BLASINT info = 0; diff --git a/arpack.h b/arpack.h index f85ec7ba9..f48e4743d 100644 --- a/arpack.h +++ b/arpack.h @@ -5,73 +5,18 @@ extern "C" { #endif -extern void ssaupd_c(int * ido, char * bmat, int n, char * which, int nev, - float tol, float * resid, int ncv, float * v, - int ldv, int * iparam, int * ipntr, float * workd, - float * workl, int lworkl, int * info); - -extern void sseupd_c(bool rvec, char * howmny, int * select, float * d, float * z, int ldz, float sigma, - char * bmat, int n, char * which, int nev, - float tol, float * resid, int ncv, float * v, - int ldv, int * iparam, int * ipntr, float * workd, - float * workl, int lworkl, int * info); - -extern void dsaupd_c(int * ido, char * bmat, int n, char * which, int nev, - double tol, double * resid, int ncv, double * v, - int ldv, int * iparam, int * ipntr, double * workd, - double * workl, int lworkl, int * info); - -extern void dseupd_c(bool rvec, char * howmny, int * select, double * d, double * z, int ldz, double sigma, - char * bmat, int n, char * which, int nev, - double tol, double * resid, int ncv, double * v, - int ldv, int * iparam, int * ipntr, double * workd, - double * workl, int lworkl, int * info); - -extern void snaupd_c(int * ido, char * bmat, int n, char * which, int nev, - float tol, float * resid, int ncv, float * v, - int ldv, int * iparam, int * ipntr, float * workd, - float * workl, int lworkl, int * info); - -extern void sneupd_c(bool rvec, char * howmny, int * select, float * dr, float * di, float * z, int ldz, float sigmar, float sigmai, - char * bmat, int n, char * which, int nev, - float tol, float * resid, int ncv, float * v, - int ldv, int * iparam, int * ipntr, float * workd, - float * workl, int lworkl, int * info); - -extern void dnaupd_c(int * ido, char * bmat, int n, char * which, int nev, - double tol, double * resid, int ncv, double * v, - int ldv, int * iparam, int * ipntr, double * workd, - double * workl, int lworkl, int * info); - -extern void dneupd_c(bool rvec, char * howmny, int * select, double * dr, double * di, double * z, int ldz, double sigmar, double sigmai, - char * bmat, int n, char * which, int nev, - double tol, double * resid, int ncv, double * v, - int ldv, int * iparam, int * ipntr, double * workd, - double * workl, int lworkl, int * info); - -extern void cnaupd_c(int * ido, char * bmat, int n, char * which, int nev, - float tol, float _Complex * resid, int ncv, float _Complex * v, - int ldv, int * iparam, int * ipntr, float _Complex * workd, - float _Complex * workl, int lworkl, float _Complex * rwork, int * info); - -extern void cneupd_c(bool rvec, char * howmny, int * select, - float _Complex * d, float _Complex * z, int ldz, float _Complex sigma, float _Complex * workev, - char * bmat, int n, char * which, int nev, - float tol, float _Complex * resid, int ncv, float _Complex * v, - int ldv, int * iparam, int * ipntr, float _Complex * workd, - float _Complex * workl, int lworkl, float _Complex * rwork, int * info); - -extern void znaupd_c(int * ido, char * bmat, int n, char * which, int nev, - double tol, double _Complex * resid, int ncv, double _Complex * v, - int ldv, int * iparam, int * ipntr, double _Complex * workd, - double _Complex * workl, int lworkl, double _Complex * rwork, int * info); - -extern void zneupd_c(bool rvec, char * howmny, int * select, - double _Complex * d, double _Complex * z, int ldz, double _Complex sigma, double _Complex * workev, - char * bmat, int n, char * which, int nev, - double tol, double _Complex * resid, int ncv, double _Complex * v, - int ldv, int * iparam, int * ipntr, double _Complex * workd, - double _Complex * workl, int lworkl, double _Complex * rwork, int * info); +void cnaupd_c(int* ido, char const* bmat, int n, char const* which, int nev, float tol, float _Complex* resid, int ncv, float _Complex* v, int ldv, int* iparam, int* ipntr, float _Complex* workd, float _Complex* workl, int lworkl, float* rwork, int* info); +void cneupd_c(bool rvec, char const* howmny, int const* select, float _Complex* d, float _Complex* z, int ldz, float _Complex sigma, float _Complex* workev, char const* bmat, int n, char const* which, int nev, float tol, float _Complex* resid, int ncv, float _Complex* v, int ldv, int* iparam, int* ipntr, float _Complex* workd, float _Complex* workl, int lworkl, float* rwork, int* info); +void dnaupd_c(int* ido, char const* bmat, int n, char const* which, int nev, double tol, double* resid, int ncv, double* v, int ldv, int* iparam, int* ipntr, double* workd, double* workl, int lworkl, int* info); +void dneupd_c(bool rvec, char const* howmny, int const* select, double* dr, double* di, double* z, int ldz, double sigmar, double sigmai, char const* bmat, int n, char const* which, int nev, double tol, double* resid, int ncv, double* v, int ldv, int* iparam, int* ipntr, double* workd, double* workl, int lworkl, int* info); +void dsaupd_c(int* ido, char const* bmat, int n, char const* which, int nev, double tol, double* resid, int ncv, double* v, int ldv, int* iparam, int* ipntr, double* workd, double* workl, int lworkl, int* info); +void dseupd_c(bool rvec, char const* howmny, int const* select, double* d, double* z, int ldz, double sigma, char const* bmat, int n, char const* which, int nev, double tol, double* resid, int ncv, double* v, int ldv, int* iparam, int* ipntr, double* workd, double* workl, int lworkl, int* info); +void snaupd_c(int* ido, char const* bmat, int n, char const* which, int nev, float tol, float* resid, int ncv, float* v, int ldv, int* iparam, int* ipntr, float* workd, float* workl, int lworkl, int* info); +void sneupd_c(bool rvec, char const* howmny, int const* select, float* dr, float* di, float* z, int ldz, float sigmar, float sigmai, char const* bmat, int n, char const* which, int nev, float tol, float* resid, int ncv, float* v, int ldv, int* iparam, int* ipntr, float* workd, float* workl, int lworkl, int* info); +void ssaupd_c(int* ido, char const* bmat, int n, char const* which, int nev, float tol, float* resid, int ncv, float* v, int ldv, int* iparam, int* ipntr, float* workd, float* workl, int lworkl, int* info); +void sseupd_c(bool rvec, char const* howmny, int const* select, float* d, float* z, int ldz, float sigma, char const* bmat, int n, char const* which, int nev, float tol, float* resid, int ncv, float* v, int ldv, int* iparam, int* ipntr, float* workd, float* workl, int lworkl, int* info); +void znaupd_c(int* ido, char const* bmat, int n, char const* which, int nev, double tol, double _Complex* resid, int ncv, double _Complex* v, int ldv, int* iparam, int* ipntr, double _Complex* workd, double _Complex* workl, int lworkl, double* rwork, int* info); +void zneupd_c(bool rvec, char const* howmny, int const* select, double _Complex* d, double _Complex* z, int ldz, double _Complex sigma, double _Complex* workev, char const* bmat, int n, char const* which, int nev, double tol, double _Complex* resid, int ncv, double _Complex* v, int ldv, int* iparam, int* ipntr, double _Complex* workd, double _Complex* workl, int lworkl, double* rwork, int* info); #ifdef __cplusplus } diff --git a/arpack.hpp b/arpack.hpp index 6ce800f57..2624fe9c3 100644 --- a/arpack.hpp +++ b/arpack.hpp @@ -38,83 +38,7 @@ enum class howmny : int { }; namespace internal { -/* - * From C++, arpack does not exist. - * Arpack is Fortran. ISO_C_BINDING is a gateway from Fortran to C, not C++. - * However C++ can interface to C which is why you find C types in the - * arpack.hpp - */ -extern "C" { -void ssaupd_c(int& ido, const char* bmat, int n, const char* which, int nev, - float tol, float* resid, int ncv, float* v, int ldv, int* iparam, - int* ipntr, float* workd, float* workl, int lworkl, int& info); - -void sseupd_c(bool rvec, const char* howmny, int* select, float* d, float* z, - int ldz, float sigma, const char* bmat, int n, const char* which, - int nev, float tol, float* resid, int ncv, float* v, int ldv, - int* iparam, int* ipntr, float* workd, float* workl, int lworkl, - int& info); - -void dsaupd_c(int& ido, const char* bmat, int n, const char* which, int nev, - double tol, double* resid, int ncv, double* v, int ldv, - int* iparam, int* ipntr, double* workd, double* workl, int lworkl, - int& info); - -void dseupd_c(bool rvec, const char* howmny, int* select, double* d, double* z, - int ldz, double sigma, const char* bmat, int n, const char* which, - int nev, double tol, double* resid, int ncv, double* v, int ldv, - int* iparam, int* ipntr, double* workd, double* workl, int lworkl, - int& info); - -void snaupd_c(int& ido, const char* bmat, int n, const char* which, int nev, - float tol, float* resid, int ncv, float* v, int ldv, int* iparam, - int* ipntr, float* workd, float* workl, int lworkl, int& info); - -void sneupd_c(bool rvec, const char* howmny, int* select, float* dr, float* di, - float* z, int ldz, float sigmar, float sigmai, const char* bmat, - int n, const char* which, int nev, float tol, float* resid, - int ncv, float* v, int ldv, int* iparam, int* ipntr, float* workd, - float* workl, int lworkl, int& info); - -void dnaupd_c(int& ido, const char* bmat, int n, const char* which, int nev, - double tol, double* resid, int ncv, double* v, int ldv, - int* iparam, int* ipntr, double* workd, double* workl, int lworkl, - int& info); - -void dneupd_c(bool rvec, const char* howmny, int* select, double* dr, - double* di, double* z, int ldz, double sigmar, double sigmai, - const char* bmat, int n, const char* which, int nev, double tol, - double* resid, int ncv, double* v, int ldv, int* iparam, - int* ipntr, double* workd, double* workl, int lworkl, int& info); - -void cnaupd_c(int& ido, const char* bmat, int n, const char* which, int nev, - float tol, float _Complex* resid, int ncv, float _Complex* v, - int ldv, int* iparam, int* ipntr, float _Complex* workd, - float _Complex* workl, int lworkl, float _Complex* rwork, - int& info); - -void cneupd_c(bool rvec, const char* howmny, int* select, float _Complex* d, - float _Complex* z, int ldz, float _Complex sigma, - float _Complex* workev, const char* bmat, int n, - const char* which, int nev, float tol, float _Complex* resid, - int ncv, float _Complex* v, int ldv, int* iparam, int* ipntr, - float _Complex* workd, float _Complex* workl, int lworkl, - float _Complex* rwork, int& info); - -void znaupd_c(int& ido, const char* bmat, int n, const char* which, int nev, - double tol, double _Complex* resid, int ncv, double _Complex* v, - int ldv, int* iparam, int* ipntr, double _Complex* workd, - double _Complex* workl, int lworkl, double _Complex* rwork, - int& info); - -void zneupd_c(bool rvec, const char* howmny, int* select, double _Complex* d, - double _Complex* z, int ldz, double _Complex sigma, - double _Complex* workev, const char* bmat, int n, - const char* which, int nev, double tol, double _Complex* resid, - int ncv, double _Complex* v, int ldv, int* iparam, int* ipntr, - double _Complex* workd, double _Complex* workl, int lworkl, - double _Complex* rwork, int& info); -} +#include "arpack.h" inline char const* convert_to_char(which const option) { switch (option) { From cb85253bdb9ec95f423f29bce8e30230a65274ae Mon Sep 17 00:00:00 2001 From: Ruslan Kabatsayev Date: Thu, 7 Jun 2018 13:12:32 +0300 Subject: [PATCH 2/4] Synchronize C++ bindings with the fixed C bindings This no longer includes a tweaked copy of arpack.h. Maintaining both sets of prototypes separately is too much manual labor. --- TESTS/icb_arpack_cpp.cpp | 2 +- arpack.hpp | 44 ++++++++++++++++++++-------------------- 2 files changed, 23 insertions(+), 23 deletions(-) diff --git a/TESTS/icb_arpack_cpp.cpp b/TESTS/icb_arpack_cpp.cpp index 8312e01b5..cff37d28a 100644 --- a/TESTS/icb_arpack_cpp.cpp +++ b/TESTS/icb_arpack_cpp.cpp @@ -126,7 +126,7 @@ void complex_symmetric_runner() { std::vector> workl(lworkl); std::vector> d(nev + 1); std::vector> z((N + 1) * (nev + 1)); - std::vector> rwork(ncv); + std::vector rwork(ncv); std::vector> workev(2 * ncv); std::array iparam{}; diff --git a/arpack.hpp b/arpack.hpp index 2624fe9c3..9d86cad35 100644 --- a/arpack.hpp +++ b/arpack.hpp @@ -93,9 +93,9 @@ inline void saupd(int& ido, bmat const bmat_option, int n, which const ritz_option, int nev, float tol, float* resid, int ncv, float* v, int ldv, int* iparam, int* ipntr, float* workd, float* workl, int lworkl, int& info) { - internal::ssaupd_c(ido, internal::convert_to_char(bmat_option), n, + internal::ssaupd_c(&ido, internal::convert_to_char(bmat_option), n, internal::convert_to_char(ritz_option), nev, tol, resid, - ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } inline void seupd(bool rvec, howmny const howmny_option, int* select, float* d, @@ -106,16 +106,16 @@ inline void seupd(bool rvec, howmny const howmny_option, int* select, float* d, internal::sseupd_c(rvec, internal::convert_to_char(howmny_option), select, d, z, ldz, sigma, internal::convert_to_char(bmat_option), n, internal::convert_to_char(ritz_option), nev, tol, resid, - ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } inline void saupd(int& ido, bmat const bmat_option, int n, which const ritz_option, int nev, double tol, double* resid, int ncv, double* v, int ldv, int* iparam, int* ipntr, double* workd, double* workl, int lworkl, int& info) { - internal::dsaupd_c(ido, internal::convert_to_char(bmat_option), n, + internal::dsaupd_c(&ido, internal::convert_to_char(bmat_option), n, internal::convert_to_char(ritz_option), nev, tol, resid, - ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } inline void seupd(bool rvec, howmny const howmny_option, int* select, double* d, @@ -127,16 +127,16 @@ inline void seupd(bool rvec, howmny const howmny_option, int* select, double* d, internal::dseupd_c(rvec, internal::convert_to_char(howmny_option), select, d, z, ldz, sigma, internal::convert_to_char(bmat_option), n, internal::convert_to_char(ritz_option), nev, tol, resid, - ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } inline void naupd(int& ido, bmat const bmat_option, int n, which const ritz_option, int nev, float tol, float* resid, int ncv, float* v, int ldv, int* iparam, int* ipntr, float* workd, float* workl, int lworkl, int& info) { - internal::snaupd_c(ido, internal::convert_to_char(bmat_option), n, + internal::snaupd_c(&ido, internal::convert_to_char(bmat_option), n, internal::convert_to_char(ritz_option), nev, tol, resid, - ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } inline void neupd(bool rvec, howmny const howmny_option, int* select, float* dr, @@ -149,16 +149,16 @@ inline void neupd(bool rvec, howmny const howmny_option, int* select, float* dr, di, z, ldz, sigmar, sigmai, internal::convert_to_char(bmat_option), n, internal::convert_to_char(ritz_option), nev, tol, resid, - ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } inline void naupd(int& ido, bmat const bmat_option, int n, which const ritz_option, int nev, double tol, double* resid, int ncv, double* v, int ldv, int* iparam, int* ipntr, double* workd, double* workl, int lworkl, int& info) { - internal::dnaupd_c(ido, internal::convert_to_char(bmat_option), n, + internal::dnaupd_c(&ido, internal::convert_to_char(bmat_option), n, internal::convert_to_char(ritz_option), nev, tol, resid, - ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } inline void neupd(bool rvec, howmny const howmny_option, int* select, @@ -171,7 +171,7 @@ inline void neupd(bool rvec, howmny const howmny_option, int* select, di, z, ldz, sigmar, sigmai, internal::convert_to_char(bmat_option), n, internal::convert_to_char(ritz_option), nev, tol, resid, - ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } inline void naupd(int& ido, bmat const bmat_option, int n, @@ -179,14 +179,14 @@ inline void naupd(int& ido, bmat const bmat_option, int n, std::complex* resid, int ncv, std::complex* v, int ldv, int* iparam, int* ipntr, std::complex* workd, std::complex* workl, int lworkl, - std::complex* rwork, int& info) { - internal::cnaupd_c(ido, internal::convert_to_char(bmat_option), n, + float* rwork, int& info) { + internal::cnaupd_c(&ido, internal::convert_to_char(bmat_option), n, internal::convert_to_char(ritz_option), nev, tol, reinterpret_cast<_Complex float*>(resid), ncv, reinterpret_cast<_Complex float*>(v), ldv, iparam, ipntr, reinterpret_cast<_Complex float*>(workd), reinterpret_cast<_Complex float*>(workl), lworkl, - reinterpret_cast<_Complex float*>(rwork), info); + rwork, &info); } inline void neupd(bool rvec, howmny const howmny_option, int* select, @@ -196,7 +196,7 @@ inline void neupd(bool rvec, howmny const howmny_option, int* select, int nev, float tol, std::complex* resid, int ncv, std::complex* v, int ldv, int* iparam, int* ipntr, std::complex* workd, std::complex* workl, - int lworkl, std::complex* rwork, int& info) { + int lworkl, float* rwork, int& info) { internal::cneupd_c(rvec, internal::convert_to_char(howmny_option), select, reinterpret_cast<_Complex float*>(d), reinterpret_cast<_Complex float*>(z), ldz, @@ -208,7 +208,7 @@ inline void neupd(bool rvec, howmny const howmny_option, int* select, reinterpret_cast<_Complex float*>(v), ldv, iparam, ipntr, reinterpret_cast<_Complex float*>(workd), reinterpret_cast<_Complex float*>(workl), lworkl, - reinterpret_cast<_Complex float*>(rwork), info); + rwork, &info); } inline void naupd(int& ido, bmat const bmat_option, int n, @@ -216,14 +216,14 @@ inline void naupd(int& ido, bmat const bmat_option, int n, std::complex* resid, int ncv, std::complex* v, int ldv, int* iparam, int* ipntr, std::complex* workd, std::complex* workl, int lworkl, - std::complex* rwork, int& info) { - internal::znaupd_c(ido, internal::convert_to_char(bmat_option), n, + double* rwork, int& info) { + internal::znaupd_c(&ido, internal::convert_to_char(bmat_option), n, internal::convert_to_char(ritz_option), nev, tol, reinterpret_cast<_Complex double*>(resid), ncv, reinterpret_cast<_Complex double*>(v), ldv, iparam, ipntr, reinterpret_cast<_Complex double*>(workd), reinterpret_cast<_Complex double*>(workl), lworkl, - reinterpret_cast<_Complex double*>(rwork), info); + rwork, &info); } inline void neupd(bool rvec, howmny const howmny_option, int* select, @@ -233,7 +233,7 @@ inline void neupd(bool rvec, howmny const howmny_option, int* select, int nev, double tol, std::complex* resid, int ncv, std::complex* v, int ldv, int* iparam, int* ipntr, std::complex* workd, std::complex* workl, - int lworkl, std::complex* rwork, int& info) { + int lworkl, double* rwork, int& info) { internal::zneupd_c(rvec, internal::convert_to_char(howmny_option), select, reinterpret_cast<_Complex double*>(d), reinterpret_cast<_Complex double*>(z), ldz, @@ -245,7 +245,7 @@ inline void neupd(bool rvec, howmny const howmny_option, int* select, reinterpret_cast<_Complex double*>(v), ldv, iparam, ipntr, reinterpret_cast<_Complex double*>(workd), reinterpret_cast<_Complex double*>(workl), lworkl, - reinterpret_cast<_Complex double*>(rwork), info); + rwork, &info); } } // namespace arpack From a8416b41a36aef75ed3410f75a5e7e93cbcb9af0 Mon Sep 17 00:00:00 2001 From: Ruslan Kabatsayev Date: Thu, 7 Jun 2018 14:07:18 +0300 Subject: [PATCH 3/4] Extend C++ test to also include double, not only float --- TESTS/icb_arpack_cpp.cpp | 62 ++++++++++++++++++++++------------------ 1 file changed, 34 insertions(+), 28 deletions(-) diff --git a/TESTS/icb_arpack_cpp.cpp b/TESTS/icb_arpack_cpp.cpp index cff37d28a..29b1aa09c 100644 --- a/TESTS/icb_arpack_cpp.cpp +++ b/TESTS/icb_arpack_cpp.cpp @@ -23,12 +23,14 @@ #define BLASINT int #endif -void diagonal_matrix_vector_product(float const* const x, float* const y) { +template +void diagonal_matrix_vector_product(Real const* const x, Real* const y) { for (int i = 0; i < 1000; ++i) { - y[i] = static_cast(i + 1) * x[i]; + y[i] = static_cast(i + 1) * x[i]; } } +template void real_symmetric_runner() { BLASINT const N = 1000; BLASINT const nev = 9; @@ -40,17 +42,17 @@ void real_symmetric_runner() { BLASINT const lworkl = 3 * (ncv * ncv) + 6 * ncv; - float const tol = 0.0f; - float const sigma = 0.0f; + Real const tol = 0.0; + Real const sigma = 0.0; bool const rvec = true; - std::vector resid(N); - std::vector V(ncv * N); - std::vector workd(3 * N, 0.0f); - std::vector workl(lworkl, 0.0f); - std::vector d((nev + 1)); - std::vector z((N + 1) * (nev + 1)); + std::vector resid(N); + std::vector V(ncv * N); + std::vector workd(3 * N, 0.0); + std::vector workl(lworkl, 0.0); + std::vector d((nev + 1)); + std::vector z((N + 1) * (nev + 1)); std::array iparam{}; @@ -90,20 +92,22 @@ void real_symmetric_runner() { for (int i = 0; i < nev; ++i) { std::cout << d[i] << "\n"; - if (std::abs(d[i] - static_cast(1000 - (nev - 1) + i)) > 1e-1) { + if (std::abs(d[i] - static_cast(1000 - (nev - 1) + i)) > 1e-1) { throw std::domain_error("Correct eigenvalues not computed"); } } std::cout << "------\n"; } -void diagonal_matrix_vector_product(std::complex const* const x, - std::complex* const y) { +template +void diagonal_matrix_vector_product(std::complex const* const x, + std::complex* const y) { for (int i = 0; i < 1000; ++i) { - y[i] = x[i] * std::complex{i + 1.0f, i + 1.0f}; + y[i] = x[i] * std::complex{Real(i + 1), Real(i + 1)}; } } +template void complex_symmetric_runner() { BLASINT const N = 1000; BLASINT const nev = 9; @@ -115,19 +119,19 @@ void complex_symmetric_runner() { BLASINT const lworkl = 3 * (ncv * ncv) + 6 * ncv; - float const tol = 0.0f; - float const sigma = 0.0f; + Real const tol = 0.0; + Real const sigma = 0.0; bool const rvec = true; - std::vector> resid(N); - std::vector> V(ncv * N); - std::vector> workd(3 * N); - std::vector> workl(lworkl); - std::vector> d(nev + 1); - std::vector> z((N + 1) * (nev + 1)); - std::vector rwork(ncv); - std::vector> workev(2 * ncv); + std::vector> resid(N); + std::vector> V(ncv * N); + std::vector> workd(3 * N); + std::vector> workl(lworkl); + std::vector> d(nev + 1); + std::vector> z((N + 1) * (nev + 1)); + std::vector rwork(ncv); + std::vector> workev(2 * ncv); std::array iparam{}; iparam[0] = 1; @@ -166,8 +170,8 @@ void complex_symmetric_runner() { for (int i = 0; i < nev; ++i) { std::cout << d[i] << "\n"; - if (std::abs(std::real(d[i]) - static_cast(1000 - i)) > 1e-1 || - std::abs(std::imag(d[i]) - static_cast(1000 - i)) > 1e-1) { + if (std::abs(std::real(d[i]) - static_cast(1000 - i)) > 1e-1 || + std::abs(std::imag(d[i]) - static_cast(1000 - i)) > 1e-1) { throw std::domain_error("Correct eigenvalues not computed"); } } @@ -177,7 +181,8 @@ int main() { sstats_c(); // arpack without debug - real_symmetric_runner(); + real_symmetric_runner(); + real_symmetric_runner(); int nopx_c, nbx_c, nrorth_c, nitref_c, nrstrt_c; float tsaupd_c, tsaup2_c, tsaitr_c, tseigt_c, tsgets_c, tsapps_c, tsconv_c; @@ -199,7 +204,8 @@ int main() { 1); // arpack with debug - complex_symmetric_runner(); + complex_symmetric_runner(); + complex_symmetric_runner(); return 0; } From 442223437866af5140fdd5f2431d00b3fd149438 Mon Sep 17 00:00:00 2001 From: Ruslan Kabatsayev Date: Thu, 7 Jun 2018 21:41:16 +0300 Subject: [PATCH 4/4] Fix C and C++ bindings for PARPACK --- PARPACK/SRC/MPI/icbpcn.f90 | 80 ++++++++++++------------ PARPACK/SRC/MPI/icbpzn.f90 | 86 +++++++++++++------------- parpack.h | 79 ++++-------------------- parpack.hpp | 122 ++++++------------------------------- 4 files changed, 114 insertions(+), 253 deletions(-) diff --git a/PARPACK/SRC/MPI/icbpcn.f90 b/PARPACK/SRC/MPI/icbpcn.f90 index f5257555c..70a49769d 100644 --- a/PARPACK/SRC/MPI/icbpcn.f90 +++ b/PARPACK/SRC/MPI/icbpcn.f90 @@ -5,23 +5,23 @@ subroutine pcnaupd_c(comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& bind(c, name="pcnaupd_c") use :: iso_c_binding implicit none - integer(kind=c_int), value, intent(in) :: comm + integer(kind=c_int), value, intent(in) :: comm integer(kind=c_int), intent(inout) :: ido - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n - character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev - real(kind=c_float_complex), value, intent(in) :: tol - real(kind=c_float_complex), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv - real(kind=c_float_complex), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr - real(kind=c_float_complex), dimension(3*n), intent(out) :: workd - real(kind=c_float_complex), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - real(kind=c_float_complex), dimension(ncv), intent(out) :: rwork + character(kind=c_char), dimension(1), intent(in) :: bmat + integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), dimension(2), intent(in) :: which + integer(kind=c_int), value, intent(in) :: nev + real(kind=c_float), value, intent(in) :: tol + complex(kind=c_float_complex),dimension(n), intent(inout) :: resid + integer(kind=c_int), value, intent(in) :: ncv + complex(kind=c_float_complex),dimension(ldv, ncv),intent(out) :: v + integer(kind=c_int), value, intent(in) :: ldv + integer(kind=c_int), dimension(11), intent(inout) :: iparam + integer(kind=c_int), dimension(11), intent(out) :: ipntr + complex(kind=c_float_complex),dimension(3*n), intent(out) :: workd + complex(kind=c_float_complex),dimension(lworkl), intent(out) :: workl + integer(kind=c_int), value, intent(in) :: lworkl + complex(kind=c_float_complex),dimension(ncv), intent(out) :: rwork integer(kind=c_int), intent(inout) :: info call pcnaupd(comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, rwork, info) @@ -33,30 +33,30 @@ subroutine pcneupd_c(comm, rvec, howmny, select, d, z, ldz, sigma, workev,& bind(c, name="pcneupd_c") use :: iso_c_binding implicit none - integer(kind=c_int), value, intent(in) :: comm - logical(kind=c_bool), value, intent(in) :: rvec - character(kind=c_char), dimension(1), intent(in) :: howmny - logical(kind=c_bool), dimension(ncv), intent(in) :: select - real(kind=c_float_complex), dimension(nev), intent(out) :: d - real(kind=c_float_complex), dimension(n, nev), intent(out) :: z - integer(kind=c_int), value, intent(in) :: ldz - real(kind=c_float_complex), value, intent(in) :: sigma - real(kind=c_float_complex), dimension(2*ncv), intent(in) :: workev - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n - character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev - real(kind=c_float_complex), value, intent(in) :: tol - real(kind=c_float_complex), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv - real(kind=c_float_complex), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr - real(kind=c_float_complex), dimension(3*n), intent(out) :: workd - real(kind=c_float_complex), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - real(kind=c_float_complex), dimension(ncv), intent(out) :: rwork + integer(kind=c_int), value, intent(in) :: comm + logical(kind=c_bool), value, intent(in) :: rvec + character(kind=c_char), dimension(1), intent(in) :: howmny + logical(kind=c_bool), dimension(ncv), intent(in) :: select + complex(kind=c_float_complex),dimension(nev), intent(out) :: d + complex(kind=c_float_complex),dimension(n, nev), intent(out) :: z + integer(kind=c_int), value, intent(in) :: ldz + complex(kind=c_float_complex),value, intent(in) :: sigma + complex(kind=c_float_complex),dimension(2*ncv), intent(out) :: workev + character(kind=c_char), dimension(1), intent(in) :: bmat + integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), dimension(2), intent(in) :: which + integer(kind=c_int), value, intent(in) :: nev + real(kind=c_float), value, intent(in) :: tol + complex(kind=c_float_complex),dimension(n), intent(inout) :: resid + integer(kind=c_int), value, intent(in) :: ncv + complex(kind=c_float_complex),dimension(ldv, ncv),intent(out) :: v + integer(kind=c_int), value, intent(in) :: ldv + integer(kind=c_int), dimension(11), intent(inout) :: iparam + integer(kind=c_int), dimension(11), intent(out) :: ipntr + complex(kind=c_float_complex),dimension(3*n), intent(out) :: workd + complex(kind=c_float_complex),dimension(lworkl), intent(out) :: workl + integer(kind=c_int), value, intent(in) :: lworkl + complex(kind=c_float_complex),dimension(ncv), intent(out) :: rwork integer(kind=c_int), intent(inout) :: info call pcneupd(comm, rvec, howmny, select, d, z, ldz, sigma, workev,& bmat, n, which, nev, tol, resid, ncv, v, ldv, & diff --git a/PARPACK/SRC/MPI/icbpzn.f90 b/PARPACK/SRC/MPI/icbpzn.f90 index cd649bf10..dd2e5d080 100644 --- a/PARPACK/SRC/MPI/icbpzn.f90 +++ b/PARPACK/SRC/MPI/icbpzn.f90 @@ -5,24 +5,24 @@ subroutine pznaupd_c(comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& bind(c, name="pznaupd_c") use :: iso_c_binding implicit none - integer(kind=c_int), value, intent(in) :: comm - integer(kind=c_int), intent(inout) :: ido - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n - character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev - real(kind=c_double_complex), value, intent(in) :: tol - real(kind=c_double_complex), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv - real(kind=c_double_complex), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr - real(kind=c_double_complex), dimension(3*n), intent(out) :: workd - real(kind=c_double_complex), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - real(kind=c_double_complex), dimension(ncv), intent(out) :: rwork - integer(kind=c_int), intent(inout) :: info + integer(kind=c_int), value, intent(in) :: comm + integer(kind=c_int), intent(inout) :: ido + character(kind=c_char), dimension(1), intent(in) :: bmat + integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), dimension(2), intent(in) :: which + integer(kind=c_int), value, intent(in) :: nev + real(kind=c_double), value, intent(in) :: tol + complex(kind=c_double_complex), dimension(n), intent(inout) :: resid + integer(kind=c_int), value, intent(in) :: ncv + complex(kind=c_double_complex), dimension(ldv, ncv),intent(out) :: v + integer(kind=c_int), value, intent(in) :: ldv + integer(kind=c_int), dimension(11), intent(inout) :: iparam + integer(kind=c_int), dimension(11), intent(out) :: ipntr + complex(kind=c_double_complex), dimension(3*n), intent(out) :: workd + complex(kind=c_double_complex), dimension(lworkl), intent(out) :: workl + integer(kind=c_int), value, intent(in) :: lworkl + complex(kind=c_double_complex), dimension(ncv), intent(out) :: rwork + integer(kind=c_int), intent(inout) :: info call pznaupd(comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,& iparam, ipntr, workd, workl, lworkl, rwork, info) end subroutine pznaupd_c @@ -33,31 +33,31 @@ subroutine pzneupd_c(comm, rvec, howmny, select, d, z, ldz, sigma, workev,& bind(c, name="pzneupd_c") use :: iso_c_binding implicit none - integer(kind=c_int), value, intent(in) :: comm - logical(kind=c_bool), value, intent(in) :: rvec - character(kind=c_char), dimension(1), intent(in) :: howmny - logical(kind=c_bool), dimension(ncv), intent(in) :: select - real(kind=c_double_complex), dimension(nev), intent(out) :: d - real(kind=c_double_complex), dimension(n, nev), intent(out) :: z - integer(kind=c_int), value, intent(in) :: ldz - real(kind=c_double_complex), value, intent(in) :: sigma - real(kind=c_double_complex), dimension(2*ncv), intent(in) :: workev - character(kind=c_char), dimension(1), intent(in) :: bmat - integer(kind=c_int), value, intent(in) :: n - character(kind=c_char), dimension(2), intent(in) :: which - integer(kind=c_int), value, intent(in) :: nev - real(kind=c_double_complex), value, intent(in) :: tol - real(kind=c_double_complex), dimension(n), intent(inout) :: resid - integer(kind=c_int), value, intent(in) :: ncv - real(kind=c_double_complex), dimension(ldv, ncv), intent(out) :: v - integer(kind=c_int), value, intent(in) :: ldv - integer(kind=c_int), dimension(11), intent(inout) :: iparam - integer(kind=c_int), dimension(11), intent(out) :: ipntr - real(kind=c_double_complex), dimension(3*n), intent(out) :: workd - real(kind=c_double_complex), dimension(lworkl), intent(out) :: workl - integer(kind=c_int), value, intent(in) :: lworkl - real(kind=c_double_complex), dimension(ncv), intent(out) :: rwork - integer(kind=c_int), intent(inout) :: info + integer(kind=c_int), value, intent(in) :: comm + logical(kind=c_bool), value, intent(in) :: rvec + character(kind=c_char), dimension(1), intent(in) :: howmny + logical(kind=c_bool), dimension(ncv), intent(in) :: select + complex(kind=c_double_complex), dimension(nev), intent(out) :: d + complex(kind=c_double_complex), dimension(n, nev), intent(out) :: z + integer(kind=c_int), value, intent(in) :: ldz + complex(kind=c_double_complex), value, intent(in) :: sigma + complex(kind=c_double_complex), dimension(2*ncv), intent(out) :: workev + character(kind=c_char), dimension(1), intent(in) :: bmat + integer(kind=c_int), value, intent(in) :: n + character(kind=c_char), dimension(2), intent(in) :: which + integer(kind=c_int), value, intent(in) :: nev + real(kind=c_double), value, intent(in) :: tol + complex(kind=c_double_complex), dimension(n), intent(inout) :: resid + integer(kind=c_int), value, intent(in) :: ncv + complex(kind=c_double_complex), dimension(ldv, ncv),intent(out) :: v + integer(kind=c_int), value, intent(in) :: ldv + integer(kind=c_int), dimension(11), intent(inout) :: iparam + integer(kind=c_int), dimension(11), intent(out) :: ipntr + complex(kind=c_double_complex), dimension(3*n), intent(out) :: workd + complex(kind=c_double_complex), dimension(lworkl), intent(out) :: workl + integer(kind=c_int), value, intent(in) :: lworkl + complex(kind=c_double_complex), dimension(ncv), intent(out) :: rwork + integer(kind=c_int), intent(inout) :: info call pzneupd(comm, rvec, howmny, select, d, z, ldz, sigma, workev,& bmat, n, which, nev, tol, resid, ncv, v, ldv, & iparam, ipntr, workd, workl, lworkl, rwork, info) diff --git a/parpack.h b/parpack.h index 10b516d6c..e1c15df23 100644 --- a/parpack.h +++ b/parpack.h @@ -12,73 +12,18 @@ extern "C" { #endif -extern void pssaupd_c(MPI_Fint comm, int * ido, const char * bmat, int n, const char * which, int nev, - float tol, float * resid, int ncv, float * v, - int ldv, int * iparam, int * ipntr, float * workd, - float * workl, int lworkl, int * info); - -extern void psseupd_c(MPI_Fint comm, bool rvec, const char * howmny, int * select, float * d, float * z, int ldz, float sigma, - const char * bmat, int n, const char * which, int nev, - float tol, float * resid, int ncv, float * v, - int ldv, int * iparam, int * ipntr, float * workd, - float * workl, int lworkl, int * info); - -extern void pdsaupd_c(MPI_Fint comm, int * ido, const char * bmat, int n, const char * which, int nev, - double tol, double * resid, int ncv, double * v, - int ldv, int * iparam, int * ipntr, double * workd, - double * workl, int lworkl, int * info); - -extern void pdseupd_c(MPI_Fint comm, bool rvec, const char * howmny, int * select, double * d, double * z, int ldz, double sigma, - const char * bmat, int n, const char * which, int nev, - double tol, double * resid, int ncv, double * v, - int ldv, int * iparam, int * ipntr, double * workd, - double * workl, int lworkl, int * info); - -extern void psnaupd_c(MPI_Fint comm, int * ido, const char * bmat, int n, const char * which, int nev, - float tol, float * resid, int ncv, float * v, - int ldv, int * iparam, int * ipntr, float * workd, - float * workl, int lworkl, int * info); - -extern void psneupd_c(MPI_Fint comm, bool rvec, const char * howmny, int * select, float * dr, float * di, float * z, int ldz, float sigmar, float sigmai, - const char * bmat, int n, const char * which, int nev, - float tol, float * resid, int ncv, float * v, - int ldv, int * iparam, int * ipntr, float * workd, - float * workl, int lworkl, int * info); - -extern void pdnaupd_c(MPI_Fint comm, int * ido, const char * bmat, int n, const char * which, int nev, - double tol, double * resid, int ncv, double * v, - int ldv, int * iparam, int * ipntr, double * workd, - double * workl, int lworkl, int * info); - -extern void pdneupd_c(MPI_Fint comm, bool rvec, const char * howmny, int * select, double * dr, double * di, double * z, int ldz, double sigmar, double sigmai, - const char * bmat, int n, const char * which, int nev, - double tol, double * resid, int ncv, double * v, - int ldv, int * iparam, int * ipntr, double * workd, - double * workl, int lworkl, int * info); - -extern void pcnaupd_c(MPI_Fint comm, int * ido, const char * bmat, int n, const char * which, int nev, - float tol, float _Complex * resid, int ncv, float _Complex * v, - int ldv, int * iparam, int * ipntr, float _Complex * workd, - float _Complex * workl, int lworkl, float _Complex * rwork, int * info); - -extern void pcneupd_c(MPI_Fint comm, bool rvec, const char * howmny, int * select, - float _Complex * d, float _Complex * z, int ldz, float _Complex sigma, float _Complex * workev, - const char * bmat, int n, const char * which, int nev, - float tol, float _Complex * resid, int ncv, float _Complex * v, - int ldv, int * iparam, int * ipntr, float _Complex * workd, - float _Complex * workl, int lworkl, float _Complex * rwork, int * info); - -extern void pznaupd_c(MPI_Fint comm, int * ido, const char * bmat, int n, const char * which, int nev, - double tol, double _Complex * resid, int ncv, double _Complex * v, - int ldv, int * iparam, int * ipntr, double _Complex * workd, - double _Complex * workl, int lworkl, double _Complex * rwork, int * info); - -extern void pzneupd_c(MPI_Fint comm, bool rvec, const char * howmny, int * select, - double _Complex * d, double _Complex * z, int ldz, double _Complex sigma, double _Complex * workev, - const char * bmat, int n, const char * which, int nev, - double tol, double _Complex * resid, int ncv, double _Complex * v, - int ldv, int * iparam, int * ipntr, double _Complex * workd, - double _Complex * workl, int lworkl, double _Complex * rwork, int * info); +void pcnaupd_c(MPI_Fint comm, int* ido, char const* bmat, int n, char const* which, int nev, float tol, float _Complex* resid, int ncv, float _Complex* v, int ldv, int* iparam, int* ipntr, float _Complex* workd, float _Complex* workl, int lworkl, float _Complex* rwork, int* info); +void pcneupd_c(MPI_Fint comm, bool rvec, char const* howmny, int const* select, float _Complex* d, float _Complex* z, int ldz, float _Complex sigma, float _Complex* workev, char const* bmat, int n, char const* which, int nev, float tol, float _Complex* resid, int ncv, float _Complex* v, int ldv, int* iparam, int* ipntr, float _Complex* workd, float _Complex* workl, int lworkl, float _Complex* rwork, int* info); +void pdnaupd_c(MPI_Fint comm, int* ido, char const* bmat, int n, char const* which, int nev, double tol, double* resid, int ncv, double* v, int ldv, int* iparam, int* ipntr, double* workd, double* workl, int lworkl, int* info); +void pdneupd_c(MPI_Fint comm, bool rvec, char const* howmny, int const* select, double* dr, double* di, double* z, int ldz, double sigmar, double sigmai, char const* bmat, int n, char const* which, int nev, double tol, double* resid, int ncv, double* v, int ldv, int* iparam, int* ipntr, double* workd, double* workl, int lworkl, int* info); +void pdsaupd_c(MPI_Fint comm, int* ido, char const* bmat, int n, char const* which, int nev, double tol, double* resid, int ncv, double* v, int ldv, int* iparam, int* ipntr, double* workd, double* workl, int lworkl, int* info); +void pdseupd_c(MPI_Fint comm, bool rvec, char const* howmny, int const* select, double* d, double* z, int ldz, double sigma, char const* bmat, int n, char const* which, int nev, double tol, double* resid, int ncv, double* v, int ldv, int* iparam, int* ipntr, double* workd, double* workl, int lworkl, int* info); +void psnaupd_c(MPI_Fint comm, int* ido, char const* bmat, int n, char const* which, int nev, float tol, float* resid, int ncv, float* v, int ldv, int* iparam, int* ipntr, float* workd, float* workl, int lworkl, int* info); +void psneupd_c(MPI_Fint comm, bool rvec, char const* howmny, int const* select, float* dr, float* di, float* z, int ldz, float sigmar, float sigmai, char const* bmat, int n, char const* which, int nev, float tol, float* resid, int ncv, float* v, int ldv, int* iparam, int* ipntr, float* workd, float* workl, int lworkl, int* info); +void pssaupd_c(MPI_Fint comm, int* ido, char const* bmat, int n, char const* which, int nev, float tol, float* resid, int ncv, float* v, int ldv, int* iparam, int* ipntr, float* workd, float* workl, int lworkl, int* info); +void psseupd_c(MPI_Fint comm, bool rvec, char const* howmny, int const* select, float* d, float* z, int ldz, float sigma, char const* bmat, int n, char const* which, int nev, float tol, float* resid, int ncv, float* v, int ldv, int* iparam, int* ipntr, float* workd, float* workl, int lworkl, int* info); +void pznaupd_c(MPI_Fint comm, int* ido, char const* bmat, int n, char const* which, int nev, double tol, double _Complex* resid, int ncv, double _Complex* v, int ldv, int* iparam, int* ipntr, double _Complex* workd, double _Complex* workl, int lworkl, double _Complex* rwork, int* info); +void pzneupd_c(MPI_Fint comm, bool rvec, char const* howmny, int const* select, double _Complex* d, double _Complex* z, int ldz, double _Complex sigma, double _Complex* workev, char const* bmat, int n, char const* which, int nev, double tol, double _Complex* resid, int ncv, double _Complex* v, int ldv, int* iparam, int* ipntr, double _Complex* workd, double _Complex* workl, int lworkl, double _Complex* rwork, int* info); #ifdef __cplusplus } diff --git a/parpack.hpp b/parpack.hpp index 74e250cbc..a46f0a208 100644 --- a/parpack.hpp +++ b/parpack.hpp @@ -12,100 +12,16 @@ namespace arpack { namespace internal { -/* - * From C++, arpack does not exist. - * Arpack is Fortran. ISO_C_BINDING is a gateway from Fortran to C, not C++. - * But, C++ can "get back" to C. - * - * NOTE IMPORTANT: MPI communicators MUST be passed from C to Fortran using - * MPI_Comm_c2f. MPI_Fint MCW = MPI_Comm_c2f(MPI_COMM_WORLD); - */ -extern "C" { -void pssaupd_c(MPI_Fint comm, int& ido, const char* bmat, int n, - const char* which, int nev, float tol, float* resid, int ncv, - float* v, int ldv, int* iparam, int* ipntr, float* workd, - float* workl, int lworkl, int& info); - -void psseupd_c(MPI_Fint comm, bool rvec, const char* howmny, int* select, - float* d, float* z, int ldz, float sigma, const char* bmat, - int n, const char* which, int nev, float tol, float* resid, - int ncv, float* v, int ldv, int* iparam, int* ipntr, - float* workd, float* workl, int lworkl, int& info); - -void pdsaupd_c(MPI_Fint comm, int& ido, const char* bmat, int n, - const char* which, int nev, double tol, double* resid, int ncv, - double* v, int ldv, int* iparam, int* ipntr, double* workd, - double* workl, int lworkl, int& info); - -void pdseupd_c(MPI_Fint comm, bool rvec, const char* howmny, int* select, - double* d, double* z, int ldz, double sigma, const char* bmat, - int n, const char* which, int nev, double tol, double* resid, - int ncv, double* v, int ldv, int* iparam, int* ipntr, - double* workd, double* workl, int lworkl, int& info); - -void psnaupd_c(MPI_Fint comm, int& ido, const char* bmat, int n, - const char* which, int nev, float tol, float* resid, int ncv, - float* v, int ldv, int* iparam, int* ipntr, float* workd, - float* workl, int lworkl, int& info); - -void psneupd_c(MPI_Fint comm, bool rvec, const char* howmny, int* select, - float* dr, float* di, float* z, int ldz, float sigmar, - float sigmai, const char* bmat, int n, const char* which, - int nev, float tol, float* resid, int ncv, float* v, int ldv, - int* iparam, int* ipntr, float* workd, float* workl, int lworkl, - int& info); - -void pdnaupd_c(MPI_Fint comm, int& ido, const char* bmat, int n, - const char* which, int nev, double tol, double* resid, int ncv, - double* v, int ldv, int* iparam, int* ipntr, double* workd, - double* workl, int lworkl, int& info); - -void pdneupd_c(MPI_Fint comm, bool rvec, const char* howmny, int* select, - double* dr, double* di, double* z, int ldz, double sigmar, - double sigmai, const char* bmat, int n, const char* which, - int nev, double tol, double* resid, int ncv, double* v, int ldv, - int* iparam, int* ipntr, double* workd, double* workl, - int lworkl, int& info); - -void pcnaupd_c(MPI_Fint comm, int& ido, const char* bmat, int n, - const char* which, int nev, float tol, float _Complex* resid, - int ncv, float _Complex* v, int ldv, int* iparam, int* ipntr, - float _Complex* workd, float _Complex* workl, int lworkl, - float _Complex* rwork, int& info); - -void pcneupd_c(MPI_Fint comm, bool rvec, const char* howmny, int* select, - float _Complex* d, float _Complex* z, int ldz, - float _Complex sigma, float _Complex* workev, const char* bmat, - int n, const char* which, int nev, float tol, - float _Complex* resid, int ncv, float _Complex* v, int ldv, - int* iparam, int* ipntr, float _Complex* workd, - float _Complex* workl, int lworkl, float _Complex* rwork, - int& info); - -void pznaupd_c(MPI_Fint comm, int& ido, const char* bmat, int n, - const char* which, int nev, double tol, double _Complex* resid, - int ncv, double _Complex* v, int ldv, int* iparam, int* ipntr, - double _Complex* workd, double _Complex* workl, int lworkl, - double _Complex* rwork, int& info); - -void pzneupd_c(MPI_Fint comm, bool rvec, const char* howmny, int* select, - double _Complex* d, double _Complex* z, int ldz, - double _Complex sigma, double _Complex* workev, const char* bmat, - int n, const char* which, int nev, double tol, - double _Complex* resid, int ncv, double _Complex* v, int ldv, - int* iparam, int* ipntr, double _Complex* workd, - double _Complex* workl, int lworkl, double _Complex* rwork, - int& info); -} +#include "parpack.h" } // namespace internal inline void saupd(MPI_Fint comm, int& ido, bmat const bmat_option, int n, which const which_option, int nev, float tol, float* resid, int ncv, float* v, int ldv, int* iparam, int* ipntr, float* workd, float* workl, int lworkl, int& info) { - internal::pssaupd_c(comm, ido, internal::convert_to_char(bmat_option), n, + internal::pssaupd_c(comm, &ido, internal::convert_to_char(bmat_option), n, internal::convert_to_char(which_option), nev, tol, resid, - ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } inline void seupd(MPI_Fint comm, bool rvec, howmny const howmny_option, @@ -118,16 +34,16 @@ inline void seupd(MPI_Fint comm, bool rvec, howmny const howmny_option, select, d, z, ldz, sigma, internal::convert_to_char(bmat_option), n, internal::convert_to_char(which_option), nev, tol, resid, - ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } inline void saupd(MPI_Fint comm, int& ido, bmat const bmat_option, int n, which const which_option, int nev, double tol, double* resid, int ncv, double* v, int ldv, int* iparam, int* ipntr, double* workd, double* workl, int lworkl, int& info) { - internal::pdsaupd_c(comm, ido, internal::convert_to_char(bmat_option), n, + internal::pdsaupd_c(comm, &ido, internal::convert_to_char(bmat_option), n, internal::convert_to_char(which_option), nev, tol, resid, - ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } inline void seupd(MPI_Fint comm, bool rvec, howmny const howmny_option, @@ -140,16 +56,16 @@ inline void seupd(MPI_Fint comm, bool rvec, howmny const howmny_option, select, d, z, ldz, sigma, internal::convert_to_char(bmat_option), n, internal::convert_to_char(which_option), nev, tol, resid, - ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } inline void naupd(MPI_Fint comm, int& ido, bmat const bmat_option, int n, which const which_option, int nev, float tol, float* resid, int ncv, float* v, int ldv, int* iparam, int* ipntr, float* workd, float* workl, int lworkl, int& info) { - internal::psnaupd_c(comm, ido, internal::convert_to_char(bmat_option), n, + internal::psnaupd_c(comm, &ido, internal::convert_to_char(bmat_option), n, internal::convert_to_char(which_option), nev, tol, resid, - ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } inline void neupd(MPI_Fint comm, bool rvec, howmny const howmny_option, @@ -162,16 +78,16 @@ inline void neupd(MPI_Fint comm, bool rvec, howmny const howmny_option, select, dr, di, z, ldz, sigmar, sigmai, internal::convert_to_char(bmat_option), n, internal::convert_to_char(which_option), nev, tol, resid, - ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } inline void naupd(MPI_Fint comm, int& ido, bmat const bmat_option, int n, which const which_option, int nev, double tol, double* resid, int ncv, double* v, int ldv, int* iparam, int* ipntr, double* workd, double* workl, int lworkl, int& info) { - internal::pdnaupd_c(comm, ido, internal::convert_to_char(bmat_option), n, + internal::pdnaupd_c(comm, &ido, internal::convert_to_char(bmat_option), n, internal::convert_to_char(which_option), nev, tol, resid, - ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } inline void neupd(MPI_Fint comm, bool rvec, howmny const howmny_option, @@ -184,7 +100,7 @@ inline void neupd(MPI_Fint comm, bool rvec, howmny const howmny_option, select, dr, di, z, ldz, sigmar, sigmai, internal::convert_to_char(bmat_option), n, internal::convert_to_char(which_option), nev, tol, resid, - ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info); + ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, &info); } inline void naupd(MPI_Fint comm, int& ido, bmat const bmat_option, int n, @@ -193,13 +109,13 @@ inline void naupd(MPI_Fint comm, int& ido, bmat const bmat_option, int n, int ldv, int* iparam, int* ipntr, std::complex* workd, std::complex* workl, int lworkl, std::complex* rwork, int& info) { - internal::pcnaupd_c(comm, ido, internal::convert_to_char(bmat_option), n, + internal::pcnaupd_c(comm, &ido, internal::convert_to_char(bmat_option), n, internal::convert_to_char(which_option), nev, tol, reinterpret_cast<_Complex float*>(resid), ncv, reinterpret_cast<_Complex float*>(v), ldv, iparam, ipntr, reinterpret_cast<_Complex float*>(workd), reinterpret_cast<_Complex float*>(workl), lworkl, - reinterpret_cast<_Complex float*>(rwork), info); + reinterpret_cast<_Complex float*>(rwork), &info); } inline void neupd(MPI_Fint comm, bool rvec, howmny const howmny_option, @@ -224,7 +140,7 @@ inline void neupd(MPI_Fint comm, bool rvec, howmny const howmny_option, reinterpret_cast<_Complex float*>(v), ldv, iparam, ipntr, reinterpret_cast<_Complex float*>(workd), reinterpret_cast<_Complex float*>(workl), lworkl, - reinterpret_cast<_Complex float*>(rwork), info); + reinterpret_cast<_Complex float*>(rwork), &info); } inline void naupd(MPI_Fint comm, int& ido, bmat const bmat_option, int n, @@ -233,13 +149,13 @@ inline void naupd(MPI_Fint comm, int& ido, bmat const bmat_option, int n, int ldv, int* iparam, int* ipntr, std::complex* workd, std::complex* workl, int lworkl, std::complex* rwork, int& info) { - internal::pznaupd_c(comm, ido, internal::convert_to_char(bmat_option), n, + internal::pznaupd_c(comm, &ido, internal::convert_to_char(bmat_option), n, internal::convert_to_char(which_option), nev, tol, reinterpret_cast<_Complex double*>(resid), ncv, reinterpret_cast<_Complex double*>(v), ldv, iparam, ipntr, reinterpret_cast<_Complex double*>(workd), reinterpret_cast<_Complex double*>(workl), lworkl, - reinterpret_cast<_Complex double*>(rwork), info); + reinterpret_cast<_Complex double*>(rwork), &info); } inline void neupd(MPI_Fint comm, bool rvec, howmny const howmny_option, @@ -262,7 +178,7 @@ inline void neupd(MPI_Fint comm, bool rvec, howmny const howmny_option, reinterpret_cast<_Complex double*>(v), ldv, iparam, ipntr, reinterpret_cast<_Complex double*>(workd), reinterpret_cast<_Complex double*>(workl), lworkl, - reinterpret_cast<_Complex double*>(rwork), info); + reinterpret_cast<_Complex double*>(rwork), &info); } } // namespace arpack #endif