Skip to content

Commit 62907bb

Browse files
RMeliRMeli
authored
Add LAPACK checks (#47)
1 parent bb2d78d commit 62907bb

8 files changed

Lines changed: 154 additions & 84 deletions

File tree

‎test/helpers/pxheevd.fypp‎

Lines changed: 46 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -70,7 +70,7 @@ contains
7070
${type}$ (kind=${dtype}$), dimension(:, :), allocatable :: Z_local_dlaf_partial_spectrum
7171
${type}$ (kind=${dtype}$), dimension(:, :), allocatable :: Z_dlaf, Z_scalapack
7272
${type}$ (kind=${dtype}$), dimension(:, :), allocatable :: Z_dlaf_partial_spectrum
73-
real(kind=${dtype}$), dimension(:), allocatable :: W_dlaf, W_scalapack, W_dlaf_partial_spectrum
73+
real(kind=${dtype}$), dimension(:), allocatable :: W_dlaf, W_scalapack, W_dlaf_partial_spectrum, W_lapack
7474
real(kind=${dtype}$), parameter :: abstol = #{if dtype == 'sp'}# 1e-5_${dtype}$ #{else}# 1e-8_${dtype}$ #{endif}#
7575

7676
integer, parameter :: lwork = 100, liwork = 100
@@ -102,6 +102,7 @@ contains
102102
call init_desc(descz_dlaf_partial_spectrum)
103103
if (rank == 0) then
104104
allocate (A(n, n))
105+
allocate (W_lapack(n))
105106
allocate (Z_dlaf(n, n))
106107
allocate (Z_scalapack(n, n))
107108
allocate (Z_dlaf_partial_spectrum(n, n))
@@ -195,6 +196,30 @@ contains
195196

196197
call p${symbol}$gemr2d(n, n, Z_local_scalapack, 1, 1, descz_local_scalapack, Z_scalapack, 1, 1, descz_scalapack, ictxt)
197198

199+
! + ------ +
200+
! | LAPACK |
201+
! + ------ +
202+
203+
if (rank == 0) then
204+
#:if type == 'real'
205+
call ${name}$evd( &
206+
'V', uplo, &
207+
n, A, n, W_lapack, &
208+
work, lwork, iwork, liwork, info &
209+
)
210+
#:else
211+
call ${name}$evd( &
212+
'V', uplo, &
213+
n, A, n, W_lapack, &
214+
work, lwork, rwork, lrwork, iwork, liwork, info &
215+
)
216+
#:endif
217+
if (info /= 0) then
218+
write (error_unit, *) 'ERROR: ${name}$evd returned info = ', info
219+
call terminate(ictxt)
220+
end if
221+
end if
222+
198223
! + ------------- +
199224
! | Check Results |
200225
! + ------------- +
@@ -211,6 +236,15 @@ contains
211236
failed = .true.
212237
write (error_unit, *) "ERROR: DLAF_PS != ScaLAPACK (eigenvalues)"
213238
end if
239+
240+
if (.not. allclose(W_dlaf, W_lapack)) then
241+
failed = .true.
242+
write (error_unit, *) "ERROR: DLAF != LAPACK (eigenvalues)"
243+
end if
244+
if (.not. allclose(W_scalapack, W_lapack)) then
245+
failed = .true.
246+
write (error_unit, *) "ERROR: ScaLAPACK != LAPACK (eigenvalues)"
247+
end if
214248
end if
215249

216250
call bcast_check(failed)
@@ -225,6 +259,16 @@ contains
225259
write (error_unit, *) "ERROR: DLAF != ScaLAPACK (eigenvectors)"
226260
end if
227261

262+
if (.not. allclose(abs(Z_dlaf), abs(A), atol=abstol)) then
263+
failed = .true.
264+
write (error_unit, *) "ERROR: DLAF != LAPACK (eigenvectors)"
265+
end if
266+
267+
if (.not. allclose(abs(Z_scalapack), abs(A), atol=abstol)) then
268+
failed = .true.
269+
write (error_unit, *) "ERROR: ScaLAPACK != LAPACK (eigenvectors)"
270+
end if
271+
228272
! The first "eval_idx_end" eigenvectors are the same as ScaLAPACK
229273
if ( &
230274
.not. allclose( &
@@ -257,6 +301,7 @@ contains
257301

258302
if (rank == 0) then
259303
if (allocated(A)) deallocate (A)
304+
if (allocated(W_lapack)) deallocate(W_lapack)
260305
if (allocated(Z_dlaf)) deallocate (Z_dlaf)
261306
if (allocated(Z_scalapack)) deallocate (Z_scalapack)
262307
end if

‎test/helpers/pxhegvd.fypp‎

Lines changed: 81 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ module pxhegvd_tests
3636
external blacs_gridexit
3737
external blacs_exit
3838
integer, external :: numroc
39-
real(kind=sp), external :: pslamch
39+
real(kind=dp), external :: dlamch
4040
real(kind=dp), external :: pdlamch
4141

4242
#:for dtype in precision
@@ -78,9 +78,9 @@ contains
7878
${type}$ (kind=${dtype}$), dimension(:, :), allocatable :: B, B_local_dlaf, B_local_scalapack, B_local_store
7979
${type}$ (kind=${dtype}$), dimension(:, :), allocatable :: Z_local_dlaf, Z_local_scalapack, Z_local_dlaf_factorized
8080
${type}$ (kind=${dtype}$), dimension(:, :), allocatable :: Z_local_dlaf_partial_spectrum, Z_local_dlaf_partial_spectrum_factorized
81-
${type}$ (kind=${dtype}$), dimension(:, :), allocatable :: Z_dlaf, Z_scalapack, Z_dlaf_factorized
81+
${type}$ (kind=${dtype}$), dimension(:, :), allocatable :: Z_dlaf, Z_scalapack, Z_dlaf_factorized, Z_lapack
8282
${type}$ (kind=${dtype}$), dimension(:, :), allocatable :: Z_dlaf_partial_spectrum, Z_dlaf_partial_spectrum_factorized
83-
real(kind=${dtype}$), dimension(:), allocatable :: W_dlaf, W_scalapack, W_dlaf_factorized
83+
real(kind=${dtype}$), dimension(:), allocatable :: W_dlaf, W_scalapack, W_dlaf_factorized, W_lapack
8484
real(kind=${dtype}$), dimension(:), allocatable :: W_dlaf_partial_spectrum, W_dlaf_partial_spectrum_factorized
8585
real(kind=${dtype}$), parameter :: abstol = #{if dtype == 'sp'}# 1e-5_${dtype}$ #{else}# 1e-8_${dtype}$ #{endif}#
8686

@@ -117,8 +117,10 @@ contains
117117
if (rank == 0) then
118118
allocate (A(n, n))
119119
allocate (B(n, n))
120+
allocate (W_lapack(n))
120121
allocate (Z_dlaf(n, n))
121122
allocate (Z_scalapack(n, n))
123+
allocate (Z_lapack(n, n))
122124
allocate (Z_dlaf_factorized(n, n))
123125
allocate (Z_dlaf_partial_spectrum(n, n))
124126
allocate (Z_dlaf_partial_spectrum_factorized(n, n))
@@ -207,7 +209,7 @@ contains
207209
call dlaf_free_grid(ictxt)
208210
call dlaf_finalize()
209211
if (info /= 0) then
210-
write (error_unit, *) 'ERROR: dlaf_p${name}$evd returned info = ', info
212+
write (error_unit, *) 'ERROR: dlaf_p${name}$gvd returned info = ', info
211213
call terminate(ictxt)
212214
end if
213215

@@ -247,12 +249,40 @@ contains
247249
)
248250
#:endif
249251
if (info /= 0) then
250-
write (error_unit, *) 'ERROR: p${name}$evd returned info = ', info
252+
write (error_unit, *) 'ERROR: p${name}$gvx returned info = ', info
251253
call terminate(ictxt)
252254
end if
253255

254256
call p${symbol}$gemr2d(n, n, Z_local_scalapack, 1, 1, descz_local_scalapack, Z_scalapack, 1, 1, descz_scalapack, ictxt)
255257

258+
! + --------- +
259+
! | ScaLAPACK |
260+
! + --------- +
261+
262+
if (rank == 0) then
263+
#:if type == 'real'
264+
call ${name}$gvx( &
265+
1, 'V', 'A', uplo, &
266+
n, A, n, B, n, &
267+
0.0_${dtype}$, 0.0_${dtype}$, 0, 0, 2 * dlamch('S'), neig, &
268+
W_lapack, Z_lapack, n, &
269+
work, lwork, iwork, ifail, info &
270+
)
271+
#:else
272+
call ${name}$gvx( &
273+
1, 'V', 'A', uplo, &
274+
n, A, n, B, n, &
275+
0.0_${dtype}$, 0.0_${dtype}$, 0, 0, 2 * dlamch('S'), neig, &
276+
W_lapack, Z_lapack, n, &
277+
work, lwork, rwork, iwork, ifail, info &
278+
)
279+
#:endif
280+
if (info /= 0) then
281+
write (error_unit, *) 'ERROR: ${name}$gvx returned info = ', info
282+
call terminate(ictxt)
283+
end if
284+
end if
285+
256286
! + ------------- +
257287
! | Check Results |
258288
! + ------------- +
@@ -264,21 +294,46 @@ contains
264294
failed = .true.
265295
write (error_unit, *) "ERROR: DLAF != ScaLAPACK (eigenvalues)"
266296
end if
267-
297+
268298
if (.not. allclose(W_dlaf_factorized, W_scalapack)) then
269299
failed = .true.
270300
write (error_unit, *) "ERROR: DLAF Factorized != ScaLAPACK (eigenvalues)"
271301
end if
272-
302+
273303
if (.not. allclose(W_dlaf_partial_spectrum, W_scalapack)) then
274304
failed = .true.
275305
write (error_unit, *) "ERROR: DLAF Partial Spectrum != ScaLAPACK (eigenvalues)"
276306
end if
277-
307+
278308
if (.not. allclose(W_dlaf_partial_spectrum_factorized, W_scalapack)) then
279309
failed = .true.
280310
write (error_unit, *) "ERROR: DLAF Partial Spectrum Factorized != ScaLAPACK (eigenvalues)"
281311
end if
312+
313+
if (.not. allclose(W_dlaf, W_lapack)) then
314+
failed = .true.
315+
write (error_unit, *) "ERROR: DLAF != LAPACK (eigenvalues)"
316+
end if
317+
318+
if (.not. allclose(W_dlaf_factorized, W_lapack)) then
319+
failed = .true.
320+
write (error_unit, *) "ERROR: DLAF Factorized != LAPACK (eigenvalues)"
321+
end if
322+
323+
if (.not. allclose(W_dlaf_partial_spectrum, W_lapack)) then
324+
failed = .true.
325+
write (error_unit, *) "ERROR: DLAF Partial Spectrum != LAPACK (eigenvalues)"
326+
end if
327+
328+
if (.not. allclose(W_dlaf_partial_spectrum_factorized, W_lapack)) then
329+
failed = .true.
330+
write (error_unit, *) "ERROR: DLAF Partial Spectrum Factorized != LAPACK (eigenvalues)"
331+
end if
332+
333+
if (.not. allclose(W_scalapack, W_lapack)) then
334+
failed = .true.
335+
write (error_unit, *) "ERROR: ScaLAPACK != LAPACK (eigenvalues)"
336+
end if
282337
end if
283338

284339
call bcast_check(failed)
@@ -313,7 +368,7 @@ contains
313368
abs(Z_dlaf(:,eval_idx_end+1:n))) &
314369
) then
315370
failed = .true.
316-
write (error_unit, *) "ERROR: DLAF Partial Spectrum != DLAF (eigenvectors [end+1, N])"
371+
write (error_unit, *) "ERROR: DLAF Partial Spectrum == DLAF (eigenvectors [end+1, N])"
317372
end if
318373

