test.F90 19 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
!    This file is part of ELPA.
!
!    The ELPA library was originally created by the ELPA consortium,
!    consisting of the following organizations:
!
!    - Max Planck Computing and Data Facility (MPCDF), formerly known as
!      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.mpcdf.mpg.de/
!
!    ELPA is free software: you can redistribute it and/or modify
!    it under the terms of the version 3 of the license of the
!    GNU Lesser General Public License as published by the Free
!    Software Foundation.
!
!    ELPA is distributed in the hope that it will be useful,
!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!    GNU Lesser General Public License for more details.
!
!    You should have received a copy of the GNU Lesser General Public License
!    along with ELPA.  If not, see <http://www.gnu.org/licenses/>
!
!    ELPA reflects a substantial effort on the part of the original
!    ELPA consortium, and we ask you to respect the spirit of the
!    license that we chose: i.e., please contribute any changes you
!    may have back to the original ELPA library distribution, and keep
!    any derivatives of ELPA under the same license that we chose for
!    the original distribution, the GNU Lesser General Public License.
!
!
#include "config-f90.h"

! Define one of TEST_REAL or TEST_COMPLEX
! Define one of TEST_SINGLE or TEST_DOUBLE
! Define one of TEST_SOLVER_1STAGE or TEST_SOLVER_2STAGE
! Define TEST_GPU \in [0, 1]
49
! Define either TEST_ALL_KERNELS or a TEST_KERNEL \in [any valid kernel]
50

51 52
#if !(defined(TEST_REAL) ^ defined(TEST_COMPLEX))
error: define exactly one of TEST_REAL or TEST_COMPLEX
53 54 55 56 57 58
#endif

#if !(defined(TEST_SINGLE) ^ defined(TEST_DOUBLE))
error: define exactly one of TEST_SINGLE or TEST_DOUBLE
#endif

59 60
#if !(defined(TEST_SOLVER_1STAGE) ^ defined(TEST_SOLVER_2STAGE) ^ defined(TEST_SCALAPACK_ALL) ^ defined(TEST_SCALAPACK_PART))
error: define exactly one of TEST_SOLVER_1STAGE or TEST_SOLVER_2STAGE or TEST_SCALAPACK_ALL or TEST_SCALAPACK_PART
61 62
#endif

63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
#ifdef TEST_SOLVER_1STAGE
#ifdef TEST_ALL_KERNELS
error: TEST_ALL_KERNELS cannot be defined for TEST_SOLVER_1STAGE
#endif
#ifdef TEST_KERNEL
error: TEST_KERNEL cannot be defined for TEST_SOLVER_1STAGE
#endif
#endif

#ifdef TEST_SOLVER_2STAGE
#if !(defined(TEST_KERNEL) ^ defined(TEST_ALL_KERNELS))
error: define either TEST_ALL_KERNELS or a valid TEST_KERNEL
#endif
#endif

78
#ifdef TEST_SINGLE
Pavel Kus's avatar
Pavel Kus committed
79 80
#  define SINGLE_PRECISION 1
#  undef  DOUBLE_PRECISION
81
#else
Pavel Kus's avatar
Pavel Kus committed
82 83
#  define DOUBLE_PRECISION 1
#  undef  SINGLE_PRECISION
84 85
#endif

86
#ifdef TEST_REAL
Pavel Kus's avatar
Pavel Kus committed
87 88 89
#  define REALCASE 1
#  undef  COMPLEXCASE
#  define MATH_DATATYPE real
Pavel Kus's avatar
Pavel Kus committed
90 91 92 93 94 95
#  define KERNEL_KEY "real_kernel"
#  ifdef TEST_SINGLE
#    define BLAS_CHAR S
#  else
#    define BLAS_CHAR D
#  endif
Pavel Kus's avatar
Pavel Kus committed
96 97 98 99
#else
#  define COMPLEXCASE 1
#  undef  REALCASE
#  define MATH_DATATYPE complex
Pavel Kus's avatar
Pavel Kus committed
100 101 102 103 104 105
#  define KERNEL_KEY "complex_kernel"
#  ifdef TEST_SINGLE
#    define BLAS_CHAR C
#  else
#    define BLAS_CHAR Z
#  endif
106 107
#endif

