From db61e8c41f2acf130db687eade1988b820c0dba8 Mon Sep 17 00:00:00 2001 From: Matthias Krack Date: Thu, 14 Nov 2024 13:23:32 +0100 Subject: [PATCH] Tag printout of the forces - Make bar the default pressure unit like for the MD trajectory file - Update regression test inputs (reference values and search strings) --- src/common/string_utilities.F | 1 + src/energy_corrections.F | 2 +- src/force_env_methods.F | 14 +- src/force_env_utils.F | 62 ++++--- src/input_cp2k_force_eval.F | 2 +- src/motion/gopt_f_methods.F | 168 +++++++++++++----- src/motion/md_energies.F | 4 +- src/motion_utils.F | 7 +- tests/Fist/regtest-7-1/TEST_FILES | 6 +- tests/Fist/regtest-7-2/TEST_FILES | 8 +- tests/Fist/regtest-nequip/TEST_FILES | 2 +- tests/QS/regtest-admm-qps-2/TEST_FILES | 4 +- tests/QS/regtest-dcdft-stress/TEST_FILES | 32 ++-- tests/QS/regtest-dft-vdw-corr-2/TEST_FILES | 2 +- tests/QS/regtest-dft-vdw-corr-4/TEST_FILES | 6 +- .../TEST_FILES | 4 +- .../TEST_FILES | 4 +- .../TEST_FILES | 4 +- .../TEST_FILES | 4 +- .../TEST_FILES | 4 +- .../regtest-double-hybrid-stress/TEST_FILES | 4 +- tests/QS/regtest-ec-meta/TEST_FILES | 8 +- tests/QS/regtest-ec-stress/TEST_FILES | 30 ++-- tests/QS/regtest-ec/TEST_FILES | 12 +- tests/QS/regtest-ecp-2/TEST_FILES | 2 +- tests/QS/regtest-hfx-ri-2/TEST_FILES | 4 +- tests/QS/regtest-hfx-stress/TEST_FILES | 8 +- tests/QS/regtest-kp-hfx-ri-2/TEST_FILES | 4 +- tests/QS/regtest-kp-hfx-ri-admm-2/TEST_FILES | 4 +- tests/QS/regtest-lrigpw/TEST_FILES | 2 +- .../regtest-mp2-admm-stress-numer/TEST_FILES | 4 +- tests/QS/regtest-mp2-admm-stress/TEST_FILES | 8 +- tests/QS/regtest-mp2-lr-stress/TEST_FILES | 8 +- tests/QS/regtest-mp2-stress/TEST_FILES | 10 +- tests/QS/regtest-nonortho/TEST_FILES | 4 +- .../regtest-ri-laplace-mp2-cubic-2/TEST_FILES | 2 +- .../QS/regtest-rpa-cubic-scaling-2/TEST_FILES | 2 +- tests/QS/regtest-stda/TEST_FILES | 2 +- tests/QS/regtest-stress/TEST_FILES | 16 +- tests/SE/regtest-3-3/TEST_FILES | 2 +- tests/TEST_TYPES | 8 +- 41 files changed, 292 insertions(+), 192 deletions(-) diff --git a/src/common/string_utilities.F b/src/common/string_utilities.F index 057a83158e..891d526ac3 100644 --- a/src/common/string_utilities.F +++ b/src/common/string_utilities.F @@ -32,6 +32,7 @@ MODULE string_utilities compress, & integer_to_string, & is_whitespace, & + lowercase, & remove_word, & s2a, a2s, & str_comp, & diff --git a/src/energy_corrections.F b/src/energy_corrections.F index a625ef2feb..a5136f9b62 100644 --- a/src/energy_corrections.F +++ b/src/energy_corrections.F @@ -192,7 +192,7 @@ MODULE energy_corrections PRIVATE -! *** Global parameters *** + ! Global parameters CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'energy_corrections' diff --git a/src/force_env_methods.F b/src/force_env_methods.F index d391989c30..4052e9abc5 100644 --- a/src/force_env_methods.F +++ b/src/force_env_methods.F @@ -378,21 +378,21 @@ RECURSIVE SUBROUTINE force_env_calc_energy_force(force_env, calc_force, & CALL section_vals_val_get(force_env%force_env_section, "PRINT%FORCES%FORCE_UNIT", & c_val=unit_string) IF (ASSOCIATED(core_particles) .OR. ASSOCIATED(shell_particles)) THEN - CALL write_forces(particles, print_forces, "ATOMIC", ndigits, unit_string, total_force, & - zero_force_core_shell_atom=.TRUE.) + CALL write_forces(particles, print_forces, "Atomic", ndigits, unit_string, & + total_force, zero_force_core_shell_atom=.TRUE.) grand_total_force(1:3) = total_force(1:3) IF (ASSOCIATED(core_particles)) THEN - CALL write_forces(core_particles, print_forces, "CORE", ndigits, unit_string, total_force, & - zero_force_core_shell_atom=.FALSE.) + CALL write_forces(core_particles, print_forces, "Core particle", ndigits, & + unit_string, total_force, zero_force_core_shell_atom=.FALSE.) grand_total_force(:) = grand_total_force(:) + total_force(:) END IF IF (ASSOCIATED(shell_particles)) THEN - CALL write_forces(shell_particles, print_forces, "SHELL", ndigits, unit_string, total_force, & - zero_force_core_shell_atom=.FALSE., & + CALL write_forces(shell_particles, print_forces, "Shell particle", ndigits, & + unit_string, total_force, zero_force_core_shell_atom=.FALSE., & grand_total_force=grand_total_force) END IF ELSE - CALL write_forces(particles, print_forces, "ATOMIC", ndigits, unit_string, total_force) + CALL write_forces(particles, print_forces, "Atomic", ndigits, unit_string, total_force) END IF END IF CALL cp_print_key_finished_output(print_forces, logger, force_env%force_env_section, "PRINT%FORCES") diff --git a/src/force_env_utils.F b/src/force_env_utils.F index fa1f1152bd..0e32d24a56 100644 --- a/src/force_env_utils.F +++ b/src/force_env_utils.F @@ -34,6 +34,7 @@ MODULE force_env_utils USE particle_list_types, ONLY: particle_list_type USE particle_types, ONLY: update_particle_set USE physcon, ONLY: angstrom + USE string_utilities, ONLY: lowercase #include "./base/base_uses.f90" IMPLICIT NONE @@ -426,37 +427,49 @@ SUBROUTINE write_forces(particles, iw, label, ndigits, unit_string, total_force, OPTIONAL :: grand_total_force LOGICAL, INTENT(IN), OPTIONAL :: zero_force_core_shell_atom - CHARACTER(LEN=23) :: fmtstr3 - CHARACTER(LEN=36) :: fmtstr2 - CHARACTER(LEN=46) :: fmtstr1 - INTEGER :: i, ikind, iparticle, n + CHARACTER(LEN=18) :: fmtstr4 + CHARACTER(LEN=29) :: fmtstr3 + CHARACTER(LEN=38) :: fmtstr2 + CHARACTER(LEN=49) :: fmtstr1 + CHARACTER(LEN=7) :: tag + CHARACTER(LEN=LEN_TRIM(label)) :: lc_label + INTEGER :: i, iparticle, n LOGICAL :: zero_force - REAL(KIND=dp) :: conv + REAL(KIND=dp) :: fconv REAL(KIND=dp), DIMENSION(3) :: f IF (iw > 0) THEN CPASSERT(ASSOCIATED(particles)) + tag = "FORCES|" + lc_label = TRIM(label) + CALL lowercase(lc_label) n = MIN(MAX(1, ndigits), 20) - fmtstr1 = "(/,T2,A,/,/,T2,A,T11,A,T18,A,T35,A3,3( X,A3))" - WRITE (UNIT=fmtstr1(39:40), FMT="(I2)") n + 4 - fmtstr2 = "(T2,I6,1X,I6,T21,A,T28,4(1X,F . ))" - WRITE (UNIT=fmtstr2(33:34), FMT="(I2)") n - WRITE (UNIT=fmtstr2(30:31), FMT="(I2)") n + 6 - fmtstr3 = "(T2,A,T28,4(1X,F . ))" - WRITE (UNIT=fmtstr3(20:21), FMT="(I2)") n - WRITE (UNIT=fmtstr3(17:18), FMT="(I2)") n + 6 + fmtstr1 = "(/,T2,A,1X,A,/,T2,A,3X,A,T20,A3,2( X,A3), X,A3)" + WRITE (UNIT=fmtstr1(35:36), FMT="(I2)") n + 5 + WRITE (UNIT=fmtstr1(43:44), FMT="(I2)") n + 6 + fmtstr2 = "(T2,A,I7,T16,3(1X,ES . ),2X,ES . )" + WRITE (UNIT=fmtstr2(21:22), FMT="(I2)") n + 7 + WRITE (UNIT=fmtstr2(24:25), FMT="(I2)") n + WRITE (UNIT=fmtstr2(33:34), FMT="(I2)") n + 7 + WRITE (UNIT=fmtstr2(36:37), FMT="(I2)") n + fmtstr3 = "(T2,A,T16,3(1X,ES . ))" + WRITE (UNIT=fmtstr3(18:19), FMT="(I2)") n + 7 + WRITE (UNIT=fmtstr3(21:22), FMT="(I2)") n + fmtstr4 = "(T2,A,T ,ES . )" + WRITE (UNIT=fmtstr4(8:9), FMT="(I2)") 3*(n + 8) + 18 + WRITE (UNIT=fmtstr4(13:14), FMT="(I2)") n + 7 + WRITE (UNIT=fmtstr4(16:17), FMT="(I2)") n IF (PRESENT(zero_force_core_shell_atom)) THEN zero_force = zero_force_core_shell_atom ELSE zero_force = .FALSE. END IF - conv = cp_unit_from_cp2k(1.0_dp, TRIM(unit_string)) + fconv = cp_unit_from_cp2k(1.0_dp, TRIM(unit_string)) WRITE (UNIT=iw, FMT=fmtstr1) & - label//" FORCES in ["//TRIM(ADJUSTL(unit_string))//"]", & - "# Atom", "Kind", "Element", " X ", " Y ", " Z ", "|F|" + tag, label//" forces ["//TRIM(ADJUSTL(unit_string))//"]", & + tag, "Atom", " x ", " y ", " z ", "|f|" total_force(1:3) = 0.0_dp DO iparticle = 1, particles%n_els - ikind = particles%els(iparticle)%atomic_kind%kind_number IF (particles%els(iparticle)%atom_index /= 0) THEN i = particles%els(iparticle)%atom_index ELSE @@ -465,22 +478,25 @@ SUBROUTINE write_forces(particles, iw, label, ndigits, unit_string, total_force, IF (zero_force .AND. (particles%els(iparticle)%shell_index /= 0)) THEN f(1:3) = 0.0_dp ELSE - f(1:3) = particles%els(iparticle)%f(1:3)*conv + f(1:3) = particles%els(iparticle)%f(1:3)*fconv END IF WRITE (UNIT=iw, FMT=fmtstr2) & - i, ikind, particles%els(iparticle)%atomic_kind%element_symbol, f(1:3), & - SQRT(SUM(f(1:3)**2)) + tag, i, f(1:3), SQRT(SUM(f(1:3)**2)) total_force(1:3) = total_force(1:3) + f(1:3) END DO WRITE (UNIT=iw, FMT=fmtstr3) & - "SUM OF "//label//" FORCES", total_force(1:3), SQRT(SUM(total_force(1:3)**2)) + tag//" Sum", total_force(1:3) + WRITE (UNIT=iw, FMT=fmtstr4) & + tag//" Total "//TRIM(ADJUSTL(lc_label))//" force", & + SQRT(SUM(total_force(1:3)**2)) END IF IF (PRESENT(grand_total_force)) THEN grand_total_force(1:3) = grand_total_force(1:3) + total_force(1:3) WRITE (UNIT=iw, FMT="(A)") "" - WRITE (UNIT=iw, FMT=fmtstr3) & - "GRAND TOTAL FORCE", grand_total_force(1:3), SQRT(SUM(grand_total_force(1:3)**2)) + WRITE (UNIT=iw, FMT=fmtstr4) & + tag//" Grand total force ["//TRIM(ADJUSTL(unit_string))//"]", & + SQRT(SUM(grand_total_force(1:3)**2)) END IF END SUBROUTINE write_forces diff --git a/src/input_cp2k_force_eval.F b/src/input_cp2k_force_eval.F index 86f0a3c271..3cfced5428 100644 --- a/src/input_cp2k_force_eval.F +++ b/src/input_cp2k_force_eval.F @@ -395,7 +395,7 @@ SUBROUTINE create_f_env_print_section(section) description="Specifies the physical unit used for the printing of the stress tensor. "// & "Note that the meaningfulness of the unit is not checked.", & usage="STRESS_UNIT kbar", & - default_c_val="GPa", & + default_c_val="bar", & repeats=.FALSE.) CALL section_add_keyword(print_key, keyword) CALL keyword_release(keyword) diff --git a/src/motion/gopt_f_methods.F b/src/motion/gopt_f_methods.F index 9276f25494..7de31172de 100644 --- a/src/motion/gopt_f_methods.F +++ b/src/motion/gopt_f_methods.F @@ -58,7 +58,7 @@ MODULE gopt_f_methods USE md_energies, ONLY: sample_memory USE message_passing, ONLY: mp_para_env_type USE motion_utils, ONLY: write_simulation_cell, & - write_stress_tensor, & + write_stress_tensor_to_file, & write_trajectory USE particle_list_types, ONLY: particle_list_type USE particle_methods, ONLY: write_structure_data @@ -75,7 +75,7 @@ MODULE gopt_f_methods #:include "gopt_f77_methods.fypp" LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE. - CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'gopt_f_methods' + CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = "gopt_f_methods" PUBLIC :: gopt_f_create_x0, & print_geo_opt_header, print_geo_opt_nc, & @@ -185,6 +185,7 @@ END SUBROUTINE gopt_f_ii !> \author Teodoro Laino [tlaino] - University of Zurich - 03.2008 ! ************************************************************************************************** SUBROUTINE gopt_f_io_init(gopt_env, output_unit, opt_energy, wildcard, its, used_time) + TYPE(gopt_f_type), POINTER :: gopt_env INTEGER, INTENT(IN) :: output_unit REAL(KIND=dp) :: opt_energy @@ -193,6 +194,7 @@ SUBROUTINE gopt_f_io_init(gopt_env, output_unit, opt_energy, wildcard, its, used REAL(KIND=dp) :: used_time TYPE(mp_para_env_type), POINTER :: para_env + CHARACTER(LEN=default_string_length) :: energy_unit, stress_unit REAL(KIND=dp) :: pres_int INTEGER(KIND=int_8) :: max_memory LOGICAL :: print_memory @@ -205,24 +207,55 @@ SUBROUTINE gopt_f_io_init(gopt_env, output_unit, opt_energy, wildcard, its, used max_memory = sample_memory(para_env) END IF + CALL section_vals_val_get(gopt_env%force_env%force_env_section, & + "PRINT%PROGRAM_RUN_INFO%ENERGY_UNIT", & + c_val=energy_unit) + CALL section_vals_val_get(gopt_env%force_env%force_env_section, & + "PRINT%STRESS_TENSOR%STRESS_UNIT", & + c_val=stress_unit) + SELECT CASE (gopt_env%type_id) CASE (default_ts_method_id, default_minimization_method_id) ! Geometry Optimization (Minimization and Transition State Search) IF (.NOT. gopt_env%dimer_rotation) THEN - CALL write_cycle_infos(output_unit, it=its, etot=opt_energy, wildcard=wildcard, & - used_time=used_time, max_memory=max_memory) + CALL write_cycle_infos(output_unit, & + it=its, & + etot=opt_energy, & + wildcard=wildcard, & + used_time=used_time, & + max_memory=max_memory, & + energy_unit=energy_unit, & + stress_unit=stress_unit) ELSE - CALL write_rot_cycle_infos(output_unit, it=its, etot=opt_energy, dimer_env=gopt_env%dimer_env, & - wildcard=wildcard, used_time=used_time, max_memory=max_memory) + CALL write_rot_cycle_infos(output_unit, & + it=its, & + etot=opt_energy, & + dimer_env=gopt_env%dimer_env, & + wildcard=wildcard, & + used_time=used_time, & + max_memory=max_memory) END IF CASE (default_cell_method_id) ! Cell Optimization pres_int = gopt_env%cell_env%pres_int - CALL write_cycle_infos(output_unit, it=its, etot=opt_energy, pres_int=pres_int, & - wildcard=wildcard, used_time=used_time, max_memory=max_memory) + CALL write_cycle_infos(output_unit, & + it=its, & + etot=opt_energy, & + pres_int=pres_int, & + wildcard=wildcard, & + used_time=used_time, & + max_memory=max_memory, & + energy_unit=energy_unit, & + stress_unit=stress_unit) CASE (default_shellcore_method_id) - CALL write_cycle_infos(output_unit, it=its, etot=opt_energy, wildcard=wildcard, & - used_time=used_time, max_memory=max_memory) + CALL write_cycle_infos(output_unit, & + it=its, & + etot=opt_energy, & + wildcard=wildcard, & + used_time=used_time, & + max_memory=max_memory, & + energy_unit=energy_unit, & + stress_unit=stress_unit) END SELECT END SUBROUTINE gopt_f_io_init @@ -253,6 +286,7 @@ END SUBROUTINE gopt_f_io_init SUBROUTINE gopt_f_io(gopt_env, force_env, root_section, its, opt_energy, & output_unit, eold, emin, wildcard, gopt_param, ndf, dx, xi, conv, pred, rat, & step, rad, used_time) + TYPE(gopt_f_type), POINTER :: gopt_env TYPE(force_env_type), POINTER :: force_env TYPE(section_vals_type), POINTER :: root_section @@ -269,6 +303,7 @@ SUBROUTINE gopt_f_io(gopt_env, force_env, root_section, its, opt_energy, & REAL(KIND=dp), INTENT(IN), OPTIONAL :: pred, rat, step, rad REAL(KIND=dp) :: used_time + CHARACTER(LEN=default_string_length) :: energy_unit, stress_unit INTEGER(KIND=int_8) :: max_memory LOGICAL :: print_memory REAL(KIND=dp) :: pres_diff, pres_diff_constr, pres_int, & @@ -283,21 +318,39 @@ SUBROUTINE gopt_f_io(gopt_env, force_env, root_section, its, opt_energy, & max_memory = sample_memory(para_env) END IF + CALL section_vals_val_get(gopt_env%force_env%force_env_section, & + "PRINT%PROGRAM_RUN_INFO%ENERGY_UNIT", & + c_val=energy_unit) + CALL section_vals_val_get(gopt_env%force_env%force_env_section, & + "PRINT%STRESS_TENSOR%STRESS_UNIT", & + c_val=stress_unit) + SELECT CASE (gopt_env%type_id) CASE (default_ts_method_id, default_minimization_method_id) ! Geometry Optimization (Minimization and Transition State Search) IF (.NOT. gopt_env%dimer_rotation) THEN CALL geo_opt_io(force_env=force_env, root_section=root_section, & motion_section=gopt_env%motion_section, its=its, opt_energy=opt_energy) - CALL write_cycle_infos(output_unit, its, etot=opt_energy, ediff=opt_energy - eold, & - pred=pred, rat=rat, step=step, rad=rad, emin=emin, & - wildcard=wildcard, used_time=used_time, max_memory=max_memory) + CALL write_cycle_infos(output_unit, & + it=its, & + etot=opt_energy, & + ediff=(opt_energy - eold), & + pred=pred, & + rat=rat, & + step=step, & + rad=rad, & + emin=emin, & + wildcard=wildcard, & + used_time=used_time, & + max_memory=max_memory, & + energy_unit=energy_unit, & + stress_unit=stress_unit) ! Possibly check convergence IF (PRESENT(conv)) THEN CPASSERT(PRESENT(ndf)) CPASSERT(PRESENT(dx)) CPASSERT(PRESENT(xi)) - CALL check_converg(ndf, dx, xi, output_unit, conv, gopt_param, max_memory) + CALL check_converg(ndf, dx, xi, output_unit, conv, gopt_param, max_memory, stress_unit) END IF ELSE CALL update_dimer_vec(gopt_env%dimer_env, gopt_env%motion_section) @@ -317,32 +370,56 @@ SUBROUTINE gopt_f_io(gopt_env, force_env, root_section, its, opt_energy, & pres_tol = gopt_env%cell_env%pres_tol CALL geo_opt_io(force_env=force_env, root_section=root_section, & motion_section=gopt_env%motion_section, its=its, opt_energy=opt_energy) - CALL write_cycle_infos(output_unit, its, etot=opt_energy, ediff=opt_energy - eold, & - pred=pred, rat=rat, step=step, rad=rad, emin=emin, pres_int=pres_int, & - wildcard=wildcard, used_time=used_time, max_memory=max_memory) + CALL write_cycle_infos(output_unit, & + it=its, & + etot=opt_energy, & + ediff=(opt_energy - eold), & + pred=pred, & + rat=rat, & + step=step, & + rad=rad, & + emin=emin, & + pres_int=pres_int, & + wildcard=wildcard, & + used_time=used_time, & + max_memory=max_memory, & + energy_unit=energy_unit, & + stress_unit=stress_unit) ! Possibly check convergence IF (PRESENT(conv)) THEN CPASSERT(PRESENT(ndf)) CPASSERT(PRESENT(dx)) CPASSERT(PRESENT(xi)) IF (gopt_env%cell_env%constraint_id == fix_none) THEN - CALL check_converg(ndf, dx, xi, output_unit, conv, gopt_param, max_memory, pres_diff, pres_tol) + CALL check_converg(ndf, dx, xi, output_unit, conv, gopt_param, max_memory, stress_unit, & + pres_diff, pres_tol) ELSE pres_diff_constr = gopt_env%cell_env%pres_constr - gopt_env%cell_env%pres_ext - CALL check_converg(ndf, dx, xi, output_unit, conv, gopt_param, max_memory, pres_diff, & - pres_tol, pres_diff_constr) + CALL check_converg(ndf, dx, xi, output_unit, conv, gopt_param, max_memory, stress_unit, & + pres_diff, pres_tol, pres_diff_constr) END IF END IF CASE (default_shellcore_method_id) - CALL write_cycle_infos(output_unit, its, etot=opt_energy, ediff=opt_energy - eold, & - pred=pred, rat=rat, step=step, rad=rad, emin=emin, wildcard=wildcard, & - used_time=used_time, max_memory=max_memory) + CALL write_cycle_infos(output_unit, & + it=its, & + etot=opt_energy, & + ediff=(opt_energy - eold), & + pred=pred, & + rat=rat, & + step=step, & + rad=rad, & + emin=emin, & + wildcard=wildcard, & + used_time=used_time, & + max_memory=max_memory, & + energy_unit=energy_unit, & + stress_unit=stress_unit) ! Possibly check convergence IF (PRESENT(conv)) THEN CPASSERT(PRESENT(ndf)) CPASSERT(PRESENT(dx)) CPASSERT(PRESENT(xi)) - CALL check_converg(ndf, dx, xi, output_unit, conv, gopt_param, max_memory) + CALL check_converg(ndf, dx, xi, output_unit, conv, gopt_param, max_memory, stress_unit) END IF END SELECT @@ -400,7 +477,7 @@ END SUBROUTINE gopt_f_io_finalize !> \param used_time ... ! ************************************************************************************************** SUBROUTINE write_cycle_infos(output_unit, it, etot, ediff, pred, rat, step, rad, emin, & - pres_int, wildcard, used_time, max_memory) + pres_int, wildcard, used_time, max_memory, energy_unit, stress_unit) INTEGER, INTENT(IN) :: output_unit, it REAL(KIND=dp), INTENT(IN) :: etot @@ -409,9 +486,9 @@ SUBROUTINE write_cycle_infos(output_unit, it, etot, ediff, pred, rat, step, rad, CHARACTER(LEN=5), INTENT(IN) :: wildcard REAL(KIND=dp), INTENT(IN) :: used_time INTEGER(KIND=int_8), INTENT(IN) :: max_memory + CHARACTER(LEN=default_string_length), INTENT(IN) :: energy_unit, stress_unit CHARACTER(LEN=5) :: tag - REAL(KIND=dp) :: tmp_r1 IF (output_unit > 0) THEN tag = "OPT| " @@ -421,19 +498,22 @@ SUBROUTINE write_cycle_infos(output_unit, it, etot, ediff, pred, rat, step, rad, WRITE (UNIT=output_unit, FMT="(T2,A,T55,1X,A25)") & tag//"Optimization method", wildcard WRITE (UNIT=output_unit, FMT="(T2,A,T55,1X,F25.10)") & - tag//"Total energy [hartree]", etot + tag//"Total energy ["//TRIM(ADJUSTL(energy_unit))//"]", & + cp_unit_from_cp2k(etot, TRIM(energy_unit)) IF (PRESENT(pres_int)) THEN - tmp_r1 = cp_unit_from_cp2k(pres_int, "bar") WRITE (UNIT=output_unit, FMT="(T2,A,T55,1X,F25.10)") & - tag//"Internal pressure [bar]", tmp_r1 + tag//"Internal pressure ["//TRIM(ADJUSTL(stress_unit))//"]", & + cp_unit_from_cp2k(pres_int, TRIM(stress_unit)) END IF IF (PRESENT(ediff)) THEN WRITE (UNIT=output_unit, FMT="(T2,A,T55,1X,F25.10)") & - tag//"Effective energy change [hartree]", ediff + tag//"Effective energy change ["//TRIM(ADJUSTL(energy_unit))//"]", & + cp_unit_from_cp2k(ediff, TRIM(energy_unit)) END IF IF (PRESENT(pred)) THEN WRITE (UNIT=output_unit, FMT="(T2,A,T55,1X,F25.10)") & - tag//"Predicted energy change [hartree]", pred + tag//"Predicted energy change ["//TRIM(ADJUSTL(energy_unit))//"]", & + cp_unit_from_cp2k(pred, TRIM(energy_unit)) END IF IF (PRESENT(rat)) THEN WRITE (UNIT=output_unit, FMT="(T2,A,T55,1X,F25.10)") & @@ -546,8 +626,8 @@ END SUBROUTINE write_rot_cycle_infos !> \param pres_tol ... !> \param pres_diff_constr ... ! ************************************************************************************************** - SUBROUTINE check_converg(ndf, dr, g, output_unit, conv, gopt_param, max_memory, pres_diff, & - pres_tol, pres_diff_constr) + SUBROUTINE check_converg(ndf, dr, g, output_unit, conv, gopt_param, max_memory, stress_unit, & + pres_diff, pres_tol, pres_diff_constr) INTEGER, INTENT(IN) :: ndf REAL(KIND=dp), INTENT(IN) :: dr(ndf), g(ndf) @@ -555,6 +635,7 @@ SUBROUTINE check_converg(ndf, dr, g, output_unit, conv, gopt_param, max_memory, LOGICAL, INTENT(OUT) :: conv TYPE(gopt_param_type), POINTER :: gopt_param INTEGER(KIND=int_8), INTENT(IN) :: max_memory + CHARACTER(LEN=default_string_length), INTENT(IN) :: stress_unit REAL(KIND=dp), INTENT(IN), OPTIONAL :: pres_diff, pres_tol, pres_diff_constr CHARACTER(LEN=5) :: tag @@ -562,7 +643,7 @@ SUBROUTINE check_converg(ndf, dr, g, output_unit, conv, gopt_param, max_memory, LOGICAL :: conv_dx, conv_g, conv_p, conv_rdx, & conv_rg REAL(KIND=dp) :: dumm, dxcon, gcon, maxdum(4), rmsgcon, & - rmsxcon, tmp_r1 + rmsxcon dxcon = gopt_param%max_dr gcon = gopt_param%max_force @@ -657,21 +738,24 @@ SUBROUTINE check_converg(ndf, dr, g, output_unit, conv, gopt_param, max_memory, END IF IF (PRESENT(pres_diff) .AND. PRESENT(pres_tol)) THEN - tmp_r1 = cp_unit_from_cp2k(pres_diff, "bar") WRITE (UNIT=output_unit, FMT="(T2,A)") TRIM(tag) IF (PRESENT(pres_diff_constr)) THEN WRITE (UNIT=output_unit, FMT="(T2,A,T55,1X,F25.10)") & - tag//"Pressure deviation without constraint [bar]", tmp_r1 - tmp_r1 = cp_unit_from_cp2k(pres_diff_constr, "bar") + tag//"Pressure deviation without constraint ["// & + TRIM(ADJUSTL(stress_unit))//"]", & + cp_unit_from_cp2k(pres_diff, TRIM(stress_unit)) WRITE (UNIT=output_unit, FMT="(T2,A,T55,1X,F25.10)") & - tag//"Pressure deviation with constraint [bar]", tmp_r1 + tag//"Pressure deviation with constraint ["// & + TRIM(ADJUSTL(stress_unit))//"]", & + cp_unit_from_cp2k(pres_diff_constr, TRIM(stress_unit)) ELSE WRITE (UNIT=output_unit, FMT="(T2,A,T55,1X,F25.10)") & - tag//"Pressure deviation [bar]", tmp_r1 + tag//"Pressure deviation ["//TRIM(ADJUSTL(stress_unit))//"]", & + cp_unit_from_cp2k(pres_diff, TRIM(stress_unit)) END IF - tmp_r1 = cp_unit_from_cp2k(pres_tol, "bar") WRITE (UNIT=output_unit, FMT="(T2,A,T55,1X,F25.10)") & - tag//"Pressure tolerance [bar]", tmp_r1 + tag//"Pressure tolerance ["//TRIM(ADJUSTL(stress_unit))//"]", & + cp_unit_from_cp2k(pres_tol, TRIM(stress_unit)) IF (conv_p) THEN WRITE (UNIT=output_unit, FMT="(T2,A,T77,A4)") & tag//"Pressure is converged", " YES" @@ -971,7 +1055,7 @@ SUBROUTINE geo_opt_io(force_env, root_section, motion_section, its, opt_energy) particle_set => particles%els CALL virial_evaluate(atomic_kind_set, particle_set, local_particles, & virial, para_env) - CALL write_stress_tensor(virial, cell, motion_section, its, 0.0_dp) + CALL write_stress_tensor_to_file(virial, cell, motion_section, its, 0.0_dp) ! Write the cell CALL write_simulation_cell(cell, motion_section, its, 0.0_dp) diff --git a/src/motion/md_energies.F b/src/motion/md_energies.F index 700240f036..56228b7ce6 100644 --- a/src/motion/md_energies.F +++ b/src/motion/md_energies.F @@ -69,7 +69,7 @@ MODULE md_energies set_md_env USE message_passing, ONLY: mp_para_env_type USE motion_utils, ONLY: write_simulation_cell,& - write_stress_tensor,& + write_stress_tensor_to_file,& write_trajectory USE particle_list_types, ONLY: particle_list_type USE particle_methods, ONLY: write_structure_data @@ -467,7 +467,7 @@ SUBROUTINE md_write_output(md_env) CALL print_barostat_status(barostat, simpar, my_pos, my_act, cell, itimes, time) ! Print Stress Tensor - CALL write_stress_tensor(virial, cell, motion_section, itimes, time*femtoseconds, my_pos, my_act) + CALL write_stress_tensor_to_file(virial, cell, motion_section, itimes, time*femtoseconds, my_pos, my_act) ! Print Polarisability Tensor IF (ASSOCIATED(force_env%qs_env)) THEN diff --git a/src/motion_utils.F b/src/motion_utils.F index 4806f4652b..eddec9b941 100644 --- a/src/motion_utils.F +++ b/src/motion_utils.F @@ -53,7 +53,7 @@ MODULE motion_utils PRIVATE - PUBLIC :: write_trajectory, write_stress_tensor, write_simulation_cell, & + PUBLIC :: write_trajectory, write_stress_tensor_to_file, write_simulation_cell, & get_output_format, rot_ana CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'motion_utils' @@ -522,8 +522,7 @@ END SUBROUTINE get_output_format !> \author Teodoro Laino [tlaino] - University of Zurich !> \version 1.0 ! ************************************************************************************************** - SUBROUTINE write_stress_tensor(virial, cell, motion_section, itimes, time, pos, & - act) + SUBROUTINE write_stress_tensor_to_file(virial, cell, motion_section, itimes, time, pos, act) TYPE(virial_type), POINTER :: virial TYPE(cell_type), POINTER :: cell @@ -581,7 +580,7 @@ SUBROUTINE write_stress_tensor(virial, cell, motion_section, itimes, time, pos, "PRINT%STRESS") END IF - END SUBROUTINE write_stress_tensor + END SUBROUTINE write_stress_tensor_to_file ! ************************************************************************************************** !> \brief Prints the Simulation Cell diff --git a/tests/Fist/regtest-7-1/TEST_FILES b/tests/Fist/regtest-7-1/TEST_FILES index 2586891d36..7393dfaa3b 100644 --- a/tests/Fist/regtest-7-1/TEST_FILES +++ b/tests/Fist/regtest-7-1/TEST_FILES @@ -52,9 +52,9 @@ uo2_shell_nve_zbl.inp 2 1.0E-14 - # thermal regions uo2_shell_nve_cascade.inp 2 1.0E-14 -0.118497693908E+03 # Geometry optimisation for core-shell model -UO2-4x4x4-core-forces.inp 43 1.0E-14 0 -UO2-4x4x4-core-shell-debug.inp 42 3e+00 4.6877e-06 -UO2-4x4x4-shell-forces.inp 44 1.0E-14 0 +UO2-4x4x4-core-forces.inp 43 1.0E-11 0 +UO2-4x4x4-core-shell-debug.inp 42 3e+00 4.6877E-06 +UO2-4x4x4-shell-forces.inp 44 1.0E-11 0 # Automatic fitting of the BUCK4RANGES polynomials UO2-4x4x4-autofit.inp 11 1E-12 -948.24095020004961 # Connectivity user diff --git a/tests/Fist/regtest-7-2/TEST_FILES b/tests/Fist/regtest-7-2/TEST_FILES index b9fbd62580..24159641e2 100644 --- a/tests/Fist/regtest-7-2/TEST_FILES +++ b/tests/Fist/regtest-7-2/TEST_FILES @@ -63,10 +63,10 @@ UO2-2x2x2-cs-geo_opt-cg.inp 11 1e-11 -1 UO2-2x2x2-cs-geo_opt-lbfgs.inp 11 3e-14 -118.530158827854791 # Enable fixed atom constraint for core-shell models UO2-4x4x4-fixd.inp 11 9e-14 -619.588154772236749 -UO2-4x4x4-cs-fixd.inp 43 1.0E-14 0.008410 -UO2-4x4x4-cs-fixd-restart.inp 44 1.0E-14 0.017655 -UO2-4x4x4-cs-fixd-nvt.inp 54 1.0E-14 0.041076 -UO2-4x4x4-cs-fixd-npt.inp 54 1.0E-14 0.045987 +UO2-4x4x4-cs-fixd.inp 43 3.0E-05 8.410097E-03 +UO2-4x4x4-cs-fixd-restart.inp 44 1.0E-05 1.765517E-02 +UO2-4x4x4-cs-fixd-nvt.inp 54 1.0E-05 4.107616E-02 +UO2-4x4x4-cs-fixd-npt.inp 54 1.0E-05 4.598688E-02 # Test UO2 force fields with generic input UO2-Morelon-5x5x5-cell_opt.inp 11 5.0E-13 -1210.562919201563318 #EOF diff --git a/tests/Fist/regtest-nequip/TEST_FILES b/tests/Fist/regtest-nequip/TEST_FILES index 33fbf32faa..88a22f2c80 100644 --- a/tests/Fist/regtest-nequip/TEST_FILES +++ b/tests/Fist/regtest-nequip/TEST_FILES @@ -1,4 +1,4 @@ # Test of NequIP using libtorch https://pytorch.org/cppdocs/installing.html water-sp.inp 11 1.0E-6 -17.195440909240052 -water-bulk-dp.inp 31 1.0E-9 3.78036960937E+00 +water-bulk-dp.inp 31 1.0E-9 3.78036960937E+04 #EOF diff --git a/tests/QS/regtest-admm-qps-2/TEST_FILES b/tests/QS/regtest-admm-qps-2/TEST_FILES index d9a345c6ce..44ce7dfcd6 100644 --- a/tests/QS/regtest-admm-qps-2/TEST_FILES +++ b/tests/QS/regtest-admm-qps-2/TEST_FILES @@ -3,8 +3,8 @@ # see regtest/TEST_FILES H2O-ADMMP-GAPW_force.inp 0 H2O-ADMMQ-OPTX_geopt.inp 11 1.0e-10 -16.883674379799505 -H2O-ADMMS-HYB_stress.inp 31 1.0e-8 2.12343399949E+00 +H2O-ADMMS-HYB_stress.inp 31 1.0e-8 2.12343399949E+04 O2-ADMMP-HYB_geopt.inp 11 1.0e-10 -31.768410590536480 -O2-ADMMQ-GAPW_stress.inp 31 1.0e-8 2.68914575665E+00 +O2-ADMMQ-GAPW_stress.inp 31 1.0e-8 2.68914575665E+04 O2-ADMMS-OPTX_force.inp 0 #EOF diff --git a/tests/QS/regtest-dcdft-stress/TEST_FILES b/tests/QS/regtest-dcdft-stress/TEST_FILES index 49856a2aec..505098e8e6 100644 --- a/tests/QS/regtest-dcdft-stress/TEST_FILES +++ b/tests/QS/regtest-dcdft-stress/TEST_FILES @@ -3,35 +3,35 @@ # see regtest/TEST_FILES # Density-corrected DFT Stress tensor tests # LDA - PBE MO solver -N2_t01.inp 31 1e-05 3.27841013742E+01 +N2_t01.inp 31 1e-05 3.27841013742E+05 # LDA - PBE AO solver -N2_t02.inp 31 1e-05 3.27915201801E+01 +N2_t02.inp 31 1e-05 3.27915201801E+05 # PBE - LDA MO solver -N2_t03.inp 31 1e-05 3.27261434593E+01 +N2_t03.inp 31 1e-05 3.27261434593E+05 # PBE - LDA AO solver -N2_t04.inp 31 1e-05 3.27915201801E+01 +N2_t04.inp 31 1e-05 3.27915201801E+05 # LDA - TPSS MO solver -N2_t05.inp 31 1e-05 2.76973145058E+01 +N2_t05.inp 31 1e-05 2.76973145058E+05 # TPSS - LDA MO solver -N2_t06.inp 31 1e-05 -5.02530331310E+02 +N2_t06.inp 31 1e-05 -5.02530331310E+06 # LDA - BR89 AO solver -N2_t07.inp 31 1e-05 -5.03370759578E+02 +N2_t07.inp 31 1e-05 -5.03370759578E+06 # BR89 - LDA AO solver -N2_t08.inp 31 1e-05 -5.02524932385E+02 +N2_t08.inp 31 1e-05 -5.02524932385E+06 # HFX - PBE MO solver -N2_t09.inp 31 1e-05 6.87212873998E+01 +N2_t09.inp 31 1e-05 6.87212873998E+05 # HFX - PBE AO solver -N2_t10.inp 31 1e-05 6.90331362007E+01 +N2_t10.inp 31 1e-05 6.90331362007E+05 # PBE0 - PADE MO solver -N2_t11.inp 31 1e-05 -4.60746548827E+02 +N2_t11.inp 31 1e-05 -4.60746548827E+06 # PBE0 - PADE AO solver -N2_t12.inp 31 1e-05 -4.60764113421E+02 +N2_t12.inp 31 1e-05 -4.60764113421E+06 # HFX-ADMM-NONE - PBE MO solver -N2_t13.inp 31 1e-05 -4.97853794203E+02 +N2_t13.inp 31 1e-05 -4.97853794203E+06 # HFX-ADMM-NONE - PBE AO solver -N2_t14.inp 31 1e-05 -4.97853821220E+02 +N2_t14.inp 31 1e-05 -4.97853821220E+06 # HFX-ADMM-DEFAULT - PBE MO solver -N2_t15.inp 31 1e-05 -4.98120398473E+02 +N2_t15.inp 31 1e-05 -4.98120398473E+06 # HFX-ADMM-DEFAULT - PBE AO solver -N2_t16.inp 31 1e-05 -4.98120397529E+02 +N2_t16.inp 31 1e-05 -4.98120397529E+06 #EOF diff --git a/tests/QS/regtest-dft-vdw-corr-2/TEST_FILES b/tests/QS/regtest-dft-vdw-corr-2/TEST_FILES index ac8f624251..7565372587 100644 --- a/tests/QS/regtest-dft-vdw-corr-2/TEST_FILES +++ b/tests/QS/regtest-dft-vdw-corr-2/TEST_FILES @@ -11,7 +11,7 @@ dftd3_t12.inp 33 1.0E-14 dftd3_t13.inp 33 1.0E-14 -0.00045037056834 dftd3_t14.inp 33 1.0E-14 -0.00022349123009 dftd3_t15.inp 33 1.0E-14 -0.00022349123009 -dftd3_t16.inp 31 1.0E-10 -2.42360772711E-02 +dftd3_t16.inp 31 1.0E-10 -2.42360772711E+02 # argon-vdW-DF1.inp 1 3e-13 -85.04054534692069 argon-vdW-DF2.inp 1 2e-13 -85.20254545254821 diff --git a/tests/QS/regtest-dft-vdw-corr-4/TEST_FILES b/tests/QS/regtest-dft-vdw-corr-4/TEST_FILES index 49556a2973..d239df0fc7 100644 --- a/tests/QS/regtest-dft-vdw-corr-4/TEST_FILES +++ b/tests/QS/regtest-dft-vdw-corr-4/TEST_FILES @@ -4,10 +4,10 @@ # 1 compares the last total energy in the file # for details see cp2k/tools/do_regtest pbe_dftd4.inp 33 1.0E-14 -0.00283102230260 -pbe_dftd4_force.inp 72 1.0E-07 0.00004379 -pbe_dftd4_stress.inp 31 1.0E-07 -2.03123914683E-02 +pbe_dftd4_force.inp 72 8.0E-05 4.37932362E-05 +pbe_dftd4_stress.inp 31 1.0E-07 -2.03123914683E+02 ta1.inp 0 ta2.inp 0 ta3.inp 0 -ta4.inp 31 1.0E-07 2.83597961983E+00 +ta4.inp 31 1.0E-07 2.83597961983E+04 #EOF diff --git a/tests/QS/regtest-double-hybrid-stress-laplace/TEST_FILES b/tests/QS/regtest-double-hybrid-stress-laplace/TEST_FILES index b7411cbf36..551f604387 100644 --- a/tests/QS/regtest-double-hybrid-stress-laplace/TEST_FILES +++ b/tests/QS/regtest-double-hybrid-stress-laplace/TEST_FILES @@ -1,3 +1,3 @@ -H2O_br89_mp2_an.inp 31 2E-5 2.55476623536E+01 -CH3_br89_mp2_an.inp 31 3e-04 -2.03435661393E+00 +H2O_br89_mp2_an.inp 31 2E-5 2.55476623536E+05 +CH3_br89_mp2_an.inp 31 3e-04 -2.03435661393E+04 #EOF diff --git a/tests/QS/regtest-double-hybrid-stress-meta/TEST_FILES b/tests/QS/regtest-double-hybrid-stress-meta/TEST_FILES index 5de09fd34d..76c831b311 100644 --- a/tests/QS/regtest-double-hybrid-stress-meta/TEST_FILES +++ b/tests/QS/regtest-double-hybrid-stress-meta/TEST_FILES @@ -1,3 +1,3 @@ -H2O_tpss_mp2_an.inp 31 2E-5 2.54869194190E+01 -CH3_tpss_mp2_an.inp 31 3e-04 -2.54808062417E+00 +H2O_tpss_mp2_an.inp 31 2E-5 2.54869194190E+05 +CH3_tpss_mp2_an.inp 31 3e-04 -2.54808062417E+04 #EOF diff --git a/tests/QS/regtest-double-hybrid-stress-numer-laplace/TEST_FILES b/tests/QS/regtest-double-hybrid-stress-numer-laplace/TEST_FILES index 17cea843c1..b5080fcb5a 100644 --- a/tests/QS/regtest-double-hybrid-stress-numer-laplace/TEST_FILES +++ b/tests/QS/regtest-double-hybrid-stress-numer-laplace/TEST_FILES @@ -1,3 +1,3 @@ -H2O_br89_mp2_numer.inp 31 2E-5 2.55423523081E+01 -CH3_br89_mp2_numer.inp 31 3e-04 -2.03608134504E+00 +H2O_br89_mp2_numer.inp 31 2E-5 2.55423523081E+05 +CH3_br89_mp2_numer.inp 31 3e-04 -2.03608134504E+04 #EOF diff --git a/tests/QS/regtest-double-hybrid-stress-numer-meta/TEST_FILES b/tests/QS/regtest-double-hybrid-stress-numer-meta/TEST_FILES index cb86e66306..3e7e504e8d 100644 --- a/tests/QS/regtest-double-hybrid-stress-numer-meta/TEST_FILES +++ b/tests/QS/regtest-double-hybrid-stress-numer-meta/TEST_FILES @@ -1,3 +1,3 @@ -H2O_tpss_mp2_numer.inp 31 2E-5 2.54850505089E+01 -CH3_tpss_mp2_numer.inp 31 3e-04 -1.97880393918E+00 +H2O_tpss_mp2_numer.inp 31 2E-5 2.54850505089E+05 +CH3_tpss_mp2_numer.inp 31 3e-04 -1.97880393918E+04 #EOF diff --git a/tests/QS/regtest-double-hybrid-stress-numer/TEST_FILES b/tests/QS/regtest-double-hybrid-stress-numer/TEST_FILES index b013a60eb1..59f38893d8 100644 --- a/tests/QS/regtest-double-hybrid-stress-numer/TEST_FILES +++ b/tests/QS/regtest-double-hybrid-stress-numer/TEST_FILES @@ -1,3 +1,3 @@ -H2O_pbe_mp2_an.inp 31 2E-5 -5.90054852250E-01 -CH3_pbe_mp2_an.inp 31 3e-04 -2.46395259407E+00 +H2O_pbe_mp2_an.inp 31 2E-5 -5.90054852250E+03 +CH3_pbe_mp2_an.inp 31 3e-04 -2.46395259407E+04 #EOF diff --git a/tests/QS/regtest-double-hybrid-stress/TEST_FILES b/tests/QS/regtest-double-hybrid-stress/TEST_FILES index 19c1d2020b..952135b2f1 100644 --- a/tests/QS/regtest-double-hybrid-stress/TEST_FILES +++ b/tests/QS/regtest-double-hybrid-stress/TEST_FILES @@ -1,3 +1,3 @@ -H2O_pbe_mp2_an.inp 31 2E-5 -5.90056513122E-01 -CH3_pbe_mp2_an.inp 31 3e-04 -2.46394792935E+00 +H2O_pbe_mp2_an.inp 31 2E-5 -5.90056513122E+03 +CH3_pbe_mp2_an.inp 31 3e-04 -2.46394792935E+04 #EOF diff --git a/tests/QS/regtest-ec-meta/TEST_FILES b/tests/QS/regtest-ec-meta/TEST_FILES index d0501ccde7..61ac50f71b 100644 --- a/tests/QS/regtest-ec-meta/TEST_FILES +++ b/tests/QS/regtest-ec-meta/TEST_FILES @@ -10,11 +10,11 @@ N2_pade_br89.inp 11 1e-12 -19.5 # FORCE: BR89 - PADE AO solver N2_br89_pade.inp 11 1e-12 -19.795370307536491 # STRESS: PADE - TPSS MO solver -N2_pade_tpss_stress.inp 31 1e-05 -5.01969865527E+02 +N2_pade_tpss_stress.inp 31 1e-05 -5.01969865527E+06 # STRESS: TPSS - PADE MO solver -N2_tpss_pade_stress.inp 31 1e-05 -5.02652401254E+02 +N2_tpss_pade_stress.inp 31 1e-05 -5.02652401254E+06 # STRESS: PADE - BR89 AO solver -N2_pade_br89_stress.inp 31 1e-05 -5.03273252086E+02 +N2_pade_br89_stress.inp 31 1e-05 -5.03273252086E+06 # STRESS: BR89 - PADE AO solver -N2_br89_pade_stress.inp 31 1e-05 -5.02543292201E+02 +N2_br89_pade_stress.inp 31 1e-05 -5.02543292201E+06 #EOF diff --git a/tests/QS/regtest-ec-stress/TEST_FILES b/tests/QS/regtest-ec-stress/TEST_FILES index edb0693f67..a8ab6238ce 100644 --- a/tests/QS/regtest-ec-stress/TEST_FILES +++ b/tests/QS/regtest-ec-stress/TEST_FILES @@ -3,33 +3,33 @@ # see regtest/TEST_FILES # Harris functional energy correction stress tensor tests # PADE - PADE MO solver -N2_t01.inp 31 1e-05 3.26443566797E+01 +N2_t01.inp 31 1e-05 3.26443566797E+05 # PADE - PBE -N2_t02.inp 31 5e-05 3.26450578945E+01 +N2_t02.inp 31 5e-05 3.26450578945E+05 # PBE - PADE -N2_t03.inp 31 5e-05 3.25833150889E+01 +N2_t03.inp 31 5e-05 3.25833150889E+05 # PBE - PBE -N2_t04.inp 31 1e-05 3.27026970587E+01 +N2_t04.inp 31 1e-05 3.27026970587E+05 # HFX - PBE -N2_t05.inp 31 5e-05 -4.99918264201E+02 +N2_t05.inp 31 5e-05 -4.99918264201E+06 # PBE0 - PADE -N2_t06.inp 31 5e-05 -5.02611808577E+02 +N2_t06.inp 31 5e-05 -5.02611808577E+06 # PADE - PADE w/ Harris basis -N2_t07.inp 31 1e-05 -5.09706561950E+02 +N2_t07.inp 31 1e-05 -5.09706561950E+06 # PBE - PBE w/ Harris basis -N2_t08.inp 31 5e-05 -4.40020265431E+02 +N2_t08.inp 31 5e-05 -4.40020265431E+06 # PBE0 - PBE w/ Harris basis AO solver -N2_t08b.inp 31 5e-05 -5.04243430029E+02 +N2_t08b.inp 31 5e-05 -5.04243430029E+06 # PBE0 - PBE w/ Harris basis -N2_t09.inp 31 5e-05 -5.06200216422E+02 +N2_t09.inp 31 5e-05 -5.06200216422E+06 # HFX - PBE w/ Harris basis -N2_t10.inp 31 1e-05 -4.39582090179E+02 +N2_t10.inp 31 1e-05 -4.39582090179E+06 # HFX-ADMM-NONE - PBE -N2_t11.inp 31 1e-05 -4.99281767965E+02 +N2_t11.inp 31 1e-05 -4.99281767965E+06 # PBE0-ADMM-NONE - PBE w/ Harris basis -N2_t12.inp 31 1e-05 -5.69368274518E+02 +N2_t12.inp 31 1e-05 -5.69368274518E+06 # PBE0-ADMM-DEFAULT - PBE -N2_t13.inp 31 1e-05 -5.68693895220E+02 +N2_t13.inp 31 1e-05 -5.68693895220E+06 # PBE0-ADMM-DEFAULT - PBE w/ Harris basis -N2_t14.inp 31 1e-05 -5.69208832157E+02 +N2_t14.inp 31 1e-05 -5.69208832157E+06 #EOF diff --git a/tests/QS/regtest-ec/TEST_FILES b/tests/QS/regtest-ec/TEST_FILES index c3b9a8029e..bd37452a68 100644 --- a/tests/QS/regtest-ec/TEST_FILES +++ b/tests/QS/regtest-ec/TEST_FILES @@ -45,17 +45,17 @@ H2_H2O_LSKGaH_AO_grad.inp 72 1E-06 H2_H2O_LSKGaH_MO_grad.inp 72 1E-06 0.24256217 # # STRESS: KS + KG embed + Harris (TRS4) + AO solver -H2_H2O_KSKGeH_AO_an.inp 31 1e-05 1.95042985060E+02 +H2_H2O_KSKGeH_AO_an.inp 31 1e-05 1.95042985060E+06 # STRESS: KS + KG embed + Harris (TRS4) + MO solver -H2_H2O_KSKGeH_MO_an.inp 31 1e-05 -9.06100773653E-01 +H2_H2O_KSKGeH_MO_an.inp 31 1e-05 -9.06100773653E+03 # STRESS: LS + KG atomic + Harris (TRS4) + AO solver -H2_H2O_LSKGaH_AO_an.inp 31 1e-05 1.49007996537E+02 +H2_H2O_LSKGaH_AO_an.inp 31 1e-05 1.49007996537E+06 # STRESS: LS + KG atomic + Harris (TRS4) + MO solver -H2_H2O_LSKGaH_MO_an.inp 31 1e-05 1.49107834133E+02 +H2_H2O_LSKGaH_MO_an.inp 31 1e-05 1.49107834133E+06 # STRESS: KS + Harris (Diag) + MO solver -H2O_KSH_MO_an.inp 31 1e-05 4.50118137345E+01 +H2O_KSH_MO_an.inp 31 1e-05 4.50118137345E+05 # STRESS: KS + Harris (Diag) + MO solver - Diagonal numerical -H2O_KSH_AO_numdiag.inp 31 1e-05 -2.41849782017E+00 +H2O_KSH_AO_numdiag.inp 31 1e-05 -2.41849782017E+04 # N2_ec-hfx.inp 11 1e-10 -19.8158435718 N2_ec-hfx-admm.inp 11 1e-10 -19.8434174923 diff --git a/tests/QS/regtest-ecp-2/TEST_FILES b/tests/QS/regtest-ecp-2/TEST_FILES index a96bbfa10e..ec2f453c6b 100644 --- a/tests/QS/regtest-ecp-2/TEST_FILES +++ b/tests/QS/regtest-ecp-2/TEST_FILES @@ -1,3 +1,3 @@ ICl_lanl2dz_gpw.inp 0 -Rn_stuttgart_gapw.inp 31 1.0E-08 3.56470376649E-01 +Rn_stuttgart_gapw.inp 31 1.0E-08 3.56470376649E+03 #SbH3_def2_gapw.inp 11 1.0E-11 -241.595963788403253 diff --git a/tests/QS/regtest-hfx-ri-2/TEST_FILES b/tests/QS/regtest-hfx-ri-2/TEST_FILES index 9bc8c1f6c1..70c1f8a66d 100644 --- a/tests/QS/regtest-hfx-ri-2/TEST_FILES +++ b/tests/QS/regtest-hfx-ri-2/TEST_FILES @@ -4,6 +4,6 @@ CH-hfx-ri-mo.inp 11 1.0E-9 Ne-hfx-pbc-metric-rho.inp 11 1.0E-9 -636.720103843241191 Ne-hfx-pbc-metric-mo.inp 11 1.0E-9 -635.511722336957519 CH3-b3lyp-ADMM.inp 11 1.0E-9 -7.347189043204780 -H2O-pbe0-stress-truncated.inp 31 1.0E-8 1.10578148678E+00 -H2O-hfx-stress-identity.inp 31 1.0E-8 7.89429744040E-01 +H2O-pbe0-stress-truncated.inp 31 1.0E-8 1.10578148678E+04 +H2O-hfx-stress-identity.inp 31 1.0E-8 7.89429744040E+03 #EOF diff --git a/tests/QS/regtest-hfx-stress/TEST_FILES b/tests/QS/regtest-hfx-stress/TEST_FILES index c5d0cd0fa0..7832f9b5ae 100644 --- a/tests/QS/regtest-hfx-stress/TEST_FILES +++ b/tests/QS/regtest-hfx-stress/TEST_FILES @@ -1,8 +1,8 @@ # runs are executed in the same order as in this file # the second field tells which test should be run in order to compare with the last available output # see regtest/TEST_FILES -ch3-admm.inp 31 2e-08 -7.1722067999999997 -ch3.inp 31 7e-09 28.390280199999999 -ch4-admm.inp 31 7e-06 -7.1069467700000004 -h2o.inp 31 2e-08 1.26297506E+01 +ch3-admm.inp 31 2e-08 -7.17220679382E+04 +ch3.inp 31 7e-09 2.83902801789E+05 +ch4-admm.inp 31 7e-06 -7.10696315806E+04 +h2o.inp 31 2e-08 1.26297506407E+05 #EOF diff --git a/tests/QS/regtest-kp-hfx-ri-2/TEST_FILES b/tests/QS/regtest-kp-hfx-ri-2/TEST_FILES index ff9b24537d..1958b7eebf 100644 --- a/tests/QS/regtest-kp-hfx-ri-2/TEST_FILES +++ b/tests/QS/regtest-kp-hfx-ri-2/TEST_FILES @@ -1,6 +1,6 @@ diamond_gapw_tc.inp 11 1.0E-10 -75.016281067533328 -diamond_gpw_stress.inp 31 1.0E-8 -4.12844314823E-01 +diamond_gpw_stress.inp 31 1.0E-8 -4.12844314823E+03 hBN_gapw_ovlp.inp 11 1.0E-10 -86.260185593662356 hBN_gpw_pbe0.inp 11 1.0E-10 -8.628406066722894 -LiH_gapw_stress.inp 31 1.0E-8 -2.20168679931E+00 +LiH_gapw_stress.inp 31 1.0E-8 -2.20168679931E+04 He_debug.inp 0 diff --git a/tests/QS/regtest-kp-hfx-ri-admm-2/TEST_FILES b/tests/QS/regtest-kp-hfx-ri-admm-2/TEST_FILES index 8349b6d83e..f6082ef61c 100644 --- a/tests/QS/regtest-kp-hfx-ri-admm-2/TEST_FILES +++ b/tests/QS/regtest-kp-hfx-ri-admm-2/TEST_FILES @@ -1,7 +1,7 @@ hBN_gpw_pbe0.inp 11 1.0E-10 -8.627502654876013 LiH_gapw_pbex.inp 11 1.0E-10 -7.774042231360941 LiH_gpw_none.inp 11 1.0E-10 -5.383857047510018 -hBN_gapw_lsd_stress.inp 31 1.0E-8 -1.24548924781E+00 +hBN_gapw_lsd_stress.inp 31 1.0E-8 -1.24548924781E+04 diamond_admmp.inp 11 1.0E-10 -8.244883910014904 diamond_admms.inp 11 1.0E-10 -79.738004880335254 -diamond_admmq.inp 31 1.0E-8 -5.01813876744E+00 +diamond_admmq.inp 31 1.0E-8 -5.01813876744E+04 diff --git a/tests/QS/regtest-lrigpw/TEST_FILES b/tests/QS/regtest-lrigpw/TEST_FILES index b7dc93e523..e04ee825c9 100644 --- a/tests/QS/regtest-lrigpw/TEST_FILES +++ b/tests/QS/regtest-lrigpw/TEST_FILES @@ -15,5 +15,5 @@ H2O_lri_stress.inp 1 6e-13 H2O_lri_inv_autoselect.inp 1 6e-13 -17.14529622380567 H2O_lri_shg.inp 1 5e-13 -10.25090613732518 H2O_lri_molopt.inp 1 1e-07 -17.16069016913325 -H2O_lri_ppl.inp 72 1e-07 0.00096169 +H2O_lri_ppl.inp 72 2e-06 9.61688740E-04 #EOF diff --git a/tests/QS/regtest-mp2-admm-stress-numer/TEST_FILES b/tests/QS/regtest-mp2-admm-stress-numer/TEST_FILES index ae44c0b390..8563401ce5 100644 --- a/tests/QS/regtest-mp2-admm-stress-numer/TEST_FILES +++ b/tests/QS/regtest-mp2-admm-stress-numer/TEST_FILES @@ -1,3 +1,3 @@ -H2O_grad_admm_numerical.inp 31 1e-05 1.21339718776E+01 -CH_grad_admm_numerical.inp 31 1e-05 -1.25961610835E+01 +H2O_grad_admm_numerical.inp 31 1e-05 1.21339718776E+05 +CH_grad_admm_numerical.inp 31 1e-05 -1.25961610835E+05 #EOF diff --git a/tests/QS/regtest-mp2-admm-stress/TEST_FILES b/tests/QS/regtest-mp2-admm-stress/TEST_FILES index 1fd55fd748..599e96f499 100644 --- a/tests/QS/regtest-mp2-admm-stress/TEST_FILES +++ b/tests/QS/regtest-mp2-admm-stress/TEST_FILES @@ -1,5 +1,5 @@ -H2O_stress_admm_none.inp 31 1e-05 -8.79381855793E+00 -CH_stress_admm_none.inp 31 1e-05 -3.60943676817E+00 -H2O_stress_admm.inp 31 1e-05 -9.35745152260E+00 -CH_stress_admm.inp 31 2e-05 -3.52452919427E+00 +H2O_stress_admm_none.inp 31 1e-05 -8.79381855793E+04 +CH_stress_admm_none.inp 31 1e-05 -3.60943676817E+04 +H2O_stress_admm.inp 31 1e-05 -9.35745152260E+04 +CH_stress_admm.inp 31 2e-05 -3.52452919427E+04 #EOF diff --git a/tests/QS/regtest-mp2-lr-stress/TEST_FILES b/tests/QS/regtest-mp2-lr-stress/TEST_FILES index 92e2ec3efe..4ab6a6ea89 100644 --- a/tests/QS/regtest-mp2-lr-stress/TEST_FILES +++ b/tests/QS/regtest-mp2-lr-stress/TEST_FILES @@ -1,5 +1,5 @@ -H2O_mp2_lr.inp 31 1e-05 -9.32628949342E+00 -CH_mp2_lr.inp 31 1e-05 -5.78120564924E+00 -H2O_mp2_lr_Coulomb_metric.inp 31 1e-05 -9.32542295092E+00 -H2O_mp2_mix_cl.inp 31 1e-05 -8.27072031429E+00 +H2O_mp2_lr.inp 31 1e-05 -9.32628949342E+04 +CH_mp2_lr.inp 31 1e-05 -5.78120564924E+04 +H2O_mp2_lr_Coulomb_metric.inp 31 1e-05 -9.32542295092E+04 +H2O_mp2_mix_cl.inp 31 1e-05 -8.27072031429E+04 #EOF diff --git a/tests/QS/regtest-mp2-stress/TEST_FILES b/tests/QS/regtest-mp2-stress/TEST_FILES index edcba5ceda..dadad4b49d 100644 --- a/tests/QS/regtest-mp2-stress/TEST_FILES +++ b/tests/QS/regtest-mp2-stress/TEST_FILES @@ -1,6 +1,6 @@ -H2O_stress_an.inp 31 4E-5 -5.25556165651E-01 -H2O_stress_numdiag_mme.inp 31 4e-04 7.71586253050E-02 -H2_stress_num.inp 31 2e-04 -3.15708775879E+00 -H2_stress_num_mme.inp 31 1e-06 -1.10003978495E+00 -CH3_stress_an.inp 31 3e-04 1.66390217667E+01 +H2O_stress_an.inp 31 4E-5 -5.25556165651E+03 +H2O_stress_numdiag_mme.inp 31 4e-04 7.71586253050E+02 +H2_stress_num.inp 31 2e-04 -3.15708775879E+04 +H2_stress_num_mme.inp 31 1e-06 -1.10003978495E+04 +CH3_stress_an.inp 31 3e-04 1.66390217667E+05 #EOF diff --git a/tests/QS/regtest-nonortho/TEST_FILES b/tests/QS/regtest-nonortho/TEST_FILES index 9330c2b2fd..436cfe4024 100644 --- a/tests/QS/regtest-nonortho/TEST_FILES +++ b/tests/QS/regtest-nonortho/TEST_FILES @@ -3,6 +3,6 @@ graphite2.inp 2 3e-09 - graphite3.inp 2 2e-09 -0.195249325151E+02 graphite-stm.inp 0 graphite-lumo.inp 30 1.0E-14 -15.517030 -graph_b111.inp 31 1.0E-10 2.15956187930E+01 -graph_b111_gapw.inp 31 1.0E-10 1.70660769662E+01 +graph_b111.inp 31 1.0E-10 2.15956187930E+05 +graph_b111_gapw.inp 31 1.0E-10 1.70660769662E+05 #EOF diff --git a/tests/QS/regtest-ri-laplace-mp2-cubic-2/TEST_FILES b/tests/QS/regtest-ri-laplace-mp2-cubic-2/TEST_FILES index ee9c3dceb3..526a43ee5b 100644 --- a/tests/QS/regtest-ri-laplace-mp2-cubic-2/TEST_FILES +++ b/tests/QS/regtest-ri-laplace-mp2-cubic-2/TEST_FILES @@ -2,6 +2,6 @@ H2O_md.inp 11 5e-10 H2O_md_periodic.inp 11 5e-10 -17.072819528277421 H2O_dh_admm.inp 11 1e-8 -17.374161311241036 H2O_dh_meta.inp 11 1e-8 -17.098390876814651 -H2O_dh_stress.inp 31 1e-5 -1.06026734706E+01 +H2O_dh_stress.inp 31 1e-5 -1.06026734706E+05 CH3_md.inp 11 5e-10 -7.305999531027744 #EOF diff --git a/tests/QS/regtest-rpa-cubic-scaling-2/TEST_FILES b/tests/QS/regtest-rpa-cubic-scaling-2/TEST_FILES index 17013ec02b..17d0d6a4e6 100644 --- a/tests/QS/regtest-rpa-cubic-scaling-2/TEST_FILES +++ b/tests/QS/regtest-rpa-cubic-scaling-2/TEST_FILES @@ -2,7 +2,7 @@ H2O_md.inp 11 5e-10 H2O_md_periodic.inp 11 5e-10 -17.152310315958466 H2O_dh_admm.inp 11 1e-8 -17.396989762637503 H2O_dh_meta.inp 11 1e-8 -17.170279640063168 -H2O_dh_stress.inp 31 1e-5 2.47150975818E+01 +H2O_dh_stress.inp 31 1e-5 2.47150975818E+05 CH3_md_admm.inp 11 5e-10 -7.358442899510273 CH3_md_periodic.inp 11 5e-8 -6.826364548206040 H2O_added_mos.inp 0 diff --git a/tests/QS/regtest-stda/TEST_FILES b/tests/QS/regtest-stda/TEST_FILES index 86549d61cd..8f18890841 100644 --- a/tests/QS/regtest-stda/TEST_FILES +++ b/tests/QS/regtest-stda/TEST_FILES @@ -3,6 +3,6 @@ # e.g. 0 means do not compare anything, running is enough # 1 compares the last total energy in the file # for details see cp2k/tools/do_regtest -CH2O_none.inp 72 1.0E-06 0.00245398 +CH2O_none.inp 72 3.0E-06 2.45397540E-03 CH2O_s1.inp 72 1.0E-06 0.00464871 #EOF diff --git a/tests/QS/regtest-stress/TEST_FILES b/tests/QS/regtest-stress/TEST_FILES index 1eef99356b..a2263b1db4 100644 --- a/tests/QS/regtest-stress/TEST_FILES +++ b/tests/QS/regtest-stress/TEST_FILES @@ -1,9 +1,9 @@ -LiH-stress-lda-rks.inp 31 1.0E-09 1.43216316844E-02 -LiH-stress-lda-uks.inp 31 1.0E-09 -5.41331233597E-02 -LiH-stress-pbe-rks.inp 31 1.0E-09 3.10592428841E-01 -LiH-stress-pbe-uks.inp 31 1.0E-09 1.15090744258E-01 -SiC-stress-pbe-nlcc.inp 31 1.0E-09 -1.84632367133E+01 -SiC-stress-tpss.inp 31 1.0E-09 1.33145056114E+00 -SiC-stress-br89.inp 31 1.0E-09 -5.12223409624E+00 -LiH-stress-pbe-uks-vdW.inp 31 1.0E-09 -2.66548358795E-01 +LiH-stress-lda-rks.inp 31 1.0E-09 1.43216316844E+02 +LiH-stress-lda-uks.inp 31 1.0E-09 -5.41331233597E+02 +LiH-stress-pbe-rks.inp 31 1.0E-09 3.10592428841E+03 +LiH-stress-pbe-uks.inp 31 1.0E-09 1.15090744258E+03 +SiC-stress-pbe-nlcc.inp 31 1.0E-09 -1.84632367133E+05 +SiC-stress-tpss.inp 31 1.0E-09 1.33145056114E+04 +SiC-stress-br89.inp 31 1.0E-09 -5.12223409624E+04 +LiH-stress-pbe-uks-vdW.inp 31 1.0E-09 -2.66548358795E+03 #EOF diff --git a/tests/SE/regtest-3-3/TEST_FILES b/tests/SE/regtest-3-3/TEST_FILES index 9971541a99..68b90c73b7 100644 --- a/tests/SE/regtest-3-3/TEST_FILES +++ b/tests/SE/regtest-3-3/TEST_FILES @@ -6,6 +6,6 @@ wfn_ex4.inp 3 3e-14 - # EWALD with LSD H2O-4.inp 3 4e-11 -636.04298707893065 # NDDO Stress tensor -LiH.inp 31 1.0E-14 1.04528094398E+01 +LiH.inp 31 1.0E-14 1.04528094398E+05 # PERIODIC NDDO #EOF diff --git a/tests/TEST_TYPES b/tests/TEST_TYPES index 138f9c45d6..5cff120bfb 100644 --- a/tests/TEST_TYPES +++ b/tests/TEST_TYPES @@ -41,8 +41,8 @@ X=!2 HELIUM| Total energy = !5 Total charge and spin!9 DEBUG| Sum of differences!5 -SUM OF CORE FORCES !8 -SUM OF SHELL FORCES !8 +FORCES| Total core particle force !6 +FORCES| Total shell particle force !6 PRM01!2 Final value !6 SUMMARY:: Number of molecule kinds found:!7 @@ -52,7 +52,7 @@ Direct MP2 Canonical Energy =!6 RESP 1!4 Band gap: !4 Exchange-correlation energy: !3 -GRAND TOTAL FORCE !7 +FORCES| Grand total force !6 BASOPT| Total residuum value: !5 Final value of function !6 Emp2-RI = !3 @@ -70,7 +70,7 @@ TDDFPT|[[:space:]]*1 !3 Log(1-CN):!10 MD| Temperature \[K\] !4 Current value of constraint !6 -SUM OF ATOMIC FORCES !8 +FORCES| Total atomic force !5 Diabatic electronic coupling (rotation!6 Diabatic electronic coupling (wfn !7 Charge transfer energy!6