Loading [MathJax]/jax/input/TeX/config.js
 (git:b77b4be)
•All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros
qs_linres_types.F
Go to the documentation of this file.
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 Type definitiona for linear response calculations
10!> \author MI
11! **************************************************************************************************
12MODULE qs_linres_types
13 USE atomic_kind_types, ONLY: atomic_kind_type,&
14 get_atomic_kind,&
15 get_atomic_kind_set
16 USE basis_set_types, ONLY: get_gto_basis_set,&
17 gto_basis_set_type
18 USE cp_array_utils, ONLY: cp_2d_i_p_type,&
19 cp_2d_r_p_type
20 USE cp_dbcsr_api, ONLY: dbcsr_p_type
21 USE cp_fm_struct, ONLY: cp_fm_struct_p_type,&
22 cp_fm_struct_type
23 USE cp_fm_types, ONLY: cp_fm_release,&
24 cp_fm_type
25 USE kinds, ONLY: dp
26 USE qs_grid_atom, ONLY: grid_atom_type
27 USE qs_harmonics_atom, ONLY: harmonics_atom_type
28 USE qs_kind_types, ONLY: get_qs_kind,&
29 qs_kind_type
30 USE qs_loc_types, ONLY: qs_loc_env_release,&
31 qs_loc_env_type
32 USE qs_rho_atom_types, ONLY: rho_atom_coeff,&
33 rho_atom_type
34 USE qs_rho_types, ONLY: qs_rho_p_type,&
35 qs_rho_release
36 USE realspace_grid_types, ONLY: realspace_grid_type
37#include "./base/base_uses.f90"
38
39 IMPLICIT NONE
40
41 PRIVATE
42
43! **************************************************************************************************
44!> \brief General settings for linear response calculations
45!> \param property which quantity is to be calculated by LR
46!> \param opt_method method to optimize the psi1 by minimization of the second order term of the energy
47!> \param preconditioner which kind of preconditioner should be used, if any
48!> \param localized_psi 0 : don't use the canonical psi0, but the maximally localized wavefunctions
49!> \param do_kernel the kernel is zero if the rho1 is zero as for the magnetic field perturbation
50!> \param tolerance convergence criterion for the optimization of the psi1
51!> \author MI
52! **************************************************************************************************
53 TYPE linres_control_type
54 INTEGER :: property = huge(0)
55 INTEGER :: preconditioner_type = huge(0)
56 INTEGER :: restart_every = huge(0)
57 REAL(kind=dp) :: energy_gap = huge(0.0_dp)
58 INTEGER :: max_iter = huge(0)
59 LOGICAL :: localized_psi0 = .false.
60 LOGICAL :: do_kernel = .false.
61 LOGICAL :: converged = .false.
62 LOGICAL :: linres_restart = .false.
63 LOGICAL :: lr_triplet = .false.
64 REAL(kind=dp) :: eps = huge(0.0_dp)
65 REAL(kind=dp) :: eps_filter = tiny(0.0_dp)
66 TYPE(qs_loc_env_type), POINTER :: qs_loc_env => null()
67 CHARACTER(LEN=8) :: flag = ""
68 END TYPE linres_control_type
69
70! **************************************************************************************************
71!> \param ref_coun t
72!> \param full_nmr true if the full correction is calculated
73!> \param simplenmr_done , fullnmr_done : flags that indicate what has been
74!> already calculated: used for restart
75!> \param centers_set centers of the maximally localized psi0
76!> \param spreads_set spreads of the maximally localized psi0
77!> \param p_psi 0 : full matrixes, operator p applied to psi0
78!> \param rxp_psi 0 : full matrixes, operator (r-d)xp applied to psi0
79!> \param psi 1_p : response wavefunctions to the perturbation given by
80!> H1=p (xyz) applied to psi0
81!> \param psi 1_rxp : response wavefunctions to the perturbation given by
82!> H1=(r-d_i)xp applied to psi0_i where d_i is the center
83!> \param psi 1_D : response wavefunctions to the perturbation given by
84!> H1=(d_j-d_i)xp applied to psi0_i where d_i is the center
85!> and d_j is the center of psi0_j and psi1_D_j is the result
86!> This operator has to be used in nstate scf calculations,
87!> one for each psi1_D_j vector
88!> \param chemical_shift the tensor for each atom
89!> \param chi_tensor the susceptibility tensor
90!> \param jrho 1_set : current density on the global grid, if gapw this is only the soft part
91!> \param jrho 1_atom_set : current density on the local atomic grids (only if gapw)
92!> \author MI
93! **************************************************************************************************
94 TYPE current_env_type
95 LOGICAL :: full = .false.
96 LOGICAL :: simple_done(6) = .false.
97 LOGICAL :: simple_converged(6) = .false.
98 LOGICAL :: do_qmmm = .false.
99 LOGICAL :: use_old_gauge_atom = .true.
100 LOGICAL :: chi_pbc = .false.
101 LOGICAL :: do_selected_states = .false.
102 LOGICAL :: gauge_init = .false.
103 LOGICAL :: all_pert_op_done = .false.
104 LOGICAL, DIMENSION(:, :), POINTER :: full_done => null()
105 INTEGER :: nao = huge(1)
106 INTEGER, DIMENSION(2) :: nstates = huge(1)
107 INTEGER :: gauge = huge(1)
108 INTEGER :: orb_center = huge(1)
109 INTEGER, DIMENSION(2) :: nbr_center = huge(1)
110 INTEGER, DIMENSION(:), POINTER :: list_cubes => null()
111 INTEGER, DIMENSION(:), POINTER :: selected_states_on_atom_list => null()
112 INTEGER, DIMENSION(:, :, :), POINTER :: statetrueindex => null()
113 CHARACTER(LEN=30) :: gauge_name = ""
114 CHARACTER(LEN=30) :: orb_center_name = ""
115 REAL(dp) :: chi_tensor(3, 3, 2) = 0.0_dp
116 REAL(dp) :: chi_tensor_loc(3, 3, 2) = 0.0_dp
117 REAL(dp) :: gauge_atom_radius = 0.0_dp
118 REAL(dp) :: selected_states_atom_radius = 0.0_dp
119 REAL(dp), DIMENSION(:, :), POINTER :: basisfun_center => null()
120 TYPE(cp_2d_i_p_type), DIMENSION(:), POINTER :: center_list => null()
121 TYPE(cp_2d_r_p_type), DIMENSION(:), POINTER :: centers_set => null()
122 TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: psi1_p => null()
123 TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: psi1_rxp => null()
124 TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: psi1_d => null()
125 TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: p_psi0 => null()
126 TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: rxp_psi0 => null()
127 TYPE(jrho_atom_type), DIMENSION(:), POINTER :: jrho1_atom_set => null()
128 TYPE(qs_rho_p_type), DIMENSION(:), POINTER :: jrho1_set => null()
129 TYPE(realspace_grid_type), DIMENSION(:), POINTER :: rs_buf => null()
130 TYPE(realspace_grid_type), DIMENSION(:, :), POINTER :: rs_gauge => null()
131 TYPE(cp_fm_type), DIMENSION(:), POINTER :: psi0_order => null()
132 END TYPE current_env_type
133
134! **************************************************************************************************
135! \param type for polarisability calculation using Berry operator
136 TYPE polar_env_type
137 LOGICAL :: do_raman = .false.
138 LOGICAL :: run_stopped = .false.
139 LOGICAL :: do_periodic = .true.
140 REAL(dp), DIMENSION(:, :), POINTER :: polar => null()
141 TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: psi1_dberry => null()
142 TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: dberry_psi0 => null()
143 END TYPE polar_env_type
144! **************************************************************************************************
145
146 TYPE issc_env_type
147 INTEGER :: issc_natms = 0
148 INTEGER, DIMENSION(:), POINTER :: issc_on_atom_list => null()
149 LOGICAL :: interpolate_issc = .false.
150 LOGICAL :: do_fc = .false.
151 LOGICAL :: do_sd = .false.
152 LOGICAL :: do_pso = .false.
153 LOGICAL :: do_dso = .false.
154 REAL(dp) :: issc_gapw_radius = 0.0_dp
155 REAL(dp) :: issc_factor = 0.0_dp
156 REAL(dp) :: issc_factor_gapw = 0.0_dp
157 REAL(dp), DIMENSION(:, :, :, :, :), POINTER :: issc => null()
158 REAL(dp), DIMENSION(:, :, :, :, :), POINTER :: issc_loc => null()
159 TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: psi1_efg => null()
160 TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: psi1_pso => null()
161 TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: psi1_dso => null()
162 TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: efg_psi0 => null()
163 TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: pso_psi0 => null()
164 TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: dso_psi0 => null()
165 TYPE(cp_fm_type), DIMENSION(:), POINTER :: psi1_fc => null()
166 TYPE(cp_fm_type), DIMENSION(:), POINTER :: fc_psi0 => null()
167 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_efg => null()
168 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_pso => null()
169 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_dso => null()
170 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_fc => null()
171 END TYPE issc_env_type
172
173! **************************************************************************************************
174 TYPE nmr_env_type
175 INTEGER :: n_nics = -1
176 INTEGER, DIMENSION(:), POINTER :: cs_atom_list => null()
177 INTEGER, DIMENSION(:), POINTER :: do_calc_cs_atom => null()
178 LOGICAL :: do_nics = .false.
179 LOGICAL :: interpolate_shift = .false.
180 REAL(dp) :: shift_gapw_radius = 0.0_dp
181 REAL(dp) :: shift_factor = 0.0_dp
182 REAL(dp) :: shift_factor_gapw = 0.0_dp
183 REAL(dp) :: chi_factor = 0.0_dp
184 REAL(dp) :: chi_si2shiftppm = 0.0_dp
185 REAL(dp) :: chi_si2ppmcgs = 0.0_dp
186 REAL(dp), DIMENSION(:, :), POINTER :: r_nics => null()
187 REAL(dp), DIMENSION(:, :, :), POINTER :: chemical_shift => null()
188 REAL(dp), DIMENSION(:, :, :), POINTER :: chemical_shift_loc => null()
189 REAL(dp), DIMENSION(:, :, :), POINTER :: chemical_shift_nics_loc => null()
190 REAL(dp), DIMENSION(:, :, :), POINTER :: chemical_shift_nics => null()
191 END TYPE nmr_env_type
192
193! **************************************************************************************************
194 TYPE epr_env_type
195 REAL(dp) :: g_free_factor = 0.0_dp
196 REAL(dp) :: g_soo_chicorr_factor = 0.0_dp
197 REAL(dp) :: g_soo_factor = 0.0_dp
198 REAL(dp) :: g_so_factor = 0.0_dp
199 REAL(dp) :: g_so_factor_gapw = 0.0_dp
200 REAL(dp) :: g_zke_factor = 0.0_dp
201 REAL(dp) :: g_zke = 0.0_dp
202 REAL(dp), DIMENSION(:, :), POINTER :: g_total => null()
203 REAL(dp), DIMENSION(:, :), POINTER :: g_so => null()
204 REAL(dp), DIMENSION(:, :), POINTER :: g_soo => null()
205 TYPE(qs_rho_p_type), DIMENSION(:, :), POINTER :: nablavks_set => null()
206 TYPE(nablavks_atom_type), DIMENSION(:), POINTER :: nablavks_atom_set => null()
207 TYPE(qs_rho_p_type), DIMENSION(:, :), POINTER :: bind_set => null()
208 TYPE(rho_atom_coeff), DIMENSION(:, :), POINTER :: bind_atom_set => null()
209 TYPE(rho_atom_type), DIMENSION(:), POINTER :: vks_atom_set => null()
210 END TYPE epr_env_type
211
212! **************************************************************************************************
213 TYPE nablavks_atom_type
214 TYPE(rho_atom_coeff), DIMENSION(:, :), POINTER :: nablavks_vec_rad_h => null()
215 TYPE(rho_atom_coeff), DIMENSION(:, :), POINTER :: nablavks_vec_rad_s => null()
216 END TYPE nablavks_atom_type
217
218! **************************************************************************************************
219 TYPE jrho_atom_type
220 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: cjc_h => null()
221 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: cjc_s => null()
222 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: cjc0_h => null()
223 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: cjc0_s => null()
224 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: cjc_ii_h => null()
225 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: cjc_ii_s => null()
226 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: cjc_iii_h => null()
227 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: cjc_iii_s => null()
228 TYPE(rho_atom_coeff), DIMENSION(:, :), POINTER :: jrho_vec_rad_h => null()
229 TYPE(rho_atom_coeff), DIMENSION(:, :), POINTER :: jrho_vec_rad_s => null()
230 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: jrho_h => null()
231 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: jrho_s => null()
232 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: jrho_a_h => null()
233 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: jrho_a_s => null()
234 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: jrho_b_h => null()
235 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: jrho_b_s => null()
236 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: jrho_a_h_ii => null()
237 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: jrho_a_s_ii => null()
238 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: jrho_b_h_ii => null()
239 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: jrho_b_s_ii => null()
240 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: jrho_a_h_iii => null()
241 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: jrho_a_s_iii => null()
242 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: jrho_b_h_iii => null()
243 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: jrho_b_s_iii => null()
244 END TYPE jrho_atom_type
245
246! \param type for dC/dR calculation
247 TYPE dcdr_env_type
248 INTEGER :: nao = -1
249 INTEGER :: orb_center = -1
250 INTEGER :: beta = -1
251 INTEGER :: lambda = -1
252 INTEGER :: output_unit = -1
253 INTEGER :: nspins = -1
254 INTEGER, DIMENSION(:), ALLOCATABLE :: nmo
255 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_hc => null()
256 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s1 => null()
257 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_t1 => null()
258 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s => null()
259 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_t => null()
260 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ppnl_1 => null()
261 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_core_charge_1 => null()
262 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_nosym_temp => null()
263 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_nosym_temp2 => null()
264 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: moments => null()
265 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_apply_op_constant => null()
266 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: hamiltonian1 => null()
267 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: perturbed_dm_correction => null()
268 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_vhxc_perturbed_basis => null()
269 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_difdip => null()
270 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_d_vhxc_dr => null()
271 REAL(dp), DIMENSION(:, :), POINTER :: deltar => null()
272 REAL(dp), DIMENSION(:, :), POINTER :: delta_basis_function => null()
273 REAL(dp), DIMENSION(:, :, :, :), POINTER :: apt_subset => null()
274 REAL(dp), DIMENSION(:, :, :, :), POINTER :: apt_at_dcdr_per_center => null()
275 TYPE(cp_fm_type), DIMENSION(:), POINTER :: mo_coeff => null()
276 TYPE(cp_fm_type), DIMENSION(:), POINTER :: dcr => null()
277 TYPE(cp_fm_type), DIMENSION(:), POINTER :: dcr_prime => null()
278 TYPE(cp_fm_type), DIMENSION(:), POINTER :: op_dr => null()
279 TYPE(cp_fm_type), DIMENSION(:), POINTER :: chc => null()
280 TYPE(cp_fm_type), DIMENSION(:), POINTER :: ch1c => null()
281 TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: matrix_m_alpha => null()
282 CHARACTER(LEN=30) :: orb_center_name = ""
283 TYPE(cp_2d_i_p_type), DIMENSION(:), POINTER :: center_list => null()
284 TYPE(cp_2d_r_p_type), DIMENSION(:), POINTER :: centers_set => null()
285 INTEGER, DIMENSION(2) :: nbr_center = -1
286 INTEGER, DIMENSION(2) :: nstates = -1
287 REAL(dp), DIMENSION(3) :: ref_point = 0.0_dp
288 REAL(dp), DIMENSION(3) :: dipole_pos = 0.0_dp
289 LOGICAL :: localized_psi0 = .false.
290 INTEGER, POINTER :: list_of_atoms(:) => null()
291 LOGICAL :: distributed_origin = .false.
292 LOGICAL :: z_matrix_method = .false.
293 TYPE(cp_fm_struct_type), POINTER :: aoao_fm_struct => null()
294 TYPE(cp_fm_struct_type), POINTER :: homohomo_fm_struct => null()
295 TYPE(cp_fm_struct_p_type), DIMENSION(:), POINTER :: momo_fm_struct => null()
296 TYPE(cp_fm_struct_p_type), DIMENSION(:), POINTER :: likemos_fm_struct => null()
297 REAL(dp), DIMENSION(:, :, :), POINTER :: apt_el_dcdr => null()
298 REAL(dp), DIMENSION(:, :, :), POINTER :: apt_nuc_dcdr => null()
299 REAL(dp), DIMENSION(:, :, :), POINTER :: apt_total_dcdr => null()
300 REAL(dp), DIMENSION(:, :, :, :), POINTER :: apt_el_dcdr_per_center => null()
301 REAL(dp), DIMENSION(:, :, :, :), POINTER :: apt_el_dcdr_per_subset => null()
302 END TYPE dcdr_env_type
303
304! \param type for VCD calculation
305 TYPE vcd_env_type
306 TYPE(dcdr_env_type) :: dcdr_env = dcdr_env_type()
307
308 INTEGER :: output_unit = -1
309 REAL(dp), DIMENSION(3) :: spatial_origin = 0.0_dp
310 REAL(dp), DIMENSION(3) :: spatial_origin_atom = 0.0_dp
311 REAL(dp), DIMENSION(3) :: magnetic_origin = 0.0_dp
312 REAL(dp), DIMENSION(3) :: magnetic_origin_atom = 0.0_dp
313 LOGICAL :: distributed_origin = .false.
314 LOGICAL :: origin_dependent_op_mfp = .false.
315 LOGICAL :: do_mfp = .false.
316
317 ! APTs and AATs in velocity form
318 REAL(dp), DIMENSION(:, :, :), POINTER :: apt_el_nvpt => null()
319 REAL(dp), DIMENSION(:, :, :), POINTER :: apt_nuc_nvpt => null()
320 REAL(dp), DIMENSION(:, :, :), POINTER :: apt_total_nvpt => null()
321 REAL(dp), DIMENSION(:, :, :), POINTER :: aat_atom_nvpt => null()
322 REAL(dp), DIMENSION(:, :, :), POINTER :: aat_atom_mfp => null()
323
324 ! Matrices
325 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_dsdv => null(), &
326 matrix_drpnl => null(), &
327 matrix_hxc_dsdv => null(), &
328 hcom => null(), &
329 dipvel_ao => null(), &
330 dipvel_ao_delta => null(), &
331 matrix_rxrv => null(), &
332 matrix_dsdb => null()
333
334 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_hr => null(), &
335 matrix_rh => null(), &
336 matrix_difdip2 => null(), &
337 moments_der => null(), &
338 moments_der_right => null(), &
339 moments_der_left => null(), &
340 matrix_r_doublecom => null(), &
341 matrix_rcomr => null(), &
342 matrix_rrcom => null(), &
343 matrix_dcom => null(), &
344 matrix_r_rxvr => null(), &
345 matrix_rxvr_r => null(), &
346 matrix_nosym_temp_33 => null(), &
347 matrix_nosym_temp2_33 => null()
348
349 TYPE(cp_fm_type), DIMENSION(:), POINTER :: dcv => null(), &
350 dcv_prime => null(), &
351 op_dv => null(), &
352 dcb => null(), &
353 dcb_prime => null(), &
354 op_db => null()
355 END TYPE vcd_env_type
356
357 CHARACTER(len=*), PARAMETER, PRIVATE :: modulen = 'qs_linres_types'
358
359! *** Public data types ***
360
361 PUBLIC :: linres_control_type, &
362 nmr_env_type, issc_env_type, jrho_atom_type, &
363 epr_env_type, dcdr_env_type, vcd_env_type, &
364 nablavks_atom_type, current_env_type, &
365 polar_env_type
366
367! *** Public subroutines ***
368
369 PUBLIC :: allocate_jrho_atom_rad, deallocate_jrho_atom_set, get_nmr_env, &
370 get_current_env, allocate_jrho_coeff, init_jrho_atom_set, init_nablavks_atom_set, &
371 linres_control_release, set_epr_env, deallocate_nablavks_atom_set, &
372 set2zero_jrho_atom_rad, get_epr_env, get_issc_env, set_current_env, &
373 get_polar_env, polar_env_release, set_polar_env
374
375CONTAINS
376
377! **************************************************************************************************
378!> \brief ...
379!> \param linres_control ...
380! **************************************************************************************************
381 SUBROUTINE linres_control_release(linres_control)
382
383 TYPE(linres_control_type), INTENT(INOUT) :: linres_control
384
385 IF (ASSOCIATED(linres_control%qs_loc_env)) THEN
386 CALL qs_loc_env_release(linres_control%qs_loc_env)
387 DEALLOCATE (linres_control%qs_loc_env)
388 END IF
389
390 END SUBROUTINE linres_control_release
391
392! **************************************************************************************************
393!> \brief ...
394!> \param current_env ...
395!> \param simple_done ...
396!> \param simple_converged ...
397!> \param full_done ...
398!> \param nao ...
399!> \param nstates ...
400!> \param gauge ...
401!> \param list_cubes ...
402!> \param statetrueindex ...
403!> \param gauge_name ...
404!> \param basisfun_center ...
405!> \param nbr_center ...
406!> \param center_list ...
407!> \param centers_set ...
408!> \param psi1_p ...
409!> \param psi1_rxp ...
410!> \param psi1_D ...
411!> \param p_psi0 ...
412!> \param rxp_psi0 ...
413!> \param jrho1_atom_set ...
414!> \param jrho1_set ...
415!> \param chi_tensor ...
416!> \param chi_tensor_loc ...
417!> \param gauge_atom_radius ...
418!> \param rs_gauge ...
419!> \param use_old_gauge_atom ...
420!> \param chi_pbc ...
421!> \param psi0_order ...
422! **************************************************************************************************
423 SUBROUTINE get_current_env(current_env, simple_done, simple_converged, full_done, nao, &
424 nstates, gauge, list_cubes, statetrueindex, gauge_name, basisfun_center, &
425 nbr_center, center_list, centers_set, psi1_p, psi1_rxp, psi1_D, p_psi0, &
426 rxp_psi0, jrho1_atom_set, jrho1_set, chi_tensor, &
427 chi_tensor_loc, gauge_atom_radius, rs_gauge, use_old_gauge_atom, &
428 chi_pbc, psi0_order)
429
430 TYPE(current_env_type), OPTIONAL :: current_env
431 LOGICAL, OPTIONAL :: simple_done(6), simple_converged(6)
432 LOGICAL, DIMENSION(:, :), OPTIONAL, POINTER :: full_done
433 INTEGER, OPTIONAL :: nao, nstates(2), gauge
434 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: list_cubes
435 INTEGER, DIMENSION(:, :, :), OPTIONAL, POINTER :: statetrueindex
436 CHARACTER(LEN=30), OPTIONAL :: gauge_name
437 REAL(dp), DIMENSION(:, :), OPTIONAL, POINTER :: basisfun_center
438 INTEGER, OPTIONAL :: nbr_center(2)
439 TYPE(cp_2d_i_p_type), DIMENSION(:), OPTIONAL, &
440 POINTER :: center_list
441 TYPE(cp_2d_r_p_type), DIMENSION(:), OPTIONAL, &
442 POINTER :: centers_set
443 TYPE(cp_fm_type), DIMENSION(:, :), OPTIONAL, &
444 POINTER :: psi1_p, psi1_rxp, psi1_d, p_psi0, &
445 rxp_psi0
446 TYPE(jrho_atom_type), DIMENSION(:), OPTIONAL, &
447 POINTER :: jrho1_atom_set
448 TYPE(qs_rho_p_type), DIMENSION(:), OPTIONAL, &
449 POINTER :: jrho1_set
450 REAL(dp), INTENT(OUT), OPTIONAL :: chi_tensor(3, 3, 2), &
451 chi_tensor_loc(3, 3, 2), &
452 gauge_atom_radius
453 TYPE(realspace_grid_type), DIMENSION(:, :), &
454 OPTIONAL, POINTER :: rs_gauge
455 LOGICAL, OPTIONAL :: use_old_gauge_atom, chi_pbc
456 TYPE(cp_fm_type), DIMENSION(:), OPTIONAL, POINTER :: psi0_order
457
458 IF (PRESENT(simple_done)) simple_done(1:6) = current_env%simple_done(1:6)
459 IF (PRESENT(simple_converged)) simple_converged(1:6) = current_env%simple_converged(1:6)
460 IF (PRESENT(full_done)) full_done => current_env%full_done
461 IF (PRESENT(nao)) nao = current_env%nao
462 IF (PRESENT(nstates)) nstates(1:2) = current_env%nstates(1:2)
463 IF (PRESENT(gauge)) gauge = current_env%gauge
464 IF (PRESENT(list_cubes)) list_cubes => current_env%list_cubes
465 IF (PRESENT(statetrueindex)) statetrueindex => current_env%statetrueindex
466 IF (PRESENT(gauge_name)) gauge_name = current_env%gauge_name
467 IF (PRESENT(basisfun_center)) basisfun_center => current_env%basisfun_center
468 IF (PRESENT(nbr_center)) nbr_center(1:2) = current_env%nbr_center(1:2)
469 IF (PRESENT(center_list)) center_list => current_env%center_list
470 IF (PRESENT(centers_set)) centers_set => current_env%centers_set
471 IF (PRESENT(chi_tensor)) chi_tensor(:, :, :) = current_env%chi_tensor(:, :, :)
472 IF (PRESENT(chi_tensor_loc)) chi_tensor_loc(:, :, :) = current_env%chi_tensor_loc(:, :, :)
473 IF (PRESENT(psi1_p)) psi1_p => current_env%psi1_p
474 IF (PRESENT(psi1_rxp)) psi1_rxp => current_env%psi1_rxp
475 IF (PRESENT(psi1_d)) psi1_d => current_env%psi1_D
476 IF (PRESENT(p_psi0)) p_psi0 => current_env%p_psi0
477 IF (PRESENT(rxp_psi0)) rxp_psi0 => current_env%rxp_psi0
478 IF (PRESENT(jrho1_atom_set)) jrho1_atom_set => current_env%jrho1_atom_set
479 IF (PRESENT(jrho1_set)) jrho1_set => current_env%jrho1_set
480 IF (PRESENT(rs_gauge)) rs_gauge => current_env%rs_gauge
481 IF (PRESENT(psi0_order)) psi0_order => current_env%psi0_order
482 IF (PRESENT(chi_pbc)) chi_pbc = current_env%chi_pbc
483 IF (PRESENT(gauge_atom_radius)) gauge_atom_radius = current_env%gauge_atom_radius
484 IF (PRESENT(use_old_gauge_atom)) use_old_gauge_atom = current_env%use_old_gauge_atom
485
486 END SUBROUTINE get_current_env
487
488! **************************************************************************************************
489!> \brief ...
490!> \param nmr_env ...
491!> \param n_nics ...
492!> \param cs_atom_list ...
493!> \param do_calc_cs_atom ...
494!> \param r_nics ...
495!> \param chemical_shift ...
496!> \param chemical_shift_loc ...
497!> \param chemical_shift_nics_loc ...
498!> \param chemical_shift_nics ...
499!> \param shift_gapw_radius ...
500!> \param do_nics ...
501!> \param interpolate_shift ...
502! **************************************************************************************************
503 SUBROUTINE get_nmr_env(nmr_env, n_nics, cs_atom_list, do_calc_cs_atom, &
504 r_nics, chemical_shift, chemical_shift_loc, &
505 chemical_shift_nics_loc, chemical_shift_nics, &
506 shift_gapw_radius, do_nics, interpolate_shift)
507
508 TYPE(nmr_env_type) :: nmr_env
509 INTEGER, INTENT(OUT), OPTIONAL :: n_nics
510 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: cs_atom_list, do_calc_cs_atom
511 REAL(dp), DIMENSION(:, :), OPTIONAL, POINTER :: r_nics
512 REAL(dp), DIMENSION(:, :, :), OPTIONAL, POINTER :: chemical_shift, chemical_shift_loc, &
513 chemical_shift_nics_loc, &
514 chemical_shift_nics
515 REAL(dp), INTENT(OUT), OPTIONAL :: shift_gapw_radius
516 LOGICAL, INTENT(OUT), OPTIONAL :: do_nics, interpolate_shift
517
518 IF (PRESENT(n_nics)) n_nics = nmr_env%n_nics
519 IF (PRESENT(cs_atom_list)) cs_atom_list => nmr_env%cs_atom_list
520 IF (PRESENT(do_calc_cs_atom)) do_calc_cs_atom => nmr_env%do_calc_cs_atom
521 IF (PRESENT(chemical_shift)) chemical_shift => nmr_env%chemical_shift
522 IF (PRESENT(chemical_shift_loc)) chemical_shift_loc => nmr_env%chemical_shift_loc
523 IF (PRESENT(chemical_shift_nics)) chemical_shift_nics => nmr_env%chemical_shift_nics
524 IF (PRESENT(r_nics)) r_nics => nmr_env%r_nics
525 IF (PRESENT(chemical_shift_nics_loc)) chemical_shift_nics_loc => nmr_env%chemical_shift_nics_loc
526 IF (PRESENT(shift_gapw_radius)) shift_gapw_radius = nmr_env%shift_gapw_radius
527 IF (PRESENT(do_nics)) do_nics = nmr_env%do_nics
528 IF (PRESENT(interpolate_shift)) interpolate_shift = nmr_env%interpolate_shift
529
530 END SUBROUTINE get_nmr_env
531
532! **************************************************************************************************
533!> \brief ...
534!> \param issc_env ...
535!> \param issc_on_atom_list ...
536!> \param issc_gapw_radius ...
537!> \param issc_loc ...
538!> \param do_fc ...
539!> \param do_sd ...
540!> \param do_pso ...
541!> \param do_dso ...
542!> \param issc ...
543!> \param interpolate_issc ...
544!> \param psi1_efg ...
545!> \param psi1_pso ...
546!> \param psi1_dso ...
547!> \param psi1_fc ...
548!> \param efg_psi0 ...
549!> \param pso_psi0 ...
550!> \param dso_psi0 ...
551!> \param fc_psi0 ...
552!> \param matrix_efg ...
553!> \param matrix_pso ...
554!> \param matrix_dso ...
555!> \param matrix_fc ...
556! **************************************************************************************************
557 SUBROUTINE get_issc_env(issc_env, issc_on_atom_list, issc_gapw_radius, issc_loc, &
558 do_fc, do_sd, do_pso, do_dso, &
559 issc, interpolate_issc, psi1_efg, psi1_pso, psi1_dso, psi1_fc, efg_psi0, pso_psi0, dso_psi0, fc_psi0, &
560 matrix_efg, matrix_pso, matrix_dso, matrix_fc)
561
562 TYPE(issc_env_type) :: issc_env
563 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: issc_on_atom_list
564 REAL(dp), OPTIONAL :: issc_gapw_radius
565 REAL(dp), DIMENSION(:, :, :, :, :), OPTIONAL, &
566 POINTER :: issc_loc
567 LOGICAL, OPTIONAL :: do_fc, do_sd, do_pso, do_dso
568 REAL(dp), DIMENSION(:, :, :, :, :), OPTIONAL, &
569 POINTER :: issc
570 LOGICAL, OPTIONAL :: interpolate_issc
571 TYPE(cp_fm_type), DIMENSION(:, :), OPTIONAL, &
572 POINTER :: psi1_efg, psi1_pso, psi1_dso
573 TYPE(cp_fm_type), DIMENSION(:), OPTIONAL, POINTER :: psi1_fc
574 TYPE(cp_fm_type), DIMENSION(:, :), OPTIONAL, &
575 POINTER :: efg_psi0, pso_psi0, dso_psi0
576 TYPE(cp_fm_type), DIMENSION(:), OPTIONAL, POINTER :: fc_psi0
577 TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, &
578 POINTER :: matrix_efg, matrix_pso, matrix_dso, &
579 matrix_fc
580
581 IF (PRESENT(issc_on_atom_list)) issc_on_atom_list => issc_env%issc_on_atom_list
582 IF (PRESENT(issc_gapw_radius)) issc_gapw_radius = issc_env%issc_gapw_radius
583 IF (PRESENT(issc_loc)) issc_loc => issc_env%issc_loc
584 IF (PRESENT(issc)) issc => issc_env%issc
585 IF (PRESENT(interpolate_issc)) interpolate_issc = issc_env%interpolate_issc
586 IF (PRESENT(psi1_efg)) psi1_efg => issc_env%psi1_efg
587 IF (PRESENT(psi1_pso)) psi1_pso => issc_env%psi1_pso
588 IF (PRESENT(psi1_dso)) psi1_dso => issc_env%psi1_dso
589 IF (PRESENT(psi1_fc)) psi1_fc => issc_env%psi1_fc
590 IF (PRESENT(efg_psi0)) efg_psi0 => issc_env%efg_psi0
591 IF (PRESENT(pso_psi0)) pso_psi0 => issc_env%pso_psi0
592 IF (PRESENT(dso_psi0)) dso_psi0 => issc_env%dso_psi0
593 IF (PRESENT(fc_psi0)) fc_psi0 => issc_env%fc_psi0
594 IF (PRESENT(matrix_efg)) matrix_efg => issc_env%matrix_efg
595 IF (PRESENT(matrix_pso)) matrix_pso => issc_env%matrix_pso
596 IF (PRESENT(matrix_fc)) matrix_fc => issc_env%matrix_fc
597 IF (PRESENT(matrix_dso)) matrix_dso => issc_env%matrix_dso
598 IF (PRESENT(do_fc)) do_fc = issc_env%do_fc
599 IF (PRESENT(do_sd)) do_sd = issc_env%do_sd
600 IF (PRESENT(do_pso)) do_pso = issc_env%do_pso
601 IF (PRESENT(do_dso)) do_dso = issc_env%do_dso
602
603 END SUBROUTINE get_issc_env
604
605! **************************************************************************************************
606!> \brief ...
607!> \param current_env ...
608!> \param jrho1_atom_set ...
609!> \param jrho1_set ...
610! **************************************************************************************************
611 SUBROUTINE set_current_env(current_env, jrho1_atom_set, jrho1_set)
612
613 TYPE(current_env_type) :: current_env
614 TYPE(jrho_atom_type), DIMENSION(:), OPTIONAL, &
615 POINTER :: jrho1_atom_set
616 TYPE(qs_rho_p_type), DIMENSION(:), OPTIONAL, &
617 POINTER :: jrho1_set
618
619 INTEGER :: idir
620
621 IF (PRESENT(jrho1_atom_set)) THEN
622 IF (ASSOCIATED(current_env%jrho1_atom_set)) THEN
623 CALL deallocate_jrho_atom_set(current_env%jrho1_atom_set)
624 END IF
625 current_env%jrho1_atom_set => jrho1_atom_set
626 END IF
627
628 IF (PRESENT(jrho1_set)) THEN
629 IF (ASSOCIATED(current_env%jrho1_set)) THEN
630 DO idir = 1, 3
631 CALL qs_rho_release(current_env%jrho1_set(idir)%rho)
632 DEALLOCATE (current_env%jrho1_set(idir)%rho)
633 END DO
634 END IF
635 current_env%jrho1_set => jrho1_set
636 END IF
637
638 END SUBROUTINE set_current_env
639
640! **************************************************************************************************
641!> \brief ...
642!> \param epr_env ...
643!> \param g_total ...
644!> \param g_so ...
645!> \param g_soo ...
646!> \param nablavks_set ...
647!> \param nablavks_atom_set ...
648!> \param bind_set ...
649!> \param bind_atom_set ...
650! **************************************************************************************************
651 SUBROUTINE get_epr_env(epr_env, g_total, g_so, g_soo, nablavks_set, nablavks_atom_set, &
652 bind_set, bind_atom_set)
653
654 TYPE(epr_env_type) :: epr_env
655 REAL(dp), DIMENSION(:, :), OPTIONAL, POINTER :: g_total, g_so, g_soo
656 TYPE(qs_rho_p_type), DIMENSION(:, :), OPTIONAL, &
657 POINTER :: nablavks_set
658 TYPE(nablavks_atom_type), DIMENSION(:), OPTIONAL, &
659 POINTER :: nablavks_atom_set
660 TYPE(qs_rho_p_type), DIMENSION(:, :), OPTIONAL, &
661 POINTER :: bind_set
662 TYPE(rho_atom_coeff), DIMENSION(:, :), OPTIONAL, &
663 POINTER :: bind_atom_set
664
665 IF (PRESENT(g_total)) g_total => epr_env%g_total
666 IF (PRESENT(g_so)) g_so => epr_env%g_so
667 IF (PRESENT(g_soo)) g_soo => epr_env%g_soo
668 IF (PRESENT(nablavks_set)) nablavks_set => epr_env%nablavks_set
669 IF (PRESENT(nablavks_atom_set)) nablavks_atom_set => epr_env%nablavks_atom_set
670 IF (PRESENT(bind_set)) bind_set => epr_env%bind_set
671 IF (PRESENT(bind_atom_set)) bind_atom_set => epr_env%bind_atom_set
672
673 END SUBROUTINE get_epr_env
674
675! **************************************************************************************************
676!> \brief ...
677!> \param epr_env ...
678!> \param g_free_factor ...
679!> \param g_soo_chicorr_factor ...
680!> \param g_soo_factor ...
681!> \param g_so_factor ...
682!> \param g_so_factor_gapw ...
683!> \param g_zke_factor ...
684!> \param nablavks_set ...
685!> \param nablavks_atom_set ...
686! **************************************************************************************************
687 SUBROUTINE set_epr_env(epr_env, g_free_factor, g_soo_chicorr_factor, &
688 g_soo_factor, g_so_factor, g_so_factor_gapw, &
689 g_zke_factor, nablavks_set, nablavks_atom_set)
690
691 TYPE(epr_env_type) :: epr_env
692 REAL(dp), INTENT(IN), OPTIONAL :: g_free_factor, g_soo_chicorr_factor, &
693 g_soo_factor, g_so_factor, &
694 g_so_factor_gapw, g_zke_factor
695 TYPE(qs_rho_p_type), DIMENSION(:, :), OPTIONAL, &
696 POINTER :: nablavks_set
697 TYPE(nablavks_atom_type), DIMENSION(:), OPTIONAL, &
698 POINTER :: nablavks_atom_set
699
700 INTEGER :: idir, ispin
701
702 IF (PRESENT(g_free_factor)) epr_env%g_free_factor = g_free_factor
703 IF (PRESENT(g_zke_factor)) epr_env%g_zke_factor = g_zke_factor
704 IF (PRESENT(g_so_factor)) epr_env%g_so_factor = g_so_factor
705 IF (PRESENT(g_so_factor_gapw)) epr_env%g_so_factor_gapw = g_so_factor_gapw
706 IF (PRESENT(g_soo_factor)) epr_env%g_soo_factor = g_soo_factor
707 IF (PRESENT(g_soo_chicorr_factor)) epr_env%g_soo_chicorr_factor = g_soo_chicorr_factor
708
709 IF (PRESENT(nablavks_set)) THEN
710 IF (ASSOCIATED(epr_env%nablavks_set)) THEN
711 DO ispin = 1, 2
712 DO idir = 1, 3
713 CALL qs_rho_release(epr_env%nablavks_set(idir, ispin)%rho)
714 DEALLOCATE (epr_env%nablavks_set(idir, ispin)%rho)
715 END DO
716 END DO
717 END IF
718 epr_env%nablavks_set => nablavks_set
719 END IF
720
721 IF (PRESENT(nablavks_atom_set)) THEN
722 IF (ASSOCIATED(epr_env%nablavks_atom_set)) THEN
723 CALL deallocate_nablavks_atom_set(epr_env%nablavks_atom_set)
724 END IF
725 epr_env%nablavks_atom_set => nablavks_atom_set
726 END IF
727
728 END SUBROUTINE set_epr_env
729
730! **************************************************************************************************
731!> \brief ...
732!> \param nablavks_atom_set ...
733!> \param natom ...
734! **************************************************************************************************
735 SUBROUTINE allocate_nablavks_atom_set(nablavks_atom_set, natom)
736
737 TYPE(nablavks_atom_type), DIMENSION(:), POINTER :: nablavks_atom_set
738 INTEGER, INTENT(IN) :: natom
739
740 INTEGER :: iat
741
742 ALLOCATE (nablavks_atom_set(natom))
743
744 DO iat = 1, natom
745 NULLIFY (nablavks_atom_set(iat)%nablavks_vec_rad_h)
746 NULLIFY (nablavks_atom_set(iat)%nablavks_vec_rad_s)
747 END DO
748 END SUBROUTINE allocate_nablavks_atom_set
749
750! **************************************************************************************************
751!> \brief ...
752!> \param nablavks_atom_set ...
753! **************************************************************************************************
754 SUBROUTINE deallocate_nablavks_atom_set(nablavks_atom_set)
755
756 TYPE(nablavks_atom_type), DIMENSION(:), POINTER :: nablavks_atom_set
757
758 INTEGER :: i, iat, idir, n, natom
759
760 cpassert(ASSOCIATED(nablavks_atom_set))
761 natom = SIZE(nablavks_atom_set)
762
763 DO iat = 1, natom
764 IF (ASSOCIATED(nablavks_atom_set(iat)%nablavks_vec_rad_h)) THEN
765 IF (ASSOCIATED(nablavks_atom_set(iat)%nablavks_vec_rad_h(1, 1)%r_coef)) THEN
766 n = SIZE(nablavks_atom_set(iat)%nablavks_vec_rad_h, 2)
767 DO i = 1, n
768 DO idir = 1, 3
769 DEALLOCATE (nablavks_atom_set(iat)%nablavks_vec_rad_h(idir, i)%r_coef)
770 DEALLOCATE (nablavks_atom_set(iat)%nablavks_vec_rad_s(idir, i)%r_coef)
771 END DO
772 END DO
773 END IF
774 DEALLOCATE (nablavks_atom_set(iat)%nablavks_vec_rad_h)
775 DEALLOCATE (nablavks_atom_set(iat)%nablavks_vec_rad_s)
776 END IF
777 END DO
778 DEALLOCATE (nablavks_atom_set)
779 END SUBROUTINE deallocate_nablavks_atom_set
780
781! **************************************************************************************************
782!> \brief ...
783!> \param jrho_atom_set ...
784! **************************************************************************************************
785 SUBROUTINE deallocate_jrho_atom_set(jrho_atom_set)
786
787 TYPE(jrho_atom_type), DIMENSION(:), POINTER :: jrho_atom_set
788
789 INTEGER :: i, iat, idir, n, natom
790
791 cpassert(ASSOCIATED(jrho_atom_set))
792 natom = SIZE(jrho_atom_set)
793
794 DO iat = 1, natom
795 IF (ASSOCIATED(jrho_atom_set(iat)%cjc_h)) THEN
796 IF (ASSOCIATED(jrho_atom_set(iat)%cjc_h(1)%r_coef)) THEN
797 n = SIZE(jrho_atom_set(iat)%cjc_h)
798 DO i = 1, n
799 !
800 ! size = (nsotot,nsotot) replicated
801 DEALLOCATE (jrho_atom_set(iat)%cjc0_h(i)%r_coef, &
802 jrho_atom_set(iat)%cjc0_s(i)%r_coef, &
803 jrho_atom_set(iat)%cjc_h(i)%r_coef, &
804 jrho_atom_set(iat)%cjc_s(i)%r_coef, &
805 jrho_atom_set(iat)%cjc_ii_h(i)%r_coef, &
806 jrho_atom_set(iat)%cjc_ii_s(i)%r_coef, &
807 jrho_atom_set(iat)%cjc_iii_h(i)%r_coef, &
808 jrho_atom_set(iat)%cjc_iii_s(i)%r_coef)
809 END DO
810 END IF
811 DEALLOCATE (jrho_atom_set(iat)%cjc0_h, &
812 jrho_atom_set(iat)%cjc0_s, &
813 jrho_atom_set(iat)%cjc_h, &
814 jrho_atom_set(iat)%cjc_s, &
815 jrho_atom_set(iat)%cjc_ii_h, &
816 jrho_atom_set(iat)%cjc_ii_s, &
817 jrho_atom_set(iat)%cjc_iii_h, &
818 jrho_atom_set(iat)%cjc_iii_s)
819 END IF
820
821 IF (ASSOCIATED(jrho_atom_set(iat)%jrho_a_h)) THEN
822 IF (ASSOCIATED(jrho_atom_set(iat)%jrho_a_h(1)%r_coef)) THEN
823 n = SIZE(jrho_atom_set(iat)%jrho_a_h)
824 DO i = 1, n
825 !
826 ! size = (nr,max_iso_not0) distributed
827 DEALLOCATE (jrho_atom_set(iat)%jrho_h(i)%r_coef, &
828 jrho_atom_set(iat)%jrho_s(i)%r_coef, &
829 jrho_atom_set(iat)%jrho_a_h(i)%r_coef, &
830 jrho_atom_set(iat)%jrho_a_s(i)%r_coef, &
831 jrho_atom_set(iat)%jrho_b_h(i)%r_coef, &
832 jrho_atom_set(iat)%jrho_b_s(i)%r_coef, &
833 jrho_atom_set(iat)%jrho_a_h_ii(i)%r_coef, &
834 jrho_atom_set(iat)%jrho_a_s_ii(i)%r_coef, &
835 jrho_atom_set(iat)%jrho_b_h_ii(i)%r_coef, &
836 jrho_atom_set(iat)%jrho_b_s_ii(i)%r_coef, &
837 jrho_atom_set(iat)%jrho_a_h_iii(i)%r_coef, &
838 jrho_atom_set(iat)%jrho_a_s_iii(i)%r_coef, &
839 jrho_atom_set(iat)%jrho_b_h_iii(i)%r_coef, &
840 jrho_atom_set(iat)%jrho_b_s_iii(i)%r_coef)
841 END DO
842 END IF
843 DEALLOCATE (jrho_atom_set(iat)%jrho_h, &
844 jrho_atom_set(iat)%jrho_s, &
845 jrho_atom_set(iat)%jrho_a_h, &
846 jrho_atom_set(iat)%jrho_a_s, &
847 jrho_atom_set(iat)%jrho_b_h, &
848 jrho_atom_set(iat)%jrho_b_s, &
849 jrho_atom_set(iat)%jrho_a_h_ii, &
850 jrho_atom_set(iat)%jrho_a_s_ii, &
851 jrho_atom_set(iat)%jrho_b_h_ii, &
852 jrho_atom_set(iat)%jrho_b_s_ii, &
853 jrho_atom_set(iat)%jrho_a_h_iii, &
854 jrho_atom_set(iat)%jrho_a_s_iii, &
855 jrho_atom_set(iat)%jrho_b_h_iii, &
856 jrho_atom_set(iat)%jrho_b_s_iii)
857 END IF
858
859 IF (ASSOCIATED(jrho_atom_set(iat)%jrho_vec_rad_h)) THEN
860 IF (ASSOCIATED(jrho_atom_set(iat)%jrho_vec_rad_h(1, 1)%r_coef)) THEN
861 n = SIZE(jrho_atom_set(iat)%jrho_vec_rad_h, 2)
862 DO i = 1, n
863 DO idir = 1, 3
864 !
865 ! size =(nr,na) distributed
866 DEALLOCATE (jrho_atom_set(iat)%jrho_vec_rad_h(idir, i)%r_coef, &
867 jrho_atom_set(iat)%jrho_vec_rad_s(idir, i)%r_coef)
868 END DO
869 END DO
870 END IF
871 DEALLOCATE (jrho_atom_set(iat)%jrho_vec_rad_h, &
872 jrho_atom_set(iat)%jrho_vec_rad_s)
873 END IF
874 END DO
875 DEALLOCATE (jrho_atom_set)
876
877 END SUBROUTINE deallocate_jrho_atom_set
878
879! **************************************************************************************************
880!> \brief ...
881!> \param jrho1_atom ...
882!> \param ispin ...
883!> \param nr ...
884!> \param na ...
885!> \param max_iso_not0 ...
886! **************************************************************************************************
887 SUBROUTINE allocate_jrho_atom_rad(jrho1_atom, ispin, nr, na, max_iso_not0)
888
889 TYPE(jrho_atom_type), POINTER :: jrho1_atom
890 INTEGER, INTENT(IN) :: ispin, nr, na, max_iso_not0
891
892 CHARACTER(len=*), PARAMETER :: routinen = 'allocate_jrho_atom_rad'
893
894 INTEGER :: handle, idir
895
896 CALL timeset(routinen, handle)
897
898 cpassert(ASSOCIATED(jrho1_atom))
899
900 DO idir = 1, 3
901 ALLOCATE (jrho1_atom%jrho_vec_rad_h(idir, ispin)%r_coef(nr, na), &
902 jrho1_atom%jrho_vec_rad_s(idir, ispin)%r_coef(nr, na))
903 jrho1_atom%jrho_vec_rad_h(idir, ispin)%r_coef = 0.0_dp
904 jrho1_atom%jrho_vec_rad_s(idir, ispin)%r_coef = 0.0_dp
905 END DO
906
907 ALLOCATE (jrho1_atom%jrho_h(ispin)%r_coef(nr, max_iso_not0), &
908 jrho1_atom%jrho_s(ispin)%r_coef(nr, max_iso_not0), &
909 jrho1_atom%jrho_a_h(ispin)%r_coef(nr, max_iso_not0), &
910 jrho1_atom%jrho_a_s(ispin)%r_coef(nr, max_iso_not0), &
911 jrho1_atom%jrho_b_h(ispin)%r_coef(nr, max_iso_not0), &
912 jrho1_atom%jrho_b_s(ispin)%r_coef(nr, max_iso_not0), &
913 jrho1_atom%jrho_a_h_ii(ispin)%r_coef(nr, max_iso_not0), &
914 jrho1_atom%jrho_a_s_ii(ispin)%r_coef(nr, max_iso_not0), &
915 jrho1_atom%jrho_b_h_ii(ispin)%r_coef(nr, max_iso_not0), &
916 jrho1_atom%jrho_b_s_ii(ispin)%r_coef(nr, max_iso_not0), &
917 jrho1_atom%jrho_a_h_iii(ispin)%r_coef(nr, max_iso_not0), &
918 jrho1_atom%jrho_a_s_iii(ispin)%r_coef(nr, max_iso_not0), &
919 jrho1_atom%jrho_b_h_iii(ispin)%r_coef(nr, max_iso_not0), &
920 jrho1_atom%jrho_b_s_iii(ispin)%r_coef(nr, max_iso_not0))
921 !
922 jrho1_atom%jrho_h(ispin)%r_coef = 0.0_dp
923 jrho1_atom%jrho_s(ispin)%r_coef = 0.0_dp
924 jrho1_atom%jrho_a_h(ispin)%r_coef = 0.0_dp
925 jrho1_atom%jrho_a_s(ispin)%r_coef = 0.0_dp
926 jrho1_atom%jrho_b_h(ispin)%r_coef = 0.0_dp
927 jrho1_atom%jrho_b_s(ispin)%r_coef = 0.0_dp
928 jrho1_atom%jrho_a_h_ii(ispin)%r_coef = 0.0_dp
929 jrho1_atom%jrho_a_s_ii(ispin)%r_coef = 0.0_dp
930 jrho1_atom%jrho_b_h_ii(ispin)%r_coef = 0.0_dp
931 jrho1_atom%jrho_b_s_ii(ispin)%r_coef = 0.0_dp
932 jrho1_atom%jrho_a_h_iii(ispin)%r_coef = 0.0_dp
933 jrho1_atom%jrho_a_s_iii(ispin)%r_coef = 0.0_dp
934 jrho1_atom%jrho_b_h_iii(ispin)%r_coef = 0.0_dp
935 jrho1_atom%jrho_b_s_iii(ispin)%r_coef = 0.0_dp
936 CALL timestop(handle)
937
938 END SUBROUTINE allocate_jrho_atom_rad
939
940! **************************************************************************************************
941!> \brief ...
942!> \param jrho1_atom ...
943!> \param ispin ...
944! **************************************************************************************************
945 SUBROUTINE set2zero_jrho_atom_rad(jrho1_atom, ispin)
946 !
947 TYPE(jrho_atom_type), POINTER :: jrho1_atom
948 INTEGER, INTENT(IN) :: ispin
949
950!
951
952 cpassert(ASSOCIATED(jrho1_atom))
953 !
954 jrho1_atom%jrho_h(ispin)%r_coef = 0.0_dp
955 jrho1_atom%jrho_s(ispin)%r_coef = 0.0_dp
956 !
957 jrho1_atom%jrho_a_h(ispin)%r_coef = 0.0_dp
958 jrho1_atom%jrho_a_s(ispin)%r_coef = 0.0_dp
959 jrho1_atom%jrho_b_h(ispin)%r_coef = 0.0_dp
960 jrho1_atom%jrho_b_s(ispin)%r_coef = 0.0_dp
961 !
962 jrho1_atom%jrho_a_h_ii(ispin)%r_coef = 0.0_dp
963 jrho1_atom%jrho_a_s_ii(ispin)%r_coef = 0.0_dp
964 jrho1_atom%jrho_b_h_ii(ispin)%r_coef = 0.0_dp
965 jrho1_atom%jrho_b_s_ii(ispin)%r_coef = 0.0_dp
966 !
967 jrho1_atom%jrho_a_h_iii(ispin)%r_coef = 0.0_dp
968 jrho1_atom%jrho_a_s_iii(ispin)%r_coef = 0.0_dp
969 jrho1_atom%jrho_b_h_iii(ispin)%r_coef = 0.0_dp
970 jrho1_atom%jrho_b_s_iii(ispin)%r_coef = 0.0_dp
971 !
972 END SUBROUTINE set2zero_jrho_atom_rad
973
974! **************************************************************************************************
975
976! **************************************************************************************************
977!> \brief ...
978!> \param jrho1_atom_set ...
979!> \param iatom ...
980!> \param nsotot ...
981! **************************************************************************************************
982 SUBROUTINE allocate_jrho_coeff(jrho1_atom_set, iatom, nsotot)
983
984 TYPE(jrho_atom_type), DIMENSION(:), POINTER :: jrho1_atom_set
985 INTEGER, INTENT(IN) :: iatom, nsotot
986
987 CHARACTER(len=*), PARAMETER :: routinen = 'allocate_jrho_coeff'
988
989 INTEGER :: handle, i
990
991 CALL timeset(routinen, handle)
992 cpassert(ASSOCIATED(jrho1_atom_set))
993 DO i = 1, SIZE(jrho1_atom_set(iatom)%cjc0_h, 1)
994 ALLOCATE (jrho1_atom_set(iatom)%cjc0_h(i)%r_coef(nsotot, nsotot), &
995 jrho1_atom_set(iatom)%cjc0_s(i)%r_coef(nsotot, nsotot), &
996 jrho1_atom_set(iatom)%cjc_h(i)%r_coef(nsotot, nsotot), &
997 jrho1_atom_set(iatom)%cjc_s(i)%r_coef(nsotot, nsotot), &
998 jrho1_atom_set(iatom)%cjc_ii_h(i)%r_coef(nsotot, nsotot), &
999 jrho1_atom_set(iatom)%cjc_ii_s(i)%r_coef(nsotot, nsotot), &
1000 jrho1_atom_set(iatom)%cjc_iii_h(i)%r_coef(nsotot, nsotot), &
1001 jrho1_atom_set(iatom)%cjc_iii_s(i)%r_coef(nsotot, nsotot))
1002 jrho1_atom_set(iatom)%cjc0_h(i)%r_coef = 0.0_dp
1003 jrho1_atom_set(iatom)%cjc0_s(i)%r_coef = 0.0_dp
1004 jrho1_atom_set(iatom)%cjc_h(i)%r_coef = 0.0_dp
1005 jrho1_atom_set(iatom)%cjc_s(i)%r_coef = 0.0_dp
1006 jrho1_atom_set(iatom)%cjc_ii_h(i)%r_coef = 0.0_dp
1007 jrho1_atom_set(iatom)%cjc_ii_s(i)%r_coef = 0.0_dp
1008 jrho1_atom_set(iatom)%cjc_iii_h(i)%r_coef = 0.0_dp
1009 jrho1_atom_set(iatom)%cjc_iii_s(i)%r_coef = 0.0_dp
1010 END DO
1011 CALL timestop(handle)
1012 END SUBROUTINE allocate_jrho_coeff
1013
1014! **************************************************************************************************
1015
1016! **************************************************************************************************
1017!> \brief ...
1018!> \param jrho1_atom_set ...
1019!> \param iatom ...
1020! **************************************************************************************************
1021 SUBROUTINE deallocate_jrho_coeff(jrho1_atom_set, iatom)
1022
1023 TYPE(jrho_atom_type), DIMENSION(:), POINTER :: jrho1_atom_set
1024 INTEGER, INTENT(IN) :: iatom
1025
1026 CHARACTER(len=*), PARAMETER :: routinen = 'deallocate_jrho_coeff'
1027
1028 INTEGER :: handle, i
1029
1030 CALL timeset(routinen, handle)
1031 cpassert(ASSOCIATED(jrho1_atom_set))
1032 DO i = 1, SIZE(jrho1_atom_set(iatom)%cjc0_h, 1)
1033 DEALLOCATE (jrho1_atom_set(iatom)%cjc0_h(i)%r_coef, &
1034 jrho1_atom_set(iatom)%cjc0_s(i)%r_coef, &
1035 jrho1_atom_set(iatom)%cjc_h(i)%r_coef, &
1036 jrho1_atom_set(iatom)%cjc_s(i)%r_coef, &
1037 jrho1_atom_set(iatom)%cjc_ii_h(i)%r_coef, &
1038 jrho1_atom_set(iatom)%cjc_ii_s(i)%r_coef, &
1039 jrho1_atom_set(iatom)%cjc_iii_h(i)%r_coef, &
1040 jrho1_atom_set(iatom)%cjc_iii_s(i)%r_coef)
1041 END DO
1042 CALL timestop(handle)
1043 END SUBROUTINE deallocate_jrho_coeff
1044
1045! **************************************************************************************************
1046
1047! **************************************************************************************************
1048!> \brief ...
1049!> \param jrho1_atom_set ...
1050!> \param iatom ...
1051!> \param cjc_h ...
1052!> \param cjc_s ...
1053!> \param cjc_ii_h ...
1054!> \param cjc_ii_s ...
1055!> \param cjc_iii_h ...
1056!> \param cjc_iii_s ...
1057!> \param jrho_vec_rad_h ...
1058!> \param jrho_vec_rad_s ...
1059! **************************************************************************************************
1060 SUBROUTINE get_jrho_atom(jrho1_atom_set, iatom, cjc_h, cjc_s, cjc_ii_h, cjc_ii_s, &
1061 cjc_iii_h, cjc_iii_s, jrho_vec_rad_h, jrho_vec_rad_s)
1062
1063 TYPE(jrho_atom_type), DIMENSION(:), POINTER :: jrho1_atom_set
1064 INTEGER, INTENT(IN) :: iatom
1065 TYPE(rho_atom_coeff), DIMENSION(:), OPTIONAL, &
1066 POINTER :: cjc_h, cjc_s, cjc_ii_h, cjc_ii_s, &
1067 cjc_iii_h, cjc_iii_s
1068 TYPE(rho_atom_coeff), DIMENSION(:, :), OPTIONAL, &
1069 POINTER :: jrho_vec_rad_h, jrho_vec_rad_s
1070
1071 cpassert(ASSOCIATED(jrho1_atom_set))
1072
1073 IF (PRESENT(cjc_h)) cjc_h => jrho1_atom_set(iatom)%cjc_h
1074 IF (PRESENT(cjc_s)) cjc_s => jrho1_atom_set(iatom)%cjc_s
1075 IF (PRESENT(cjc_ii_h)) cjc_ii_h => jrho1_atom_set(iatom)%cjc_ii_h
1076 IF (PRESENT(cjc_ii_s)) cjc_ii_s => jrho1_atom_set(iatom)%cjc_ii_s
1077 IF (PRESENT(cjc_iii_h)) cjc_iii_h => jrho1_atom_set(iatom)%cjc_iii_h
1078 IF (PRESENT(cjc_iii_s)) cjc_iii_s => jrho1_atom_set(iatom)%cjc_iii_s
1079 IF (PRESENT(jrho_vec_rad_h)) jrho_vec_rad_h => jrho1_atom_set(iatom)%jrho_vec_rad_h
1080 IF (PRESENT(jrho_vec_rad_s)) jrho_vec_rad_s => jrho1_atom_set(iatom)%jrho_vec_rad_s
1081
1082 END SUBROUTINE get_jrho_atom
1083
1084! **************************************************************************************************
1085!> \brief ...
1086!> \param jrho1_atom_set ...
1087!> \param atomic_kind_set ...
1088!> \param nspins ...
1089! **************************************************************************************************
1090 SUBROUTINE init_jrho_atom_set(jrho1_atom_set, atomic_kind_set, nspins)
1091 TYPE(jrho_atom_type), DIMENSION(:), POINTER :: jrho1_atom_set
1092 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1093 INTEGER, INTENT(IN) :: nspins
1094
1095 CHARACTER(len=*), PARAMETER :: routinen = 'init_jrho_atom_set'
1096
1097 INTEGER :: handle, iat, iatom, ikind, nat, natom, &
1098 nkind
1099 INTEGER, DIMENSION(:), POINTER :: atom_list
1100
1101 CALL timeset(routinen, handle)
1102
1103 cpassert(ASSOCIATED(atomic_kind_set))
1104
1105 IF (ASSOCIATED(jrho1_atom_set)) THEN
1106 CALL deallocate_jrho_atom_set(jrho1_atom_set)
1107 END IF
1108
1109 CALL get_atomic_kind_set(atomic_kind_set, natom=natom)
1110 ALLOCATE (jrho1_atom_set(natom))
1111
1112 nkind = SIZE(atomic_kind_set)
1113
1114 DO ikind = 1, nkind
1115
1116 CALL get_atomic_kind(atomic_kind_set(ikind), atom_list=atom_list, natom=nat)
1117
1118 DO iat = 1, nat
1119 iatom = atom_list(iat)
1120
1121 ! Allocate the radial density for each LM,for each atom
1122 ALLOCATE (jrho1_atom_set(iatom)%jrho_vec_rad_h(3, nspins), &
1123 jrho1_atom_set(iatom)%jrho_vec_rad_s(3, nspins), &
1124 jrho1_atom_set(iatom)%jrho_h(nspins), &
1125 jrho1_atom_set(iatom)%jrho_s(nspins), &
1126 jrho1_atom_set(iatom)%jrho_a_h(nspins), &
1127 jrho1_atom_set(iatom)%jrho_a_s(nspins), &
1128 jrho1_atom_set(iatom)%jrho_b_h(nspins), &
1129 jrho1_atom_set(iatom)%jrho_b_s(nspins), &
1130 jrho1_atom_set(iatom)%jrho_a_h_ii(nspins), &
1131 jrho1_atom_set(iatom)%jrho_a_s_ii(nspins), &
1132 jrho1_atom_set(iatom)%jrho_b_s_ii(nspins), &
1133 jrho1_atom_set(iatom)%jrho_b_h_ii(nspins), &
1134 jrho1_atom_set(iatom)%jrho_a_h_iii(nspins), &
1135 jrho1_atom_set(iatom)%jrho_a_s_iii(nspins), &
1136 jrho1_atom_set(iatom)%jrho_b_s_iii(nspins), &
1137 jrho1_atom_set(iatom)%jrho_b_h_iii(nspins), &
1138 jrho1_atom_set(iatom)%cjc0_h(nspins), &
1139 jrho1_atom_set(iatom)%cjc0_s(nspins), &
1140 jrho1_atom_set(iatom)%cjc_h(nspins), &
1141 jrho1_atom_set(iatom)%cjc_s(nspins), &
1142 jrho1_atom_set(iatom)%cjc_ii_h(nspins), &
1143 jrho1_atom_set(iatom)%cjc_ii_s(nspins), &
1144 jrho1_atom_set(iatom)%cjc_iii_h(nspins), &
1145 jrho1_atom_set(iatom)%cjc_iii_s(nspins))
1146
1147 END DO ! iat
1148
1149 END DO ! ikind
1150
1151 CALL timestop(handle)
1152
1153 END SUBROUTINE init_jrho_atom_set
1154
1155! **************************************************************************************************
1156!> \brief ...
1157!> \param nablavks_atom_set ...
1158!> \param atomic_kind_set ...
1159!> \param qs_kind_set ...
1160!> \param nspins ...
1161! **************************************************************************************************
1162 SUBROUTINE init_nablavks_atom_set(nablavks_atom_set, atomic_kind_set, qs_kind_set, nspins)
1163
1164 TYPE(nablavks_atom_type), DIMENSION(:), POINTER :: nablavks_atom_set
1165 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1166 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1167 INTEGER, INTENT(IN) :: nspins
1168
1169 CHARACTER(len=*), PARAMETER :: routinen = 'init_nablavks_atom_set'
1170
1171 INTEGER :: handle, iat, iatom, idir, ikind, ispin, &
1172 max_iso_not0, maxso, na, nat, natom, &
1173 nkind, nr, nset, nsotot
1174 INTEGER, DIMENSION(:), POINTER :: atom_list
1175 TYPE(grid_atom_type), POINTER :: grid_atom
1176 TYPE(gto_basis_set_type), POINTER :: orb_basis_set
1177 TYPE(harmonics_atom_type), POINTER :: harmonics
1178
1179 CALL timeset(routinen, handle)
1180
1181 cpassert(ASSOCIATED(qs_kind_set))
1182
1183 IF (ASSOCIATED(nablavks_atom_set)) THEN
1184 CALL deallocate_nablavks_atom_set(nablavks_atom_set)
1185 END IF
1186
1187 CALL get_atomic_kind_set(atomic_kind_set, natom=natom)
1188
1189 CALL allocate_nablavks_atom_set(nablavks_atom_set, natom)
1190
1191 nkind = SIZE(atomic_kind_set)
1192
1193 DO ikind = 1, nkind
1194 CALL get_atomic_kind(atomic_kind_set(ikind), atom_list=atom_list, natom=nat)
1195 CALL get_qs_kind(qs_kind_set(ikind), &
1196 basis_set=orb_basis_set, &
1197 harmonics=harmonics, &
1198 grid_atom=grid_atom)
1199
1200 na = grid_atom%ng_sphere
1201 nr = grid_atom%nr
1202
1203 CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
1204 maxso=maxso, nset=nset)
1205 nsotot = maxso*nset
1206 max_iso_not0 = harmonics%max_iso_not0
1207 DO iat = 1, nat
1208 iatom = atom_list(iat)
1209 !*** allocate the radial density for each LM,for each atom ***
1210
1211 ALLOCATE (nablavks_atom_set(iatom)%nablavks_vec_rad_h(3, nspins))
1212 ALLOCATE (nablavks_atom_set(iatom)%nablavks_vec_rad_s(3, nspins))
1213 DO ispin = 1, nspins
1214 DO idir = 1, 3
1215 NULLIFY (nablavks_atom_set(iatom)%nablavks_vec_rad_h(idir, ispin)%r_coef)
1216 NULLIFY (nablavks_atom_set(iatom)%nablavks_vec_rad_s(idir, ispin)%r_coef)
1217 ALLOCATE (nablavks_atom_set(iatom)%nablavks_vec_rad_h(idir, ispin)%r_coef(nr, na))
1218 ALLOCATE (nablavks_atom_set(iatom)%nablavks_vec_rad_s(idir, ispin)%r_coef(nr, na))
1219 END DO
1220 END DO ! ispin
1221 END DO ! iat
1222
1223 END DO ! ikind
1224
1225 CALL timestop(handle)
1226
1227 END SUBROUTINE init_nablavks_atom_set
1228
1229! **************************************************************************************************
1230!> \brief ...
1231!> \param polar_env ...
1232!> \param do_raman ...
1233!> \param do_periodic ...
1234!> \param dBerry_psi0 ...
1235!> \param polar ...
1236!> \param psi1_dBerry ...
1237!> \param run_stopped ...
1238!> \par History
1239!> 06.2018 polar_env integrated into qs_env (MK)
1240! **************************************************************************************************
1241 SUBROUTINE get_polar_env(polar_env, do_raman, do_periodic, dBerry_psi0, polar, psi1_dBerry, run_stopped)
1242
1243 TYPE(polar_env_type), INTENT(IN) :: polar_env
1244 LOGICAL, OPTIONAL :: do_raman, do_periodic
1245 TYPE(cp_fm_type), DIMENSION(:, :), OPTIONAL, &
1246 POINTER :: dberry_psi0
1247 REAL(dp), DIMENSION(:, :), OPTIONAL, POINTER :: polar
1248 TYPE(cp_fm_type), DIMENSION(:, :), OPTIONAL, &
1249 POINTER :: psi1_dberry
1250 LOGICAL, OPTIONAL :: run_stopped
1251
1252 IF (PRESENT(polar)) polar => polar_env%polar
1253 IF (PRESENT(do_raman)) do_raman = polar_env%do_raman
1254 IF (PRESENT(do_periodic)) do_periodic = polar_env%do_periodic
1255 IF (PRESENT(dberry_psi0)) dberry_psi0 => polar_env%dBerry_psi0
1256 IF (PRESENT(psi1_dberry)) psi1_dberry => polar_env%psi1_dBerry
1257 IF (PRESENT(run_stopped)) run_stopped = polar_env%run_stopped
1258
1259 END SUBROUTINE get_polar_env
1260
1261! **************************************************************************************************
1262!> \brief ...
1263!> \param polar_env ...
1264!> \param do_raman ...
1265!> \param do_periodic ...
1266!> \param dBerry_psi0 ...
1267!> \param polar ...
1268!> \param psi1_dBerry ...
1269!> \param run_stopped ...
1270! **************************************************************************************************
1271 SUBROUTINE set_polar_env(polar_env, do_raman, do_periodic, dBerry_psi0, polar, &
1272 psi1_dBerry, run_stopped)
1273
1274 TYPE(polar_env_type), INTENT(INOUT) :: polar_env
1275 LOGICAL, OPTIONAL :: do_raman, do_periodic
1276 TYPE(cp_fm_type), DIMENSION(:, :), OPTIONAL, &
1277 POINTER :: dberry_psi0
1278 REAL(dp), DIMENSION(:, :), OPTIONAL, POINTER :: polar
1279 TYPE(cp_fm_type), DIMENSION(:, :), OPTIONAL, &
1280 POINTER :: psi1_dberry
1281 LOGICAL, OPTIONAL :: run_stopped
1282
1283 IF (PRESENT(polar)) polar_env%polar => polar
1284 IF (PRESENT(do_raman)) polar_env%do_raman = do_raman
1285 IF (PRESENT(do_periodic)) polar_env%do_periodic = do_periodic
1286 IF (PRESENT(psi1_dberry)) polar_env%psi1_dBerry => psi1_dberry
1287 IF (PRESENT(dberry_psi0)) polar_env%dBerry_psi0 => dberry_psi0
1288 IF (PRESENT(run_stopped)) polar_env%run_stopped = run_stopped
1289
1290 END SUBROUTINE set_polar_env
1291
1292! **************************************************************************************************
1293!> \brief Deallocate the polar environment
1294!> \param polar_env ...
1295!> \par History
1296!> 06.2018 polar_env integrated into qs_env (MK)
1297! **************************************************************************************************
1298 SUBROUTINE polar_env_release(polar_env)
1299
1300 TYPE(polar_env_type), POINTER :: polar_env
1301
1302 IF (ASSOCIATED(polar_env)) THEN
1303 IF (ASSOCIATED(polar_env%polar)) THEN
1304 DEALLOCATE (polar_env%polar)
1305 END IF
1306 CALL cp_fm_release(polar_env%dBerry_psi0)
1307 CALL cp_fm_release(polar_env%psi1_dBerry)
1308 DEALLOCATE (polar_env)
1309 NULLIFY (polar_env)
1310 END IF
1311
1312 END SUBROUTINE polar_env_release
1313
1314END MODULE qs_linres_types
cp_fm_types::cp_fm_release
Definition cp_fm_types.F:87
atomic_kind_types
Define the atomic kind types and their sub types.
Definition atomic_kind_types.F:23
atomic_kind_types::get_atomic_kind_set
subroutine, public get_atomic_kind_set(atomic_kind_set, atom_of_kind, kind_of, natom_of_kind, maxatom, natom, nshell, fist_potential_present, shell_present, shell_adiabatic, shell_check_distance, damping_present)
Get attributes of an atomic kind set.
Definition atomic_kind_types.F:223
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
basis_set_types
Definition basis_set_types.F:15
basis_set_types::get_gto_basis_set
subroutine, public get_gto_basis_set(gto_basis_set, name, aliases, norm_type, kind_radius, ncgf, nset, nsgf, cgf_symbol, sgf_symbol, norm_cgf, set_radius, lmax, lmin, lx, ly, lz, m, ncgf_set, npgf, nsgf_set, nshell, cphi, pgf_radius, sphi, scon, zet, first_cgf, first_sgf, l, last_cgf, last_sgf, n, gcc, maxco, maxl, maxpgf, maxsgf_set, maxshell, maxso, nco_sum, npgf_sum, nshell_sum, maxder, short_kind_radius, npgf_seg_sum)
...
Definition basis_set_types.F:624
cp_array_utils
various utilities that regard array of different kinds: output, allocation,... maybe it is not a good...
Definition cp_array_utils.F:18
cp_dbcsr_api
Definition cp_dbcsr_api.F:8
cp_fm_struct
represent the structure of a full matrix
Definition cp_fm_struct.F:14
cp_fm_types
represent a full matrix distributed on many processors
Definition cp_fm_types.F:15
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
qs_grid_atom
Definition qs_grid_atom.F:8
qs_harmonics_atom
Definition qs_harmonics_atom.F:8
qs_kind_types
Define the quickstep kind type and their sub types.
Definition qs_kind_types.F:23
qs_kind_types::get_qs_kind
subroutine, public get_qs_kind(qs_kind, basis_set, basis_type, ncgf, nsgf, all_potential, tnadd_potential, gth_potential, sgp_potential, upf_potential, se_parameter, dftb_parameter, xtb_parameter, dftb3_param, zatom, zeff, elec_conf, mao, lmax_dftb, alpha_core_charge, ccore_charge, core_charge, core_charge_radius, paw_proj_set, paw_atom, hard_radius, hard0_radius, max_rad_local, covalent_radius, vdw_radius, gpw_type_forced, harmonics, max_iso_not0, max_s_harm, grid_atom, ngrid_ang, ngrid_rad, lmax_rho0, dft_plus_u_atom, l_of_dft_plus_u, n_of_dft_plus_u, u_minus_j, u_of_dft_plus_u, j_of_dft_plus_u, alpha_of_dft_plus_u, beta_of_dft_plus_u, j0_of_dft_plus_u, occupation_of_dft_plus_u, dispersion, bs_occupation, magnetization, no_optimize, addel, laddel, naddel, orbitals, max_scf, eps_scf, smear, u_ramping, u_minus_j_target, eps_u_ramping, init_u_ramping_each_scf, reltmat, ghost, floating, name, element_symbol, pao_basis_size, pao_model_file, pao_potentials, pao_descriptors, nelec)
Get attributes of an atomic kind.
Definition qs_kind_types.F:454
qs_linres_types
Type definitiona for linear response calculations.
Definition qs_linres_types.F:12
qs_linres_types::init_jrho_atom_set
subroutine, public init_jrho_atom_set(jrho1_atom_set, atomic_kind_set, nspins)
...
Definition qs_linres_types.F:1091
qs_linres_types::deallocate_nablavks_atom_set
subroutine, public deallocate_nablavks_atom_set(nablavks_atom_set)
...
Definition qs_linres_types.F:755
qs_linres_types::set_polar_env
subroutine, public set_polar_env(polar_env, do_raman, do_periodic, dberry_psi0, polar, psi1_dberry, run_stopped)
...
Definition qs_linres_types.F:1273
qs_linres_types::get_current_env
subroutine, public get_current_env(current_env, simple_done, simple_converged, full_done, nao, nstates, gauge, list_cubes, statetrueindex, gauge_name, basisfun_center, nbr_center, center_list, centers_set, psi1_p, psi1_rxp, psi1_d, p_psi0, rxp_psi0, jrho1_atom_set, jrho1_set, chi_tensor, chi_tensor_loc, gauge_atom_radius, rs_gauge, use_old_gauge_atom, chi_pbc, psi0_order)
...
Definition qs_linres_types.F:429
qs_linres_types::get_issc_env
subroutine, public get_issc_env(issc_env, issc_on_atom_list, issc_gapw_radius, issc_loc, do_fc, do_sd, do_pso, do_dso, issc, interpolate_issc, psi1_efg, psi1_pso, psi1_dso, psi1_fc, efg_psi0, pso_psi0, dso_psi0, fc_psi0, matrix_efg, matrix_pso, matrix_dso, matrix_fc)
...
Definition qs_linres_types.F:561
qs_linres_types::set_current_env
subroutine, public set_current_env(current_env, jrho1_atom_set, jrho1_set)
...
Definition qs_linres_types.F:612
qs_linres_types::deallocate_jrho_atom_set
subroutine, public deallocate_jrho_atom_set(jrho_atom_set)
...
Definition qs_linres_types.F:786
qs_linres_types::allocate_jrho_coeff
subroutine, public allocate_jrho_coeff(jrho1_atom_set, iatom, nsotot)
...
Definition qs_linres_types.F:983
qs_linres_types::get_nmr_env
subroutine, public get_nmr_env(nmr_env, n_nics, cs_atom_list, do_calc_cs_atom, r_nics, chemical_shift, chemical_shift_loc, chemical_shift_nics_loc, chemical_shift_nics, shift_gapw_radius, do_nics, interpolate_shift)
...
Definition qs_linres_types.F:507
qs_linres_types::set_epr_env
subroutine, public set_epr_env(epr_env, g_free_factor, g_soo_chicorr_factor, g_soo_factor, g_so_factor, g_so_factor_gapw, g_zke_factor, nablavks_set, nablavks_atom_set)
...
Definition qs_linres_types.F:690
qs_linres_types::init_nablavks_atom_set
subroutine, public init_nablavks_atom_set(nablavks_atom_set, atomic_kind_set, qs_kind_set, nspins)
...
Definition qs_linres_types.F:1163
qs_linres_types::set2zero_jrho_atom_rad
subroutine, public set2zero_jrho_atom_rad(jrho1_atom, ispin)
...
Definition qs_linres_types.F:946
qs_linres_types::polar_env_release
subroutine, public polar_env_release(polar_env)
Deallocate the polar environment.
Definition qs_linres_types.F:1299
qs_linres_types::linres_control_release
subroutine, public linres_control_release(linres_control)
...
Definition qs_linres_types.F:382
qs_linres_types::get_polar_env
subroutine, public get_polar_env(polar_env, do_raman, do_periodic, dberry_psi0, polar, psi1_dberry, run_stopped)
...
Definition qs_linres_types.F:1242
qs_linres_types::get_epr_env
subroutine, public get_epr_env(epr_env, g_total, g_so, g_soo, nablavks_set, nablavks_atom_set, bind_set, bind_atom_set)
...
Definition qs_linres_types.F:653
qs_linres_types::allocate_jrho_atom_rad
subroutine, public allocate_jrho_atom_rad(jrho1_atom, ispin, nr, na, max_iso_not0)
...
Definition qs_linres_types.F:888
qs_loc_types
New version of the module for the localization of the molecular orbitals This should be able to use d...
Definition qs_loc_types.F:25
qs_loc_types::qs_loc_env_release
subroutine, public qs_loc_env_release(qs_loc_env)
...
Definition qs_loc_types.F:192
qs_rho_atom_types
Definition qs_rho_atom_types.F:8
qs_rho_types
superstucture that hold various representations of the density and keeps track of which ones are vali...
Definition qs_rho_types.F:18
qs_rho_types::qs_rho_release
subroutine, public qs_rho_release(rho_struct)
releases a rho_struct by decreasing the reference count by one and deallocating if it reaches 0 (to b...
Definition qs_rho_types.F:115
realspace_grid_types
Definition realspace_grid_types.F:18
atomic_kind_types::atomic_kind_type
Provides all information about an atomic kind.
Definition atomic_kind_types.F:45
basis_set_types::gto_basis_set_type
Definition basis_set_types.F:72
cp_array_utils::cp_2d_i_p_type
represent a pointer to a 2d array
Definition cp_array_utils.F:231
cp_array_utils::cp_2d_r_p_type
represent a pointer to a 2d array
Definition cp_array_utils.F:109
cp_dbcsr_api::dbcsr_p_type
Definition cp_dbcsr_api.F:170
cp_fm_struct::cp_fm_struct_p_type
Definition cp_fm_struct.F:100
cp_fm_struct::cp_fm_struct_type
keeps the information about the structure of a full matrix
Definition cp_fm_struct.F:82
cp_fm_types::cp_fm_type
represent a full matrix
Definition cp_fm_types.F:113
qs_grid_atom::grid_atom_type
Definition qs_grid_atom.F:44
qs_harmonics_atom::harmonics_atom_type
Definition qs_harmonics_atom.F:32
qs_kind_types::qs_kind_type
Provides all information about a quickstep kind.
Definition qs_kind_types.F:171
qs_linres_types::current_env_type
Definition qs_linres_types.F:94
qs_linres_types::dcdr_env_type
Definition qs_linres_types.F:247
qs_linres_types::epr_env_type
Definition qs_linres_types.F:194
qs_linres_types::issc_env_type
Definition qs_linres_types.F:146
qs_linres_types::jrho_atom_type
Definition qs_linres_types.F:219
qs_linres_types::linres_control_type
General settings for linear response calculations.
Definition qs_linres_types.F:53
qs_linres_types::nablavks_atom_type
Definition qs_linres_types.F:213
qs_linres_types::nmr_env_type
Definition qs_linres_types.F:174
qs_linres_types::polar_env_type
Definition qs_linres_types.F:136
qs_linres_types::vcd_env_type
Definition qs_linres_types.F:305
qs_loc_types::qs_loc_env_type
contains all the info needed by quickstep to calculate the spread of a selected set of orbitals and i...
Definition qs_loc_types.F:80
qs_rho_atom_types::rho_atom_coeff
Definition qs_rho_atom_types.F:19
qs_rho_atom_types::rho_atom_type
Definition qs_rho_atom_types.F:23
qs_rho_types::qs_rho_p_type
Definition qs_rho_types.F:89
realspace_grid_types::realspace_grid_type
Definition realspace_grid_types.F:136