108 109 110 111
#include "assert.h"

program test
   use elpa
112 113 114 115 116 117 118

   use test_util
   use test_setup_mpi
   use test_prepare_matrix
   use test_read_input_parameters
   use test_blacs_infrastructure
   use test_check_correctness
Pavel Kus's avatar
Pavel Kus committed
119
   use test_analytic
120
#ifdef WITH_SCALAPACK_TESTS
Pavel Kus's avatar
Pavel Kus committed
121
   use test_scalapack
122
#endif
123

124 125 126
#ifdef HAVE_REDIRECT
   use test_redirect
#endif
127 128
   implicit none

Pavel Kus's avatar
Pavel Kus committed
129 130 131 132 133
#include "../../src/general/precision_kinds.F90"

#define EV_TYPE real(kind=rk)
#define MATRIX_TYPE MATH_DATATYPE(kind=rck)

134
   ! matrix dimensions
135
   integer                     :: na, nev, nblk
136 137

   ! mpi
138 139 140 141 142
   integer                     :: myid, nprocs
   integer                     :: na_cols, na_rows  ! local matrix size
   integer                     :: np_cols, np_rows  ! number of MPI processes per column/row
   integer                     :: my_prow, my_pcol  ! local MPI task position (my_prow, my_pcol) in the grid (0..np_cols -1, 0..np_rows -1)
   integer                     :: mpierr
143 144

   ! blacs
145
   integer                     :: my_blacs_ctxt, sc_desc(9), info, nprow, npcol
146 147

   ! The Matrix
148
   MATRIX_TYPE, allocatable    :: a(:,:), as(:,:)
149
#if defined(TEST_HERMITIAN_MULTIPLY)
150
   MATRIX_TYPE, allocatable    :: b(:,:), c(:,:)
Pavel Kus's avatar
Pavel Kus committed
151 152 153
#endif
#if defined(TEST_GENERALIZED_EIGENPROBLEM)
   MATRIX_TYPE, allocatable    :: b(:,:), bs(:,:)
154
#endif
155
   ! eigenvectors
156
   MATRIX_TYPE, allocatable    :: z(:,:)
157
   ! eigenvalues
158
   EV_TYPE, allocatable        :: ev(:), ev_analytic(:)
159

160 161
   logical                     :: check_all_evals

162 163
   EV_TYPE, allocatable        :: d(:), sd(:), ds(:), sds(:)
   EV_TYPE                     :: diagonalELement, subdiagonalElement
164

165
   integer                     :: error, status
166

167 168
   type(output_t)              :: write_to_file
   class(elpa_t), pointer      :: e
169
#ifdef TEST_ALL_KERNELS
170
   integer                     :: i
171 172 173
#endif
#ifdef TEST_ALL_LAYOUTS
   character(len=1), parameter :: layouts(2) = [ 'C', 'R' ]
174 175 176 177 178 179 180 181
   integer                     :: i_layout
#endif
   integer                     :: kernel
   character(len=1)            :: layout
#ifdef TEST_COMPLEX
   EV_TYPE                     :: norm, normmax
   MATRIX_TYPE, allocatable    :: tmp1(:,:), tmp2(:,:)
#endif
182
   call read_input_parameters_traditional(na, nev, nblk, write_to_file)
183
   call setup_mpi(myid, nprocs)
184 185 186 187
#ifdef HAVE_REDIRECT
#ifdef WITH_MPI
     call MPI_BARRIER(MPI_COMM_WORLD, mpierr)
     call redirect_stdout(myid)
188
#endif
189
#endif
190

191
   check_all_evals = .true.
192

193 194 195 196 197
   if (elpa_init(CURRENT_API_VERSION) /= ELPA_OK) then
     print *, "ELPA API version not supported"
     stop 1
   endif

198 199 200 201 202
   if (myid == 0) then
     print '((a,i0))', 'Program ' // TEST_CASE
     print *, ""
   endif

203
#ifdef TEST_ALL_LAYOUTS
204
   do i_layout = 1, size(layouts)               ! layouts
205
     layout = layouts(i_layout)
206
     do np_cols = 1, nprocs                     ! factors
207 208 209 210 211
       if (mod(nprocs,np_cols) /= 0 ) then
         cycle
       endif
