From 505004e768553317c5167b64a671a2141ec29edc Mon Sep 17 00:00:00 2001 From: Andreas Marek Date: Tue, 3 Nov 2015 13:47:07 +0100 Subject: [PATCH] Update of c test cases The examples, how to invoke ELPA from a c program have been updated. There are now examples for ELPA1 and ELPA2 both real and complex case. The test cases are still with less functionality than their Fortran counter parts, they are just ment as a "proof-of-concept". --- INSTALL | 2 +- Makefile.am | 85 +++++-- configure.ac | 4 +- src/elpa2.F90 | 15 +- src/elpa_c_interface.F90 | 15 +- .../elpa1_test_complex_c_version.c | 223 +++++++++++++++++ .../elpa1_test_real_c_version.c} | 3 +- .../elpa2_test_complex_c_version.c | 227 ++++++++++++++++++ .../Makefile.example | 0 .../{ => fortran_test_programs}/read_real.F90 | 0 .../test_complex.F90 | 0 .../test_complex2.F90 | 0 .../test_complex2_choose_kernel_with_api.F90 | 0 .../test_complex2_default_kernel.F90 | 0 .../{ => fortran_test_programs}/test_real.F90 | 0 .../test_real2.F90 | 0 .../test_real2_choose_kernel_with_api.F90 | 0 .../test_real2_default_kernel.F90 | 0 ..._real2_default_kernel_qr_decomposition.F90 | 0 .../test_real_with_c.F90 | 0 test/shared_sources/blacs_infrastructure.F90 | 15 ++ .../{call_elpa1_real.c => call_elpa1.c} | 7 + test/shared_sources/call_elpa2.c | 67 ++++++ test/shared_sources/check_correctnes.F90 | 18 ++ test/shared_sources/mod_from_c.F90 | 46 +++- test/shared_sources/prepare_matrix.F90 | 29 ++- 26 files changed, 712 insertions(+), 44 deletions(-) create mode 100644 test/c_test_programs/elpa1_test_complex_c_version.c rename test/{test_real_c_version.c => c_test_programs/elpa1_test_real_c_version.c} (97%) create mode 100644 test/c_test_programs/elpa2_test_complex_c_version.c rename test/{ => fortran_test_programs}/Makefile.example (100%) rename test/{ => fortran_test_programs}/read_real.F90 (100%) rename test/{ => fortran_test_programs}/test_complex.F90 (100%) rename test/{ => fortran_test_programs}/test_complex2.F90 (100%) rename test/{ => fortran_test_programs}/test_complex2_choose_kernel_with_api.F90 (100%) rename test/{ => fortran_test_programs}/test_complex2_default_kernel.F90 (100%) rename test/{ => fortran_test_programs}/test_real.F90 (100%) rename test/{ => fortran_test_programs}/test_real2.F90 (100%) rename test/{ => fortran_test_programs}/test_real2_choose_kernel_with_api.F90 (100%) rename test/{ => fortran_test_programs}/test_real2_default_kernel.F90 (100%) rename test/{ => fortran_test_programs}/test_real2_default_kernel_qr_decomposition.F90 (100%) rename test/{ => fortran_test_programs}/test_real_with_c.F90 (100%) rename test/shared_sources/{call_elpa1_real.c => call_elpa1.c} (88%) create mode 100644 test/shared_sources/call_elpa2.c diff --git a/INSTALL b/INSTALL index b9e2ada6..7549236d 100644 --- a/INSTALL +++ b/INSTALL @@ -9,7 +9,7 @@ Debian, and OpenSuse. More, will hopefully follow in the future. If you want to build (or have to since no packages are available) ELPA yourself, please note that ELPA is shipped with a typical "configure" and "make" -procedure. This is the only supported way how to build and install ELPA. +autotools procedure. This is the only supported way how to build and install ELPA. If you obtained ELPA from the official git repository, you will not find the needed configure script! Please look at the "INSTALL_FROM_GIT_VERSION" file diff --git a/Makefile.am b/Makefile.am index e6c3b9c8..4d543cc2 100644 --- a/Makefile.am +++ b/Makefile.am @@ -95,17 +95,17 @@ nobase_elpa_include_HEADERS += elpa/elpa.h elpa/elpa_kernel_constants.h elpa/elp # other files to distribute filesdir = $(docdir)/examples dist_files_DATA = \ - test/read_real.F90 \ - test/test_complex2.F90 \ - test/test_complex2_default_kernel.F90 \ - test/test_complex2_choose_kernel_with_api.F90 \ - test/test_complex.F90 \ - test/test_real2.F90 \ - test/test_real2_default_kernel.F90 \ - test/test_real2_default_kernel_qr_decomposition.F90 \ - test/test_real2_choose_kernel_with_api.F90 \ - test/test_real.F90 \ - test/test_real_with_c.F90 \ + test/fortran_test_programs/read_real.F90 \ + test/fortran_test_programs/test_complex2.F90 \ + test/fortran_test_programs/test_complex2_default_kernel.F90 \ + test/fortran_test_programs/test_complex2_choose_kernel_with_api.F90 \ + test/fortran_test_programs/test_complex.F90 \ + test/fortran_test_programs/test_real2.F90 \ + test/fortran_test_programs/test_real2_default_kernel.F90 \ + test/fortran_test_programs/test_real2_default_kernel_qr_decomposition.F90 \ + test/fortran_test_programs/test_real2_choose_kernel_with_api.F90 \ + test/fortran_test_programs/test_real.F90 \ + test/fortran_test_programs/test_real_with_c.F90 \ src/print_available_elpa2_kernels.F90 dist_doc_DATA = README COPYING/COPYING COPYING/gpl.txt COPYING/lgpl.txt @@ -129,6 +129,9 @@ noinst_PROGRAMS = \ elpa2_test_real_choose_kernel_with_api@SUFFIX@ \ elpa2_test_complex_choose_kernel_with_api@SUFFIX@ \ elpa1_test_real_c_version@SUFFIX@ \ + elpa1_test_complex_c_version@SUFFIX@ \ + elpa2_test_real_c_version@SUFFIX@ \ + elpa2_test_complex_c_version@SUFFIX@ \ elpa1_test_real_with_c@SUFFIX@ @@ -143,45 +146,61 @@ endif shared_sources = test/shared_sources/util.F90 test/shared_sources/read_input_parameters.F90 test/shared_sources/check_correctnes.F90 test/shared_sources/setup_mpi.F90 \ test/shared_sources/blacs_infrastructure.F90 test/shared_sources/prepare_matrix.F90 -elpa1_test_real_c_version@SUFFIX@_SOURCES = test/test_real_c_version.c $(shared_sources) $(redirect_sources) +elpa1_test_real_c_version@SUFFIX@_SOURCES = test/c_test_programs/elpa1_test_real_c_version.c $(shared_sources) $(redirect_sources) elpa1_test_real_c_version@SUFFIX@_LDADD = $(build_lib) elpa1_test_real_c_version@SUFFIX@_LINK = $(LINK) $(FCLIBS) -elpa1_test_real@SUFFIX@_SOURCES = test/test_real.F90 $(shared_sources) $(redirect_sources) +elpa1_test_complex_c_version@SUFFIX@_SOURCES = test/c_test_programs/elpa1_test_complex_c_version.c $(shared_sources) $(redirect_sources) +elpa1_test_complex_c_version@SUFFIX@_LDADD = $(build_lib) +elpa1_test_complex_c_version@SUFFIX@_LINK = $(LINK) $(FCLIBS) + +elpa2_test_real_c_version@SUFFIX@_SOURCES = test/c_test_programs/elpa2_test_real_c_version.c $(shared_sources) $(redirect_sources) +elpa2_test_real_c_version@SUFFIX@_LDADD = $(build_lib) +elpa2_test_real_c_version@SUFFIX@_LINK = $(LINK) $(FCLIBS) + +elpa2_test_complex_c_version@SUFFIX@_SOURCES = test/c_test_programs/elpa2_test_complex_c_version.c $(shared_sources) $(redirect_sources) +elpa2_test_complex_c_version@SUFFIX@_LDADD = $(build_lib) +elpa2_test_complex_c_version@SUFFIX@_LINK = $(LINK) $(FCLIBS) + + +elpa1_test_real@SUFFIX@_SOURCES = test/fortran_test_programs/test_real.F90 $(shared_sources) $(redirect_sources) elpa1_test_real@SUFFIX@_LDADD = $(build_lib) -elpa1_test_real_with_c@SUFFIX@_SOURCES = test/test_real_with_c.F90 test/shared_sources/mod_from_c.F90 test/shared_sources/call_elpa1_real.c $(shared_sources) $(redirect_sources) +elpa1_test_real_with_c@SUFFIX@_SOURCES = test/fortran_test_programs/test_real_with_c.F90 test/shared_sources/mod_from_c.F90 test/shared_sources/call_elpa1.c $(shared_sources) $(redirect_sources) elpa1_test_real_with_c@SUFFIX@_LDADD = $(build_lib) -elpa2_test_real@SUFFIX@_SOURCES = test/test_real2.F90 $(shared_sources) $(redirect_sources) +elpa1_test_complex_with_c@SUFFIX@_SOURCES = test/fortran_test_programs/test_complex_with_c.F90 test/shared_sources/mod_from_c.F90 test/shared_sources/call_elpa1.c $(shared_sources) $(redirect_sources) +elpa1_test_cpmplex_with_c@SUFFIX@_LDADD = $(build_lib) + +elpa2_test_real@SUFFIX@_SOURCES = test/fortran_test_programs/test_real2.F90 $(shared_sources) $(redirect_sources) elpa2_test_real@SUFFIX@_LDADD = $(build_lib) -elpa2_test_real_default_kernel@SUFFIX@_SOURCES = test/test_real2_default_kernel.F90 $(shared_sources) $(redirect_sources) +elpa2_test_real_default_kernel@SUFFIX@_SOURCES = test/fortran_test_programs/test_real2_default_kernel.F90 $(shared_sources) $(redirect_sources) elpa2_test_real_default_kernel@SUFFIX@_LDADD = $(build_lib) -elpa2_test_real_default_kernel_qr_decomposition@SUFFIX@_SOURCES = test/test_real2_default_kernel_qr_decomposition.F90 $(shared_sources) $(redirect_sources) +elpa2_test_real_default_kernel_qr_decomposition@SUFFIX@_SOURCES = test/fortran_test_programs/test_real2_default_kernel_qr_decomposition.F90 $(shared_sources) $(redirect_sources) elpa2_test_real_default_kernel_qr_decomposition@SUFFIX@_LDADD = $(build_lib) -elpa2_test_real_choose_kernel_with_api@SUFFIX@_SOURCES = test/test_real2_choose_kernel_with_api.F90 $(shared_sources) $(redirect_sources) +elpa2_test_real_choose_kernel_with_api@SUFFIX@_SOURCES = test/fortran_test_programs/test_real2_choose_kernel_with_api.F90 $(shared_sources) $(redirect_sources) elpa2_test_real_choose_kernel_with_api@SUFFIX@_LDADD = $(build_lib) -elpa1_test_complex@SUFFIX@_SOURCES = test/test_complex.F90 $(shared_sources) $(redirect_sources) +elpa1_test_complex@SUFFIX@_SOURCES = test/fortran_test_programs/test_complex.F90 $(shared_sources) $(redirect_sources) elpa1_test_complex@SUFFIX@_LDADD = $(build_lib) -elpa2_test_complex@SUFFIX@_SOURCES = test/test_complex2.F90 $(shared_sources) $(redirect_sources) +elpa2_test_complex@SUFFIX@_SOURCES = test/fortran_test_programs/test_complex2.F90 $(shared_sources) $(redirect_sources) elpa2_test_complex@SUFFIX@_LDADD = $(build_lib) -elpa2_test_complex_default_kernel@SUFFIX@_SOURCES = test/test_complex2_default_kernel.F90 $(shared_sources) $(redirect_sources) +elpa2_test_complex_default_kernel@SUFFIX@_SOURCES = test/fortran_test_programs/test_complex2_default_kernel.F90 $(shared_sources) $(redirect_sources) elpa2_test_complex_default_kernel@SUFFIX@_LDADD = $(build_lib) -elpa2_test_complex_choose_kernel_with_api@SUFFIX@_SOURCES = test/test_complex2_choose_kernel_with_api.F90 $(shared_sources) $(redirect_sources) +elpa2_test_complex_choose_kernel_with_api@SUFFIX@_SOURCES = test/fortran_test_programs/test_complex2_choose_kernel_with_api.F90 $(shared_sources) $(redirect_sources) elpa2_test_complex_choose_kernel_with_api@SUFFIX@_LDADD = $(build_lib) @@ -193,6 +212,9 @@ check_SCRIPTS = \ elpa1_test_real.sh \ elpa1_test_real_with_c.sh \ elpa1_test_real_c_version.sh \ + elpa1_test_complex_c_version.sh \ + elpa2_test_real_c_version.sh \ + elpa2_test_complex_c_version.sh \ elpa2_test_real.sh \ elpa2_test_real_default_kernel.sh \ elpa1_test_complex.sh \ @@ -216,6 +238,25 @@ elpa1_test_real_c_version.sh: echo 'mpiexec -n 2 ./elpa1_test_real_c_version@SUFFIX@ $$TEST_FLAGS' > elpa1_test_real_c_version.sh chmod +x elpa1_test_real_c_version.sh +elpa1_test_complex_c_version.sh: + echo 'mpiexec -n 2 ./elpa1_test_complex_c_version@SUFFIX@ $$TEST_FLAGS' > elpa1_test_complex_c_version.sh + chmod +x elpa1_test_complex_c_version.sh + +elpa2_test_real_c_version.sh: + echo 'mpiexec -n 2 ./elpa2_test_real_c_version@SUFFIX@ $$TEST_FLAGS' > elpa2_test_real_c_version.sh + chmod +x elpa2_test_real_c_version.sh + +elpa2_test_complex_c_version.sh: + echo 'mpiexec -n 2 ./elpa2_test_complex_c_version@SUFFIX@ $$TEST_FLAGS' > elpa2_test_complex_c_version.sh + chmod +x elpa2_test_complex_c_version.sh + +elpa1_test_real_c_version.sh: + echo 'mpiexec -n 2 ./elpa1_test_real_c_version@SUFFIX@ $$TEST_FLAGS' > elpa1_test_real_c_version.sh + chmod +x elpa1_test_real_c_version.sh + +elpa1_test_complex_c_version.sh: + echo 'mpiexec -n 2 ./elpa1_test_complex_c_version@SUFFIX@ $$TEST_FLAGS' > elpa1_test_complex_c_version.sh + chmod +x elpa1_test_complex_c_version.sh elpa2_test_real.sh: echo 'mpiexec -n 2 ./elpa2_test_real@SUFFIX@ $$TEST_FLAGS' > elpa2_test_real.sh chmod +x elpa2_test_real.sh diff --git a/configure.ac b/configure.ac index 4674f9b1..7fa51aa5 100644 --- a/configure.ac +++ b/configure.ac @@ -101,8 +101,6 @@ if test x"${enable_openmp}" = x"yes"; then FCFLAGS="$OPENMP_FCFLAGS $FCFLAGS" fi - - # C++ AC_LANG([C++]) AC_PROG_CXX @@ -340,7 +338,7 @@ else AC_MSG_RESULT([${have_blas}]) if test x"${have_blas}" = x"no" ; then - AC_MSG_ERROR([could not link with blas: specify path]) + AC_MSG_ERROR([could not link with blas: specify path]) fi dnl now lapack AC_SEARCH_LIBS([dlarrv],[lapack],[have_lapack=yes],[have_lapack=no]) diff --git a/src/elpa2.F90 b/src/elpa2.F90 index 6f369c1a..4bf5f594 100644 --- a/src/elpa2.F90 +++ b/src/elpa2.F90 @@ -528,7 +528,8 @@ function solve_evp_complex_2stage(na, nev, a, lda, ev, q, ldq, nblk, & ! Backtransform stage 2 ttt0 = MPI_Wtime() - call trans_ev_band_to_full_complex(na, nev, nblk, nbw, a, lda, tmat, q, ldq, matrixCols, num_blocks, mpi_comm_rows, mpi_comm_cols) + call trans_ev_band_to_full_complex(na, nev, nblk, nbw, a, lda, tmat, q, ldq, matrixCols, num_blocks, & + mpi_comm_rows, mpi_comm_cols) ttt1 = MPI_Wtime() if (my_prow==0 .and. my_pcol==0 .and. elpa_print_times) & write(error_unit,*) 'Time trans_ev_band_to_full_complex :',ttt1-ttt0 @@ -847,13 +848,16 @@ subroutine bandred_real(na, a, lda, nblk, nbw, matrixCols, numBlocks, mpi_comm_r ! VAV = Tmat * V**T * A * V * Tmat**T = (U*Tmat**T)**T * V * Tmat**T - call dgemm('T','N',n_cols,n_cols,l_cols,1.d0,umc,ubound(umc,dim=1),umc(1,n_cols+1),ubound(umc,dim=1),0.d0,vav,ubound(vav,dim=1)) - call dtrmm('Right','Upper','Trans','Nonunit',n_cols,n_cols,1.d0,tmat(1,1,istep),ubound(tmat,dim=1),vav,ubound(vav,dim=1)) + call dgemm('T','N',n_cols,n_cols,l_cols,1.d0,umc,ubound(umc,dim=1),umc(1,n_cols+1), & + ubound(umc,dim=1),0.d0,vav,ubound(vav,dim=1)) + call dtrmm('Right','Upper','Trans','Nonunit',n_cols,n_cols,1.d0,tmat(1,1,istep), & + ubound(tmat,dim=1),vav,ubound(vav,dim=1)) call symm_matrix_allreduce(n_cols,vav, nbw, nbw ,mpi_comm_cols) ! U = U - 0.5 * V * VAV - call dgemm('N','N',l_cols,n_cols,n_cols,-0.5d0,umc(1,n_cols+1),ubound(umc,dim=1),vav,ubound(vav,dim=1),1.d0,umc,ubound(umc,dim=1)) + call dgemm('N','N',l_cols,n_cols,n_cols,-0.5d0,umc(1,n_cols+1),ubound(umc,dim=1),vav, & + ubound(vav,dim=1),1.d0,umc,ubound(umc,dim=1)) ! Transpose umc -> umr (stored in vmr, second half) @@ -3568,7 +3572,8 @@ end subroutine herm_matrix_allreduce !------------------------------------------------------------------------------- -subroutine trans_ev_band_to_full_complex(na, nqc, nblk, nbw, a, lda, tmat, q, ldq, matrixCols, numBlocks, mpi_comm_rows, mpi_comm_cols) +subroutine trans_ev_band_to_full_complex(na, nqc, nblk, nbw, a, lda, tmat, q, ldq, matrixCols, & + numBlocks, mpi_comm_rows, mpi_comm_cols) !------------------------------------------------------------------------------- ! trans_ev_band_to_full_complex: diff --git a/src/elpa_c_interface.F90 b/src/elpa_c_interface.F90 index e4c74b88..62ce4c53 100644 --- a/src/elpa_c_interface.F90 +++ b/src/elpa_c_interface.F90 @@ -47,6 +47,7 @@ ! distributed along with the original code in the file "COPYING". #include "config-f90.h" + !c> #include !c> int elpa_get_communicators(int mpi_comm_world, int my_prow, int my_pcol, int *mpi_comm_rows, int *mpi_comm_cols); function get_elpa_row_col_comms_wrapper(mpi_comm_world, my_prow, my_pcol, & @@ -55,6 +56,7 @@ use, intrinsic :: iso_c_binding use elpa1, only : get_elpa_row_col_comms + implicit none integer(kind=c_int) :: mpierr integer(kind=c_int), value :: mpi_comm_world, my_prow, my_pcol integer(kind=c_int) :: mpi_comm_rows, mpi_comm_cols @@ -72,6 +74,7 @@ use, intrinsic :: iso_c_binding use elpa1, only : solve_evp_real + implicit none integer(kind=c_int) :: success integer(kind=c_int), value, intent(in) :: na, nev, lda, ldq, nblk, matrixCols, mpi_comm_cols, mpi_comm_rows real(kind=c_double) :: a(1:lda,1:matrixCols), ev(1:na), q(1:ldq,1:matrixCols) @@ -88,7 +91,7 @@ end function - ! int elpa_solve_evp_complex_stage1(int na, int nev, double_complex *a, int lda, double *ev, double_complex *q, int ldq, int nblk, int matrixCols, int mpi_comm_rows, int mpi_comm_cols); + !c> int elpa_solve_evp_complex_stage1(int na, int nev, double complex *a, int lda, double *ev, double complex *q, int ldq, int nblk, int matrixCols, int mpi_comm_rows, int mpi_comm_cols); function solve_evp_real_wrapper(na, nev, a, lda, ev, q, ldq, nblk, & matrixCols, mpi_comm_rows, mpi_comm_cols) & result(success) bind(C,name="elpa_solve_evp_complex_1stage") @@ -96,6 +99,7 @@ use, intrinsic :: iso_c_binding use elpa1, only : solve_evp_complex + implicit none integer(kind=c_int) :: success integer(kind=c_int), value, intent(in) :: na, nev, lda, ldq, nblk, matrixCols, mpi_comm_cols, mpi_comm_rows complex(kind=c_double_complex) :: a(1:lda,1:matrixCols), q(1:ldq,1:matrixCols) @@ -113,7 +117,7 @@ end function - !c> int elpa_solve_evp_real_stage2(int na, int nev, double *a, int lda, double *ev, double *q, int ldq, int nblk, int matrixCols, int mpi_comm_rows, int mpi_comm_cols, int THIS_REAL_ELPA_KERNEL_API, int useQR); + !c> int elpa_solve_evp_real_stage2(int na, int nev, double *a, int lda, double *ev, double *q, int ldq, int nblk, int matrixCols, int mpi_comm_rows, int mpi_comm_cols, int mpi_comm_all, int THIS_REAL_ELPA_KERNEL_API, int useQR); function solve_elpa2_evp_real_wrapper(na, nev, a, lda, ev, q, ldq, nblk, & matrixCols, mpi_comm_rows, mpi_comm_cols, mpi_comm_all, & THIS_REAL_ELPA_KERNEL_API, useQR) & @@ -122,6 +126,7 @@ use, intrinsic :: iso_c_binding use elpa2, only : solve_evp_real_2stage + implicit none integer(kind=c_int) :: success integer(kind=c_int), value, intent(in) :: na, nev, lda, ldq, nblk, matrixCols, mpi_comm_cols, mpi_comm_rows, & mpi_comm_all @@ -138,7 +143,8 @@ useQRFortran = .true. endif - successFortran = solve_evp_real_2stage(na, nev, a, lda, ev, q, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, mpi_comm_all, & + successFortran = solve_evp_real_2stage(na, nev, a, lda, ev, q, ldq, nblk, matrixCols, mpi_comm_rows, & + mpi_comm_cols, mpi_comm_all, & THIS_REAL_ELPA_KERNEL_API, useQRFortran) if (successFortran) then @@ -149,7 +155,7 @@ end function - ! int elpa_solve_evp_complex_stage2(int na, int nev, double_complex *a, int lda, double *ev, double_complex *q, int ldq, int nblk, int matrixCols, int mpi_comm_rows, int mpi_comm_cols); + !c> int elpa_solve_evp_complex_stage2(int na, int nev, double complex *a, int lda, double *ev, double complex *q, int ldq, int nblk, int matrixCols, int mpi_comm_rows, int mpi_comm_cols, int mpi_comm_all, int THIS_COMPLEX_ELPA_KERNEL_API); function solve_elpa2_evp_complex_wrapper(na, nev, a, lda, ev, q, ldq, nblk, & matrixCols, mpi_comm_rows, mpi_comm_cols, mpi_comm_all, & THIS_COMPLEX_ELPA_KERNEL_API) & @@ -158,6 +164,7 @@ use, intrinsic :: iso_c_binding use elpa2, only : solve_evp_complex_2stage + implicit none integer(kind=c_int) :: success integer(kind=c_int), value, intent(in) :: na, nev, lda, ldq, nblk, matrixCols, mpi_comm_cols, mpi_comm_rows, & mpi_comm_all diff --git a/test/c_test_programs/elpa1_test_complex_c_version.c b/test/c_test_programs/elpa1_test_complex_c_version.c new file mode 100644 index 00000000..9f98520f --- /dev/null +++ b/test/c_test_programs/elpa1_test_complex_c_version.c @@ -0,0 +1,223 @@ +/* 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 */ +/* */ +/* 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. */ +/* */ +/* */ + +#include "config-f90.h" + +#include +#include +#include +#include + +#include +#include + +main(int argc, char** argv) { + int myid; + int nprocs; + + int na, nev, nblk; + + int status; + + int np_cols, np_rows, np_colsStart; + + int my_blacs_ctxt, nprow, npcol, my_prow, my_pcol; + + int mpierr; + + int my_mpi_comm_world; + int mpi_comm_rows, mpi_comm_cols; + + int info, *sc_desc; + + int na_rows, na_cols; + double startVal; + + complex double *a, *z, *as, *tmp1, *tmp2; + + double *ev, *xr; + + int *iseed; + + int success; + + MPI_Init(&argc, &argv); + MPI_Comm_size(MPI_COMM_WORLD, &nprocs); + MPI_Comm_rank(MPI_COMM_WORLD, &myid); + + na = 1000; + nev = 500; + nblk = 16; + + if (myid == 0) { + printf("This is the c version of an ELPA test-programm\n"); + printf("\n"); + printf("It will call the 1stage ELPA complex solver for a matrix\n"); + printf("of matrix size %d. It will compute %d eigenvalues\n",na,nev); + printf("and uses a blocksize of %d\n",nblk); + printf("\n"); + printf("This is an example program with much less functionality\n"); + printf("as it's Fortran counterpart. It's only purpose is to show how \n"); + printf("to evoke ELPA1 from a c programm\n"); + + printf("\n"); + + } + + status = 0; + + startVal = sqrt((double) nprocs); + np_colsStart = (int) round(startVal); + for (np_cols=np_colsStart;np_cols>1;np_cols--){ + if (nprocs %np_cols ==0){ + break; + } + } + + np_rows = nprocs/np_cols; + + if (myid == 0) { + printf("\n"); + printf("Number of processor rows %d, cols %d, total %d \n",np_rows,np_cols,nprocs); + } + + /* set up blacs */ + /* convert communicators before */ + my_mpi_comm_world = MPI_Comm_c2f(MPI_COMM_WORLD); + set_up_blacsgrid_from_fortran(my_mpi_comm_world, &my_blacs_ctxt, &np_rows, &np_cols, &nprow, &npcol, &my_prow, &my_pcol); + + if (myid == 0) { + printf("\n"); + printf("Past BLACS_Gridinfo...\n"); + printf("\n"); + } + + /* get the ELPA row and col communicators. */ + /* These are NOT usable in C without calling the MPI_Comm_f2c function on them !! */ + my_mpi_comm_world = MPI_Comm_c2f(MPI_COMM_WORLD); + mpierr = elpa_get_communicators(my_mpi_comm_world, my_prow, my_pcol, &mpi_comm_rows, &mpi_comm_cols); + + if (myid == 0) { + printf("\n"); + printf("Past split communicator setup for rows and columns...\n"); + printf("\n"); + } + + sc_desc = malloc(9*sizeof(int)); + + set_up_blacs_descriptor_from_fortran(na, nblk, my_prow, my_pcol, np_rows, np_cols, &na_rows, &na_cols, sc_desc, my_blacs_ctxt, &info); + + if (myid == 0) { + printf("\n"); + printf("Past scalapack descriptor setup...\n"); + printf("\n"); + } + + /* allocate the matrices needed for elpa */ + if (myid == 0) { + printf("\n"); + printf("Allocating matrices with na_rows=%d and na_cols=%d\n",na_rows, na_cols); + printf("\n"); + } + + a = malloc(na_rows*na_cols*sizeof(complex double)); + z = malloc(na_rows*na_cols*sizeof(complex double)); + as = malloc(na_rows*na_cols*sizeof(complex double)); + + xr = malloc(na_rows*na_cols*sizeof(double)); + + + ev = malloc(na*sizeof(double)); + + tmp1 = malloc(na_rows*na_cols*sizeof(complex double)); + tmp2 = malloc(na_rows*na_cols*sizeof(complex double)); + + iseed = malloc(4096*sizeof(int)); + + prepare_matrix_complex_from_fortran(na, myid, na_rows, na_cols, sc_desc, iseed, xr, a, z, as); + + free(xr); + + if (myid == 0) { + printf("\n"); + printf("Entering ELPA 1stage complex solver\n"); + printf("\n"); + } + + mpierr = MPI_Barrier(MPI_COMM_WORLD); + + success = elpa_solve_evp_complex_1stage(na, nev, a, na_rows, ev, z, na_rows, nblk, na_cols, mpi_comm_rows, mpi_comm_cols); + + if (success != 1) { + printf("error in ELPA solve \n"); + mpierr = MPI_Abort(MPI_COMM_WORLD, 99); + } + + + if (myid == 0) { + printf("\n"); + printf("1stage ELPA complex solver complete\n"); + printf("\n"); + } + + /* check the results */ + status = check_correctness_complex_from_fortran(na, nev, na_rows, na_cols, as, z, ev, sc_desc, myid, tmp1, tmp2); + + if (status !=0){ + printf("The computed EVs are not correct !\n"); + } + if (status ==0){ + printf("All ok!\n"); + } + + free(sc_desc); + free(a); + free(z); + free(as); + + free(tmp1); + free(tmp2); + + MPI_Finalize(); + + return 0; +} diff --git a/test/test_real_c_version.c b/test/c_test_programs/elpa1_test_real_c_version.c similarity index 97% rename from test/test_real_c_version.c rename to test/c_test_programs/elpa1_test_real_c_version.c index c9e84d0b..5945782f 100644 --- a/test/test_real_c_version.c +++ b/test/c_test_programs/elpa1_test_real_c_version.c @@ -93,7 +93,8 @@ main(int argc, char** argv) { printf("and uses a blocksize of %d\n",nblk); printf("\n"); printf("This is an example program with much less functionality\n"); - printf("as it's Fortran counterpart \n"); + printf("as it's Fortran counterpart. It's only purpose is to show how \n"); + printf("to evoke ELPA1 from a c programm\n"); printf("\n"); } diff --git a/test/c_test_programs/elpa2_test_complex_c_version.c b/test/c_test_programs/elpa2_test_complex_c_version.c new file mode 100644 index 00000000..92719ede --- /dev/null +++ b/test/c_test_programs/elpa2_test_complex_c_version.c @@ -0,0 +1,227 @@ +/* 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 */ +/* */ +/* 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. */ +/* */ +/* */ + +#include "config-f90.h" + +#include +#include +#include +#include + +#include +#include + +main(int argc, char** argv) { + int myid; + int nprocs; + + int na, nev, nblk; + + int status; + + int np_cols, np_rows, np_colsStart; + + int my_blacs_ctxt, nprow, npcol, my_prow, my_pcol; + + int mpierr; + + int my_mpi_comm_world; + int mpi_comm_rows, mpi_comm_cols; + + int info, *sc_desc; + + int na_rows, na_cols; + double startVal; + + complex double *a, *z, *as, *tmp1, *tmp2; + + double *ev, *xr; + + int *iseed; + + int success; + + int THIS_COMPLEX_ELPA_KERNEL_API; + + MPI_Init(&argc, &argv); + MPI_Comm_size(MPI_COMM_WORLD, &nprocs); + MPI_Comm_rank(MPI_COMM_WORLD, &myid); + + na = 1000; + nev = 500; + nblk = 16; + + if (myid == 0) { + printf("This is the c version of an ELPA test-programm\n"); + printf("\n"); + printf("It will call the 1stage ELPA complex solver for a matrix\n"); + printf("of matrix size %d. It will compute %d eigenvalues\n",na,nev); + printf("and uses a blocksize of %d\n",nblk); + printf("\n"); + printf("This is an example program with much less functionality\n"); + printf("as it's Fortran counterpart. It's only purpose is to show how \n"); + printf("to evoke ELPA1 from a c programm\n"); + + printf("\n"); + + } + + status = 0; + + startVal = sqrt((double) nprocs); + np_colsStart = (int) round(startVal); + for (np_cols=np_colsStart;np_cols>1;np_cols--){ + if (nprocs %np_cols ==0){ + break; + } + } + + np_rows = nprocs/np_cols; + + if (myid == 0) { + printf("\n"); + printf("Number of processor rows %d, cols %d, total %d \n",np_rows,np_cols,nprocs); + } + + /* set up blacs */ + /* convert communicators before */ + my_mpi_comm_world = MPI_Comm_c2f(MPI_COMM_WORLD); + set_up_blacsgrid_from_fortran(my_mpi_comm_world, &my_blacs_ctxt, &np_rows, &np_cols, &nprow, &npcol, &my_prow, &my_pcol); + + if (myid == 0) { + printf("\n"); + printf("Past BLACS_Gridinfo...\n"); + printf("\n"); + } + + /* get the ELPA row and col communicators. */ + /* These are NOT usable in C without calling the MPI_Comm_f2c function on them !! */ + my_mpi_comm_world = MPI_Comm_c2f(MPI_COMM_WORLD); + mpierr = elpa_get_communicators(my_mpi_comm_world, my_prow, my_pcol, &mpi_comm_rows, &mpi_comm_cols); + + if (myid == 0) { + printf("\n"); + printf("Past split communicator setup for rows and columns...\n"); + printf("\n"); + } + + sc_desc = malloc(9*sizeof(int)); + + set_up_blacs_descriptor_from_fortran(na, nblk, my_prow, my_pcol, np_rows, np_cols, &na_rows, &na_cols, sc_desc, my_blacs_ctxt, &info); + + if (myid == 0) { + printf("\n"); + printf("Past scalapack descriptor setup...\n"); + printf("\n"); + } + + /* allocate the matrices needed for elpa */ + if (myid == 0) { + printf("\n"); + printf("Allocating matrices with na_rows=%d and na_cols=%d\n",na_rows, na_cols); + printf("\n"); + } + + a = malloc(na_rows*na_cols*sizeof(complex double)); + z = malloc(na_rows*na_cols*sizeof(complex double)); + as = malloc(na_rows*na_cols*sizeof(complex double)); + + xr = malloc(na_rows*na_cols*sizeof(double)); + + + ev = malloc(na*sizeof(double)); + + tmp1 = malloc(na_rows*na_cols*sizeof(complex double)); + tmp2 = malloc(na_rows*na_cols*sizeof(complex double)); + + iseed = malloc(4096*sizeof(int)); + + prepare_matrix_complex_from_fortran(na, myid, na_rows, na_cols, sc_desc, iseed, xr, a, z, as); + + free(xr); + + if (myid == 0) { + printf("\n"); + printf("Entering ELPA 2stage complex solver\n"); + printf("\n"); + } + + mpierr = MPI_Barrier(MPI_COMM_WORLD); + THIS_COMPLEX_ELPA_KERNEL_API = ELPA2_COMPLEX_KERNEL_GENERIC; + success = elpa_solve_evp_complex_2stage(na, nev, a, na_rows, ev, z, na_rows, nblk, na_cols, mpi_comm_rows, mpi_comm_cols, my_mpi_comm_world, THIS_COMPLEX_ELPA_KERNEL_API); + + if (success != 1) { + printf("error in ELPA solve \n"); + mpierr = MPI_Abort(MPI_COMM_WORLD, 99); + } + + + if (myid == 0) { + printf("\n"); + printf("2stage ELPA complex solver complete\n"); + printf("\n"); + } + + /* check the results */ + status = check_correctness_complex_from_fortran(na, nev, na_rows, na_cols, as, z, ev, sc_desc, myid, tmp1, tmp2); + + if (status !=0){ + printf("The computed EVs are not correct !\n"); + } + if (status ==0){ + if (myid == 0) { + printf("All ok!\n"); + } + } + + free(sc_desc); + free(a); + free(z); + free(as); + + free(tmp1); + free(tmp2); + + MPI_Finalize(); + + return 0; +} diff --git a/test/Makefile.example b/test/fortran_test_programs/Makefile.example similarity index 100% rename from test/Makefile.example rename to test/fortran_test_programs/Makefile.example diff --git a/test/read_real.F90 b/test/fortran_test_programs/read_real.F90 similarity index 100% rename from test/read_real.F90 rename to test/fortran_test_programs/read_real.F90 diff --git a/test/test_complex.F90 b/test/fortran_test_programs/test_complex.F90 similarity index 100% rename from test/test_complex.F90 rename to test/fortran_test_programs/test_complex.F90 diff --git a/test/test_complex2.F90 b/test/fortran_test_programs/test_complex2.F90 similarity index 100% rename from test/test_complex2.F90 rename to test/fortran_test_programs/test_complex2.F90 diff --git a/test/test_complex2_choose_kernel_with_api.F90 b/test/fortran_test_programs/test_complex2_choose_kernel_with_api.F90 similarity index 100% rename from test/test_complex2_choose_kernel_with_api.F90 rename to test/fortran_test_programs/test_complex2_choose_kernel_with_api.F90 diff --git a/test/test_complex2_default_kernel.F90 b/test/fortran_test_programs/test_complex2_default_kernel.F90 similarity index 100% rename from test/test_complex2_default_kernel.F90 rename to test/fortran_test_programs/test_complex2_default_kernel.F90 diff --git a/test/test_real.F90 b/test/fortran_test_programs/test_real.F90 similarity index 100% rename from test/test_real.F90 rename to test/fortran_test_programs/test_real.F90 diff --git a/test/test_real2.F90 b/test/fortran_test_programs/test_real2.F90 similarity index 100% rename from test/test_real2.F90 rename to test/fortran_test_programs/test_real2.F90 diff --git a/test/test_real2_choose_kernel_with_api.F90 b/test/fortran_test_programs/test_real2_choose_kernel_with_api.F90 similarity index 100% rename from test/test_real2_choose_kernel_with_api.F90 rename to test/fortran_test_programs/test_real2_choose_kernel_with_api.F90 diff --git a/test/test_real2_default_kernel.F90 b/test/fortran_test_programs/test_real2_default_kernel.F90 similarity index 100% rename from test/test_real2_default_kernel.F90 rename to test/fortran_test_programs/test_real2_default_kernel.F90 diff --git a/test/test_real2_default_kernel_qr_decomposition.F90 b/test/fortran_test_programs/test_real2_default_kernel_qr_decomposition.F90 similarity index 100% rename from test/test_real2_default_kernel_qr_decomposition.F90 rename to test/fortran_test_programs/test_real2_default_kernel_qr_decomposition.F90 diff --git a/test/test_real_with_c.F90 b/test/fortran_test_programs/test_real_with_c.F90 similarity index 100% rename from test/test_real_with_c.F90 rename to test/fortran_test_programs/test_real_with_c.F90 diff --git a/test/shared_sources/blacs_infrastructure.F90 b/test/shared_sources/blacs_infrastructure.F90 index 0ceb880b..f3167721 100644 --- a/test/shared_sources/blacs_infrastructure.F90 +++ b/test/shared_sources/blacs_infrastructure.F90 @@ -73,13 +73,17 @@ module mod_blacs_infrastructure np_rows, np_cols, na_rows, & na_cols, sc_desc, my_blacs_ctxt, info) + use elpa_utilities, only : error_unit + implicit none + include "mpif.h" integer, intent(inout) :: na, nblk, my_prow, my_pcol, np_rows, & np_cols, na_rows, na_cols, sc_desc(1:9), & my_blacs_ctxt, info integer, external :: numroc + integer :: mpierr ! determine the neccessary size of the distributed matrices, ! we use the scalapack tools routine NUMROC @@ -94,6 +98,17 @@ module mod_blacs_infrastructure ! row/col 0/0 (arg 6 and 7) call descinit(sc_desc, na, na, nblk, nblk, 0, 0, my_blacs_ctxt, na_rows, info) + + if (info .ne. 0) then + write(error_unit,*) 'Error in BLACS descinit! info=',info + write(error_unit,*) 'Most likely this happend since you want to use' + write(error_unit,*) 'more MPI tasks than are possible for your' + write(error_unit,*) 'problem size (matrix size and blocksize)!' + write(error_unit,*) 'The blacsgrid can not be set up properly' + write(error_unit,*) 'Try reducing the number of MPI tasks...' + call MPI_ABORT(mpi_comm_world, 1, mpierr) + endif + end subroutine subroutine set_up_blacs_descriptor_wrapper(na, nblk, my_prow, my_pcol, & diff --git a/test/shared_sources/call_elpa1_real.c b/test/shared_sources/call_elpa1.c similarity index 88% rename from test/shared_sources/call_elpa1_real.c rename to test/shared_sources/call_elpa1.c index 72ade3aa..38c30819 100644 --- a/test/shared_sources/call_elpa1_real.c +++ b/test/shared_sources/call_elpa1.c @@ -43,6 +43,7 @@ #include #include #include +#include int call_elpa1_real_solver_from_c(int na, int nev, int ncols, double *a, int lda, double *ev, double *q, int ldq, int nblk, int mpi_comm_rows, int mpi_comm_cols) { int result; @@ -50,6 +51,12 @@ int call_elpa1_real_solver_from_c(int na, int nev, int ncols, double *a, int lda return result; } +int call_elpa1_complex_solver_from_c(int na, int nev, int ncols, complex double *a, int lda, double *ev, complex double *q, int ldq, int nblk, int mpi_comm_rows, int mpi_comm_cols) { + int result; + result = elpa_solve_evp_complex_1stage(na, nev, ncols, a, lda, ev, q, ldq, nblk, mpi_comm_rows, mpi_comm_cols); + return result; +} + int call_elpa_get_comm_from_c(int mpi_comm_world, int my_prow, int my_pcol, int *mpi_comm_rows, int *mpi_comm_cols){ int mpierr; diff --git a/test/shared_sources/call_elpa2.c b/test/shared_sources/call_elpa2.c new file mode 100644 index 00000000..38c30819 --- /dev/null +++ b/test/shared_sources/call_elpa2.c @@ -0,0 +1,67 @@ +/* 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 */ +/* */ +/* 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. */ +/* */ +/* */ +#include +#include +#include +#include +#include + +int call_elpa1_real_solver_from_c(int na, int nev, int ncols, double *a, int lda, double *ev, double *q, int ldq, int nblk, int mpi_comm_rows, int mpi_comm_cols) { + int result; + result = elpa_solve_evp_real_1stage(na, nev, ncols, a, lda, ev, q, ldq, nblk, mpi_comm_rows, mpi_comm_cols); + return result; +} + +int call_elpa1_complex_solver_from_c(int na, int nev, int ncols, complex double *a, int lda, double *ev, complex double *q, int ldq, int nblk, int mpi_comm_rows, int mpi_comm_cols) { + int result; + result = elpa_solve_evp_complex_1stage(na, nev, ncols, a, lda, ev, q, ldq, nblk, mpi_comm_rows, mpi_comm_cols); + return result; +} + +int call_elpa_get_comm_from_c(int mpi_comm_world, int my_prow, int my_pcol, int *mpi_comm_rows, int *mpi_comm_cols){ + int mpierr; + + mpierr = elpa_get_communicators(mpi_comm_world, my_prow, my_pcol, mpi_comm_rows, mpi_comm_cols); + + return mpierr; +} + diff --git a/test/shared_sources/check_correctnes.F90 b/test/shared_sources/check_correctnes.F90 index cbe685f2..ba082192 100644 --- a/test/shared_sources/check_correctnes.F90 +++ b/test/shared_sources/check_correctnes.F90 @@ -71,6 +71,7 @@ module mod_check_correctness ! 1. Residual (maximum of || A*Zi - Zi*EVi ||) ! tmp1 = A * Z + ! as is original stored matrix, Z are the EVs call pzgemm('N','N',na,nev,na,CONE,as,1,1,sc_desc, & z,1,1,sc_desc,CZERO,tmp1,1,1,sc_desc) @@ -219,5 +220,22 @@ module mod_check_correctness end function + function check_correctness_complex_wrapper(na, nev, na_rows, na_cols, as, z, ev, sc_desc, myid, tmp1, tmp2) result(status) & + bind(C,name="check_correctness_complex_from_fortran") + + use iso_c_binding + + implicit none + + integer(kind=c_int) :: status + integer(kind=c_int), value :: na, nev, myid, na_rows, na_cols + complex(kind=c_double) :: as(1:na_rows,1:na_cols), z(1:na_rows,1:na_cols) + complex(kind=c_double) :: tmp1(1:na_rows,1:na_cols), tmp2(1:na_rows,1:na_cols) + real(kind=c_double) :: ev(1:na) + integer(kind=c_int) :: sc_desc(1:9) + + status = check_correctness_complex(na, nev, as, z, ev, sc_desc, myid, tmp1, tmp2) + + end function end module mod_check_correctness diff --git a/test/shared_sources/mod_from_c.F90 b/test/shared_sources/mod_from_c.F90 index 01d33430..ed47f270 100644 --- a/test/shared_sources/mod_from_c.F90 +++ b/test/shared_sources/mod_from_c.F90 @@ -57,6 +57,23 @@ module from_c end function elpa1_real_c + end interface + + interface + integer(kind=c_int) function elpa1_complex_c(na, nev, a, lda, ev, q, ldq, & + nblk, matrixCols, mpi_comm_rows, mpi_comm_cols ) & + bind(C, name="call_elpa1_complex_solver_from_c") + + use iso_c_binding + implicit none + + integer(kind=c_int), value :: na, nev, lda, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols + real(kind=c_double) :: ev(1:na) + complex(kind=c_double) :: a(1:lda,1:matrixCOls), q(1:ldq,1:matrixCols) + + end function elpa1_complex_c + + end interface interface @@ -84,7 +101,7 @@ module from_c logical :: success integer :: successC - real*8 :: a(1:lda,1:matrixCols), ev(1:na), q(1:ldq,1:matrixCols) + real(kind=c_double) :: a(1:lda,1:matrixCols), ev(1:na), q(1:ldq,1:matrixCols) successC = elpa1_real_c(na, nev, a, lda, ev, q, ldq, nblk, & matrixCols, mpi_comm_rows, mpi_comm_cols) @@ -97,6 +114,33 @@ module from_c end function + function solve_elpa1_complex_call_from_c(na, nev, a, lda, ev, q, ldq, & + nblk, matrixCOls, mpi_comm_rows, mpi_comm_cols ) & + result(success) + + use iso_c_binding + implicit none + + integer :: na, nev, lda, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols + logical :: success + integer :: successC + + real(kind=c_double) :: ev(1:na) + complex(kind=c_double) :: a(1:lda,1:matrixCols), q(1:ldq,1:matrixCols) + + + successC = elpa1_complex_c(na, nev, a, lda, ev, q, ldq, nblk, & + matrixCols, mpi_comm_rows, mpi_comm_cols) + + if (successC .eq. 1) then + success = .true. + else + success = .false. + endif + + end function + + function call_elpa_get_comm_from_c(mpi_comm_world, my_prow, my_pcol, & mpi_comm_rows, mpi_comm_cols) result(mpierr) diff --git a/test/shared_sources/prepare_matrix.F90 b/test/shared_sources/prepare_matrix.F90 index a28bc30a..3e889aca 100644 --- a/test/shared_sources/prepare_matrix.F90 +++ b/test/shared_sources/prepare_matrix.F90 @@ -43,7 +43,7 @@ module mod_prepare_matrix interface prepare_matrix module procedure prepare_matrix_complex - module procedure prepare_matrix_real + module procedure prepare_matrix_real end interface contains @@ -52,12 +52,12 @@ module mod_prepare_matrix implicit none - integer, intent(in) :: myid, na, sc_desc(:) - integer, intent(inout) :: iseed(:) - real*8, intent(inout) :: xr(:,:) - complex*16, intent(inout) :: z(:,:), a(:,:), as(:,:) + integer, intent(in) :: myid, na, sc_desc(:) + integer, intent(inout) :: iseed(:) + real(kind=8), intent(inout) :: xr(:,:) + complex(kind=8), intent(inout) :: z(:,:), a(:,:), as(:,:) - complex*16, parameter :: CZERO = (0.d0, 0.d0), CONE = (1.d0, 0.d0) + complex(kind=8), parameter :: CZERO = (0.d0, 0.d0), CONE = (1.d0, 0.d0) ! for getting a hermitian test matrix A we get a random matrix Z ! and calculate A = Z + Z**H @@ -138,8 +138,23 @@ module mod_prepare_matrix real(kind=c_double) :: z(1:na_rows,1:na_cols), a(1:na_rows,1:na_cols), & as(1:na_rows,1:na_cols) - print *,"in prepare wrapper" call prepare_matrix_real(na, myid, sc_desc, iseed, a, z, as) end subroutine + subroutine prepare_matrix_complex_wrapper(na, myid, na_rows, na_cols, sc_desc, iseed, xr, a, z, as) & + bind(C, name="prepare_matrix_complex_from_fortran") + use iso_c_binding + + implicit none + + integer(kind=c_int) , value :: myid, na, na_rows, na_cols + integer(kind=c_int) :: sc_desc(1:9) + integer(kind=c_int) :: iseed(1:4096) + real(kind=c_double) :: xr(1:na_rows,1:na_cols) + complex(kind=c_double) :: z(1:na_rows,1:na_cols), a(1:na_rows,1:na_cols), & + as(1:na_rows,1:na_cols) + + call prepare_matrix_complex(na, myid, sc_desc, iseed, xr, a, z, as) + end subroutine + end module -- GitLab