(git:34ef472)
bsse.F
Go to the documentation of this file.
1 !--------------------------------------------------------------------------------------------------!
2 ! CP2K: A general program to perform molecular dynamics simulations !
3 ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 ! !
5 ! SPDX-License-Identifier: GPL-2.0-or-later !
6 !--------------------------------------------------------------------------------------------------!
7 
8 ! **************************************************************************************************
9 !> \brief Module to perform a counterpoise correction (BSSE)
10 !> \par History
11 !> 6.2005 created [tlaino]
12 !> \author Teodoro Laino
13 ! **************************************************************************************************
14 MODULE bsse
15  USE atomic_kind_types, ONLY: get_atomic_kind
16  USE cell_types, ONLY: cell_type
17  USE cp2k_info, ONLY: write_restart_header
18  USE cp_external_control, ONLY: external_control
19  USE cp_log_handling, ONLY: cp_get_default_logger,&
20  cp_logger_type
21  USE cp_output_handling, ONLY: cp_add_iter_level,&
22  cp_iterate,&
23  cp_print_key_finished_output,&
24  cp_print_key_unit_nr,&
25  cp_rm_iter_level
26  USE cp_subsys_methods, ONLY: create_small_subsys
27  USE cp_subsys_types, ONLY: cp_subsys_get,&
28  cp_subsys_release,&
29  cp_subsys_type
30  USE force_env_types, ONLY: force_env_get,&
31  force_env_type
32  USE global_types, ONLY: global_environment_type
33  USE input_constants, ONLY: do_qs
34  USE input_section_types, ONLY: section_vals_get,&
35  section_vals_get_subs_vals,&
36  section_vals_type,&
37  section_vals_val_get,&
38  section_vals_val_set,&
39  section_vals_write
40  USE kinds, ONLY: default_string_length,&
41  dp
42  USE memory_utilities, ONLY: reallocate
43  USE message_passing, ONLY: mp_para_env_type
44  USE particle_list_types, ONLY: particle_list_type
45  USE qs_energy, ONLY: qs_energies
46  USE qs_energy_types, ONLY: qs_energy_type
47  USE qs_environment, ONLY: qs_init
48  USE qs_environment_types, ONLY: get_qs_env,&
49  qs_env_create,&
50  qs_env_release,&
51  qs_environment_type
52  USE string_utilities, ONLY: compress
53 #include "./base/base_uses.f90"
54 
55  IMPLICIT NONE
56  PRIVATE
57 
58  LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
59  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'bsse'
60 
61  PUBLIC :: do_bsse_calculation
62 
63 CONTAINS
64 
65 ! **************************************************************************************************
66 !> \brief Perform an COUNTERPOISE CORRECTION (BSSE)
67 !> For a 2-body system the correction scheme can be represented as:
68 !>
69 !> E_{AB}^{2} = E_{AB}(AB) - E_A(AB) - E_B(AB) [BSSE-corrected interaction energy]
70 !> E_{AB}^{2,uncorr} = E_{AB}(AB) - E_A(A) - E_B(B)
71 !> E_{AB}^{CP} = E_{AB}(AB) + [ E_A(A) - E_A(AB) ] + [ E_B(B) - E_B(AB) ]
72 !> [CP-corrected total energy of AB]
73 !> \param force_env ...
74 !> \param globenv ...
75 !> \par History
76 !> 06.2005 created [tlaino]
77 !> \author Teodoro Laino
78 ! **************************************************************************************************
79  SUBROUTINE do_bsse_calculation(force_env, globenv)
80  TYPE(force_env_type), POINTER :: force_env
81  TYPE(global_environment_type), POINTER :: globenv
82 
83  INTEGER :: i, istart, k, num_of_conf, num_of_frag
84  INTEGER, DIMENSION(:, :), POINTER :: conf
85  LOGICAL :: explicit, should_stop
86  REAL(kind=dp), DIMENSION(:), POINTER :: em
87  TYPE(cp_logger_type), POINTER :: logger
88  TYPE(section_vals_type), POINTER :: bsse_section, fragment_energies_section, &
89  n_frags, root_section
90 
91  NULLIFY (bsse_section, n_frags, em, conf)
92  logger => cp_get_default_logger()
93  root_section => force_env%root_section
94  bsse_section => section_vals_get_subs_vals(force_env%force_env_section, "BSSE")
95  n_frags => section_vals_get_subs_vals(bsse_section, "FRAGMENT")
96  CALL section_vals_get(n_frags, n_repetition=num_of_frag)
97 
98  ! Number of configurations
99  num_of_conf = 0
100  DO k = 1, num_of_frag
101  num_of_conf = num_of_conf + fact(num_of_frag)/(fact(k)*fact(num_of_frag - k))
102  END DO
103  ALLOCATE (conf(num_of_conf, num_of_frag))
104  ALLOCATE (em(num_of_conf))
105  CALL gen_nbody_conf(num_of_frag, conf)
106 
107  should_stop = .false.
108  istart = 0
109  fragment_energies_section => section_vals_get_subs_vals(bsse_section, "FRAGMENT_ENERGIES")
110  CALL section_vals_get(fragment_energies_section, explicit=explicit)
111  IF (explicit) THEN
112  CALL section_vals_val_get(fragment_energies_section, "_DEFAULT_KEYWORD_", n_rep_val=istart)
113  DO i = 1, istart
114  CALL section_vals_val_get(fragment_energies_section, "_DEFAULT_KEYWORD_", r_val=em(i), &
115  i_rep_val=i)
116  END DO
117  END IF
118  ! Setup the iteration level for BSSE
119  CALL cp_add_iter_level(logger%iter_info, "BSSE")
120  CALL cp_iterate(logger%iter_info, last=.false., iter_nr=istart)
121 
122  ! Evaluating the energy of the N-body cluster terms
123  DO i = istart + 1, num_of_conf
124  CALL cp_iterate(logger%iter_info, last=(i == num_of_conf), iter_nr=i)
125  CALL eval_bsse_energy(conf(i, :), em(i), force_env, n_frags, &
126  root_section, globenv, should_stop)
127  IF (should_stop) EXIT
128 
129  ! If no signal was received in the inner loop let's check also at this stage
130  CALL external_control(should_stop, "BSSE", globenv=globenv)
131  IF (should_stop) EXIT
132 
133  ! Dump Restart info only if the calculation of the energy of a configuration
134  ! ended nicely..
135  CALL section_vals_val_set(fragment_energies_section, "_DEFAULT_KEYWORD_", r_val=em(i), &
136  i_rep_val=i)
137  CALL write_bsse_restart(bsse_section, root_section)
138  END DO
139  IF (.NOT. should_stop) CALL dump_bsse_results(conf, em, num_of_frag, bsse_section)
140  CALL cp_rm_iter_level(logger%iter_info, "BSSE")
141  DEALLOCATE (em)
142  DEALLOCATE (conf)
143 
144  END SUBROUTINE do_bsse_calculation
145 
146 ! **************************************************************************************************
147 !> \brief Evaluate the N-body energy contribution to the BSSE evaluation
148 !> \param conf ...
149 !> \param Em ...
150 !> \param force_env ...
151 !> \param n_frags ...
152 !> \param root_section ...
153 !> \param globenv ...
154 !> \param should_stop ...
155 !> \par History
156 !> 07.2005 created [tlaino]
157 !> \author Teodoro Laino
158 ! **************************************************************************************************
159  SUBROUTINE eval_bsse_energy(conf, Em, force_env, n_frags, root_section, &
160  globenv, should_stop)
161  INTEGER, DIMENSION(:), INTENT(IN) :: conf
162  REAL(kind=dp), INTENT(OUT) :: em
163  TYPE(force_env_type), POINTER :: force_env
164  TYPE(section_vals_type), POINTER :: n_frags, root_section
165  TYPE(global_environment_type), POINTER :: globenv
166  LOGICAL, INTENT(OUT) :: should_stop
167 
168  INTEGER :: i, j, k, num_of_sub_conf, num_of_sub_frag
169  INTEGER, DIMENSION(:, :), POINTER :: conf_loc
170  REAL(kind=dp) :: my_energy
171  REAL(kind=dp), DIMENSION(:), POINTER :: em_loc
172 
173  NULLIFY (conf_loc, em_loc)
174  should_stop = .false.
175  ! Count the number of subconfiguration to evaluate..
176  num_of_sub_frag = count(conf == 1)
177  num_of_sub_conf = 0
178  IF (num_of_sub_frag == 1) THEN
179  CALL eval_bsse_energy_low(force_env, conf, conf, n_frags, root_section, globenv, em)
180  ELSE
181  my_energy = 0.0_dp
182  DO k = 1, num_of_sub_frag
183  num_of_sub_conf = num_of_sub_conf + &
184  fact(num_of_sub_frag)/(fact(k)*fact(num_of_sub_frag - k))
185  END DO
186  ALLOCATE (conf_loc(num_of_sub_conf, num_of_sub_frag))
187  ALLOCATE (em_loc(num_of_sub_conf))
188  em_loc = 0.0_dp
189  CALL gen_nbody_conf(num_of_sub_frag, conf_loc)
190  CALL make_plan_conf(conf, conf_loc)
191  DO i = 1, num_of_sub_conf
192  CALL eval_bsse_energy_low(force_env, conf, conf_loc(i, :), n_frags, &
193  root_section, globenv, em_loc(i))
194  CALL external_control(should_stop, "BSSE", globenv=globenv)
195  IF (should_stop) EXIT
196  END DO
197  ! Energy
198  k = count(conf == 1)
199  DO i = 1, num_of_sub_conf
200  j = count(conf_loc(i, :) == 1)
201  my_energy = my_energy + (-1.0_dp)**(k + j)*em_loc(i)
202  END DO
203  em = my_energy
204  DEALLOCATE (em_loc)
205  DEALLOCATE (conf_loc)
206  END IF
207 
208  END SUBROUTINE eval_bsse_energy
209 
210 ! **************************************************************************************************
211 !> \brief Evaluate the N-body energy contribution to the BSSE evaluation
212 !> \param force_env ...
213 !> \param conf ...
214 !> \param conf_loc ...
215 !> \param n_frags ...
216 !> \param root_section ...
217 !> \param globenv ...
218 !> \param energy ...
219 !> \par History
220 !> 07.2005 created [tlaino]
221 !> 2014/09/17 made atom list to be read from repeated occurrence of LIST [LTong]
222 !> \author Teodoro Laino
223 ! **************************************************************************************************
224  SUBROUTINE eval_bsse_energy_low(force_env, conf, conf_loc, n_frags, &
225  root_section, globenv, energy)
226  TYPE(force_env_type), POINTER :: force_env
227  INTEGER, DIMENSION(:), INTENT(IN) :: conf, conf_loc
228  TYPE(section_vals_type), POINTER :: n_frags, root_section
229  TYPE(global_environment_type), POINTER :: globenv
230  REAL(kind=dp), INTENT(OUT) :: energy
231 
232  CHARACTER(LEN=default_string_length) :: name
233  CHARACTER(len=default_string_length), &
234  DIMENSION(:), POINTER :: atom_type
235  INTEGER :: i, ir, isize, j, k, method_name_id, &
236  my_targ, n_rep, num_of_frag, old_size, &
237  present_charge, present_multpl
238  INTEGER, DIMENSION(:), POINTER :: atom_index, atom_list, my_conf, tmplist
239  TYPE(cell_type), POINTER :: cell
240  TYPE(cp_subsys_type), POINTER :: subsys
241  TYPE(mp_para_env_type), POINTER :: para_env
242  TYPE(particle_list_type), POINTER :: particles
243  TYPE(section_vals_type), POINTER :: bsse_section, dft_section, &
244  force_env_section, subsys_section
245 
246  CALL section_vals_get(n_frags, n_repetition=num_of_frag)
247  cpassert(SIZE(conf) == num_of_frag)
248  NULLIFY (subsys, particles, para_env, cell, atom_index, atom_type, tmplist, &
249  force_env_section)
250  CALL force_env_get(force_env, force_env_section=force_env_section)
251  CALL section_vals_val_get(force_env_section, "METHOD", i_val=method_name_id)
252  bsse_section => section_vals_get_subs_vals(force_env_section, "BSSE")
253  subsys_section => section_vals_get_subs_vals(force_env_section, "SUBSYS")
254  dft_section => section_vals_get_subs_vals(force_env_section, "DFT")
255 
256  ALLOCATE (my_conf(SIZE(conf)))
257  my_conf = conf
258  CALL force_env_get(force_env=force_env, subsys=subsys, para_env=para_env, &
259  cell=cell)
260  CALL cp_subsys_get(subsys, particles=particles)
261  isize = 0
262  ALLOCATE (atom_index(isize))
263  DO i = 1, num_of_frag
264  IF (conf(i) == 1) THEN
265  !
266  ! Get the list of atoms creating the present fragment
267  !
268  old_size = isize
269  CALL section_vals_val_get(n_frags, "LIST", i_rep_section=i, n_rep_val=n_rep)
270  IF (n_rep /= 0) THEN
271  DO ir = 1, n_rep
272  CALL section_vals_val_get(n_frags, "LIST", i_rep_section=i, i_rep_val=ir, i_vals=tmplist)
273  CALL reallocate(atom_index, 1, isize + SIZE(tmplist))
274  atom_index(isize + 1:isize + SIZE(tmplist)) = tmplist
275  isize = SIZE(atom_index)
276  END DO
277  END IF
278  my_conf(i) = isize - old_size
279  cpassert(conf(i) /= 0)
280  END IF
281  END DO
282  CALL conf_info_setup(present_charge, present_multpl, conf, conf_loc, bsse_section, &
283  dft_section)
284  !
285  ! Get names and modify the ghost ones
286  !
287  ALLOCATE (atom_type(isize))
288  DO j = 1, isize
289  my_targ = atom_index(j)
290  DO k = 1, SIZE(particles%els)
291  CALL get_atomic_kind(particles%els(k)%atomic_kind, atom_list=atom_list, name=name)
292  IF (any(atom_list == my_targ)) EXIT
293  END DO
294  atom_type(j) = name
295  END DO
296  DO i = 1, SIZE(conf_loc)
297  IF (my_conf(i) /= 0 .AND. conf_loc(i) == 0) THEN
298  DO j = sum(my_conf(1:i - 1)) + 1, sum(my_conf(1:i))
299  atom_type(j) = trim(atom_type(j))//"_ghost"
300  END DO
301  END IF
302  END DO
303  CALL dump_bsse_info(atom_index, atom_type, conf, conf_loc, bsse_section, &
304  present_charge, present_multpl)
305  !
306  ! Let's start setting up environments and calculations
307  !
308  energy = 0.0_dp
309  IF (method_name_id == do_qs) THEN
310  block
311  TYPE(qs_environment_type), POINTER :: qs_env
312  TYPE(qs_energy_type), POINTER :: qs_energy
313  TYPE(cp_subsys_type), POINTER :: subsys_loc
314  NULLIFY (subsys_loc)
315  CALL create_small_subsys(subsys_loc, big_subsys=subsys, &
316  small_para_env=para_env, small_cell=cell, sub_atom_index=atom_index, &
317  sub_atom_kind_name=atom_type, para_env=para_env, &
318  force_env_section=force_env_section, subsys_section=subsys_section)
319 
320  ALLOCATE (qs_env)
321  CALL qs_env_create(qs_env, globenv)
322  CALL qs_init(qs_env, para_env, root_section, globenv=globenv, cp_subsys=subsys_loc, &
323  force_env_section=force_env_section, subsys_section=subsys_section, &
324  use_motion_section=.false.)
325  CALL cp_subsys_release(subsys_loc)
326 
327  !
328  ! Evaluate Energy
329  !
330  CALL qs_energies(qs_env)
331  CALL get_qs_env(qs_env, energy=qs_energy)
332  energy = qs_energy%total
333  CALL qs_env_release(qs_env)
334  DEALLOCATE (qs_env)
335  END block
336  ELSE
337  cpabort("")
338  END IF
339  DEALLOCATE (atom_index)
340  DEALLOCATE (atom_type)
341  DEALLOCATE (my_conf)
342 
343  END SUBROUTINE eval_bsse_energy_low
344 
345 ! **************************************************************************************************
346 !> \brief Dumps bsse information (configuration fragment)
347 !> \param atom_index ...
348 !> \param atom_type ...
349 !> \param conf ...
350 !> \param conf_loc ...
351 !> \param bsse_section ...
352 !> \param present_charge ...
353 !> \param present_multpl ...
354 !> \par History
355 !> 07.2005 created [tlaino]
356 !> \author Teodoro Laino
357 ! **************************************************************************************************
358  SUBROUTINE dump_bsse_info(atom_index, atom_type, conf, conf_loc, bsse_section, &
359  present_charge, present_multpl)
360  INTEGER, DIMENSION(:), POINTER :: atom_index
361  CHARACTER(len=default_string_length), &
362  DIMENSION(:), POINTER :: atom_type
363  INTEGER, DIMENSION(:), INTENT(IN) :: conf, conf_loc
364  TYPE(section_vals_type), POINTER :: bsse_section
365  INTEGER, INTENT(IN) :: present_charge, present_multpl
366 
367  INTEGER :: i, istat, iw
368  CHARACTER(len=20*SIZE(conf)) :: conf_loc_s, conf_s
369  TYPE(cp_logger_type), POINTER :: logger
370 
371  NULLIFY (logger)
372  logger => cp_get_default_logger()
373  iw = cp_print_key_unit_nr(logger, bsse_section, "PRINT%PROGRAM_RUN_INFO", &
374  extension=".log")
375  IF (iw > 0) THEN
376  WRITE (conf_s, fmt="(1000I0)", iostat=istat) conf;
377  IF (istat .NE. 0) conf_s = "exceeded"
378  CALL compress(conf_s, full=.true.)
379  WRITE (conf_loc_s, fmt="(1000I0)", iostat=istat) conf_loc;
380  IF (istat .NE. 0) conf_loc_s = "exceeded"
381  CALL compress(conf_loc_s, full=.true.)
382 
383  WRITE (unit=iw, fmt="(/,T2,A)") repeat("-", 79)
384  WRITE (unit=iw, fmt="(T2,A,T80,A)") "-", "-"
385  WRITE (unit=iw, fmt="(T2,A,T5,A,T30,A,T55,A,T80,A)") &
386  "-", "BSSE CALCULATION", "FRAGMENT CONF: "//trim(conf_s), "FRAGMENT SUBCONF: "//trim(conf_loc_s), "-"
387  WRITE (unit=iw, fmt="(T2,A,T30,A,I6,T55,A,I6,T80,A)") "-", "CHARGE =", present_charge, "MULTIPLICITY =", &
388  present_multpl, "-"
389  WRITE (unit=iw, fmt="(T2,A,T80,A)") "-", "-"
390  WRITE (unit=iw, fmt="(T2,A,T20,A,T60,A,T80,A)") "-", "ATOM INDEX", "ATOM NAME", "-"
391  WRITE (unit=iw, fmt="(T2,A,T20,A,T60,A,T80,A)") "-", "----------", "---------", "-"
392  DO i = 1, SIZE(atom_index)
393  WRITE (unit=iw, fmt="(T2,A,T20,I6,T61,A,T80,A)") "-", atom_index(i), trim(atom_type(i)), "-"
394  END DO
395  WRITE (unit=iw, fmt="(T2,A)") repeat("-", 79)
396 
397  CALL cp_print_key_finished_output(iw, logger, bsse_section, &
398  "PRINT%PROGRAM_RUN_INFO")
399 
400  END IF
401  END SUBROUTINE dump_bsse_info
402 
403 ! **************************************************************************************************
404 !> \brief Read modified parameters for configurations
405 !> \param present_charge ...
406 !> \param present_multpl ...
407 !> \param conf ...
408 !> \param conf_loc ...
409 !> \param bsse_section ...
410 !> \param dft_section ...
411 !> \par History
412 !> 09.2007 created [tlaino]
413 !> \author Teodoro Laino - University of Zurich
414 ! **************************************************************************************************
415  SUBROUTINE conf_info_setup(present_charge, present_multpl, conf, conf_loc, &
416  bsse_section, dft_section)
417  INTEGER, INTENT(OUT) :: present_charge, present_multpl
418  INTEGER, DIMENSION(:), INTENT(IN) :: conf, conf_loc
419  TYPE(section_vals_type), POINTER :: bsse_section, dft_section
420 
421  INTEGER :: i, nconf
422  INTEGER, DIMENSION(:), POINTER :: glb_conf, sub_conf
423  LOGICAL :: explicit
424  TYPE(section_vals_type), POINTER :: configurations
425 
426  present_charge = 0
427  present_multpl = 0
428  NULLIFY (configurations, glb_conf, sub_conf)
429  ! Loop over all configurations to pick up the right one
430  configurations => section_vals_get_subs_vals(bsse_section, "CONFIGURATION")
431  CALL section_vals_get(configurations, explicit=explicit, n_repetition=nconf)
432  IF (explicit) THEN
433  DO i = 1, nconf
434  CALL section_vals_val_get(configurations, "GLB_CONF", i_rep_section=i, i_vals=glb_conf)
435  IF (SIZE(glb_conf) /= SIZE(conf)) &
436  CALL cp_abort(__location__, &
437  "GLB_CONF requires a binary description of the configuration. Number of integer "// &
438  "different from the number of fragments defined!")
439  CALL section_vals_val_get(configurations, "SUB_CONF", i_rep_section=i, i_vals=sub_conf)
440  IF (SIZE(sub_conf) /= SIZE(conf)) &
441  CALL cp_abort(__location__, &
442  "SUB_CONF requires a binary description of the configuration. Number of integer "// &
443  "different from the number of fragments defined!")
444  IF (all(conf == glb_conf) .AND. all(conf_loc == sub_conf)) THEN
445  CALL section_vals_val_get(configurations, "CHARGE", i_rep_section=i, &
446  i_val=present_charge)
447  CALL section_vals_val_get(configurations, "MULTIPLICITY", i_rep_section=i, &
448  i_val=present_multpl)
449  END IF
450  END DO
451  END IF
452  ! Setup parameter for this configuration
453  CALL section_vals_val_set(dft_section, "CHARGE", i_val=present_charge)
454  CALL section_vals_val_set(dft_section, "MULTIPLICITY", i_val=present_multpl)
455  END SUBROUTINE conf_info_setup
456 
457 ! **************************************************************************************************
458 !> \brief Dumps results
459 !> \param conf ...
460 !> \param Em ...
461 !> \param num_of_frag ...
462 !> \param bsse_section ...
463 !> \par History
464 !> 09.2007 created [tlaino]
465 !> \author Teodoro Laino - University of Zurich
466 ! **************************************************************************************************
467  SUBROUTINE dump_bsse_results(conf, Em, num_of_frag, bsse_section)
468  INTEGER, DIMENSION(:, :), INTENT(IN) :: conf
469  REAL(kind=dp), DIMENSION(:), POINTER :: em
470  INTEGER, INTENT(IN) :: num_of_frag
471  TYPE(section_vals_type), POINTER :: bsse_section
472 
473  INTEGER :: i, iw
474  TYPE(cp_logger_type), POINTER :: logger
475 
476  NULLIFY (logger)
477  logger => cp_get_default_logger()
478  iw = cp_print_key_unit_nr(logger, bsse_section, "PRINT%PROGRAM_RUN_INFO", &
479  extension=".log")
480 
481  IF (iw > 0) THEN
482  WRITE (unit=iw, fmt="(/,T2,A)") repeat("-", 79)
483  WRITE (unit=iw, fmt="(T2,A,T80,A)") "-", "-"
484  WRITE (unit=iw, fmt="(T2,A,T36,A,T80,A)") &
485  "-", "BSSE RESULTS", "-"
486  WRITE (unit=iw, fmt="(T2,A,T80,A)") "-", "-"
487  WRITE (unit=iw, fmt="(T2,A,T20,A,F16.6,T80,A)") "-", "CP-corrected Total energy:", sum(em), "-"
488  WRITE (unit=iw, fmt="(T2,A,T80,A)") "-", "-"
489  DO i = 1, SIZE(conf, 1)
490  IF (i .GT. 1) THEN
491  IF (sum(conf(i - 1, :)) == 1 .AND. sum(conf(i, :)) /= 1) THEN
492  WRITE (unit=iw, fmt="(T2,A,T80,A)") "-", "-"
493  END IF
494  END IF
495  WRITE (unit=iw, fmt="(T2,A,T24,I3,A,F16.6,T80,A)") "-", sum(conf(i, :)), "-body contribution:", em(i), "-"
496  END DO
497  WRITE (unit=iw, fmt="(T2,A,T20,A,F16.6,T80,A)") "-", "BSSE-free interaction energy:", sum(em(num_of_frag + 1:)), "-"
498  WRITE (unit=iw, fmt="(T2,A)") repeat("-", 79)
499  END IF
500 
501  CALL cp_print_key_finished_output(iw, logger, bsse_section, &
502  "PRINT%PROGRAM_RUN_INFO")
503 
504  END SUBROUTINE dump_bsse_results
505 
506 ! **************************************************************************************************
507 !> \brief generate the N-body configuration for the N-body BSSE evaluation
508 !> \param Num_of_frag ...
509 !> \param conf ...
510 !> \par History
511 !> 07.2005 created [tlaino]
512 !> \author Teodoro Laino
513 ! **************************************************************************************************
514  SUBROUTINE gen_nbody_conf(Num_of_frag, conf)
515  INTEGER, INTENT(IN) :: num_of_frag
516  INTEGER, DIMENSION(:, :), POINTER :: conf
517 
518  INTEGER :: k, my_ind
519 
520  my_ind = 0
521  !
522  ! Set up the N-body configurations
523  !
524  conf = 0
525  DO k = 1, num_of_frag
526  CALL build_nbody_conf(1, num_of_frag, conf, k, my_ind)
527  END DO
528  END SUBROUTINE gen_nbody_conf
529 
530 ! **************************************************************************************************
531 !> \brief ...
532 !> \param ldown ...
533 !> \param lup ...
534 !> \param conf ...
535 !> \param k ...
536 !> \param my_ind ...
537 ! **************************************************************************************************
538  RECURSIVE SUBROUTINE build_nbody_conf(ldown, lup, conf, k, my_ind)
539  INTEGER, INTENT(IN) :: ldown, lup
540  INTEGER, DIMENSION(:, :), POINTER :: conf
541  INTEGER, INTENT(IN) :: k
542  INTEGER, INTENT(INOUT) :: my_ind
543 
544  INTEGER :: i, kloc, my_ind0
545 
546  kloc = k - 1
547  my_ind0 = my_ind
548  IF (kloc /= 0) THEN
549  DO i = ldown, lup
550  CALL build_nbody_conf(i + 1, lup, conf, kloc, my_ind)
551  conf(my_ind0 + 1:my_ind, i) = 1
552  my_ind0 = my_ind
553  END DO
554  ELSE
555  DO i = ldown, lup
556  my_ind = my_ind + 1
557  conf(my_ind, i) = 1
558  END DO
559  END IF
560  END SUBROUTINE build_nbody_conf
561 
562 ! **************************************************************************************************
563 !> \brief ...
564 !> \param num ...
565 !> \return ...
566 ! **************************************************************************************************
567  RECURSIVE FUNCTION fact(num) RESULT(my_fact)
568  INTEGER, INTENT(IN) :: num
569  INTEGER :: my_fact
570 
571  IF (num <= 1) THEN
572  my_fact = 1
573  ELSE
574  my_fact = num*fact(num - 1)
575  END IF
576  END FUNCTION fact
577 
578 ! **************************************************************************************************
579 !> \brief ...
580 !> \param main_conf ...
581 !> \param conf ...
582 ! **************************************************************************************************
583  SUBROUTINE make_plan_conf(main_conf, conf)
584  INTEGER, DIMENSION(:), INTENT(IN) :: main_conf
585  INTEGER, DIMENSION(:, :), POINTER :: conf
586 
587  INTEGER :: i, ind
588  INTEGER, DIMENSION(:, :), POINTER :: tmp_conf
589 
590  ALLOCATE (tmp_conf(SIZE(conf, 1), SIZE(main_conf)))
591  tmp_conf = 0
592  ind = 0
593  DO i = 1, SIZE(main_conf)
594  IF (main_conf(i) /= 0) THEN
595  ind = ind + 1
596  tmp_conf(:, i) = conf(:, ind)
597  END IF
598  END DO
599  DEALLOCATE (conf)
600  ALLOCATE (conf(SIZE(tmp_conf, 1), SIZE(tmp_conf, 2)))
601  conf = tmp_conf
602  DEALLOCATE (tmp_conf)
603 
604  END SUBROUTINE make_plan_conf
605 
606 ! **************************************************************************************************
607 !> \brief Writes restart for BSSE calculations
608 !> \param bsse_section ...
609 !> \param root_section ...
610 !> \par History
611 !> 01.2008 created [tlaino]
612 !> \author Teodoro Laino
613 ! **************************************************************************************************
614  SUBROUTINE write_bsse_restart(bsse_section, root_section)
615 
616  TYPE(section_vals_type), POINTER :: bsse_section, root_section
617 
618  INTEGER :: ires
619  TYPE(cp_logger_type), POINTER :: logger
620 
621  logger => cp_get_default_logger()
622  ires = cp_print_key_unit_nr(logger, bsse_section, "PRINT%RESTART", &
623  extension=".restart", do_backup=.false., file_position="REWIND")
624 
625  IF (ires > 0) THEN
626  CALL write_restart_header(ires)
627  CALL section_vals_write(root_section, unit_nr=ires, hide_root=.true.)
628  END IF
629 
630  CALL cp_print_key_finished_output(ires, logger, bsse_section, &
631  "PRINT%RESTART")
632 
633  END SUBROUTINE write_bsse_restart
634 
635 END MODULE bsse
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
bsse
Module to perform a counterpoise correction (BSSE)
Definition: bsse.F:14
bsse::do_bsse_calculation
subroutine, public do_bsse_calculation(force_env, globenv)
Perform an COUNTERPOISE CORRECTION (BSSE) For a 2-body system the correction scheme can be represente...
Definition: bsse.F:80
cell_types
Handles all functions related to the CELL.
Definition: cell_types.F:15
cp2k_info
some minimal info about CP2K, including its version and license
Definition: cp2k_info.F:16
cp2k_info::write_restart_header
subroutine, public write_restart_header(iunit)
Writes the header for the restart file.
Definition: cp2k_info.F:333
cp_external_control
Routines to handle the external control of CP2K.
Definition: cp_external_control.F:15
cp_external_control::external_control
subroutine, public external_control(should_stop, flag, globenv, target_time, start_time, force_check)
External manipulations during a run : when the <PROJECT_NAME>.EXIT_$runtype command is sent the progr...
Definition: cp_external_control.F:90
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_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::cp_print_key_unit_nr
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout)
...
Definition: cp_output_handling.F:803
cp_output_handling::cp_print_key_finished_output
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
Definition: cp_output_handling.F:1013
cp_output_handling::cp_iterate
subroutine, public cp_iterate(iteration_info, last, iter_nr, increment, iter_nr_out)
adds one to the actual iteration
Definition: cp_output_handling.F:574
cp_output_handling::cp_rm_iter_level
subroutine, public cp_rm_iter_level(iteration_info, level_name, n_rlevel_att)
Removes an iteration level.
Definition: cp_output_handling.F:655
cp_output_handling::cp_add_iter_level
subroutine, public cp_add_iter_level(iteration_info, level_name, n_rlevel_new)
Adds an iteration level.
Definition: cp_output_handling.F:612
cp_subsys_methods
Initialize a small environment for a particular calculation.
Definition: cp_subsys_methods.F:15
cp_subsys_methods::create_small_subsys
subroutine, public create_small_subsys(small_subsys, big_subsys, small_cell, small_para_env, sub_atom_index, sub_atom_kind_name, para_env, force_env_section, subsys_section, ignore_outside_box)
updates the molecule information of the given subsys
Definition: cp_subsys_methods.F:265
cp_subsys_types
types that represent a subsys, i.e. a part of the system
Definition: cp_subsys_types.F:16
cp_subsys_types::cp_subsys_release
subroutine, public cp_subsys_release(subsys)
releases a subsys (see doc/ReferenceCounting.html)
Definition: cp_subsys_types.F:150
cp_subsys_types::cp_subsys_get
subroutine, public cp_subsys_get(subsys, ref_count, atomic_kinds, atomic_kind_set, particles, particle_set, local_particles, molecules, molecule_set, molecule_kinds, molecule_kind_set, local_molecules, para_env, colvar_p, shell_particles, core_particles, gci, multipoles, natom, nparticle, ncore, nshell, nkind, atprop, virial, results, cell)
returns information about various attributes of the given subsys
Definition: cp_subsys_types.F:345
force_env_types
Interface for the force calculations.
Definition: force_env_types.F:18
force_env_types::force_env_get
recursive subroutine, public force_env_get(force_env, in_use, fist_env, qs_env, meta_env, fp_env, subsys, para_env, potential_energy, additional_potential, kinetic_energy, harmonic_shell, kinetic_shell, cell, sub_force_env, qmmm_env, qmmmx_env, eip_env, pwdft_env, globenv, input, force_env_section, method_name_id, root_section, mixed_env, nnp_env, embed_env)
returns various attributes about the force environment
Definition: force_env_types.F:329
global_types
Define type storing the global information of a run. Keep the amount of stored data small....
Definition: global_types.F:21
input_constants
collects all constants needed in input so that they can be used without circular dependencies
Definition: input_constants.F:17
input_constants::do_qs
integer, parameter, public do_qs
Definition: input_constants.F:48
input_section_types
objects that represent the structure of input sections and the data contained in an input section
Definition: input_section_types.F:15
input_section_types::section_vals_val_set
subroutine, public section_vals_val_set(section_vals, keyword_name, i_rep_section, i_rep_val, val, l_val, i_val, r_val, c_val, l_vals_ptr, i_vals_ptr, r_vals_ptr, c_vals_ptr)
sets the requested value
Definition: input_section_types.F:1216
input_section_types::section_vals_get_subs_vals
recursive type(section_vals_type) function, pointer, public section_vals_get_subs_vals(section_vals, subsection_name, i_rep_section, can_return_null)
returns the values of the requested subsection
Definition: input_section_types.F:724
input_section_types::section_vals_write
recursive subroutine, public section_vals_write(section_vals, unit_nr, hide_root, hide_defaults)
writes the values in the given section in a way that is suitable to the automatic parsing
Definition: input_section_types.F:1419
input_section_types::section_vals_get
subroutine, public section_vals_get(section_vals, ref_count, n_repetition, n_subs_vals_rep, section, explicit)
returns various attributes about the section_vals
Definition: input_section_types.F:697
input_section_types::section_vals_val_get
subroutine, public section_vals_val_get(section_vals, keyword_name, i_rep_section, i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, c_vals, explicit)
returns the requested value
Definition: input_section_types.F:1040
kinds
Defines the basic variable types.
Definition: kinds.F:23
kinds::dp
integer, parameter, public dp
Definition: kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition: kinds.F:57
memory_utilities
Utility routines for the memory handling.
Definition: memory_utilities.F:14
message_passing
Interface to the message passing library MPI.
Definition: message_passing.F:23
particle_list_types
represent a simple array based list of the given type
Definition: particle_list_types.F:15
qs_energy_types
Definition: qs_energy_types.F:14
qs_energy
Perform a QUICKSTEP wavefunction optimization (single point)
Definition: qs_energy.F:14
qs_energy::qs_energies
subroutine, public qs_energies(qs_env, consistent_energies, calc_forces)
Driver routine for QUICKSTEP single point wavefunction optimization.
Definition: qs_energy.F:65
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, 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_nonbond, sab_almo, sab_kp, sab_kp_nosym, 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, 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, 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, ecoul_1c, rho0_s_rs, rho0_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, 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, rhs)
Get the QUICKSTEP environment.
Definition: qs_environment_types.F:502
qs_environment_types::qs_env_release
subroutine, public qs_env_release(qs_env)
releases the given qs_env (see doc/ReferenceCounting.html)
Definition: qs_environment_types.F:1366
qs_environment_types::qs_env_create
subroutine, public qs_env_create(qs_env, globenv)
allocates and intitializes a qs_env
Definition: qs_environment_types.F:1351
qs_environment
Definition: qs_environment.F:19
qs_environment::qs_init
subroutine, public qs_init(qs_env, para_env, root_section, globenv, cp_subsys, kpoint_env, cell, cell_ref, qmmm, qmmm_env_qm, force_env_section, subsys_section, use_motion_section)
Read the input and the database files for the setup of the QUICKSTEP environment.
Definition: qs_environment.F:237
string_utilities
Utilities for string manipulations.
Definition: string_utilities.F:16
string_utilities::compress
subroutine, public compress(string, full)
Eliminate multiple space characters in a string. If full is .TRUE., then all spaces are eliminated.
Definition: string_utilities.F:3190