From 9c0f83189bdc840286f10fd30da8c1e2f680fbfa Mon Sep 17 00:00:00 2001 From: Hans Pabst Date: Fri, 24 Oct 2025 15:12:29 +0200 Subject: [PATCH] Disable IEEE exceptions for LAPACK - FP-exceptions for ScaLAPACK are disabled since a long time. - __HAS_IEEE_EXCEPTIONS denotes intrinsic module available. - Harmonized some CFM/FM code format/comments. --- src/fm/cp_cfm_diag.F | 17 +++++++---------- src/fm/cp_cfm_dlaf_api.F | 4 +++- src/fm/cp_fm_diag.F | 33 ++++++++++++++++----------------- src/fm/cp_fm_dlaf_api.F | 17 +++++++++-------- 4 files changed, 35 insertions(+), 36 deletions(-) diff --git a/src/fm/cp_cfm_diag.F b/src/fm/cp_cfm_diag.F index 17ef1e1435..3273e32219 100644 --- a/src/fm/cp_cfm_diag.F +++ b/src/fm/cp_cfm_diag.F @@ -114,9 +114,9 @@ CONTAINS INTEGER, DIMENSION(9) :: descm, descv COMPLEX(KIND=dp), DIMENSION(:, :), & POINTER :: v +#endif #if defined (__HAS_IEEE_EXCEPTIONS) LOGICAL, DIMENSION(5) :: halt -#endif #endif CALL timeset(routineN, handle) @@ -152,29 +152,26 @@ CONTAINS DEALLOCATE (iwork, rwork, work) ALLOCATE (iwork(liwork), rwork(lrwork), work(lwork)) -#if defined(__parallel) -! Scalapack takes advantage of IEEE754 exceptions for speedup. +! (Sca-)LAPACK takes advantage of IEEE754 exceptions for speedup. ! Therefore, we disable floating point traps temporarily. #if defined (__HAS_IEEE_EXCEPTIONS) CALL ieee_get_halting_mode(IEEE_ALL, halt) CALL ieee_set_halting_mode(IEEE_ALL, .FALSE.) #endif - +#if defined(__parallel) CALL pzheevd('V', 'U', n, m(1, 1), 1, 1, descm, eigenvalues(1), v(1, 1), 1, 1, descv, & work(1), lwork, rwork(1), lrwork, iwork(1), liwork, info) - -#if defined (__HAS_IEEE_EXCEPTIONS) - CALL ieee_set_halting_mode(IEEE_ALL, halt) -#endif #else CALL zheevd('V', 'U', n, m(1, 1), SIZE(m, 1), eigenvalues(1), & work(1), lwork, rwork(1), lrwork, iwork(1), liwork, info) eigenvectors%local_data = matrix%local_data #endif +#if defined (__HAS_IEEE_EXCEPTIONS) + CALL ieee_set_halting_mode(IEEE_ALL, halt) +#endif DEALLOCATE (iwork, rwork, work) - IF (info /= 0) & - CPABORT("Diagonalisation of a complex matrix failed") + IF (info /= 0) CPABORT("Diagonalisation of a complex matrix failed") CALL timestop(handle) diff --git a/src/fm/cp_cfm_dlaf_api.F b/src/fm/cp_cfm_dlaf_api.F index 3572fbecb1..a65444c56f 100644 --- a/src/fm/cp_cfm_dlaf_api.F +++ b/src/fm/cp_cfm_dlaf_api.F @@ -108,7 +108,7 @@ CONTAINS CALL timestop(handle) END SUBROUTINE cp_cfm_pzpotri_dlaf - ! ************************************************************************************************** +! ************************************************************************************************** !> \brief DLA-Future eigensolver for complex Hermitian matrices !> \param matrix ... !> \param eigenvectors ... @@ -210,6 +210,7 @@ CONTAINS ! Use eigenvectors matrix as workspace CALL cp_cfm_uplo_to_full(matrix, eigenvectors) + ! Create DLAF grid from BLACS context (if already present, does nothing) blacs_context = matrix%matrix_struct%context%get_handle() CALL cp_dlaf_create_grid(blacs_context) @@ -282,6 +283,7 @@ CONTAINS CALL cp_cfm_uplo_to_full(amatrix, eigenvectors) CALL cp_cfm_uplo_to_full(bmatrix, eigenvectors) + ! Create DLAF grid from BLACS context (if already present, does nothing) blacs_context = amatrix%matrix_struct%context%get_handle() CALL cp_dlaf_create_grid(blacs_context) diff --git a/src/fm/cp_fm_diag.F b/src/fm/cp_fm_diag.F index 557ae44b8e..c1c79da5c3 100644 --- a/src/fm/cp_fm_diag.F +++ b/src/fm/cp_fm_diag.F @@ -86,10 +86,10 @@ MODULE cp_fm_diag ! The following saved variables are diagonalization global ! Stores the default library for diagonalization - INTEGER, SAVE, PUBLIC :: diag_type = 0 + INTEGER, SAVE, PUBLIC :: diag_type = 0 ! Minimum number of eigenvectors for the use of the ELPA eigensolver. ! The ScaLAPACK eigensolver is used as fallback for all smaller cases. - INTEGER, SAVE :: elpa_neigvec_min = 0 + INTEGER, SAVE :: elpa_neigvec_min = 0 #if defined(__DLAF) ! Minimum number of eigenvectors for the use of the DLAF eigensolver. ! The ScaLAPACK eigensolver is used as fallback for all smaller cases. @@ -701,13 +701,13 @@ CONTAINS INTEGER, DIMENSION(:), ALLOCATABLE :: iclustr REAL(KIND=dp), DIMENSION(:), ALLOCATABLE :: gap INTEGER, EXTERNAL :: iceil, numroc -#if defined (__HAS_IEEE_EXCEPTIONS) - LOGICAL, DIMENSION(5) :: halt -#endif #else INTEGER :: nla, nlz INTEGER, EXTERNAL :: ilaenv #endif +#if defined (__HAS_IEEE_EXCEPTIONS) + LOGICAL, DIMENSION(5) :: halt +#endif ! by default all n = matrix%matrix_struct%nrow_global @@ -786,22 +786,19 @@ CONTAINS ALLOCATE (iwork(liwork)) ALLOCATE (work(lwork)) - ! Scalapack takes advantage of IEEE754 exceptions for speedup. + ! ScaLAPACK takes advantage of IEEE754 exceptions for speedup. ! Therefore, we disable floating point traps temporarily. #if defined (__HAS_IEEE_EXCEPTIONS) CALL ieee_get_halting_mode(IEEE_ALL, halt) CALL ieee_set_halting_mode(IEEE_ALL, .FALSE.) #endif - CALL pdsyevx(job_type, "I", "U", n, a(1, 1), 1, 1, desca, vl, vu, 1, neig_local, abstol, m, nz, w(1), orfac, & z(1, 1), 1, 1, descz, work(1), lwork, iwork(1), liwork, ifail(1), iclustr(1), gap, info) - #if defined (__HAS_IEEE_EXCEPTIONS) CALL ieee_set_halting_mode(IEEE_ALL, halt) #endif ! Error handling - IF (info /= 0) THEN IF (ionode) THEN output_unit = cp_logger_get_unit_nr(logger, local=.FALSE.) @@ -823,12 +820,8 @@ CONTAINS END IF ! Release work storage - DEALLOCATE (gap) DEALLOCATE (iclustr) - DEALLOCATE (ifail) - DEALLOCATE (iwork) - DEALLOCATE (work) #else @@ -856,11 +849,19 @@ CONTAINS nla = SIZE(a, 1) nlz = SIZE(z, 1) + ! LAPACK takes advantage of IEEE754 exceptions for speedup. + ! Therefore, we disable floating point traps temporarily. +#if defined (__HAS_IEEE_EXCEPTIONS) + CALL ieee_get_halting_mode(IEEE_ALL, halt) + CALL ieee_set_halting_mode(IEEE_ALL, .FALSE.) +#endif 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) +#if defined (__HAS_IEEE_EXCEPTIONS) + CALL ieee_set_halting_mode(IEEE_ALL, halt) +#endif ! Error handling - IF (info /= 0) THEN output_unit = cp_logger_get_unit_nr(logger, local=.FALSE.) WRITE (unit=output_unit, FMT="(/,(T3,A,T12,1X,I10))") & @@ -872,13 +873,11 @@ CONTAINS CPABORT("Error in DSYEVX (ScaLAPACK)") END IF +#endif ! Release work storage - DEALLOCATE (ifail) DEALLOCATE (iwork) DEALLOCATE (work) - -#endif eigenvalues(1:neig_local) = w(1:neig_local) DEALLOCATE (w) diff --git a/src/fm/cp_fm_dlaf_api.F b/src/fm/cp_fm_dlaf_api.F index 3e936d8e71..9e91492615 100644 --- a/src/fm/cp_fm_dlaf_api.F +++ b/src/fm/cp_fm_dlaf_api.F @@ -101,7 +101,6 @@ CONTAINS INTEGER :: handle CALL timeset(routineN, handle) - #if defined(__DLAF) CALL dlaf_pspotrf(uplo, n, a, ia, ja, desca, info) #else @@ -247,7 +246,7 @@ CONTAINS CHARACTER, PARAMETER :: uplo = 'L' CHARACTER(LEN=100) :: message - INTEGER :: dlaf_handle, handle, n + INTEGER :: blacs_context, dlaf_handle, handle, n INTEGER, DIMENSION(9) :: desca, descz INTEGER, TARGET :: info REAL(KIND=dp), DIMENSION(:, :), POINTER :: a, z @@ -259,8 +258,9 @@ CONTAINS ! Use eigenvectors matrix as workspace CALL cp_fm_uplo_to_full(matrix, eigenvectors) - ! Create DLAF grid from BLACS context; if already present, does nothing - CALL cp_dlaf_create_grid(matrix%matrix_struct%context%get_handle()) + ! Create DLAF grid from BLACS context (if already present, does nothing) + blacs_context = matrix%matrix_struct%context%get_handle() + CALL cp_dlaf_create_grid(blacs_context) n = matrix%matrix_struct%nrow_global @@ -272,9 +272,7 @@ CONTAINS info = -1 CALL timeset(dlaf_name, dlaf_handle) - CALL dlaf_pdsyevd(uplo, n, a, 1, 1, desca, eigenvalues, z, 1, 1, descz, info) - CALL timestop(dlaf_handle) IF (info /= 0) THEN @@ -295,6 +293,7 @@ CONTAINS MARK_USED(dlaf_handle) MARK_USED(dlaf_name) MARK_USED(message) + MARK_USED(blacs_context) CPABORT("CP2K compiled without DLA-Future-Fortran library.") #endif @@ -357,7 +356,7 @@ CONTAINS CHARACTER, PARAMETER :: uplo = 'L' CHARACTER(LEN=100) :: message - INTEGER :: dlaf_handle, handle, n + INTEGER :: blacs_context, dlaf_handle, handle, n INTEGER, DIMENSION(9) :: desca, descb, descz INTEGER, TARGET :: info REAL(KIND=dp), DIMENSION(:, :), POINTER :: a, b, z @@ -371,7 +370,8 @@ CONTAINS CALL cp_fm_uplo_to_full(b_matrix, eigenvectors) ! Create DLAF grid from BLACS context; if already present, does nothing - CALL cp_dlaf_create_grid(a_matrix%matrix_struct%context%get_handle()) + blacs_context = a_matrix%matrix_struct%context%get_handle() + CALL cp_dlaf_create_grid(blacs_context) n = a_matrix%matrix_struct%nrow_global @@ -406,6 +406,7 @@ CONTAINS MARK_USED(uplo) MARK_USED(n) MARK_USED(info) + MARK_USED(blacs_context) MARK_USED(dlaf_handle) MARK_USED(dlaf_name) MARK_USED(message)