(git:0de0cc2)
cp_iter_types.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 Collection of routines to handle the iteration info
10 ! **************************************************************************************************
12  USE kinds, ONLY: default_path_length,&
14 #include "../base/base_uses.f90"
15 
16  IMPLICIT NONE
17  PRIVATE
18 
19  ! iteration_info
20  PUBLIC :: cp_iteration_info_type, &
25 
26  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_iter_types'
27  LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .false.
28 
29  ! When adding a new iteration level PLEASE update the following list with the proper name!
30  CHARACTER(LEN=default_path_length), PARAMETER, PUBLIC, DIMENSION(18) :: each_possible_labels = (/ &
31  "__ROOT__ ", &
32  "JUST_ENERGY ", &
33  "POWELL_OPT ", &
34  "QS_SCF ", &
35  "XAS_SCF ", &
36  "MD ", &
37  "PINT ", &
38  "METADYNAMICS ", &
39  "GEO_OPT ", &
40  "ROT_OPT ", &
41  "CELL_OPT ", &
42  "BAND ", &
43  "EP_LIN_SOLVER ", &
44  "SPLINE_FIND_COEFFS", &
45  "REPLICA_EVAL ", &
46  "BSSE ", &
47  "SHELL_OPT ", &
48  "TDDFT_SCF "/)
49 
50  CHARACTER(LEN=default_path_length), PARAMETER, PUBLIC, DIMENSION(18) :: each_desc_labels = (/ &
51  "Iteration level for __ROOT__ (fictitious iteration level) ", &
52  "Iteration level for an ENERGY/ENERGY_FORCE calculation. ", &
53  "Iteration level for POWELL based optimization steps. ", &
54  "Iteration level for the SCF steps. ", &
55  "Iteration level for the X-Ray Absorption Spectroscopy (XAS) SCF steps. ", &
56  "Iteration level for the MD steps. ", &
57  "Iteration level for the Path integral md steps. ", &
58  "Iteration level for the METADYNAMICS steps (number of hills added). ", &
59  "Iteration level for the Geometry optimization steps. ", &
60  "Iteration level for the Rotational optimization steps in the Dimer calculation.", &
61  "Iteration level for the Cell optimization steps. ", &
62  "Iteration level for the BAND calculation steps ", &
63  "Iteration level for the Energy Perturbation (EP) linear solver ", &
64  "Iteration level for the solution of the coefficients of the splines ", &
65  "Iteration level for the evaluation of the Replica Environment ", &
66  "Iteration level for the Basis Set Superposition Error (BSSE) calculation ", &
67  "Iteration level for the Shell-Core distances optimization steps ", &
68  "Iteration level for the Time-Dependent Density Functional Theory SCF steps. "/)
69 
70 ! **************************************************************************************************
71 !> \brief contains the information about the current state of the program
72 !> to be able to decide if output is necessary
73 !> \author fawzi
74 ! **************************************************************************************************
75  TYPE cp_iteration_info_type
76  INTEGER :: ref_count = -1
77  INTEGER :: print_level = -1, n_rlevel = -1
78  INTEGER, DIMENSION(:), POINTER :: iteration => null()
79  LOGICAL, DIMENSION(:), POINTER :: last_iter => null()
80  CHARACTER(len=default_string_length) :: project_name = ""
81  CHARACTER(LEN=default_string_length), &
82  DIMENSION(:), POINTER :: level_name => null()
83  END TYPE cp_iteration_info_type
84 
85 CONTAINS
86 
87 ! **************************************************************************************************
88 !> \brief creates an output info object
89 !> \param iteration_info the object to create
90 !> \param project_name name of the project, used to create the filenames
91 !> \author fawzi
92 ! **************************************************************************************************
93  PURE SUBROUTINE cp_iteration_info_create(iteration_info, project_name)
94  TYPE(cp_iteration_info_type), POINTER :: iteration_info
95  CHARACTER(len=*), INTENT(in) :: project_name
96 
97  ALLOCATE (iteration_info)
98 
99  iteration_info%ref_count = 1
100  iteration_info%print_level = 2
101  iteration_info%n_rlevel = 1
102  iteration_info%project_name = project_name
103  ALLOCATE (iteration_info%iteration(iteration_info%n_rlevel))
104  ALLOCATE (iteration_info%level_name(iteration_info%n_rlevel))
105  ALLOCATE (iteration_info%last_iter(iteration_info%n_rlevel))
106  iteration_info%iteration(iteration_info%n_rlevel) = 1
107  iteration_info%level_name(iteration_info%n_rlevel) = "__ROOT__"
108  iteration_info%last_iter(iteration_info%n_rlevel) = .false.
109 
110  END SUBROUTINE cp_iteration_info_create
111 
112 ! **************************************************************************************************
113 !> \brief retains the iteration_info (see doc/ReferenceCounting.html)
114 !> \param iteration_info the iteration_info to retain
115 !> \author fawzi
116 ! **************************************************************************************************
117  SUBROUTINE cp_iteration_info_retain(iteration_info)
118  TYPE(cp_iteration_info_type), INTENT(INOUT) :: iteration_info
119 
120  CHARACTER(len=*), PARAMETER :: routinen = 'cp_iteration_info_retain', &
121  routinep = modulen//':'//routinen
122 
123  IF (iteration_info%ref_count <= 0) THEN
124  cpabort(routinep//" iteration_info%ref_counf<=0")
125  END IF
126  iteration_info%ref_count = iteration_info%ref_count + 1
127  END SUBROUTINE cp_iteration_info_retain
128 
129 ! **************************************************************************************************
130 !> \brief releases the iteration_info (see doc/ReferenceCounting.html)
131 !> \param iteration_info the iteration_info to release
132 !> \author fawzi
133 ! **************************************************************************************************
134  SUBROUTINE cp_iteration_info_release(iteration_info)
135  TYPE(cp_iteration_info_type), POINTER :: iteration_info
136 
137  CHARACTER(len=*), PARAMETER :: routinen = 'cp_iteration_info_release', &
138  routinep = modulen//':'//routinen
139 
140  IF (ASSOCIATED(iteration_info)) THEN
141  IF (iteration_info%ref_count <= 0) THEN
142  cpabort(routinep//" iteration_info%ref_counf<=0")
143  END IF
144  iteration_info%ref_count = iteration_info%ref_count - 1
145  IF (iteration_info%ref_count == 0) THEN
146  IF (ASSOCIATED(iteration_info%iteration)) THEN
147  DEALLOCATE (iteration_info%iteration)
148  END IF
149  IF (ASSOCIATED(iteration_info%last_iter)) THEN
150  DEALLOCATE (iteration_info%last_iter)
151  END IF
152  IF (ASSOCIATED(iteration_info%level_name)) THEN
153  DEALLOCATE (iteration_info%level_name)
154  END IF
155  DEALLOCATE (iteration_info)
156  END IF
157  END IF
158  END SUBROUTINE cp_iteration_info_release
159 
160 ! **************************************************************************************************
161 !> \brief Copies iterations info of an iteration info into another iteration info
162 !> \param iteration_info_in the iteration_info to be copied
163 !> \param iteration_info_out the iteration_info results of the copy
164 !> \author Teodoro Laino [tlaino]
165 ! **************************************************************************************************
166  SUBROUTINE cp_iteration_info_copy_iter(iteration_info_in, iteration_info_out)
167  TYPE(cp_iteration_info_type), INTENT(INOUT) :: iteration_info_in, iteration_info_out
168 
169  CHARACTER(len=*), PARAMETER :: routinen = 'cp_iteration_info_copy_iter', &
170  routinep = modulen//':'//routinen
171 
172  INTEGER :: i
173 
174  IF (iteration_info_in%ref_count <= 0) THEN
175  cpabort(routinep//" iteration_info_in%ref_counf<=0")
176  END IF
177 
178  iteration_info_out%n_rlevel = iteration_info_in%n_rlevel
179 
180  DEALLOCATE (iteration_info_out%iteration)
181  i = SIZE(iteration_info_in%iteration)
182  ALLOCATE (iteration_info_out%iteration(i))
183  iteration_info_out%iteration = iteration_info_in%iteration
184 
185  DEALLOCATE (iteration_info_out%last_iter)
186  i = SIZE(iteration_info_in%last_iter)
187  ALLOCATE (iteration_info_out%last_iter(i))
188  iteration_info_out%last_iter = iteration_info_in%last_iter
189 
190  DEALLOCATE (iteration_info_out%level_name)
191  i = SIZE(iteration_info_in%level_name)
192  ALLOCATE (iteration_info_out%level_name(i))
193  iteration_info_out%level_name = iteration_info_in%level_name
194 
195  END SUBROUTINE cp_iteration_info_copy_iter
196 
197 END MODULE cp_iter_types
198 
Collection of routines to handle the iteration info.
Definition: cp_iter_types.F:11
subroutine, public cp_iteration_info_copy_iter(iteration_info_in, iteration_info_out)
Copies iterations info of an iteration info into another iteration info.
pure subroutine, public cp_iteration_info_create(iteration_info, project_name)
creates an output info object
Definition: cp_iter_types.F:94
character(len=default_path_length), dimension(18), parameter, public each_possible_labels
Definition: cp_iter_types.F:30
subroutine, public cp_iteration_info_retain(iteration_info)
retains the iteration_info (see doc/ReferenceCounting.html)
subroutine, public cp_iteration_info_release(iteration_info)
releases the iteration_info (see doc/ReferenceCounting.html)
character(len=default_path_length), dimension(18), parameter, public each_desc_labels
Definition: cp_iter_types.F:50
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public default_string_length
Definition: kinds.F:57
integer, parameter, public default_path_length
Definition: kinds.F:58