#else
   layout = 'C'
212 213 214
   do np_cols = NINT(SQRT(REAL(nprocs))),2,-1
      if(mod(nprocs,np_cols) == 0 ) exit
   enddo
215
#endif
216 217

   np_rows = nprocs/np_cols
218
   assert(nprocs == np_rows * np_cols)
219

220 221 222 223
   if (myid == 0) then
     print '((a,i0))', 'Matrix size: ', na
     print '((a,i0))', 'Num eigenvectors: ', nev
     print '((a,i0))', 'Blocksize: ', nblk
224
#ifdef WITH_MPI
225 226
     print '((a,i0))', 'Num MPI proc: ', nprocs
     print '(3(a,i0))','Number of processor rows=',np_rows,', cols=',np_cols,', total=',nprocs
227
     print '(a)',      'Process layout: ' // layout
228
#endif
229 230 231
     print *,''
   endif

232 233 234 235 236 237 238
#ifdef TEST_QR_DECOMPOSITION

#if TEST_GPU == 1
#ifdef WITH_MPI
     call mpi_finalize(mpierr)
#endif
     stop 77
239
#endif /* TEST_GPU */
240 241 242 243 244 245 246 247 248 249 250 251 252
   if (nblk .lt. 64) then
     if (myid .eq. 0) then
       print *,"At the moment QR decomposition need blocksize of at least 64"
     endif
     if ((na .lt. 64) .and. (myid .eq. 0)) then
       print *,"This is why the matrix size must also be at least 64 or only 1 MPI task can be used"
     endif

#ifdef WITH_MPI
     call mpi_finalize(mpierr)
#endif
     stop 77
   endif
253
#endif /* TEST_QR_DECOMPOSITION */
254

255 256
   call set_up_blacsgrid(mpi_comm_world, np_rows, np_cols, layout, &
                         my_blacs_ctxt, my_prow, my_pcol)
257 258 259 260

   call set_up_blacs_descriptor(na, nblk, my_prow, my_pcol, np_rows, np_cols, &
                                na_rows, na_cols, sc_desc, my_blacs_ctxt, info)

261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283
   e => elpa_allocate()

   call e%set("na", na, error)
   assert_elpa_ok(error)
   call e%set("nev", nev, error)
   assert_elpa_ok(error)
   call e%set("local_nrows", na_rows, error)
   assert_elpa_ok(error)
   call e%set("local_ncols", na_cols, error)
   assert_elpa_ok(error)
   call e%set("nblk", nblk, error)
   assert_elpa_ok(error)

#ifdef WITH_MPI
   call e%set("mpi_comm_parent", MPI_COMM_WORLD, error)
   assert_elpa_ok(error)
   call e%set("process_row", my_prow, error)
   assert_elpa_ok(error)
   call e%set("process_col", my_pcol, error)
   assert_elpa_ok(error)
#endif

   call e%set("timings",1)
Pavel Kus's avatar
Pavel Kus committed
284
   call e%set("debug", 1)
285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305

   assert_elpa_ok(e%setup())

#ifdef TEST_SOLVER_1STAGE
   call e%set("solver", ELPA_SOLVER_1STAGE)
#else
   call e%set("solver", ELPA_SOLVER_2STAGE)
#endif
   assert_elpa_ok(error)

   call e%set("gpu", TEST_GPU, error)
   assert_elpa_ok(error)

#ifdef TEST_QR_DECOMPOSITION
   call e%set("qr", 1, error)
   assert_elpa_ok(error)
#endif

   if (myid == 0) print *, ""

   ! allocate matrices
Pavel Kus's avatar
Pavel Kus committed
306 307
   allocate(a (na_rows,na_cols))
   allocate(as(na_rows,na_cols))
308 309 310
   allocate(z (na_rows,na_cols))
   allocate(ev(na))

311 312 313 314 315
#ifdef TEST_HERMITIAN_MULTIPLY
   allocate(b (na_rows,na_cols))
   allocate(c (na_rows,na_cols))
#endif