319374
if ( &
@@ -331,8 +386,19 @@ contains
331386
abs(Z_dlaf(:,eval_idx_end+1:n))) &
332387
) then
333388
failed = .true.
334-
write (error_unit, *) "ERROR: DLAF Partial Spectrum Factorized != DLAF (eigenvectors [end+1, N])"
389+
write (error_unit, *) "ERROR: DLAF Partial Spectrum Factorized == DLAF (eigenvectors [end+1, N])"
390+
end if
391+
392+
if (.not. allclose(abs(Z_dlaf), abs(Z_lapack), atol=abstol)) then
393+
failed = .true.
394+
write (error_unit, *) "ERROR: DLAF != LAPACK (eigenvectors)"
335395
end if
396+
397+
if (.not. allclose(abs(Z_scalapack), abs(Z_lapack), atol=abstol)) then
398+
failed = .true.
399+
write (error_unit, *) "ERROR: ScaLAPACK != LAPACK (eigenvectors)"
400+
end if
401+
336402
end if
337403

338404
call bcast_check(failed)
@@ -345,8 +411,13 @@ contains
345411
if (rank == 0) then
346412
if (allocated(A)) deallocate (A)
347413
if (allocated(B)) deallocate (B)
414+
if (allocated(W_lapack)) deallocate(W_lapack)
348415
if (allocated(Z_dlaf)) deallocate (Z_dlaf)
416+
if (allocated(Z_lapack)) deallocate (Z_lapack)
349417
if (allocated(Z_scalapack)) deallocate (Z_scalapack)
418+
if (allocated(Z_dlaf_factorized)) deallocate(Z_dlaf_factorized)
419+
if (allocated(Z_dlaf_partial_spectrum)) deallocate(Z_dlaf_partial_spectrum)
420+
if (allocated(Z_dlaf_partial_spectrum_factorized)) deallocate(Z_dlaf_partial_spectrum_factorized)
350421
end if
351422
if (allocated(A_local_dlaf)) deallocate (A_local_dlaf)
352423
if (allocated(A_local_scalapack)) deallocate (A_local_scalapack)

