Skip to content
Permalink
Browse files

FM library: bug in leading dimension (#408)

* xTB regtests refactored

* Adjust debug settings

* Adjust regtest target value

* FM library: fix leading dimension for structures created by template,
use leading dimension in LAPACK calls correctly.
  • Loading branch information...
juerghutter committed Jun 11, 2019
1 parent 56a682c commit e7ec2900eb0330e65d6c33499f764e4d9f8a35bb
Showing with 18 additions and 8 deletions.
  1. +9 −5 src/fm/cp_fm_diag.F
  2. +9 −3 src/fm/cp_fm_struct.F
@@ -283,7 +283,7 @@ SUBROUTINE cp_fm_syevd(matrix, eigenvectors, eigenvalues, info)
#if defined(__SCALAPACK)
TYPE(cp_fm_type), POINTER :: eigenvectors_new, matrix_new
#else
INTEGER :: liwork, lwork
INTEGER :: liwork, lwork, nl
INTEGER, DIMENSION(:), POINTER :: iwork
REAL(KIND=dp), DIMENSION(:, :), POINTER :: m
REAL(KIND=dp), DIMENSION(:), POINTER :: work
@@ -322,8 +322,9 @@ SUBROUTINE cp_fm_syevd(matrix, eigenvectors, eigenvalues, info)
work(:) = 0.0_dp
ALLOCATE (iwork(1))
iwork(:) = 0
nl = SIZE(m, 1)

CALL dsyevd('V', 'U', n, m(1, 1), n, eig(1), work(1), lwork, iwork(1), liwork, myinfo)
CALL dsyevd('V', 'U', n, m(1, 1), nl, eig(1), work(1), lwork, iwork(1), liwork, myinfo)

IF (myinfo /= 0) THEN
CPABORT("ERROR in DSYEVD: Could not retrieve work array sizes")
@@ -340,7 +341,7 @@ SUBROUTINE cp_fm_syevd(matrix, eigenvectors, eigenvalues, info)
ALLOCATE (iwork(liwork))
iwork(:) = 0

CALL dsyevd('V', 'U', n, m(1, 1), n, eig(1), work(1), lwork, iwork(1), liwork, myinfo)
CALL dsyevd('V', 'U', n, m(1, 1), nl, eig(1), work(1), lwork, iwork(1), liwork, myinfo)

IF (myinfo /= 0) THEN
CPABORT("Matrix diagonalization failed")
@@ -521,6 +522,7 @@ SUBROUTINE cp_fm_syevx(matrix, eigenvectors, eigenvalues, neig, work_syevx)
LOGICAL, DIMENSION(5) :: halt
#endif
#else
INTEGER :: nla, nlz
INTEGER, EXTERNAL :: ilaenv
#endif

@@ -670,9 +672,11 @@ SUBROUTINE cp_fm_syevx(matrix, eigenvectors, eigenvalues, neig, work_syevx)
ALLOCATE (iwork(liwork))
ALLOCATE (work(lwork))
info = 0
nla = SIZE(a, 1)
nlz = SIZE(z, 1)

CALL dsyevx(job_type, "I", "U", n, a(1, 1), n, vl, vu, 1, neig_local, abstol, m, w, z(1, 1), n, work(1), lwork, &
iwork(1), ifail(1), info)
CALL dsyevx(job_type, "I", "U", n, a(1, 1), nla, vl, vu, 1, neig_local, &
abstol, m, w, z(1, 1), nlz, work(1), lwork, iwork(1), ifail(1), info)

! Error handling

@@ -186,8 +186,13 @@ SUBROUTINE cp_fm_struct_create(fmstruct, para_env, context, nrow_global, &
CALL cp_blacs_env_retain(fmstruct%context)
CALL cp_para_env_retain(fmstruct%para_env)

IF (PRESENT(nrow_global)) fmstruct%nrow_global = nrow_global
IF (PRESENT(ncol_global)) fmstruct%ncol_global = ncol_global
IF (PRESENT(nrow_global)) THEN
fmstruct%nrow_global = nrow_global
fmstruct%local_leading_dimension = 1
END IF
IF (PRESENT(ncol_global)) THEN
fmstruct%ncol_global = ncol_global
END IF

! try to avoid small left-over blocks (anyway naive)
IF (PRESENT(nrow_block)) THEN
@@ -237,7 +242,8 @@ SUBROUTINE cp_fm_struct_create(fmstruct, para_env, context, nrow_global, &
fmstruct%nrow_locals(:) = fmstruct%nrow_locals(:)/fmstruct%context%num_pe(2)
fmstruct%ncol_locals(:) = fmstruct%ncol_locals(:)/fmstruct%context%num_pe(1)

IF (SUM(fmstruct%ncol_locals) .NE. fmstruct%ncol_global .OR. SUM(fmstruct%nrow_locals) .NE. fmstruct%nrow_global) THEN
IF (SUM(fmstruct%ncol_locals) .NE. fmstruct%ncol_global .OR. &
SUM(fmstruct%nrow_locals) .NE. fmstruct%nrow_global) THEN
! try to collect some output if this is going to happen again
! this seems to trigger on blanc, but should really never happen
logger => cp_get_default_logger()

0 comments on commit e7ec290

Please sign in to comment.
You can’t perform that action at this time.