Pavel Kus's avatar
Pavel Kus committed
316 317 318 319 320 321 322 323
#ifdef TEST_GENERALIZED_EIGENPROBLEM
   allocate(b (na_rows,na_cols))
   allocate(bs (na_rows,na_cols))
   ! todo: only temporarily, before we start using random SPD matrix for B
   allocate(d (na), ds(na))
   allocate(sd (na), sds(na))
#endif

324
#if defined(TEST_EIGENVALUES) || defined(TEST_SOLVE_TRIDIAGONAL) || defined(TEST_EIGENVECTORS) || defined(TEST_QR_DECOMPOSITION) || defined(TEST_CHOLESKY)
325 326 327 328 329
   allocate(d (na), ds(na))
   allocate(sd (na), sds(na))
   allocate(ev_analytic(na))
#endif

330
   ! prepare matrices
Pavel Kus's avatar
Pavel Kus committed
331
   call e%timer_start("prepare_matrices")
332 333 334 335
   a(:,:) = 0.0
   z(:,:) = 0.0
   ev(:) = 0.0

Pavel Kus's avatar
Pavel Kus committed
336
#if defined(TEST_EIGENVECTORS) || defined(TEST_HERMITIAN_MULTIPLY) || defined(TEST_QR_DECOMPOSITION) || defined(TEST_GENERALIZED_EIGENPROBLEM)
Pavel Kus's avatar
Pavel Kus committed
337 338
#ifdef TEST_MATRIX_ANALYTIC
   call prepare_matrix_analytic(na, a, nblk, myid, np_rows, np_cols, my_prow, my_pcol)
339
   as(:,:) = a
Pavel Kus's avatar
Pavel Kus committed
340
#else  /* TEST_MATRIX_ANALYTIC */
341
   if (nev .ge. 1) then
342
     call prepare_matrix_random(na, myid, sc_desc, a, z, as)
Pavel Kus's avatar
Pavel Kus committed
343 344 345 346
#if defined(TEST_GENERALIZED_EIGENPROBLEM)
     !call prepare_matrix_random(na, myid, sc_desc, b, z, bs)
     ! TODO create random SPD matrix
     !diagonalElement = (2.546_rk, 0.0_rk)
347 348
     diagonalElement = 2.546_rk * ONE
     subdiagonalElement = ZERO
Pavel Kus's avatar
Pavel Kus committed
349 350 351 352
     call prepare_matrix_toeplitz(na, diagonalElement, subdiagonalElement, &
                                  d, sd, ds, sds, b, bs, nblk, np_rows, &
                                  np_cols, my_prow, my_pcol)
#endif
353 354
   else
     ! zero eigenvectors and not analytic test => toeplitz matrix
Pavel Kus's avatar
Pavel Kus committed
355 356
     diagonalElement = 0.45_rk
     subdiagonalElement =  0.78_rk
357
     call prepare_matrix_toeplitz(na, diagonalElement, subdiagonalElement, &
358 359 360
                                  d, sd, ds, sds, a, as, nblk, np_rows, &
                                  np_cols, my_prow, my_pcol)
   endif
361 362

#ifdef TEST_HERMITIAN_MULTIPLY
Pavel Kus's avatar
Pavel Kus committed
363 364
   b(:,:) = 2.0_rk * a(:,:)
   c(:,:) = ONE
365 366
#endif /* TEST_HERMITIAN_MULTIPLY */

Pavel Kus's avatar
Pavel Kus committed
367
#endif /* (not) TEST_MATRIX_ANALYTIC */
368
#endif /* defined(TEST_EIGENVECTORS) || defined(TEST_HERMITIAN_MULTIPLY) || defined(TEST_QR_DECOMPOSITION) */
369

370
#if defined(TEST_EIGENVALUES) || defined(TEST_SOLVE_TRIDIAGONAL)
Pavel Kus's avatar
Pavel Kus committed
371 372
   diagonalElement = 0.45_rk
   subdiagonalElement =  0.78_rk
373
   call prepare_matrix_toeplitz(na, diagonalElement, subdiagonalElement, &
Andreas Marek's avatar
Andreas Marek committed
374 375
                                d, sd, ds, sds, a, as, nblk, np_rows, &
                                np_cols, my_prow, my_pcol)
376
#endif /* EIGENVALUES OR TRIDIAGONAL */
377