‎test/helpers/pxpotrf.fypp‎

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -146,6 +146,23 @@ contains
146146
failed = .true.
147147
write (error_unit, *) "ERROR: DLAF != ScaLAPACK (uplo='${uplo}$')"
148148
end if
149+
150+
! Check against LAPACK
151+
152+
call ${name}$potrf(uplo, n, A, n, info)
153+
if (info /= 0) then
154+
write (error_unit, *) 'ERROR: ${name}$potrf returned info = ', info
155+
end if
156+
157+
if (.not. allclose(R_dlaf, A, uplo=uplo)) then
158+
failed = .true.
159+
write (error_unit, *) "ERROR: DLAF != LAPACK (uplo='${uplo}$')"
160+
end if
161+
if (.not. allclose(R_scalapack, A, uplo=uplo)) then
162+
failed = .true.
163+
write (error_unit, *) "ERROR: ScaLAPACK != LAPACK (uplo='${uplo}$')"
164+
end if
165+
149166
end if
150167

151168
call bcast_check(failed)

‎test/helpers/pxpotri.fypp‎

Lines changed: 10 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -158,9 +158,18 @@ contains
158158
write (error_unit, *) "ERROR: DLAF != ScaLAPACK"
159159
end if
160160

161-
! Check against LAPACK too
161+
! Check against LAPACK
162+
162163
call ${name}$potrf(uplo, n, A, n, info)
164+
if (info /= 0) then
165+
write (error_unit, *) 'ERROR: ${name}$potrf returned info = ', info
166+
end if
167+
163168
call ${name}$potri(uplo, n, A, n, info)
169+
if (info /= 0) then
170+
write (error_unit, *) 'ERROR: ${name}$potri returned info = ', info
171+
end if
172+
164173
if (.not. allclose(R_dlaf, A, uplo=uplo)) then
165174
failed = .true.
166175
write (error_unit, *) "ERROR: DLAF != LAPACK"

‎test/pcpotri.f90‎

Lines changed: 0 additions & 18 deletions
This file was deleted.

‎test/pdpotri.f90‎

Lines changed: 0 additions & 18 deletions
This file was deleted.

‎test/pspotri.f90‎

Lines changed: 0 additions & 18 deletions
This file was deleted.

‎test/pzpotri.f90‎

Lines changed: 0 additions & 18 deletions
This file was deleted.

0 commit comments

Comments
 (0)