Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Defines control structures, which contain the parameters and the
10 : !> settings for the calculations.
11 : ! **************************************************************************************************
12 : MODULE xas_control
13 :
14 : USE cp_log_handling, ONLY: cp_get_default_logger,&
15 : cp_logger_type,&
16 : cp_to_string
17 : USE cp_output_handling, ONLY: cp_print_key_finished_output,&
18 : cp_print_key_unit_nr
19 : USE input_constants, ONLY: xas_1s_type,&
20 : xas_dscf,&
21 : xas_tp_fh,&
22 : xas_tp_flex,&
23 : xas_tp_hh,&
24 : xas_tp_xfh,&
25 : xas_tp_xhh,&
26 : xes_tp_val
27 : USE input_section_types, ONLY: section_vals_type,&
28 : section_vals_val_get
29 : USE kinds, ONLY: dp
30 : USE memory_utilities, ONLY: reallocate
31 : #include "./base/base_uses.f90"
32 :
33 : IMPLICIT NONE
34 :
35 : PRIVATE
36 :
37 : ! **************************************************************************************************
38 : !> \brief A type that holds controlling information for a xas calculation
39 : ! **************************************************************************************************
40 : TYPE xas_control_type
41 : INTEGER :: nexc_atoms = 0
42 : INTEGER :: nexc_search = 0
43 : INTEGER :: spin_channel = 0
44 : INTEGER :: state_type = 0
45 : INTEGER :: xas_method = 0
46 : INTEGER :: dipole_form = 0
47 : INTEGER :: added_mos = 0
48 : INTEGER :: max_iter_added = 0
49 : INTEGER :: ngauss = 0
50 : INTEGER :: stride = 0
51 : INTEGER, DIMENSION(:), POINTER :: exc_atoms => NULL()
52 : INTEGER, DIMENSION(:), POINTER :: orbital_list => NULL()
53 : LOGICAL :: cubes = .FALSE., do_centers = .FALSE.
54 : LOGICAL :: xas_restart = .FALSE.
55 : INTEGER, DIMENSION(:), POINTER :: list_cubes => NULL()
56 : !
57 : REAL(dp) :: eps_added = 0.0_dp, overlap_threshold = 0.0_dp
58 : REAL(dp) :: xes_core_occupation = 0.0_dp
59 : REAL(dp) :: xes_homo_occupation = 0.0_dp
60 : REAL(dp) :: nel_tot = 0.0_dp, xas_core_occupation = 0.0_dp
61 : END TYPE xas_control_type
62 :
63 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xas_control'
64 :
65 : ! *** Public data types ***
66 :
67 : PUBLIC :: xas_control_type
68 :
69 : ! *** Public subroutines ***
70 :
71 : PUBLIC :: read_xas_control, write_xas_control, xas_control_create, &
72 : xas_control_release
73 :
74 : CONTAINS
75 :
76 : ! **************************************************************************************************
77 : !> \brief read from input the instructions for a xes/xas calculation
78 : !> \param xas_control control variables
79 : !> error
80 : !> \param xas_section ...
81 : !> \par History
82 : !> 04.2005 created [MI]
83 : ! **************************************************************************************************
84 126 : SUBROUTINE read_xas_control(xas_control, xas_section)
85 :
86 : TYPE(xas_control_type), INTENT(INOUT) :: xas_control
87 : TYPE(section_vals_type), POINTER :: xas_section
88 :
89 : INTEGER :: i, ir, n_rep, nex_at, nex_st
90 42 : INTEGER, DIMENSION(:), POINTER :: list
91 : LOGICAL :: hempty, was_present
92 :
93 42 : was_present = .FALSE.
94 :
95 42 : NULLIFY (list)
96 :
97 : CALL section_vals_val_get(xas_section, "METHOD", &
98 42 : i_val=xas_control%xas_method)
99 :
100 : CALL section_vals_val_get(xas_section, "DIPOLE_FORM", &
101 42 : i_val=xas_control%dipole_form)
102 :
103 : CALL section_vals_val_get(xas_section, "RESTART", &
104 42 : l_val=xas_control%xas_restart)
105 :
106 : CALL section_vals_val_get(xas_section, "STATE_TYPE", &
107 42 : i_val=xas_control%state_type)
108 :
109 : CALL section_vals_val_get(xas_section, "STATE_SEARCH", &
110 42 : i_val=xas_control%nexc_search)
111 :
112 : CALL section_vals_val_get(xas_section, "SPIN_CHANNEL", &
113 42 : i_val=xas_control%spin_channel)
114 :
115 : CALL section_vals_val_get(xas_section, "XAS_CORE", &
116 42 : r_val=xas_control%xas_core_occupation)
117 :
118 : CALL section_vals_val_get(xas_section, "XAS_TOT_EL", &
119 42 : r_val=xas_control%nel_tot)
120 :
121 : CALL section_vals_val_get(xas_section, "XES_CORE", &
122 42 : r_val=xas_control%xes_core_occupation)
123 :
124 : CALL section_vals_val_get(xas_section, "XES_EMPTY_HOMO", &
125 42 : l_val=hempty)
126 42 : IF (hempty) THEN
127 2 : xas_control%xes_homo_occupation = 0
128 : ELSE
129 40 : xas_control%xes_homo_occupation = 1
130 : END IF
131 :
132 : ! It should be further generalized
133 42 : IF (.NOT. ASSOCIATED(xas_control%exc_atoms)) THEN
134 : CALL section_vals_val_get(xas_section, "ATOMS_LIST", &
135 42 : n_rep_val=n_rep)
136 :
137 42 : IF (n_rep > 0) THEN
138 38 : nex_at = 0
139 98 : DO ir = 1, n_rep
140 60 : NULLIFY (list)
141 : CALL section_vals_val_get(xas_section, "ATOMS_LIST", &
142 60 : i_rep_val=ir, i_vals=list)
143 :
144 98 : IF (ASSOCIATED(list)) THEN
145 60 : CALL reallocate(xas_control%exc_atoms, 1, nex_at + SIZE(list))
146 138 : DO i = 1, SIZE(list)
147 138 : xas_control%exc_atoms(i + nex_at) = list(i)
148 : END DO
149 60 : xas_control%nexc_atoms = nex_at + SIZE(list)
150 60 : nex_at = nex_at + SIZE(list)
151 : END IF
152 : END DO ! ir
153 : END IF
154 : END IF
155 :
156 42 : IF (.NOT. ASSOCIATED(xas_control%exc_atoms)) THEN
157 4 : xas_control%nexc_atoms = 1
158 4 : ALLOCATE (xas_control%exc_atoms(1))
159 4 : xas_control%exc_atoms(1) = 1
160 : END IF
161 :
162 : CALL section_vals_val_get(xas_section, "ADDED_MOS", &
163 42 : i_val=xas_control%added_mos)
164 :
165 : CALL section_vals_val_get(xas_section, "MAX_ITER_ADDED", &
166 42 : i_val=xas_control%max_iter_added)
167 :
168 : CALL section_vals_val_get(xas_section, "EPS_ADDED", &
169 42 : r_val=xas_control%eps_added)
170 :
171 : CALL section_vals_val_get(xas_section, "NGAUSS", &
172 42 : i_val=xas_control%ngauss)
173 :
174 : CALL section_vals_val_get(xas_section, "OVERLAP_THRESHOLD", &
175 42 : r_val=xas_control%overlap_threshold)
176 :
177 : CALL section_vals_val_get(xas_section, "ORBITAL_LIST", &
178 42 : n_rep_val=n_rep)
179 42 : IF (n_rep > 0) THEN
180 2 : nex_st = 0
181 4 : DO ir = 1, n_rep
182 2 : NULLIFY (list)
183 : CALL section_vals_val_get(xas_section, "ORBITAL_LIST", &
184 2 : i_rep_val=ir, i_vals=list)
185 :
186 4 : IF (ASSOCIATED(list)) THEN
187 2 : CALL reallocate(xas_control%orbital_list, 1, nex_st + SIZE(list))
188 6 : DO i = 1, SIZE(list)
189 6 : xas_control%orbital_list(i + nex_st) = list(i)
190 : END DO
191 2 : nex_st = nex_st + SIZE(list)
192 : END IF
193 : END DO ! ir
194 : ELSE
195 40 : ALLOCATE (xas_control%orbital_list(1))
196 40 : xas_control%orbital_list(1) = -1
197 : END IF
198 :
199 42 : END SUBROUTINE read_xas_control
200 :
201 : ! **************************************************************************************************
202 : !> \brief write on the instructions for a xes/xas calculation
203 : !> \param xas_control control variables
204 : !> error
205 : !> \param dft_section ...
206 : !> \par History
207 : !> 12.2005 created [MI]
208 : ! **************************************************************************************************
209 42 : SUBROUTINE write_xas_control(xas_control, dft_section)
210 :
211 : TYPE(xas_control_type), INTENT(IN) :: xas_control
212 : TYPE(section_vals_type), POINTER :: dft_section
213 :
214 : INTEGER :: output_unit
215 : TYPE(cp_logger_type), POINTER :: logger
216 :
217 42 : logger => cp_get_default_logger()
218 : output_unit = cp_print_key_unit_nr(logger, dft_section, &
219 42 : "PRINT%DFT_CONTROL_PARAMETERS", extension=".Log")
220 42 : IF (output_unit > 0) THEN
221 25 : SELECT CASE (xas_control%xas_method)
222 : CASE (xas_tp_hh)
223 : WRITE (UNIT=output_unit, FMT="(/,T2,A,T40,A)") &
224 4 : "XAS| Method:", &
225 8 : " Transition potential with half hole"
226 : CASE (xas_tp_xhh)
227 : WRITE (UNIT=output_unit, FMT="(/,T2,A,T40,A)") &
228 2 : "XAS| Method:", &
229 4 : " Transition potential with excited half hole"
230 : CASE (xas_tp_fh)
231 : WRITE (UNIT=output_unit, FMT="(/,T2,A,T40,A)") &
232 5 : "XAS| Method:", &
233 10 : " Transition potential with full hole"
234 : CASE (xas_tp_xfh)
235 : WRITE (UNIT=output_unit, FMT="(/,T2,A,T40,A)") &
236 4 : "XAS| Method:", &
237 8 : " Transition potential with excited full hole"
238 : CASE (xes_tp_val)
239 : WRITE (UNIT=output_unit, FMT="(/,T2,A,T40,A)") &
240 3 : "XAS| Method:", &
241 6 : " Only XES with full core and hole in lumo"
242 : CASE (xas_tp_flex)
243 : WRITE (UNIT=output_unit, FMT="(/,T2,A,T25,A)") &
244 3 : "XAS| Method:", &
245 6 : " Transition potential with occupation of core state given from input"
246 : CASE (xas_dscf)
247 : WRITE (UNIT=output_unit, FMT="(/,T2,A,T40,A)") &
248 0 : "XAS| Method:", &
249 0 : " DSCF for the first excited state"
250 : CASE default
251 21 : CPABORT("unknown xas method "//TRIM(ADJUSTL(cp_to_string(xas_control%xas_method))))
252 : END SELECT
253 21 : IF (xas_control%xas_restart) THEN
254 : WRITE (UNIT=output_unit, FMT="(/,T2,A,T30,A)") &
255 3 : "XAS|", " Orbitals read from atom-specific restart file when available"
256 : END IF
257 : END IF
258 : CALL cp_print_key_finished_output(output_unit, logger, dft_section, &
259 42 : "PRINT%DFT_CONTROL_PARAMETERS")
260 42 : END SUBROUTINE write_xas_control
261 :
262 : ! **************************************************************************************************
263 : !> \brief create retain release the xas_control_type
264 : !> \param xas_control ...
265 : !> \par History
266 : !> 04.2005 created [MI]
267 : ! **************************************************************************************************
268 42 : SUBROUTINE xas_control_create(xas_control)
269 :
270 : TYPE(xas_control_type), INTENT(OUT) :: xas_control
271 :
272 42 : xas_control%xas_method = xas_tp_hh
273 42 : xas_control%nexc_atoms = 1
274 42 : xas_control%spin_channel = 1
275 42 : xas_control%nexc_search = -1
276 42 : xas_control%state_type = xas_1s_type
277 : xas_control%xas_restart = .FALSE.
278 : xas_control%added_mos = 0
279 42 : xas_control%xes_core_occupation = 1.0_dp
280 42 : xas_control%xes_homo_occupation = 1.0_dp
281 : NULLIFY (xas_control%exc_atoms)
282 : NULLIFY (xas_control%orbital_list)
283 : xas_control%cubes = .FALSE.
284 : xas_control%do_centers = .FALSE.
285 : NULLIFY (xas_control%list_cubes)
286 :
287 42 : END SUBROUTINE xas_control_create
288 :
289 : ! **************************************************************************************************
290 : !> \brief ...
291 : !> \param xas_control ...
292 : ! **************************************************************************************************
293 42 : SUBROUTINE xas_control_release(xas_control)
294 :
295 : TYPE(xas_control_type), INTENT(INOUT) :: xas_control
296 :
297 42 : IF (ASSOCIATED(xas_control%exc_atoms)) THEN
298 42 : DEALLOCATE (xas_control%exc_atoms)
299 : END IF
300 42 : IF (ASSOCIATED(xas_control%orbital_list)) THEN
301 42 : DEALLOCATE (xas_control%orbital_list)
302 : END IF
303 42 : IF (ASSOCIATED(xas_control%list_cubes)) THEN
304 2 : DEALLOCATE (xas_control%list_cubes)
305 : END IF
306 :
307 42 : END SUBROUTINE xas_control_release
308 :
309 0 : END MODULE xas_control
|