378
#if defined(TEST_CHOLESKY)
Pavel Kus's avatar
Pavel Kus committed
379 380
   diagonalElement = 2.0_rk * ONE
   subdiagonalElement = -1.0_rk * ONE
381
   call prepare_matrix_toeplitz(na, diagonalElement, subdiagonalElement, &
382 383 384
                                d, sd, ds, sds, a, as, nblk, np_rows, &
                                np_cols, my_prow, my_pcol)
#endif /* TEST_CHOLESKY */
Pavel Kus's avatar
Pavel Kus committed
385
   call e%timer_stop("prepare_matrices")
386 387
   if (myid == 0) then
     print *, ""
Pavel Kus's avatar
Pavel Kus committed
388
     call e%print_times("prepare_matrices")
389 390
     print *, ""
   endif
391

392
   ! solve the problem
393
#ifdef TEST_ALL_KERNELS
394
   do i = 0, elpa_option_cardinality(KERNEL_KEY)  ! kernels
395
     kernel = elpa_option_enumerate(KERNEL_KEY, i)
396
#endif
397
#ifdef TEST_KERNEL
398
     kernel = TEST_KERNEL
399
#endif
400 401

#ifdef TEST_SOLVER_2STAGE
402
     call e%set(KERNEL_KEY, kernel, error)
403 404 405
#ifdef TEST_KERNEL
     assert_elpa_ok(error)
#else
406 407 408
     if (error /= ELPA_OK) then
       cycle
     endif
409 410 411 412 413 414
     ! actually used kernel might be different if forced via environment variables
     call e%get(KERNEL_KEY, kernel)
#endif
     if (myid == 0) then
       print *, elpa_int_value_to_string(KERNEL_KEY, kernel) // " kernel"
     endif
415 416
#endif

417
#ifdef TEST_ALL_KERNELS
418
     call e%timer_start(elpa_int_value_to_string(KERNEL_KEY, kernel))
419
#endif
420

Pavel Kus's avatar
Pavel Kus committed
421 422 423 424 425 426 427 428 429 430 431 432 433 434 435
!#if defined(TEST_GENERALIZED_EIGENPROBLEM)
!     call e%timer_start("generalized_eigenproblem")
!     call e%timer_start("e%cholesky()")
!     call e%cholesky(b, error)
!     assert_elpa_ok(error)
!     call e%timer_stop("e%cholesky()")
!     call e%timer_start("e%invert_triangular")
!     call e%invert_triangular(b, error)
!     assert_elpa_ok(error)
!     call e%timer_stop("e%invert_triangular")
!#ifdef WITH_MPI
!     
!#endif
!#endif

436
     ! The actual solve step
Pavel Kus's avatar
Pavel Kus committed
437
#if defined(TEST_EIGENVECTORS) || defined(TEST_QR_DECOMPOSITION) || defined(TEST_GENERALIZED_EIGENPROBLEM)
438
     call e%timer_start("e%eigenvectors()")
Pavel Kus's avatar
Pavel Kus committed
439 440
#ifdef TEST_SCALAPACK_ALL
     call solve_scalapack_all(na, a, sc_desc, ev, z)
441 442
#elif TEST_SCALAPACK_PART
     call solve_scalapack_part(na, a, sc_desc, nev, ev, z)
443
     check_all_evals = .false. ! scalapack does not compute all eigenvectors
Pavel Kus's avatar
Pavel Kus committed
444 445
#elif TEST_GENERALIZED_EIGENPROBLEM
     call e%generalized_eigenvectors(a, b, ev, z, sc_desc, error)
Pavel Kus's avatar
Pavel Kus committed
446
#else
447
     call e%eigenvectors(a, ev, z, error)
Pavel Kus's avatar
Pavel Kus committed
448
#endif
449
     call e%timer_stop("e%eigenvectors()")
450
#endif /* TEST_EIGENVECTORS || defined(TEST_QR_DECOMPOSITION) */
451

Pavel Kus's avatar
Pavel Kus committed
452 453 454 455 456
!#if defined(TEST_GENERALIZED_EIGENPROBLEM)
!     ! todo...
!     call e%timer_stop("generalized_eigenproblem")
!#endif

457 458
#ifdef TEST_EIGENVALUES
     call e%timer_start("e%eigenvalues()")
