diff --git a/src/motion/cp_lbfgs_optimizer_gopt.F b/src/motion/cp_lbfgs_optimizer_gopt.F index f48401ee48..92fcd24488 100644 --- a/src/motion/cp_lbfgs_optimizer_gopt.F +++ b/src/motion/cp_lbfgs_optimizer_gopt.F @@ -227,8 +227,17 @@ CONTAINS optimizer%dsave(29), optimizer%work_array(lenwa)) optimizer%x = x0 optimizer%task = 'START' - optimizer%wanted_relative_f_delta = wanted_relative_f_delta - optimizer%wanted_projected_gradient = wanted_projected_gradient + optimizer%i_work_array = 0 + optimizer%isave = 0 + optimizer%lower_bound = 0.0_dp + optimizer%upper_bound = 0.0_dp + optimizer%gradient = 0.0_dp + optimizer%dsave = 0.0_dp + optimizer%work_array = 0.0_dp + IF (PRESENT(wanted_relative_f_delta)) & + optimizer%wanted_relative_f_delta = wanted_relative_f_delta + IF (PRESENT(wanted_projected_gradient)) & + optimizer%wanted_projected_gradient = wanted_projected_gradient optimizer%kind_of_bound = 0 IF (PRESENT(kind_of_bound)) optimizer%kind_of_bound = kind_of_bound IF (PRESENT(lower_bound)) optimizer%lower_bound = lower_bound diff --git a/src/pw/fft/fftw3_lib.F b/src/pw/fft/fftw3_lib.F index 3af6d25d76..b71f789160 100644 --- a/src/pw/fft/fftw3_lib.F +++ b/src/pw/fft/fftw3_lib.F @@ -1123,12 +1123,26 @@ CONTAINS INTEGER :: in_offset, my_id, num_rows, out_offset, & scal_offset TYPE(C_PTR) :: fftw_plan +#if defined(__FFTW3) + COMPLEX(KIND=dp), DIMENSION(:), POINTER :: zin_slice, zout_slice +#endif !------------------------------------------------------------------------------ my_id = 0 num_rows = plan%m +#if defined(__FFTW3) + IF (plan%m <= 1) THEN + stat = 1 + CALL C_F_POINTER(C_LOC(zin(1)), zin_slice, [plan%n*plan%m]) + CALL C_F_POINTER(C_LOC(zout(1)), zout_slice, [plan%n*plan%m]) + CALL dfftw_execute_dft(plan%fftw_plan, zin_slice, zout_slice) + IF (scale /= 1.0_dp) CALL zdscal(plan%n*plan%m, scale, zout, 1) + RETURN + END IF +#endif + !$OMP PARALLEL DEFAULT(NONE), & !$OMP PRIVATE(my_id,num_rows,in_offset,out_offset,scal_offset,fftw_plan), & !$OMP SHARED(zin,zout), & diff --git a/src/skala_torch_api.F b/src/skala_torch_api.F index cec0d867f2..3cff7a36ed 100644 --- a/src/skala_torch_api.F +++ b/src/skala_torch_api.F @@ -9,14 +9,19 @@ !> \brief Small CP2K wrapper around the SKALA TorchScript functional protocol. ! ************************************************************************************************** MODULE skala_torch_api - USE kinds, ONLY: default_string_length,& - dp - USE string_utilities, ONLY: uppercase - USE torch_api, ONLY: & - torch_dict_type, torch_model_forward_mol_tensor, torch_model_load, & - torch_model_read_metadata, torch_model_release, torch_model_type, & - torch_tensor_item_double, torch_tensor_release, torch_tensor_type, & - torch_tensor_weighted_sum +#if defined (__HAS_IEEE_EXCEPTIONS) + USE ieee_exceptions, ONLY: ieee_all, & + ieee_get_halting_mode, & + ieee_set_halting_mode +#endif + USE kinds, ONLY: default_string_length, & + dp + USE string_utilities, ONLY: uppercase + USE torch_api, ONLY: & + torch_dict_type, torch_model_forward_mol_tensor, torch_model_load, & + torch_model_read_metadata, torch_model_release, torch_model_type, & + torch_tensor_item_double, torch_tensor_release, torch_tensor_type, & + torch_tensor_weighted_sum #include "./base/base_uses.f90" IMPLICIT NONE @@ -132,7 +137,16 @@ CONTAINS TYPE(torch_dict_type), INTENT(IN) :: inputs TYPE(torch_tensor_type), INTENT(INOUT) :: exc_density +#if defined (__HAS_IEEE_EXCEPTIONS) + LOGICAL, DIMENSION(5) :: ieee_halt + + CALL ieee_get_halting_mode(IEEE_ALL, ieee_halt) + CALL ieee_set_halting_mode(IEEE_ALL, .FALSE.) +#endif CALL torch_model_forward_mol_tensor(model%torch_model, "get_exc_density", inputs, exc_density) +#if defined (__HAS_IEEE_EXCEPTIONS) + CALL ieee_set_halting_mode(IEEE_ALL, ieee_halt) +#endif END SUBROUTINE skala_torch_model_get_exc_density diff --git a/src/xas_tp_scf.F b/src/xas_tp_scf.F index ba8ee28232..1a08cfd571 100644 --- a/src/xas_tp_scf.F +++ b/src/xas_tp_scf.F @@ -415,7 +415,7 @@ CONTAINS rac(3), rc(3), sto_state_overlap, & uno_eps REAL(KIND=dp), DIMENSION(:), POINTER :: all_evals, eigenvalues, uno_evals - REAL(KIND=dp), DIMENSION(:, :), POINTER :: vecbuffer, vecbuffer2 + REAL(KIND=dp), DIMENSION(:, :), POINTER :: vecbuffer TYPE(atomic_kind_type), POINTER :: atomic_kind TYPE(cell_type), POINTER :: cell TYPE(cp_2d_r_p_type), DIMENSION(:), POINTER :: stogto_overlap @@ -437,7 +437,7 @@ CONTAINS CALL timeset(routineN, handle) NULLIFY (atomic_kind, dft_control, matrix_s, matrix_ks, qs_kind_set, kinetic) - NULLIFY (cell, particle_set, local_preconditioner, vecbuffer, vecbuffer2) + NULLIFY (cell, particle_set, local_preconditioner, vecbuffer) NULLIFY (dft_control, loc_section, mos, mo_coeff, eigenvalues) NULLIFY (centers_wfn, mykind_of_kind, qs_loc_env, localized_wfn_control, stogto_overlap) NULLIFY (all_evals, all_vectors, excvec_coeff, excvec_overlap, uno_evals, para_env, blacs_env) @@ -470,8 +470,6 @@ CONTAINS ALLOCATE (vecbuffer(1, nao)) vecbuffer = 0.0_dp - ALLOCATE (vecbuffer2(1, nao)) - vecbuffer2 = 0.0_dp natom = SIZE(particle_set, 1) ALLOCATE (first_sgf(natom)) CALL get_particle_set(particle_set, qs_kind_set, first_sgf=first_sgf) @@ -503,8 +501,6 @@ CONTAINS my_kind = mykind_of_kind(ikind) my_state = 0 - CALL cp_fm_get_submatrix(mo_coeff, vecbuffer2, 1, my_state, & - nao, 1, transpose=.TRUE.) ! Rotate the wfn to get the eigenstate of the KS hamiltonian ! Only ispin=1 should be needed @@ -546,13 +542,15 @@ CONTAINS my_state = istate END IF END IF - xas_estate = my_state END DO ! istate + IF (my_state == 0) & + CPABORT("Could not identify the core state to be excited") + xas_estate = my_state CALL get_mo_set(mos(my_spin), mo_coeff=mo_coeff) CALL cp_fm_get_submatrix(mo_coeff, vecbuffer, 1, xas_estate, & nao, 1, transpose=.TRUE.) - CALL cp_fm_set_submatrix(excvec_coeff, vecbuffer2, 1, 1, & + CALL cp_fm_set_submatrix(excvec_coeff, vecbuffer, 1, 1, & nao, 1, transpose=.TRUE.) ! END IF @@ -623,7 +621,6 @@ CONTAINS END IF DEALLOCATE (vecbuffer) - DEALLOCATE (vecbuffer2) DEALLOCATE (centers_wfn, first_sgf) CALL timestop(handle) diff --git a/src/xc/xc_gauxc_interface.F b/src/xc/xc_gauxc_interface.F index 58a22335fa..2b05d25358 100644 --- a/src/xc/xc_gauxc_interface.F +++ b/src/xc/xc_gauxc_interface.F @@ -15,6 +15,12 @@ MODULE xc_gauxc_interface USE iso_fortran_env, ONLY: & error_unit +#if defined (__HAS_IEEE_EXCEPTIONS) + USE ieee_exceptions, ONLY: & + ieee_all, & + ieee_get_halting_mode, & + ieee_set_halting_mode +#endif USE iso_c_binding, ONLY: & c_associated, & c_bool, & @@ -243,11 +249,12 @@ CONTAINS #ifdef __GAUXC CHARACTER(kind=c_char), POINTER :: s(:) CHARACTER(len=32) :: stderr_env - INTEGER :: i, iw + INTEGER :: i, ierr, iw LOGICAL :: print_to_stderr INTEGER, PARAMETER :: status_message_length = 4096 iw = cp_logger_get_default_io_unit() + ierr = error_unit CALL GET_ENVIRONMENT_VARIABLE("CP2K_GAUXC_STATUS_STDERR", stderr_env) CALL uppercase(stderr_env) SELECT CASE (TRIM(stderr_env)) @@ -259,35 +266,35 @@ CONTAINS print_to_stderr = .TRUE. END SELECT IF (iw > 0) THEN - WRITE (iw, '(a,1x,i0)') "GauXC returned with status code", status%status%code + WRITE (UNIT=iw, FMT='(a,1x,i0)') "GauXC returned with status code", status%status%code IF (c_associated(status%status%message)) THEN - WRITE (iw, '(a)', ADVANCE='no') "GauXC status message: [" + WRITE (UNIT=iw, FMT='(a)', ADVANCE='no') "GauXC status message: [" CALL c_f_pointer(status%status%message, s, [status_message_length]) DO i = 1, SIZE(s) IF (s(i) == c_null_char) EXIT - WRITE (iw, '(A)', advance='no') s(i) + WRITE (UNIT=iw, FMT='(A)', ADVANCE='no') s(i) END DO - WRITE (iw, '(a)') "]" + WRITE (UNIT=iw, FMT='(a)') "]" ELSE - WRITE (iw, '(a)') "GauXC status message: [null]" + WRITE (UNIT=iw, FMT='(a)') "GauXC status message: [null]" END IF END IF IF (print_to_stderr) THEN - WRITE (error_unit, '(a,1x,i0)') "GauXC returned with status code", status%status%code + WRITE (UNIT=ierr, FMT='(a,1x,i0)') "GauXC returned with status code", status%status%code IF (c_associated(status%status%message)) THEN - WRITE (error_unit, '(a)', ADVANCE='no') "GauXC status message: [" + WRITE (UNIT=ierr, FMT='(a)', ADVANCE='no') "GauXC status message: [" CALL c_f_pointer(status%status%message, s, [status_message_length]) DO i = 1, SIZE(s) IF (s(i) == c_null_char) EXIT - WRITE (error_unit, '(A)', advance='no') s(i) + WRITE (UNIT=ierr, FMT='(A)', ADVANCE='no') s(i) END DO - WRITE (error_unit, '(a)') "]" + WRITE (UNIT=ierr, FMT='(a)') "]" ELSE - WRITE (error_unit, '(a)') "GauXC status message: [null]" + WRITE (UNIT=ierr, FMT='(a)') "GauXC status message: [null]" END IF END IF #else @@ -724,6 +731,9 @@ CONTAINS LOGICAL :: use_onedft #ifdef GAUXC_HAS_ONEDFT REAL(c_double), ALLOCATABLE, DIMENSION(:, :) :: density_zeta_zero +#if defined (__HAS_IEEE_EXCEPTIONS) + LOGICAL, DIMENSION(5) :: ieee_halt +#endif INTEGER :: omp_max_threads_restore #endif @@ -748,6 +758,10 @@ CONTAINS ! OneDFT may change the OpenMP team size for later parallel regions. ! Restore max threads only; omp_get_num_threads() is 1 here. omp_max_threads_restore = omp_get_max_threads() +#if defined (__HAS_IEEE_EXCEPTIONS) + CALL ieee_get_halting_mode(IEEE_ALL, ieee_halt) + CALL ieee_set_halting_mode(IEEE_ALL, .FALSE.) +#endif IF (.NOT. ALLOCATED(res%vxc_zeta)) THEN ALLOCATE (res%vxc_zeta, mold=density_scalar) ELSE @@ -780,6 +794,9 @@ CONTAINS res%vxc_scalar, & res%vxc_zeta) END IF +#if defined (__HAS_IEEE_EXCEPTIONS) + CALL ieee_set_halting_mode(IEEE_ALL, ieee_halt) +#endif CALL omp_set_num_threads(omp_max_threads_restore) GAUXC_RETURN_IF_ERROR(status) RETURN @@ -863,6 +880,9 @@ CONTAINS LOGICAL :: use_onedft #ifdef GAUXC_HAS_ONEDFT REAL(c_double), ALLOCATABLE, DIMENSION(:, :) :: density_zeta_zero +#if defined (__HAS_IEEE_EXCEPTIONS) + LOGICAL, DIMENSION(5) :: ieee_halt +#endif INTEGER :: omp_max_threads_restore #endif @@ -883,6 +903,10 @@ CONTAINS ! OneDFT may change the OpenMP team size for later parallel regions. ! Restore max threads only; omp_get_num_threads() is 1 here. omp_max_threads_restore = omp_get_max_threads() +#if defined (__HAS_IEEE_EXCEPTIONS) + CALL ieee_get_halting_mode(IEEE_ALL, ieee_halt) + CALL ieee_set_halting_mode(IEEE_ALL, .FALSE.) +#endif IF (nspins == 1) THEN ALLOCATE (density_zeta_zero, mold=density_scalar) density_zeta_zero = 0._dp @@ -904,6 +928,9 @@ CONTAINS TRIM(model), & res%exc_grad) END IF +#if defined (__HAS_IEEE_EXCEPTIONS) + CALL ieee_set_halting_mode(IEEE_ALL, ieee_halt) +#endif CALL omp_set_num_threads(omp_max_threads_restore) GAUXC_RETURN_IF_ERROR(status) RETURN diff --git a/tests/QS/regtest-gauxc/H2_SKALA_CDFT_CI.inp b/tests/QS/regtest-gauxc/H2_SKALA_CDFT_CI.inp index bdec86a32f..02718735ee 100644 --- a/tests/QS/regtest-gauxc/H2_SKALA_CDFT_CI.inp +++ b/tests/QS/regtest-gauxc/H2_SKALA_CDFT_CI.inp @@ -45,10 +45,9 @@ METHOD Quickstep &DFT BASIS_SET_FILE_NAME GTH_BASIS_SETS - CHARGE 1 - MULTIPLICITY 2 + MULTIPLICITY 1 POTENTIAL_FILE_NAME GTH_POTENTIALS - UKS TRUE + UKS FALSE &MGRID CUTOFF 150 REL_CUTOFF 30 @@ -60,7 +59,7 @@ EPS_DEFAULT 1.0E-8 EXTRAPOLATION USE_PREV_WF &CDFT - STRENGTH -0.110488603068 + STRENGTH -0.058519779875 TARGET 0.2 TYPE_OF_CONSTRAINT BECKE &ATOM_GROUP @@ -109,10 +108,9 @@ METHOD Quickstep &DFT BASIS_SET_FILE_NAME GTH_BASIS_SETS - CHARGE 1 - MULTIPLICITY 2 + MULTIPLICITY 1 POTENTIAL_FILE_NAME GTH_POTENTIALS - UKS TRUE + UKS FALSE &MGRID CUTOFF 150 REL_CUTOFF 30 @@ -124,7 +122,7 @@ EPS_DEFAULT 1.0E-8 EXTRAPOLATION USE_PREV_WF &CDFT - STRENGTH 0.110488603068 + STRENGTH 0.058519779627 TARGET -0.2 TYPE_OF_CONSTRAINT BECKE &ATOM_GROUP diff --git a/tests/QS/regtest-gauxc/TEST_FILES.toml b/tests/QS/regtest-gauxc/TEST_FILES.toml index 2dd98f3736..d4415fd3af 100644 --- a/tests/QS/regtest-gauxc/TEST_FILES.toml +++ b/tests/QS/regtest-gauxc/TEST_FILES.toml @@ -57,7 +57,7 @@ "H2_GAPW_SKALA_ENERGY.inp" = [{matcher="E_total", tol=1e-8, ref=-0.974637831482592}] "H2_SKALA_CDFT.inp" = [{matcher="M071", tol=1e-3, ref=0.216557647288}] "H2_GAPW_SKALA_CDFT.inp" = [{matcher="M071", tol=1e-3, ref=0.217417757774}] -"H2_SKALA_CDFT_CI.inp" = [{matcher="M077", tol=1e-8, ref=-0.703751746408790}] +"H2_SKALA_CDFT_CI.inp" = [{matcher="M077", tol=5e-8, ref=-1.39020335005227}] "H2_PBE_CDFT_REFERENCE.inp" = [{matcher="E_total", tol=1e-9, ref=-1.157232743213941}, {matcher="M071", tol=1e-8, ref=0.197625731046}] "H2_ONEDFT_PBE_CDFT.inp" = [{matcher="E_total", tol=1e-9, ref=-1.157229554329094},