(git:47b47fb)
Loading...
Searching...
No Matches
tblite_reference_cli.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Optional native tblite command-line diagnostics.
10!> \note This module has no dependency on the tblite library.
11! **************************************************************************************************
12
13MODULE tblite_reference_cli
14
15 USE atomic_kind_types, ONLY: atomic_kind_type,&
16 get_atomic_kind
17 USE cell_types, ONLY: cell_type,&
18 get_cell
19 USE cp_control_types, ONLY: dft_control_type,&
20 xtb_reference_cli_type
21 USE cp_files, ONLY: close_file,&
22 open_file
23 USE cp_log_handling, ONLY: cp_get_default_logger,&
24 cp_logger_get_default_io_unit,&
25 cp_logger_type
26 USE cp_output_handling, ONLY: debug_print_level,&
27 high_print_level,&
28 silent_print_level
29 USE cp_units, ONLY: cp_unit_from_cp2k
30 USE input_constants, ONLY: &
31 gfn1xtb, gfn2xtb, ipea1xtb, smear_energy_window, smear_fermi_dirac, smear_gaussian, &
32 smear_list, smear_mp, smear_mv, tblite_cli_born_kernel_auto, tblite_cli_born_kernel_p16, &
33 tblite_cli_born_kernel_still, tblite_cli_solution_state_bar1mol, &
34 tblite_cli_solution_state_gsolv, tblite_cli_solution_state_reference, &
35 tblite_cli_solvation_alpb, tblite_cli_solvation_cpcm, tblite_cli_solvation_gb, &
36 tblite_cli_solvation_gbe, tblite_cli_solvation_gbsa, tblite_guess_ceh, tblite_guess_eeq, &
37 tblite_guess_sad, tblite_mixer_damping_default, tblite_mixer_max_weight_default, &
38 tblite_mixer_min_weight_default, tblite_mixer_omega0_default, &
39 tblite_mixer_weight_factor_default, tblite_scc_mixer_cp2k, tblite_solver_gvd, &
40 tblite_solver_gvr
41 USE kinds, ONLY: default_path_length,&
42 dp
43 USE kpoint_types, ONLY: get_kpoint_info,&
44 kpoint_type
45 USE machine, ONLY: m_unlink
46 USE message_passing, ONLY: mp_para_env_type
47 USE particle_types, ONLY: particle_type
48 USE qs_energy_types, ONLY: qs_energy_type
49 USE qs_environment_types, ONLY: get_qs_env,&
50 qs_environment_type
51 USE qs_force_types, ONLY: qs_force_type,&
52 total_qs_force
53 USE scf_control_types, ONLY: scf_control_type
54 USE virial_types, ONLY: virial_type
55#include "../base/base_uses.f90"
56
57 IMPLICIT NONE
58 PRIVATE
59
60 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'tblite_reference_cli'
61
62 PUBLIC :: tb_reference_cli_compare
63
64CONTAINS
65
66! **************************************************************************************************
67!> \brief Run native tblite CLI and compare against CP2K/tblite.
68!> \param qs_env ...
69! **************************************************************************************************
70 SUBROUTINE tb_reference_cli_compare(qs_env)
71
72 TYPE(qs_environment_type), POINTER :: qs_env
73
74 CHARACTER(LEN=*), PARAMETER :: routinen = 'tb_reference_cli_compare'
75
76 CHARACTER(LEN=16) :: solvation_model_name
77 CHARACTER(LEN=32) :: acc_str, charge_str, efield_x_str, efield_y_str, efield_z_str, &
78 etemp_guess_val_str, etemp_str, iter_str, spin_str, spinpol_str
79 CHARACTER(LEN=4*default_path_length+128) :: efield_str, etemp_guess_str, param_str, &
80 post_processing_output_str, post_processing_str, restart_str, solvation_str, verbosity_str
81 CHARACTER(LEN=64*default_path_length) :: command
82 CHARACTER(LEN=8) :: guess, method, solver
83 CHARACTER(LEN=default_path_length) :: file_base, gen_file, grad_file, &
84 json_file, log_file, &
85 post_processing_output_file
86 INTEGER :: handle, iounit, n_periodic, natom, nkp, &
87 reference_iterations, spin
88 INTEGER, DIMENSION(3) :: periodic
89 LOGICAL :: do_kpoints, have_energy, have_gradient, &
90 have_virial, success, too_large, &
91 unsupported_kpoints
92 REAL(kind=dp) :: cli_energy, cp_energy, ediff, etemp, &
93 etemp_guess, fmax, fsum, vmax, vsum
94 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: cli_gradient, cli_virial, cp_gradient
95 REAL(kind=dp), DIMENSION(:, :), POINTER :: xkp
96 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
97 TYPE(cell_type), POINTER :: cell
98 TYPE(cp_logger_type), POINTER :: logger
99 TYPE(dft_control_type), POINTER :: dft_control
100 TYPE(kpoint_type), POINTER :: kpoints
101 TYPE(mp_para_env_type), POINTER :: para_env
102 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
103 TYPE(qs_energy_type), POINTER :: energy
104 TYPE(qs_force_type), DIMENSION(:), POINTER :: force
105 TYPE(scf_control_type), POINTER :: scf_control
106 TYPE(virial_type), POINTER :: virial
107 TYPE(xtb_reference_cli_type) :: ref
108
109 CALL timeset(routinen, handle)
110
111 NULLIFY (atomic_kind_set, cell, dft_control, energy, force, kpoints, logger, para_env, particle_set, &
112 scf_control, virial, xkp)
113 CALL get_qs_env(qs_env=qs_env, atomic_kind_set=atomic_kind_set, cell=cell, &
114 dft_control=dft_control, energy=energy, force=force, &
115 para_env=para_env, particle_set=particle_set, scf_control=scf_control, &
116 virial=virial, do_kpoints=do_kpoints, kpoints=kpoints)
117
118 ref = dft_control%qs_control%xtb_control%reference_cli
119 IF (.NOT. ref%enabled) THEN
120 CALL timestop(handle)
121 RETURN
122 END IF
123 IF (.NOT. para_env%is_source()) THEN
124 CALL timestop(handle)
125 RETURN
126 END IF
127
128 logger => cp_get_default_logger()
129 iounit = cp_logger_get_default_io_unit(logger)
130 verbosity_str = ""
131 IF (logger%iter_info%print_level == silent_print_level) THEN
132 verbosity_str = " --silent"
133 ELSE IF (logger%iter_info%print_level == high_print_level .OR. &
134 logger%iter_info%print_level == debug_print_level) THEN
135 verbosity_str = " --verbose"
136 END IF
137 IF (ref%solvation_active) THEN
138 periodic = 0
139 IF (ASSOCIATED(cell)) CALL get_cell(cell=cell, periodic=periodic)
140 n_periodic = count(periodic == 1)
141 IF (n_periodic == 3) THEN
142 WRITE (unit=iounit, fmt="(/,T2,A)") &
143 "tblite reference CLI implicit solvation is not supported for PERIODIC XYZ."
144 WRITE (unit=iounit, fmt="(T2,A)") &
145 "Use PERIODIC NONE for molecular solvation diagnostics, or remove IMPLICIT_SOLVATION."
146 cpabort("REFERENCE_CLI implicit solvation is incompatible with PERIODIC XYZ")
147 ELSE IF (n_periodic > 0) THEN
148 WRITE (unit=iounit, fmt="(/,T2,A)") &
149 "WARNING: tblite reference CLI implicit solvation with finite periodicity is diagnostic only."
150 WRITE (unit=iounit, fmt="(T2,A,I0,A)") &
151 "The generated native tblite reference geometry has ", n_periodic, &
152 " periodic direction(s); continuum-solvation conventions are primarily molecular."
153 END IF
154 END IF
155 unsupported_kpoints = .false.
156 IF (do_kpoints .AND. ASSOCIATED(kpoints)) THEN
157 nkp = 0
158 CALL get_kpoint_info(kpoint=kpoints, nkp=nkp, xkp=xkp)
159 unsupported_kpoints = nkp > 1
160 IF (nkp == 1 .AND. ASSOCIATED(xkp)) unsupported_kpoints = any(abs(xkp(:, 1)) > 1.0e-12_dp)
161 END IF
162 IF (unsupported_kpoints) THEN
163 WRITE (unit=iounit, fmt="(/,T2,A)") &
164 "tblite reference CLI check skipped: CP2K KPOINTS are active."
165 WRITE (unit=iounit, fmt="(T2,A)") &
166 "The native tblite CLI reference path does not reproduce CP2K multi-k-point sampling."
167 IF (ref%stop_on_error) THEN
168 cpabort("tblite reference CLI cannot check CP2K k-point calculations")
169 END IF
170 CALL timestop(handle)
171 RETURN
172 END IF
173 IF (dft_control%qs_control%xtb_control%tblite_scc_mixer == tblite_scc_mixer_cp2k) THEN
174 WRITE (unit=iounit, fmt="(/,T2,A)") &
175 "WARNING: tblite reference CLI cannot reproduce XTB/SCC_MIXER CP2K."
176 WRITE (unit=iounit, fmt="(T2,A)") &
177 "The external native tblite run uses tblite's own SCC mixer; only the converged result is compared."
178 IF (ref%stop_on_error) cpabort("tblite reference CLI cannot reproduce SCC_MIXER CP2K")
179 END IF
180 natom = SIZE(particle_set)
181 method = tb_reference_method_name(dft_control%qs_control%xtb_control%tblite_method)
182 guess = tb_reference_guess_name(ref%guess)
183 solver = tb_reference_solver_name(dft_control%qs_control%xtb_control%tblite_mixer_solver)
184 file_base = tb_join_path(ref%work_directory, ref%prefix)
185 gen_file = trim(file_base)//".gen"
186 grad_file = trim(file_base)//".grad"
187 json_file = trim(file_base)//".json"
188 log_file = trim(file_base)//".log"
189 post_processing_output_file = ""
190 IF (len_trim(ref%grad_file) > 0) grad_file = ref%grad_file
191 IF (len_trim(ref%json_file) > 0) json_file = ref%json_file
192 IF (len_trim(ref%post_processing_output_file) > 0) THEN
193 post_processing_output_file = ref%post_processing_output_file
194 END IF
195
196 WRITE (charge_str, "(I0)") dft_control%charge
197 spin = max(0, dft_control%multiplicity - 1)
198 WRITE (spin_str, "(I0)") spin
199 WRITE (acc_str, "(ES16.8)") dft_control%qs_control%xtb_control%tblite_accuracy
200 reference_iterations = dft_control%qs_control%xtb_control%tblite_mixer_iterations
201 WRITE (iter_str, "(I0)") reference_iterations
202 efield_str = ""
203 IF (ref%efield_active) THEN
204 WRITE (efield_x_str, "(ES16.8)") ref%efield(1)
205 WRITE (efield_y_str, "(ES16.8)") ref%efield(2)
206 WRITE (efield_z_str, "(ES16.8)") ref%efield(3)
207 efield_str = " --efield "//trim(adjustl(efield_x_str))//","// &
208 trim(adjustl(efield_y_str))//","//trim(adjustl(efield_z_str))
209 END IF
210 solvation_str = ""
211 solvation_model_name = ""
212 IF (ref%solvation_active) THEN
213 SELECT CASE (ref%solvation_model)
214 CASE (tblite_cli_solvation_alpb)
215 solvation_model_name = "ALPB"
216 solvation_str = " --alpb "
217 CASE (tblite_cli_solvation_gbsa)
218 solvation_model_name = "GBSA"
219 solvation_str = " --gbsa "
220 CASE (tblite_cli_solvation_gbe)
221 solvation_model_name = "GBE"
222 solvation_str = " --gbe "
223 CASE (tblite_cli_solvation_gb)
224 solvation_model_name = "GB"
225 solvation_str = " --gb "
226 CASE (tblite_cli_solvation_cpcm)
227 solvation_model_name = "CPCM"
228 solvation_str = " --cpcm "
229 CASE DEFAULT
230 cpabort("Unknown tblite reference CLI implicit-solvation model")
231 END SELECT
232 solvation_str = trim(solvation_str)//" "//trim(tb_shell_quote(ref%solvation_solvent))
233 SELECT CASE (ref%solvation_born_kernel)
234 CASE (tblite_cli_born_kernel_auto)
235 CASE (tblite_cli_born_kernel_p16)
236 solvation_str = trim(solvation_str)//" --born-kernel p16"
237 CASE (tblite_cli_born_kernel_still)
238 solvation_str = trim(solvation_str)//" --born-kernel still"
239 CASE DEFAULT
240 cpabort("Unknown tblite reference CLI Born kernel")
241 END SELECT
242 SELECT CASE (ref%solvation_state)
243 CASE (tblite_cli_solution_state_gsolv)
244 CASE (tblite_cli_solution_state_bar1mol)
245 solvation_str = trim(solvation_str)//" --solv-state bar1mol"
246 CASE (tblite_cli_solution_state_reference)
247 solvation_str = trim(solvation_str)//" --solv-state reference"
248 CASE DEFAULT
249 cpabort("Unknown tblite reference CLI solution state")
250 END SELECT
251 END IF
252 IF (dft_control%qs_control%xtb_control%tblite_mixer_memory /= reference_iterations) THEN
253 WRITE (unit=iounit, fmt="(/,T2,A)") &
254 "WARNING: tblite reference CLI cannot reproduce XTB/TBLITE_MIXER/MEMORY."
255 WRITE (unit=iounit, fmt="(T2,A,I0,A,I0,A)") &
256 "The native reference run uses tblite's internal mixer memory tied to --iterations (", &
257 reference_iterations, "), while CP2K uses MEMORY ", &
258 dft_control%qs_control%xtb_control%tblite_mixer_memory, "."
259 IF (ref%stop_on_error) THEN
260 cpabort("tblite reference CLI cannot reproduce TBLITE_MIXER/MEMORY")
261 END IF
262 END IF
263 IF (abs(dft_control%qs_control%xtb_control%tblite_mixer_damping - &
264 tblite_mixer_damping_default) > 10.0_dp*epsilon(1.0_dp)) THEN
265 WRITE (unit=iounit, fmt="(/,T2,A)") &
266 "WARNING: tblite reference CLI cannot reproduce XTB/TBLITE_MIXER/DAMPING."
267 WRITE (unit=iounit, fmt="(T2,A,F8.4,A,F8.4,A)") &
268 "The native reference run uses tblite's library default ", tblite_mixer_damping_default, &
269 ", while CP2K uses DAMPING ", dft_control%qs_control%xtb_control%tblite_mixer_damping, "."
270 IF (ref%stop_on_error) THEN
271 cpabort("tblite reference CLI cannot reproduce TBLITE_MIXER/DAMPING")
272 END IF
273 END IF
274 IF (abs(dft_control%qs_control%xtb_control%tblite_mixer_omega0 - &
275 tblite_mixer_omega0_default) > 10.0_dp*epsilon(1.0_dp)) THEN
276 WRITE (unit=iounit, fmt="(/,T2,A)") &
277 "WARNING: tblite reference CLI cannot reproduce XTB/TBLITE_MIXER/OMEGA0."
278 WRITE (unit=iounit, fmt="(T2,A,ES12.4,A,ES12.4,A)") &
279 "The native reference run uses tblite's library default ", tblite_mixer_omega0_default, &
280 ", while CP2K uses OMEGA0 ", dft_control%qs_control%xtb_control%tblite_mixer_omega0, "."
281 IF (ref%stop_on_error) THEN
282 cpabort("tblite reference CLI cannot reproduce TBLITE_MIXER/OMEGA0")
283 END IF
284 END IF
285 IF (abs(dft_control%qs_control%xtb_control%tblite_mixer_min_weight - &
286 tblite_mixer_min_weight_default) > 10.0_dp*epsilon(1.0_dp)) THEN
287 WRITE (unit=iounit, fmt="(/,T2,A)") &
288 "WARNING: tblite reference CLI cannot reproduce XTB/TBLITE_MIXER/MIN_WEIGHT."
289 WRITE (unit=iounit, fmt="(T2,A,ES12.4,A,ES12.4,A)") &
290 "The native reference run uses tblite's library default ", tblite_mixer_min_weight_default, &
291 ", while CP2K uses MIN_WEIGHT ", dft_control%qs_control%xtb_control%tblite_mixer_min_weight, "."
292 IF (ref%stop_on_error) THEN
293 cpabort("tblite reference CLI cannot reproduce TBLITE_MIXER/MIN_WEIGHT")
294 END IF
295 END IF
296 IF (abs(dft_control%qs_control%xtb_control%tblite_mixer_max_weight - &
297 tblite_mixer_max_weight_default) > 10.0_dp*epsilon(1.0_dp)) THEN
298 WRITE (unit=iounit, fmt="(/,T2,A)") &
299 "WARNING: tblite reference CLI cannot reproduce XTB/TBLITE_MIXER/MAX_WEIGHT."
300 WRITE (unit=iounit, fmt="(T2,A,ES12.4,A,ES12.4,A)") &
301 "The native reference run uses tblite's library default ", tblite_mixer_max_weight_default, &
302 ", while CP2K uses MAX_WEIGHT ", dft_control%qs_control%xtb_control%tblite_mixer_max_weight, "."
303 IF (ref%stop_on_error) THEN
304 cpabort("tblite reference CLI cannot reproduce TBLITE_MIXER/MAX_WEIGHT")
305 END IF
306 END IF
307 IF (abs(dft_control%qs_control%xtb_control%tblite_mixer_weight_factor - &
308 tblite_mixer_weight_factor_default) > 10.0_dp*epsilon(1.0_dp)) THEN
309 WRITE (unit=iounit, fmt="(/,T2,A)") &
310 "WARNING: tblite reference CLI cannot reproduce XTB/TBLITE_MIXER/WEIGHT_FACTOR."
311 WRITE (unit=iounit, fmt="(T2,A,ES12.4,A,ES12.4,A)") &
312 "The native reference run uses tblite's library default ", tblite_mixer_weight_factor_default, &
313 ", while CP2K uses WEIGHT_FACTOR ", &
314 dft_control%qs_control%xtb_control%tblite_mixer_weight_factor, "."
315 IF (ref%stop_on_error) THEN
316 cpabort("tblite reference CLI cannot reproduce TBLITE_MIXER/WEIGHT_FACTOR")
317 END IF
318 END IF
319 etemp = 300.0_dp
320 IF (ASSOCIATED(scf_control)) THEN
321 IF (ASSOCIATED(scf_control%smear)) THEN
322 IF (scf_control%smear%do_smear) THEN
323 etemp = cp_unit_from_cp2k(scf_control%smear%electronic_temperature, "K")
324 IF (scf_control%smear%method /= smear_fermi_dirac) THEN
325 WRITE (unit=iounit, fmt="(/,T2,A,A,A)") &
326 "WARNING: tblite reference CLI cannot reproduce CP2K smearing method ", &
327 trim(tb_reference_smear_method_name(scf_control%smear%method)), "."
328 WRITE (unit=iounit, fmt="(T2,A,F12.3,A)") &
329 "The native reference run uses Fermi-Dirac electronic temperature ", etemp, " K instead."
330 END IF
331 END IF
332 END IF
333 END IF
334 WRITE (etemp_str, "(ES16.8)") etemp
335 etemp_guess = 0.0_dp
336 etemp_guess_str = ""
337 IF (ref%electronic_temperature_guess > 0.0_dp) THEN
338 etemp_guess = cp_unit_from_cp2k(ref%electronic_temperature_guess, "K")
339 WRITE (etemp_guess_val_str, "(ES16.8)") etemp_guess
340 etemp_guess_str = " --etemp-guess "//trim(adjustl(etemp_guess_val_str))
341 END IF
342 param_str = ""
343 IF (len_trim(dft_control%qs_control%xtb_control%tblite_param_file) > 0) THEN
344 param_str = " --param "//trim(tb_shell_quote(dft_control%qs_control%xtb_control%tblite_param_file))
345 END IF
346 spinpol_str = ""
347 IF (dft_control%lsd) spinpol_str = " --spin-polarized"
348 post_processing_str = ""
349 IF (len_trim(ref%post_processing) > 0) THEN
350 post_processing_str = " --post-processing "//trim(tb_shell_quote(ref%post_processing))
351 END IF
352 post_processing_output_str = ""
353 IF (len_trim(post_processing_output_file) > 0) THEN
354 WRITE (unit=iounit, fmt="(/,T2,A)") &
355 "WARNING: tblite reference CLI POST_PROCESSING_OUTPUT was requested explicitly."
356 WRITE (unit=iounit, fmt="(T2,A)") &
357 "Some tblite 0.5.0 command-line builds document --post-processing-output but do not parse it."
358 post_processing_output_str = " --post-processing-output "// &
359 trim(tb_shell_quote(post_processing_output_file))
360 END IF
361 restart_str = " --no-restart"
362 IF (len_trim(ref%restart_file) > 0) THEN
363 restart_str = " --restart "//trim(tb_shell_quote(ref%restart_file))
364 END IF
365
366 CALL tb_write_reference_gen(qs_env, trim(gen_file))
367
368 command = trim(tb_shell_quote(ref%program_name))//" run --method "//trim(method)// &
369 trim(param_str)// &
370 trim(spinpol_str)// &
371 " --charge "//trim(adjustl(charge_str))// &
372 " --spin "//trim(adjustl(spin_str))// &
373 " --acc "//trim(adjustl(acc_str))// &
374 " --guess "//trim(guess)// &
375 " --solver "//trim(solver)// &
376 " --iterations "//trim(adjustl(iter_str))// &
377 " --etemp "//trim(adjustl(etemp_str))// &
378 trim(etemp_guess_str)// &
379 trim(efield_str)// &
380 trim(solvation_str)// &
381 trim(post_processing_str)// &
382 trim(post_processing_output_str)// &
383 trim(restart_str)// &
384 trim(verbosity_str)//" --input "//trim(tb_shell_quote(ref%input_format))// &
385 " --grad "//trim(tb_shell_quote(grad_file))// &
386 " --json "//trim(tb_shell_quote(json_file))//" "//trim(tb_shell_quote(gen_file))// &
387 " > "//trim(tb_shell_quote(log_file))//" 2>&1"
388
389 CALL tb_reference_cli_execute(ref, "run", command, log_file, iounit, success)
390 IF (.NOT. success) THEN
391 ! Retain the geometry and diagnostic output on failure, even without KEEP_FILES.
392 CALL timestop(handle)
393 RETURN
394 END IF
395
396 ALLOCATE (cli_gradient(3, natom), cli_virial(3, 3))
397 CALL tb_read_reference_grad(trim(grad_file), natom, cli_energy, cli_gradient, cli_virial, &
398 have_energy, have_gradient, have_virial)
399
400 WRITE (unit=iounit, fmt="(/,T2,A)") "tblite reference CLI check"
401 WRITE (unit=iounit, fmt="(T2,A,A)") "Executable: ", trim(ref%program_name)
402 WRITE (unit=iounit, fmt="(T2,A,A)") "Method: ", trim(method)
403 WRITE (unit=iounit, fmt="(T2,A,A)") "Guess: ", trim(guess)
404 WRITE (unit=iounit, fmt="(T2,A,A)") "Solver: ", trim(solver)
405 WRITE (unit=iounit, fmt="(T2,A,L1)") "Spin-pol.: ", dft_control%lsd
406 IF (ref%efield_active) THEN
407 WRITE (unit=iounit, fmt="(T2,A,3ES16.8,A)") "Efield: ", ref%efield, " V/Angstrom"
408 END IF
409 IF (ref%solvation_active) THEN
410 WRITE (unit=iounit, fmt="(T2,A,A,1X,A)") "Solvation: ", trim(solvation_model_name), &
411 trim(ref%solvation_solvent)
412 END IF
413 IF (len_trim(ref%post_processing) > 0) THEN
414 WRITE (unit=iounit, fmt="(T2,A,A)") "Post proc.: ", trim(ref%post_processing)
415 END IF
416 IF (len_trim(post_processing_output_file) > 0) THEN
417 WRITE (unit=iounit, fmt="(T2,A,A)") "PP output: ", trim(post_processing_output_file)
418 END IF
419 IF (ref%electronic_temperature_guess > 0.0_dp) THEN
420 WRITE (unit=iounit, fmt="(T2,A,F12.3,A)") "Guess etemp:", etemp_guess, " K"
421 END IF
422 WRITE (unit=iounit, fmt="(T2,A,A)") "Grad file: ", trim(grad_file)
423 WRITE (unit=iounit, fmt="(T2,A,A)") "JSON file: ", trim(json_file)
424 WRITE (unit=iounit, fmt="(T2,A,A)") "Log file: ", trim(log_file)
425
426 too_large = .false.
427 IF (ref%check_energy) THEN
428 IF (have_energy) THEN
429 cp_energy = energy%total
430 ediff = abs(cp_energy - cli_energy)
431 WRITE (unit=iounit, fmt="(T2,A,3ES22.12)") &
432 "Energy CP2K/CLI/absdiff:", cp_energy, cli_energy, ediff
433 too_large = too_large .OR. ediff > ref%error_limit
434 ELSE
435 WRITE (unit=iounit, fmt="(T2,A)") "Energy check skipped: no CLI energy found."
436 END IF
437 END IF
438
439 IF (ref%check_forces) THEN
440 IF (have_gradient .AND. ASSOCIATED(force)) THEN
441 ALLOCATE (cp_gradient(3, natom))
442 CALL total_qs_force(cp_gradient, force, atomic_kind_set)
443 fsum = sum(abs(cp_gradient - cli_gradient))
444 fmax = maxval(abs(cp_gradient - cli_gradient))
445 WRITE (unit=iounit, fmt="(T2,A,2ES22.12)") "Gradient diff sum/max:", fsum, fmax
446 too_large = too_large .OR. fmax > ref%error_limit
447 DEALLOCATE (cp_gradient)
448 ELSE
449 WRITE (unit=iounit, fmt="(T2,A)") "Gradient check skipped: no CLI gradient or CP2K force found."
450 END IF
451 END IF
452
453 IF (ref%check_virial) THEN
454 IF (have_virial .AND. ASSOCIATED(virial)) THEN
455 ! Native tblite prints the positive cell derivative; CP2K stores the PV virial
456 ! with the opposite sign.
457 vsum = sum(abs(-virial%pv_virial - cli_virial))
458 vmax = maxval(abs(-virial%pv_virial - cli_virial))
459 WRITE (unit=iounit, fmt="(T2,A,2ES22.12)") "Virial diff sum/max:", vsum, vmax
460 too_large = too_large .OR. vmax > ref%error_limit
461 ELSE
462 WRITE (unit=iounit, fmt="(T2,A)") "Virial check skipped: no CLI virial or CP2K virial found."
463 END IF
464 END IF
465
466 IF (too_large) THEN
467 WRITE (unit=iounit, fmt="(T2,A,ES12.4)") &
468 "tblite reference CLI deviation exceeded ERROR_LIMIT = ", ref%error_limit
469 IF (ref%stop_on_error) cpabort("tblite reference CLI deviation exceeded ERROR_LIMIT")
470 END IF
471
472 CALL tb_reference_cli_aux_commands(ref, dft_control, gen_file, file_base, verbosity_str, iounit, success)
473
474 IF (success .AND. .NOT. too_large) THEN
475 CALL tb_reference_cleanup(ref, gen_file, grad_file, json_file, log_file, post_processing_output_file)
476 END IF
477 DEALLOCATE (cli_gradient, cli_virial)
478
479 CALL timestop(handle)
480
481 END SUBROUTINE tb_reference_cli_compare
482
483! **************************************************************************************************
484!> \brief Map CP2K tblite method id to native tblite CLI method name.
485!> \param method_id ...
486!> \return ...
487! **************************************************************************************************
488 FUNCTION tb_reference_method_name(method_id) RESULT(method)
489 INTEGER, INTENT(IN) :: method_id
490 CHARACTER(LEN=8) :: method
491
492 SELECT CASE (method_id)
493 CASE (gfn1xtb)
494 method = "gfn1"
495 CASE (gfn2xtb)
496 method = "gfn2"
497 CASE (ipea1xtb)
498 method = "ipea1"
499 CASE DEFAULT
500 cpabort("Unknown tblite reference CLI method")
501 END SELECT
502
503 END FUNCTION tb_reference_method_name
504
505! **************************************************************************************************
506!> \brief Map CP2K tblite reference CLI guess id to native tblite CLI guess name.
507!> \param guess_id ...
508!> \return ...
509! **************************************************************************************************
510 FUNCTION tb_reference_guess_name(guess_id) RESULT(guess)
511 INTEGER, INTENT(IN) :: guess_id
512 CHARACTER(LEN=8) :: guess
513
514 SELECT CASE (guess_id)
515 CASE (tblite_guess_sad)
516 guess = "sad"
517 CASE (tblite_guess_eeq)
518 guess = "eeq"
519 CASE (tblite_guess_ceh)
520 guess = "ceh"
521 CASE DEFAULT
522 cpabort("Unknown tblite reference CLI guess")
523 END SELECT
524
525 END FUNCTION tb_reference_guess_name
526
527! **************************************************************************************************
528!> \brief Map CP2K tblite solver id to native tblite CLI solver name.
529!> \param solver_id ...
530!> \return ...
531! **************************************************************************************************
532 FUNCTION tb_reference_solver_name(solver_id) RESULT(solver)
533 INTEGER, INTENT(IN) :: solver_id
534 CHARACTER(LEN=8) :: solver
535
536 SELECT CASE (solver_id)
537 CASE (tblite_solver_gvd)
538 solver = "gvd"
539 CASE (tblite_solver_gvr)
540 solver = "gvr"
541 CASE DEFAULT
542 cpabort("Unknown tblite reference CLI solver")
543 END SELECT
544
545 END FUNCTION tb_reference_solver_name
546
547! **************************************************************************************************
548!> \brief Map CP2K smearing method id to a diagnostic label.
549!> \param method_id ...
550!> \return ...
551! **************************************************************************************************
552 FUNCTION tb_reference_smear_method_name(method_id) RESULT(method)
553 INTEGER, INTENT(IN) :: method_id
554 CHARACTER(LEN=24) :: method
555
556 SELECT CASE (method_id)
557 CASE (smear_fermi_dirac)
558 method = "FERMI_DIRAC"
559 CASE (smear_energy_window)
560 method = "ENERGY_WINDOW"
561 CASE (smear_list)
562 method = "LIST"
563 CASE (smear_gaussian)
564 method = "GAUSSIAN"
565 CASE (smear_mp)
566 method = "METHFESSEL_PAXTON"
567 CASE (smear_mv)
568 method = "MARZARI_VANDERBILT"
569 CASE DEFAULT
570 method = "UNKNOWN"
571 END SELECT
572
573 END FUNCTION tb_reference_smear_method_name
574
575! **************************************************************************************************
576!> \brief Run optional native tblite auxiliary subcommands.
577!> \param ref ...
578!> \param dft_control ...
579!> \param gen_file ...
580!> \param file_base ...
581!> \param verbosity_str ...
582!> \param iounit ...
583!> \param success Whether all requested commands completed successfully.
584! **************************************************************************************************
585 SUBROUTINE tb_reference_cli_aux_commands(ref, dft_control, gen_file, file_base, verbosity_str, iounit, success)
586
587 TYPE(xtb_reference_cli_type), INTENT(IN) :: ref
588 TYPE(dft_control_type), INTENT(IN) :: dft_control
589 CHARACTER(LEN=*), INTENT(IN) :: gen_file, file_base, verbosity_str
590 INTEGER, INTENT(IN) :: iounit
591 LOGICAL, INTENT(OUT) :: success
592
593 CHARACTER(LEN=32) :: charge_str, efield_x_str, efield_y_str, &
594 efield_z_str, etemp_guess_val_str, &
595 spin_str
596 CHARACTER(LEN=4*default_path_length+128) :: copy_str, dry_run_str, efield_str, &
597 etemp_guess_str, grad_str, json_str, &
598 method_str, output_str
599 CHARACTER(LEN=64*default_path_length) :: command
600 CHARACTER(LEN=default_path_length) :: guess_input, log_file
601 INTEGER :: spin
602 LOGICAL :: command_success
603 REAL(kind=dp) :: etemp_guess
604
605 success = .true.
606 WRITE (charge_str, "(I0)") dft_control%charge
607 spin = max(0, dft_control%multiplicity - 1)
608 WRITE (spin_str, "(I0)") spin
609
610 IF (ref%guess_cli%enabled) THEN
611 guess_input = ref%guess_cli%input_file
612 IF (len_trim(guess_input) == 0) guess_input = gen_file
613 etemp_guess_str = ""
614 IF (ref%guess_cli%electronic_temperature_guess > 0.0_dp) THEN
615 etemp_guess = cp_unit_from_cp2k(ref%guess_cli%electronic_temperature_guess, "K")
616 WRITE (etemp_guess_val_str, "(ES16.8)") etemp_guess
617 etemp_guess_str = " --etemp-guess "//trim(adjustl(etemp_guess_val_str))
618 END IF
619 efield_str = ""
620 IF (ref%guess_cli%efield_active) THEN
621 WRITE (efield_x_str, "(ES16.8)") ref%guess_cli%efield(1)
622 WRITE (efield_y_str, "(ES16.8)") ref%guess_cli%efield(2)
623 WRITE (efield_z_str, "(ES16.8)") ref%guess_cli%efield(3)
624 efield_str = " --efield "//trim(adjustl(efield_x_str))//","// &
625 trim(adjustl(efield_y_str))//","//trim(adjustl(efield_z_str))
626 END IF
627 grad_str = ""
628 IF (ref%guess_cli%grad) grad_str = " --grad"
629 json_str = ""
630 IF (len_trim(ref%guess_cli%json_file) > 0) THEN
631 json_str = " --json "//trim(tb_shell_quote(ref%guess_cli%json_file))
632 END IF
633 log_file = trim(file_base)//".guess.log"
634 command = trim(tb_shell_quote(ref%program_name))// &
635 " guess --charge "//trim(adjustl(charge_str))// &
636 " --spin "//trim(adjustl(spin_str))// &
637 " --method "//trim(tb_reference_guess_name(ref%guess_cli%method))// &
638 " --solver "//trim(tb_reference_solver_name(ref%guess_cli%solver))// &
639 trim(etemp_guess_str)// &
640 trim(efield_str)// &
641 trim(grad_str)// &
642 trim(json_str)// &
643 trim(verbosity_str)//" --input "//trim(tb_shell_quote(ref%guess_cli%input_format))// &
644 " "//trim(tb_shell_quote(guess_input))// &
645 " > "//trim(tb_shell_quote(log_file))//" 2>&1"
646 CALL tb_reference_cli_execute(ref, "guess", command, log_file, iounit, command_success)
647 success = success .AND. command_success
648 IF (command_success .AND. .NOT. ref%keep_files) CALL tb_delete_file(log_file)
649 IF (command_success .AND. .NOT. ref%keep_files .AND. len_trim(ref%guess_cli%json_file) > 0) THEN
650 CALL tb_delete_file(ref%guess_cli%json_file)
651 END IF
652 END IF
653
654 IF (ref%param_cli%enabled) THEN
655 method_str = ""
656 IF (ref%param_cli%method_explicit .OR. len_trim(ref%param_cli%input_file) == 0) THEN
657 method_str = " --method "// &
658 trim(tb_reference_method_name(merge(ref%param_cli%method, &
659 dft_control%qs_control%xtb_control%tblite_method, &
660 ref%param_cli%method_explicit)))
661 END IF
662 output_str = ""
663 IF (len_trim(ref%param_cli%output_file) > 0) THEN
664 output_str = " --output "//trim(tb_shell_quote(ref%param_cli%output_file))
665 END IF
666 log_file = trim(file_base)//".param.log"
667 command = trim(tb_shell_quote(ref%program_name))//" param"// &
668 trim(method_str)// &
669 trim(output_str)
670 IF (len_trim(ref%param_cli%input_file) > 0) THEN
671 command = trim(command)//" "//trim(tb_shell_quote(ref%param_cli%input_file))
672 END IF
673 command = trim(command)//" > "//trim(tb_shell_quote(log_file))//" 2>&1"
674 CALL tb_reference_cli_execute(ref, "param", command, log_file, iounit, command_success)
675 success = success .AND. command_success
676 IF (command_success .AND. .NOT. ref%keep_files) CALL tb_delete_file(log_file)
677 IF (command_success .AND. .NOT. ref%keep_files .AND. len_trim(ref%param_cli%output_file) > 0) THEN
678 CALL tb_delete_file(ref%param_cli%output_file)
679 END IF
680 END IF
681
682 IF (ref%fit_cli%enabled) THEN
683 dry_run_str = ""
684 IF (ref%fit_cli%dry_run) dry_run_str = " --dry-run"
685 copy_str = ""
686 IF (len_trim(ref%fit_cli%copy_file) > 0) THEN
687 copy_str = " --copy "//trim(tb_shell_quote(ref%fit_cli%copy_file))
688 END IF
689 log_file = trim(file_base)//".fit.log"
690 command = trim(tb_shell_quote(ref%program_name))//" fit"// &
691 trim(dry_run_str)// &
692 trim(copy_str)// &
693 trim(verbosity_str)//" "//trim(tb_shell_quote(ref%fit_cli%param_file))// &
694 " "//trim(tb_shell_quote(ref%fit_cli%input_file))// &
695 " > "//trim(tb_shell_quote(log_file))//" 2>&1"
696 CALL tb_reference_cli_execute(ref, "fit", command, log_file, iounit, command_success)
697 success = success .AND. command_success
698 IF (command_success .AND. .NOT. ref%keep_files) CALL tb_delete_file(log_file)
699 IF (command_success .AND. .NOT. ref%keep_files .AND. len_trim(ref%fit_cli%copy_file) > 0) THEN
700 CALL tb_delete_file(ref%fit_cli%copy_file)
701 END IF
702 END IF
703
704 IF (ref%tagdiff_cli%enabled) THEN
705 method_str = ""
706 IF (ref%tagdiff_cli%fit) method_str = " --fit"
707 log_file = trim(file_base)//".tagdiff.log"
708 command = trim(tb_shell_quote(ref%program_name))//" tagdiff"// &
709 trim(method_str)//" "//trim(tb_shell_quote(ref%tagdiff_cli%actual_file))// &
710 " "//trim(tb_shell_quote(ref%tagdiff_cli%reference_file))// &
711 " > "//trim(tb_shell_quote(log_file))//" 2>&1"
712 CALL tb_reference_cli_execute(ref, "tagdiff", command, log_file, iounit, command_success)
713 success = success .AND. command_success
714 IF (command_success .AND. .NOT. ref%keep_files) CALL tb_delete_file(log_file)
715 END IF
716
717 END SUBROUTINE tb_reference_cli_aux_commands
718
719! **************************************************************************************************
720!> \brief Execute one native tblite REFERENCE_CLI command.
721!> \param ref ...
722!> \param label ...
723!> \param command ...
724!> \param log_file ...
725!> \param iounit ...
726!> \param success Whether all requested commands completed successfully.
727!> \note Keep the external-process exception confined to this optional diagnostic path.
728! **************************************************************************************************
729 SUBROUTINE tb_reference_cli_execute(ref, label, command, log_file, iounit, success)
730
731 TYPE(xtb_reference_cli_type), INTENT(IN) :: ref
732 CHARACTER(LEN=*), INTENT(IN) :: label, command, log_file
733 INTEGER, INTENT(IN) :: iounit
734 LOGICAL, INTENT(OUT) :: success
735
736 CHARACTER(LEN=default_path_length) :: cmdmsg
737 INTEGER :: cmdstat, exitstat
738
739 cmdmsg = ""
740 cmdstat = 0
741 exitstat = 0
742 CALL execute_command_line(trim(command), exitstat=exitstat, cmdstat=cmdstat, cmdmsg=cmdmsg)
743 success = cmdstat == 0 .AND. exitstat == 0
744 IF (.NOT. success) THEN
745 WRITE (unit=iounit, fmt="(/,T2,A)") "tblite reference CLI check failed to run."
746 WRITE (unit=iounit, fmt="(T2,A,A)") "Command: ", trim(command)
747 WRITE (unit=iounit, fmt="(T2,A,I0,T32,A,I0)") "cmdstat:", cmdstat, "exitstat:", exitstat
748 IF (cmdstat /= 0) WRITE (unit=iounit, fmt="(T2,A,A)") "Execution error: ", trim(cmdmsg)
749 WRITE (unit=iounit, fmt="(T2,A,A)") "Diagnostic files retained; log: ", trim(log_file)
750 IF (ref%stop_on_error) cpabort("tblite reference CLI command failed")
751 ELSE
752 WRITE (unit=iounit, fmt="(/,T2,A,A)") "tblite reference CLI command completed: ", &
753 trim(label)
754 WRITE (unit=iounit, fmt="(T2,A,A)") "Log file: ", trim(log_file)
755 END IF
756
757 END SUBROUTINE tb_reference_cli_execute
758
759! **************************************************************************************************
760!> \brief Join directory and filename.
761!> \param directory ...
762!> \param filename ...
763!> \return ...
764! **************************************************************************************************
765 FUNCTION tb_join_path(directory, filename) RESULT(path)
766 CHARACTER(LEN=*), INTENT(IN) :: directory, filename
767 CHARACTER(LEN=default_path_length) :: path
768
769 IF (len_trim(directory) == 0 .OR. trim(directory) == ".") THEN
770 path = trim(filename)
771 ELSE IF (directory(len_trim(directory):len_trim(directory)) == "/") THEN
772 path = trim(directory)//trim(filename)
773 ELSE
774 path = trim(directory)//"/"//trim(filename)
775 END IF
776
777 END FUNCTION tb_join_path
778
779! **************************************************************************************************
780!> \brief Shell-quote a filename or executable path.
781!> \param text ...
782!> \return ...
783! **************************************************************************************************
784 FUNCTION tb_shell_quote(text) RESULT(quoted)
785 CHARACTER(LEN=*), INTENT(IN) :: text
786 CHARACTER(LEN=4*LEN_TRIM(text)+2) :: quoted
787
788 INTEGER :: i, pos
789
790 quoted = "'"
791 pos = 2
792 DO i = 1, len_trim(text)
793 IF (text(i:i) == "'") THEN
794 ! End the quoted part, escape the apostrophe, then resume quoting.
795 ! ACHAR avoids dependence on the compiler's backslash-literal mode.
796 quoted(pos:pos + 3) = "'"//achar(92)//"''"
797 pos = pos + 4
798 ELSE
799 quoted(pos:pos) = text(i:i)
800 pos = pos + 1
801 END IF
802 END DO
803 quoted(pos:pos) = "'"
804
805 END FUNCTION tb_shell_quote
806
807! **************************************************************************************************
808!> \brief Write current CP2K geometry as DFTB+ gen format for native tblite.
809!> \param qs_env ...
810!> \param filename ...
811! **************************************************************************************************
812 SUBROUTINE tb_write_reference_gen(qs_env, filename)
813
814 TYPE(qs_environment_type), POINTER :: qs_env
815 CHARACTER(LEN=*), INTENT(IN) :: filename
816
817 CHARACTER(LEN=2), ALLOCATABLE, DIMENSION(:) :: symbols, unique_symbols
818 INTEGER :: iatom, ikind, natom, nuniq, unit_nr
819 INTEGER, ALLOCATABLE, DIMENSION(:) :: species
820 INTEGER, DIMENSION(3) :: periodic
821 LOGICAL :: found
822 REAL(kind=dp) :: to_angstrom
823 TYPE(cell_type), POINTER :: cell
824 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
825
826 NULLIFY (cell, particle_set)
827 CALL get_qs_env(qs_env=qs_env, cell=cell, particle_set=particle_set)
828
829 natom = SIZE(particle_set)
830 to_angstrom = cp_unit_from_cp2k(1.0_dp, "angstrom")
831 ALLOCATE (symbols(natom), unique_symbols(natom), species(natom))
832 nuniq = 0
833 DO iatom = 1, natom
834 CALL get_atomic_kind(particle_set(iatom)%atomic_kind, element_symbol=symbols(iatom))
835 found = .false.
836 DO ikind = 1, nuniq
837 IF (trim(unique_symbols(ikind)) == trim(symbols(iatom))) THEN
838 found = .true.
839 EXIT
840 END IF
841 END DO
842 IF (.NOT. found) THEN
843 nuniq = nuniq + 1
844 unique_symbols(nuniq) = symbols(iatom)
845 ikind = nuniq
846 END IF
847 species(iatom) = ikind
848 END DO
849
850 CALL open_file(file_name=filename, unit_number=unit_nr, file_status="REPLACE", &
851 file_action="WRITE")
852
853 CALL get_cell(cell=cell, periodic=periodic)
854 IF (any(periodic == 1)) THEN
855 WRITE (unit=unit_nr, fmt="(I0,1X,A)") natom, "S"
856 ELSE
857 WRITE (unit=unit_nr, fmt="(I0,1X,A)") natom, "C"
858 END IF
859 WRITE (unit=unit_nr, fmt="(*(A,1X))") (trim(unique_symbols(ikind)), ikind=1, nuniq)
860 DO iatom = 1, natom
861 WRITE (unit=unit_nr, fmt="(I0,1X,I0,3(1X,ES24.16))") &
862 iatom, species(iatom), particle_set(iatom)%r(:)*to_angstrom
863 END DO
864 IF (any(periodic == 1)) THEN
865 WRITE (unit=unit_nr, fmt="(3(1X,ES24.16))") 0.0_dp, 0.0_dp, 0.0_dp
866 DO ikind = 1, 3
867 WRITE (unit=unit_nr, fmt="(3(1X,ES24.16))") cell%hmat(:, ikind)*to_angstrom
868 END DO
869 END IF
870 CALL close_file(unit_nr)
871
872 DEALLOCATE (symbols, unique_symbols, species)
873
874 END SUBROUTINE tb_write_reference_gen
875
876! **************************************************************************************************
877!> \brief Read native tblite gradient file.
878!> \param filename ...
879!> \param natom ...
880!> \param energy ...
881!> \param gradient ...
882!> \param virial ...
883!> \param have_energy ...
884!> \param have_gradient ...
885!> \param have_virial ...
886! **************************************************************************************************
887 SUBROUTINE tb_read_reference_grad(filename, natom, energy, gradient, virial, &
888 have_energy, have_gradient, have_virial)
889
890 CHARACTER(LEN=*), INTENT(IN) :: filename
891 INTEGER, INTENT(IN) :: natom
892 REAL(kind=dp), INTENT(OUT) :: energy
893 REAL(kind=dp), DIMENSION(:, :), INTENT(OUT) :: gradient, virial
894 LOGICAL, INTENT(OUT) :: have_energy, have_gradient, have_virial
895
896 CHARACTER(LEN=1024) :: line
897 INTEGER :: ios, nread, unit_nr
898 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: values
899
900 have_energy = .false.
901 have_gradient = .false.
902 have_virial = .false.
903 energy = 0.0_dp
904 gradient = 0.0_dp
905 virial = 0.0_dp
906
907 ! Keep this diagnostic read nonfatal and confined to the requested output path.
908 OPEN (newunit=unit_nr, file=trim(filename), status="OLD", action="READ", &
909 form="FORMATTED", iostat=ios)
910 IF (ios /= 0) RETURN
911
912 DO
913 READ (unit=unit_nr, fmt="(A)", iostat=ios) line
914 IF (ios /= 0) EXIT
915 IF (index(line, "energy :real:0:") > 0) THEN
916 READ (unit=unit_nr, fmt="(A)", iostat=ios) line
917 IF (ios == 0) THEN
918 READ (line, *, iostat=ios) energy
919 have_energy = ios == 0
920 END IF
921 ELSE IF (index(line, "gradient :real:2:3,") > 0) THEN
922 ALLOCATE (values(3*natom))
923 CALL tb_read_real_values(unit_nr, values, nread)
924 IF (nread == 3*natom) THEN
925 CALL tb_values_to_matrix(values, gradient)
926 have_gradient = .true.
927 END IF
928 DEALLOCATE (values)
929 ELSE IF (index(line, "virial :real:2:3,3") > 0) THEN
930 ALLOCATE (values(9))
931 CALL tb_read_real_values(unit_nr, values, nread)
932 IF (nread == 9) THEN
933 CALL tb_values_to_matrix(values, virial)
934 have_virial = .true.
935 END IF
936 DEALLOCATE (values)
937 END IF
938 END DO
939 CALL close_file(unit_nr)
940
941 END SUBROUTINE tb_read_reference_grad
942
943! **************************************************************************************************
944!> \brief Read a fixed number of real values from following lines.
945!> \param unit_nr ...
946!> \param values ...
947!> \param nread ...
948! **************************************************************************************************
949 SUBROUTINE tb_read_real_values(unit_nr, values, nread)
950
951 INTEGER, INTENT(IN) :: unit_nr
952 REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: values
953 INTEGER, INTENT(OUT) :: nread
954
955 CHARACTER(LEN=1024) :: line
956 INTEGER :: ios
957
958 nread = 0
959 DO WHILE (nread < SIZE(values))
960 READ (unit=unit_nr, fmt="(A)", iostat=ios) line
961 IF (ios /= 0) EXIT
962 CALL tb_parse_real_line(line, values, nread)
963 END DO
964
965 END SUBROUTINE tb_read_real_values
966
967! **************************************************************************************************
968!> \brief Parse real values from one text line.
969!> \param line ...
970!> \param values ...
971!> \param nread ...
972! **************************************************************************************************
973 SUBROUTINE tb_parse_real_line(line, values, nread)
974
975 CHARACTER(LEN=*), INTENT(IN) :: line
976 REAL(kind=dp), DIMENSION(:), INTENT(INOUT) :: values
977 INTEGER, INTENT(INOUT) :: nread
978
979 CHARACTER(LEN=128) :: token
980 INTEGER :: first, ios, last, pos
981
982 pos = 1
983 DO WHILE (pos <= len_trim(line) .AND. nread < SIZE(values))
984 DO WHILE (pos <= len_trim(line) .AND. index(" ,[]", line(pos:pos)) > 0)
985 pos = pos + 1
986 END DO
987 IF (pos > len_trim(line)) EXIT
988 first = pos
989 DO WHILE (pos <= len_trim(line) .AND. index(" ,[]", line(pos:pos)) == 0)
990 pos = pos + 1
991 END DO
992 last = pos - 1
993 token = line(first:last)
994 READ (token, *, iostat=ios) values(nread + 1)
995 IF (ios == 0) nread = nread + 1
996 END DO
997
998 END SUBROUTINE tb_parse_real_line
999
1000! **************************************************************************************************
1001!> \brief Convert flat native tblite values to CP2K atom-major matrix layout.
1002!> \param values ...
1003!> \param matrix ...
1004! **************************************************************************************************
1005 SUBROUTINE tb_values_to_matrix(values, matrix)
1006
1007 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: values
1008 REAL(kind=dp), DIMENSION(:, :), INTENT(OUT) :: matrix
1009
1010 INTEGER :: i, j, n
1011
1012 n = 0
1013 DO j = 1, SIZE(matrix, 2)
1014 DO i = 1, SIZE(matrix, 1)
1015 n = n + 1
1016 matrix(i, j) = values(n)
1017 END DO
1018 END DO
1019
1020 END SUBROUTINE tb_values_to_matrix
1021
1022! **************************************************************************************************
1023!> \brief Delete temporary files unless requested otherwise.
1024!> \param ref ...
1025!> \param gen_file ...
1026!> \param grad_file ...
1027!> \param json_file ...
1028!> \param log_file ...
1029!> \param post_processing_output_file ...
1030! **************************************************************************************************
1031 SUBROUTINE tb_reference_cleanup(ref, gen_file, grad_file, json_file, log_file, post_processing_output_file)
1032
1033 TYPE(xtb_reference_cli_type), INTENT(IN) :: ref
1034 CHARACTER(LEN=*), INTENT(IN) :: gen_file, grad_file, json_file, &
1035 log_file, post_processing_output_file
1036
1037 IF (ref%keep_files) RETURN
1038 CALL tb_delete_file(gen_file)
1039 CALL tb_delete_file(grad_file)
1040 CALL tb_delete_file(json_file)
1041 CALL tb_delete_file(log_file)
1042 IF (len_trim(post_processing_output_file) > 0) THEN
1043 CALL tb_delete_file(post_processing_output_file)
1044 END IF
1045
1046 END SUBROUTINE tb_reference_cleanup
1047
1048! **************************************************************************************************
1049!> \brief Delete a file if it exists.
1050!> \param filename ...
1051! **************************************************************************************************
1052 SUBROUTINE tb_delete_file(filename)
1053
1054 CHARACTER(LEN=*), INTENT(IN) :: filename
1055
1056 INTEGER :: istat
1057
1058 ! Cleanup is best effort, including files the reference CLI did not create.
1059 istat = m_unlink(filename)
1060 IF (istat /= 0) RETURN
1061
1062 END SUBROUTINE tb_delete_file
1063
1064END MODULE tblite_reference_cli
atomic_kind_types
Define the atomic kind types and their sub types.
Definition atomic_kind_types.F:23
atomic_kind_types::get_atomic_kind
subroutine, public get_atomic_kind(atomic_kind, fist_potential, element_symbol, name, mass, kind_number, natom, atom_list, rcov, rvdw, z, qeff, apol, cpol, mm_radius, shell, shell_active, damping)
Get attributes of an atomic kind.
Definition atomic_kind_types.F:138
cell_types
Handles all functions related to the CELL.
Definition cell_types.F:15
cell_types::get_cell
subroutine, public get_cell(cell, alpha, beta, gamma, deth, orthorhombic, abc, periodic, h, h_inv, symmetry_id, tag)
Get informations about a simulation cell.
Definition cell_types.F:234
cp_control_types
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
Definition cp_control_types.F:12
cp_files
Utility routines to open and close files.
Definition cp_files.F:22
cp_files::open_file
subroutine, public open_file(file_name, unit_number, file_status, file_form, file_action, file_position, file_pad, file_access, debug)
Opens a file and returns its logical unit number.
Definition cp_files.F:196
cp_files::close_file
subroutine, public close_file(unit_number, file_status)
Closes an open file given by its logical unit number.
Definition cp_files.F:63
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
cp_log_handling::cp_logger_get_default_io_unit
integer function, public cp_logger_get_default_io_unit(logger)
returns the unit nr for the ionode (-1 on all other processors) skips as well checks if the procs cal...
Definition cp_log_handling.F:523
cp_log_handling::cp_get_default_logger
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Definition cp_log_handling.F:234
cp_output_handling
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
Definition cp_output_handling.F:25
cp_output_handling::debug_print_level
integer, parameter, public debug_print_level
Definition cp_output_handling.F:73
cp_output_handling::high_print_level
integer, parameter, public high_print_level
Definition cp_output_handling.F:73
cp_output_handling::silent_print_level
integer, parameter, public silent_print_level
Definition cp_output_handling.F:73
cp_units
unit conversion facility
Definition cp_units.F:30
cp_units::cp_unit_from_cp2k
real(kind=dp) function, public cp_unit_from_cp2k(value, unit_str, defaults, power)
converts from the internal cp2k units to the given unit
Definition cp_units.F:1251
input_constants
collects all constants needed in input so that they can be used without circular dependencies
Definition input_constants.F:18
input_constants::smear_fermi_dirac
integer, parameter, public smear_fermi_dirac
Definition input_constants.F:950
input_constants::gfn1xtb
integer, parameter, public gfn1xtb
Definition input_constants.F:1427
input_constants::smear_energy_window
integer, parameter, public smear_energy_window
Definition input_constants.F:950
input_constants::tblite_scc_mixer_cp2k
integer, parameter, public tblite_scc_mixer_cp2k
Definition input_constants.F:1433
input_constants::tblite_guess_sad
integer, parameter, public tblite_guess_sad
Definition input_constants.F:1448
input_constants::tblite_cli_born_kernel_p16
integer, parameter, public tblite_cli_born_kernel_p16
Definition input_constants.F:1464
input_constants::tblite_solver_gvd
integer, parameter, public tblite_solver_gvd
Definition input_constants.F:1453
input_constants::tblite_mixer_damping_default
real(kind=dp), parameter, public tblite_mixer_damping_default
Definition input_constants.F:1441
input_constants::tblite_cli_solution_state_gsolv
integer, parameter, public tblite_cli_solution_state_gsolv
Definition input_constants.F:1468
input_constants::tblite_guess_eeq
integer, parameter, public tblite_guess_eeq
Definition input_constants.F:1448
input_constants::tblite_cli_solution_state_reference
integer, parameter, public tblite_cli_solution_state_reference
Definition input_constants.F:1468
input_constants::tblite_cli_born_kernel_still
integer, parameter, public tblite_cli_born_kernel_still
Definition input_constants.F:1464
input_constants::smear_list
integer, parameter, public smear_list
Definition input_constants.F:950
input_constants::ipea1xtb
integer, parameter, public ipea1xtb
Definition input_constants.F:1427
input_constants::tblite_cli_solvation_gb
integer, parameter, public tblite_cli_solvation_gb
Definition input_constants.F:1457
input_constants::tblite_solver_gvr
integer, parameter, public tblite_solver_gvr
Definition input_constants.F:1453
input_constants::tblite_cli_solution_state_bar1mol
integer, parameter, public tblite_cli_solution_state_bar1mol
Definition input_constants.F:1468
input_constants::tblite_cli_solvation_alpb
integer, parameter, public tblite_cli_solvation_alpb
Definition input_constants.F:1457
input_constants::smear_gaussian
integer, parameter, public smear_gaussian
Definition input_constants.F:950
input_constants::tblite_mixer_max_weight_default
real(kind=dp), parameter, public tblite_mixer_max_weight_default
Definition input_constants.F:1441
input_constants::tblite_cli_born_kernel_auto
integer, parameter, public tblite_cli_born_kernel_auto
Definition input_constants.F:1464
input_constants::tblite_mixer_omega0_default
real(kind=dp), parameter, public tblite_mixer_omega0_default
Definition input_constants.F:1441
input_constants::smear_mv
integer, parameter, public smear_mv
Definition input_constants.F:950
input_constants::tblite_cli_solvation_cpcm
integer, parameter, public tblite_cli_solvation_cpcm
Definition input_constants.F:1457
input_constants::tblite_cli_solvation_gbe
integer, parameter, public tblite_cli_solvation_gbe
Definition input_constants.F:1457
input_constants::tblite_cli_solvation_gbsa
integer, parameter, public tblite_cli_solvation_gbsa
Definition input_constants.F:1457
input_constants::smear_mp
integer, parameter, public smear_mp
Definition input_constants.F:950
input_constants::gfn2xtb
integer, parameter, public gfn2xtb
Definition input_constants.F:1427
input_constants::tblite_guess_ceh
integer, parameter, public tblite_guess_ceh
Definition input_constants.F:1448
input_constants::tblite_mixer_weight_factor_default
real(kind=dp), parameter, public tblite_mixer_weight_factor_default
Definition input_constants.F:1441
input_constants::tblite_mixer_min_weight_default
real(kind=dp), parameter, public tblite_mixer_min_weight_default
Definition input_constants.F:1441
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::default_path_length
integer, parameter, public default_path_length
Definition kinds.F:58
kpoint_types
Types and basic routines needed for a kpoint calculation.
Definition kpoint_types.F:15
kpoint_types::get_kpoint_info
subroutine, public get_kpoint_info(kpoint, kp_scheme, nkp_grid, kp_shift, symmetry, verbose, full_grid, use_real_wfn, eps_geo, parallel_group_size, kp_range, nkp, xkp, wkp, para_env, blacs_env_all, para_env_kp, para_env_inter_kp, blacs_env, kp_env, kp_aux_env, mpools, iogrp, nkp_groups, kp_dist, cell_to_index, index_to_cell, sab_nl, sab_nl_nosym, inversion_symmetry_only, symmetry_backend, symmetry_reduction_method, gamma_centered, lattice_fft)
Retrieve information from a kpoint environment.
Definition kpoint_types.F:587
machine
Machine interface based on Fortran 2003 and POSIX.
Definition machine.F:17
machine::m_unlink
integer function, public m_unlink(path)
...
Definition machine.F:675
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:27
particle_types
Define the data structure for the particle information.
Definition particle_types.F:19
qs_energy_types
Definition qs_energy_types.F:14
qs_environment_types
Definition qs_environment_types.F:14
qs_environment_types::get_qs_env
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, mimic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, matrix_vhxc, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, xcint_weights, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
Definition qs_environment_types.F:545
qs_force_types
Definition qs_force_types.F:13
qs_force_types::total_qs_force
subroutine, public total_qs_force(force, qs_force, atomic_kind_set)
Get current total force.
Definition qs_force_types.F:581
scf_control_types
parameters that control an scf iteration
Definition scf_control_types.F:17
tblite_reference_cli
Optional native tblite command-line diagnostics.
Definition tblite_reference_cli.F:13
tblite_reference_cli::tb_reference_cli_compare
subroutine, public tb_reference_cli_compare(qs_env)
Run native tblite CLI and compare against CP2K/tblite.
Definition tblite_reference_cli.F:71
virial_types
Definition virial_types.F:13
atomic_kind_types::atomic_kind_type
Provides all information about an atomic kind.
Definition atomic_kind_types.F:45
cell_types::cell_type
Type defining parameters related to the simulation cell.
Definition cell_types.F:60
cp_control_types::dft_control_type
Definition cp_control_types.F:787
cp_control_types::xtb_reference_cli_type
Definition cp_control_types.F:224
cp_log_handling::cp_logger_type
type of a logger, at the moment it contains just a print level starting at which level it should be l...
Definition cp_log_handling.F:140
kpoint_types::kpoint_type
Contains information about kpoints.
Definition kpoint_types.F:198
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:768
particle_types::particle_type
Definition particle_types.F:35
qs_energy_types::qs_energy_type
Definition qs_energy_types.F:25
qs_environment_types::qs_environment_type
Definition qs_environment_types.F:224
qs_force_types::qs_force_type
Definition qs_force_types.F:28
scf_control_types::scf_control_type
Definition scf_control_types.F:134
virial_types::virial_type
Definition virial_types.F:26