459
     call e%eigenvalues(a, ev, error)
460
     call e%timer_stop("e%eigenvalues()")
461
#endif
462 463 464

#if defined(TEST_SOLVE_TRIDIAGONAL)
     call e%timer_start("e%solve_tridiagonal()")
465
     call e%solve_tridiagonal(d, sd, z, error)
466
     call e%timer_stop("e%solve_tridiagonal()")
467 468 469
     ev(:) = d(:)
#endif

470 471 472 473 474 475
#if defined(TEST_CHOLESKY)
     call e%timer_start("e%cholesky()")
     call e%cholesky(a, error)
     call e%timer_stop("e%cholesky()")
#endif

476 477 478 479 480
#if defined(TEST_HERMITIAN_MULTIPLY)
     call e%timer_start("e%hermitian_multiply()")
     call e%hermitian_multiply('F','F', na, a, b, na_rows, na_cols, c, na_rows, na_cols, error)
     call e%timer_stop("e%hermitian_multiply()")
#endif
Pavel Kus's avatar
Pavel Kus committed
481

482 483
     assert_elpa_ok(error)

484
#ifdef TEST_ALL_KERNELS
485 486 487
     call e%timer_stop(elpa_int_value_to_string(KERNEL_KEY, kernel))
#endif

488
     if (myid .eq. 0) then
489
#ifdef TEST_ALL_KERNELS
490
       call e%print_times(elpa_int_value_to_string(KERNEL_KEY, kernel))
491 492
#else /* TEST_ALL_KERNELS */

Pavel Kus's avatar
Pavel Kus committed
493
#if defined(TEST_EIGENVECTORS) || defined(TEST_QR_DECOMPOSITION) || defined(TEST_GENERALIZED_EIGENPROBLEM)
494
       call e%print_times("e%eigenvectors()")
495
#endif
496
#ifdef TEST_EIGENVALUES
497 498
       call e%print_times("e%eigenvalues()")
#endif
499 500
#ifdef TEST_SOLVE_TRIDIAGONAL
       call e%print_times("e%solve_tridiagonal()")
501
#endif
502 503
#ifdef TEST_CHOLESKY
       call e%print_times("e%cholesky()")
504
#endif
505 506 507
#ifdef TEST_HERMITIAN_MULTIPLY
       call e%print_times("e%hermitian_multiply()")
#endif
508
#endif /* TEST_ALL_KERNELS */
509
     endif
510

511
     ! check the results
Pavel Kus's avatar
Pavel Kus committed
512 513
     call e%timer_start("check_correctness")
#if defined(TEST_EIGENVECTORS) || defined(TEST_QR_DECOMPOSITION) || defined(TEST_GENERALIZED_EIGENPROBLEM)
Pavel Kus's avatar
Pavel Kus committed
514
#ifdef TEST_MATRIX_ANALYTIC
515
     status = check_correctness_analytic(na, nev, ev, z, nblk, myid, np_rows, np_cols, my_prow, my_pcol, check_all_evals)
Pavel Kus's avatar
Pavel Kus committed
516
#else
517 518 519
!#elif defined(TEST_MATRIX_FRANK)
!     status = check_correctness_evp_numeric_residuals(na, nev, as, z, ev, sc_desc, nblk, myid, np_rows,np_cols, my_prow, my_pcol)
!#elif defined(TEST_MATRIX_RANDOM)
520
     if (nev .ge. 1) then
521 522 523 524
#if defined(TEST_GENERALIZED_EIGENPROBLEM)
       status = check_correctness_evp_numeric_residuals(na, nev, as, z, ev, sc_desc, nblk, myid, np_rows,np_cols, my_prow, &
                                                        my_pcol, bs)
#else
525
       status = check_correctness_evp_numeric_residuals(na, nev, as, z, ev, sc_desc, nblk, myid, np_rows,np_cols, my_prow, my_pcol)
526
#endif
527 528 529 530 531
     else
       ! zero eigenvectors and no analytic test => toeplitz
       status = check_correctness_eigenvalues_toeplitz(na, diagonalElement, &
         subdiagonalElement, ev, z, myid)
     endif
532
     call check_status(status, myid)
533 534 535
!#else
!#error "MATRIX TYPE"
!#endif
536
#endif
537
#endif /* defined(TEST_EIGENVECTORS) || defined(TEST_QR_DECOMPOSITION) */
538

539
#if defined(TEST_EIGENVALUES) || defined(TEST_SOLVE_TRIDIAGONAL)
Andreas Marek's avatar
Andreas Marek committed
540 541
     status = check_correctness_eigenvalues_toeplitz(na, diagonalElement, &
         subdiagonalElement, ev, z, myid)
542
     call check_status(status, myid)
543

544
#ifdef TEST_SOLVE_TRIDIAGONAL
545
     ! check eigenvectors
546
     status = check_correctness_evp_numeric_residuals(na, nev, as, z, ev, sc_desc, nblk, myid, np_rows, np_cols, my_prow, my_pcol)
547
     call check_status(status, myid)
548 549
#endif
#endif
550

551 552 553 554 555
#if defined(TEST_CHOLESKY)
     status = check_correctness_cholesky(na, a, as, na_rows, sc_desc, myid )
     call check_status(status, myid)
#endif

556 557 558 559
#if defined(TEST_HERMITIAN_MULTIPLY)
     status = check_correctness_hermitian_multiply(na, a, b, c, na_rows, sc_desc, myid )
     call check_status(status, myid)
#endif
Pavel Kus's avatar
Pavel Kus committed
560
     call e%timer_stop("check_correctness")
561

562 563 564 565
     if (myid == 0) then
       print *, ""
     endif

566 567
#ifdef TEST_ALL_KERNELS
     a(:,:) = as(:,:)
568 569 570
#if defined(TEST_GENERALIZED_EIGENPROBLEM)
     b(:,:) = bs(:,:)
#endif
571
#if defined(TEST_EIGENVALUES) || defined(TEST_SOLVE_TRIDIAGONAL) || defined(TEST_EIGENVECTORS) || defined(TEST_QR_DECOMPOSITION) || defined(TEST_CHOLESKY)
572 573 574
     d = ds
     sd = sds
#endif
575
   end do ! kernels
576
#endif
Andreas Marek's avatar
Andreas Marek committed
577

578 579
     if (myid == 0) then
       print *, ""
Pavel Kus's avatar
Pavel Kus committed
580
       call e%print_times("check_correctness")
581 582 583
       print *, ""
     endif

584 585 586 587 588 589 590
   call elpa_deallocate(e)

   deallocate(a)
   deallocate(as)
   deallocate(z)
   deallocate(ev)

591 592 593 594 595
#ifdef TEST_HERMITIAN_MULTIPLY
   deallocate(b)
   deallocate(c)
#endif

596
#if defined(TEST_EIGENVALUES) || defined(TEST_SOLVE_TRIDIAGONAL) || defined(TEST_EIGENVECTORS) || defined(TEST_QR_DECOMPOSITION) || defined(TEST_CHOLESKY)
597 598 599 600 601
   deallocate(d, ds)
   deallocate(sd, sds)
   deallocate(ev_analytic)
#endif

Pavel Kus's avatar
Pavel Kus committed
602 603 604 605 606 607 608 609
#ifdef TEST_GENERALIZED_EIGENPROBLEM
   deallocate(b)
   deallocate(bs)
   ! todo: only temporarily, before we start using random SPD matrix for B
   deallocate(d, ds)
   deallocate(sd, sds)
#endif

610 611 612 613 614 615 616
#ifdef TEST_ALL_LAYOUTS
   end do ! factors
   end do ! layouts
#endif

   call elpa_uninit()

617 618 619 620 621 622 623
#ifdef WITH_MPI
   call blacs_gridexit(my_blacs_ctxt)
   call mpi_finalize(mpierr)
#endif

   call exit(status)

624 625 626 627 628 629 630 631 632 633 634 635 636 637 638
   contains

     subroutine check_status(status, myid)
       implicit none
       integer, intent(in) :: status, myid
       integer :: mpierr
       if (status /= 0) then
         if (myid == 0) print *, "Result incorrect!"
#ifdef WITH_MPI
         call mpi_finalize(mpierr)
#endif
         call exit(status)
       endif
     end subroutine

639
end program