(git:0de0cc2)
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-2024 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 ! **************************************************************************************************
13  USE atomic_kind_types, ONLY: atomic_kind_type,&
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_fm_struct, ONLY: cp_fm_struct_p_type,&
21  cp_fm_struct_type
22  USE cp_fm_types, ONLY: cp_fm_release,&
23  cp_fm_type
24  USE dbcsr_api, ONLY: dbcsr_p_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,&
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  CHARACTER(LEN=30) :: orb_center_name = ""
281  TYPE(cp_2d_i_p_type), DIMENSION(:), POINTER :: center_list => null()
282  TYPE(cp_2d_r_p_type), DIMENSION(:), POINTER :: centers_set => null()
283  INTEGER, DIMENSION(2) :: nbr_center = -1
284  INTEGER, DIMENSION(2) :: nstates = -1
285  REAL(dp), DIMENSION(3) :: ref_point = 0.0_dp
286  REAL(dp), DIMENSION(3) :: dipole_pos = 0.0_dp
287  LOGICAL :: localized_psi0 = .false.
288  INTEGER, POINTER :: list_of_atoms(:) => null()
289  LOGICAL :: distributed_origin = .false.
290  TYPE(cp_fm_struct_type), POINTER :: aoao_fm_struct => null()
291  TYPE(cp_fm_struct_type), POINTER :: homohomo_fm_struct => null()
292  TYPE(cp_fm_struct_p_type), DIMENSION(:), POINTER :: momo_fm_struct => null()
293  TYPE(cp_fm_struct_p_type), DIMENSION(:), POINTER :: likemos_fm_struct => null()
294  REAL(dp), DIMENSION(:, :, :), POINTER :: apt_el_dcdr => null()
295  REAL(dp), DIMENSION(:, :, :), POINTER :: apt_nuc_dcdr => null()
296  REAL(dp), DIMENSION(:, :, :), POINTER :: apt_total_dcdr => null()
297  REAL(dp), DIMENSION(:, :, :, :), POINTER :: apt_el_dcdr_per_center => null()
298  REAL(dp), DIMENSION(:, :, :, :), POINTER :: apt_el_dcdr_per_subset => null()
299  END TYPE dcdr_env_type
300 
301 ! \param type for VCD calculation
302  TYPE vcd_env_type
303  TYPE(dcdr_env_type) :: dcdr_env = dcdr_env_type()
304 
305  INTEGER :: output_unit = -1
306  REAL(dp), DIMENSION(3) :: spatial_origin = 0.0_dp
307  REAL(dp), DIMENSION(3) :: spatial_origin_atom = 0.0_dp
308  REAL(dp), DIMENSION(3) :: magnetic_origin = 0.0_dp
309  REAL(dp), DIMENSION(3) :: magnetic_origin_atom = 0.0_dp
310  LOGICAL :: distributed_origin = .false.
311  LOGICAL :: origin_dependent_op_mfp = .false.
312  LOGICAL :: do_mfp = .false.
313 
314  ! APTs and AATs in velocity form
315  REAL(dp), DIMENSION(:, :, :), POINTER :: apt_el_nvpt => null()
316  REAL(dp), DIMENSION(:, :, :), POINTER :: apt_nuc_nvpt => null()
317  REAL(dp), DIMENSION(:, :, :), POINTER :: apt_total_nvpt => null()
318  REAL(dp), DIMENSION(:, :, :), POINTER :: aat_atom_nvpt => null()
319  REAL(dp), DIMENSION(:, :, :), POINTER :: aat_atom_mfp => null()
320 
321  ! Matrices
322  TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_dSdV => null(), &
323  matrix_drpnl => null(), &
324  matrix_hxc_dsdv => null(), &
325  hcom => null(), &
326  dipvel_ao => null(), &
327  dipvel_ao_delta => null(), &
328  matrix_rxrv => null(), &
329  matrix_dsdb => null()
330 
331  TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_hr => null(), &
332  matrix_rh => null(), &
333  matrix_difdip2 => null(), &
334  moments_der => null(), &
335  moments_der_right => null(), &
336  moments_der_left => null(), &
337  matrix_r_doublecom => null(), &
338  matrix_rcomr => null(), &
339  matrix_rrcom => null(), &
340  matrix_dcom => null(), &
341  matrix_r_rxvr => null(), &
342  matrix_rxvr_r => null(), &
343  matrix_nosym_temp_33 => null(), &
344  matrix_nosym_temp2_33 => null()
345 
346  TYPE(cp_fm_type), DIMENSION(:), POINTER :: dCV => null(), &
347  dcv_prime => null(), &
348  op_dv => null(), &
349  dcb => null(), &
350  dcb_prime => null(), &
351  op_db => null()
352  END TYPE vcd_env_type
353 
354  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_linres_types'
355 
356 ! *** Public data types ***
357 
358  PUBLIC :: linres_control_type, &
359  nmr_env_type, issc_env_type, jrho_atom_type, &
360  epr_env_type, dcdr_env_type, vcd_env_type, &
361  nablavks_atom_type, current_env_type, &
362  polar_env_type
363 
364 ! *** Public subroutines ***
365 
371 
372 CONTAINS
373 
374 ! **************************************************************************************************
375 !> \brief ...
376 !> \param linres_control ...
377 ! **************************************************************************************************
378  SUBROUTINE linres_control_release(linres_control)
379 
380  TYPE(linres_control_type), INTENT(INOUT) :: linres_control
381 
382  IF (ASSOCIATED(linres_control%qs_loc_env)) THEN
383  CALL qs_loc_env_release(linres_control%qs_loc_env)
384  DEALLOCATE (linres_control%qs_loc_env)
385  END IF
386 
387  END SUBROUTINE linres_control_release
388 
389 ! **************************************************************************************************
390 !> \brief ...
391 !> \param current_env ...
392 !> \param simple_done ...
393 !> \param simple_converged ...
394 !> \param full_done ...
395 !> \param nao ...
396 !> \param nstates ...
397 !> \param gauge ...
398 !> \param list_cubes ...
399 !> \param statetrueindex ...
400 !> \param gauge_name ...
401 !> \param basisfun_center ...
402 !> \param nbr_center ...
403 !> \param center_list ...
404 !> \param centers_set ...
405 !> \param psi1_p ...
406 !> \param psi1_rxp ...
407 !> \param psi1_D ...
408 !> \param p_psi0 ...
409 !> \param rxp_psi0 ...
410 !> \param jrho1_atom_set ...
411 !> \param jrho1_set ...
412 !> \param chi_tensor ...
413 !> \param chi_tensor_loc ...
414 !> \param gauge_atom_radius ...
415 !> \param rs_gauge ...
416 !> \param use_old_gauge_atom ...
417 !> \param chi_pbc ...
418 !> \param psi0_order ...
419 ! **************************************************************************************************
420  SUBROUTINE get_current_env(current_env, simple_done, simple_converged, full_done, nao, &
421  nstates, gauge, list_cubes, statetrueindex, gauge_name, basisfun_center, &
422  nbr_center, center_list, centers_set, psi1_p, psi1_rxp, psi1_D, p_psi0, &
423  rxp_psi0, jrho1_atom_set, jrho1_set, chi_tensor, &
424  chi_tensor_loc, gauge_atom_radius, rs_gauge, use_old_gauge_atom, &
425  chi_pbc, psi0_order)
426 
427  TYPE(current_env_type), OPTIONAL :: current_env
428  LOGICAL, OPTIONAL :: simple_done(6), simple_converged(6)
429  LOGICAL, DIMENSION(:, :), OPTIONAL, POINTER :: full_done
430  INTEGER, OPTIONAL :: nao, nstates(2), gauge
431  INTEGER, DIMENSION(:), OPTIONAL, POINTER :: list_cubes
432  INTEGER, DIMENSION(:, :, :), OPTIONAL, POINTER :: statetrueindex
433  CHARACTER(LEN=30), OPTIONAL :: gauge_name
434  REAL(dp), DIMENSION(:, :), OPTIONAL, POINTER :: basisfun_center
435  INTEGER, OPTIONAL :: nbr_center(2)
436  TYPE(cp_2d_i_p_type), DIMENSION(:), OPTIONAL, &
437  POINTER :: center_list
438  TYPE(cp_2d_r_p_type), DIMENSION(:), OPTIONAL, &
439  POINTER :: centers_set
440  TYPE(cp_fm_type), DIMENSION(:, :), OPTIONAL, &
441  POINTER :: psi1_p, psi1_rxp, psi1_d, p_psi0, &
442  rxp_psi0
443  TYPE(jrho_atom_type), DIMENSION(:), OPTIONAL, &
444  POINTER :: jrho1_atom_set
445  TYPE(qs_rho_p_type), DIMENSION(:), OPTIONAL, &
446  POINTER :: jrho1_set
447  REAL(dp), INTENT(OUT), OPTIONAL :: chi_tensor(3, 3, 2), &
448  chi_tensor_loc(3, 3, 2), &
449  gauge_atom_radius
450  TYPE(realspace_grid_type), DIMENSION(:, :), &
451  OPTIONAL, POINTER :: rs_gauge
452  LOGICAL, OPTIONAL :: use_old_gauge_atom, chi_pbc
453  TYPE(cp_fm_type), DIMENSION(:), OPTIONAL, POINTER :: psi0_order
454 
455  IF (PRESENT(simple_done)) simple_done(1:6) = current_env%simple_done(1:6)
456  IF (PRESENT(simple_converged)) simple_converged(1:6) = current_env%simple_converged(1:6)
457  IF (PRESENT(full_done)) full_done => current_env%full_done
458  IF (PRESENT(nao)) nao = current_env%nao
459  IF (PRESENT(nstates)) nstates(1:2) = current_env%nstates(1:2)
460  IF (PRESENT(gauge)) gauge = current_env%gauge
461  IF (PRESENT(list_cubes)) list_cubes => current_env%list_cubes
462  IF (PRESENT(statetrueindex)) statetrueindex => current_env%statetrueindex
463  IF (PRESENT(gauge_name)) gauge_name = current_env%gauge_name
464  IF (PRESENT(basisfun_center)) basisfun_center => current_env%basisfun_center
465  IF (PRESENT(nbr_center)) nbr_center(1:2) = current_env%nbr_center(1:2)
466  IF (PRESENT(center_list)) center_list => current_env%center_list
467  IF (PRESENT(centers_set)) centers_set => current_env%centers_set
468  IF (PRESENT(chi_tensor)) chi_tensor(:, :, :) = current_env%chi_tensor(:, :, :)
469  IF (PRESENT(chi_tensor_loc)) chi_tensor_loc(:, :, :) = current_env%chi_tensor_loc(:, :, :)
470  IF (PRESENT(psi1_p)) psi1_p => current_env%psi1_p
471  IF (PRESENT(psi1_rxp)) psi1_rxp => current_env%psi1_rxp
472  IF (PRESENT(psi1_d)) psi1_d => current_env%psi1_D
473  IF (PRESENT(p_psi0)) p_psi0 => current_env%p_psi0
474  IF (PRESENT(rxp_psi0)) rxp_psi0 => current_env%rxp_psi0
475  IF (PRESENT(jrho1_atom_set)) jrho1_atom_set => current_env%jrho1_atom_set
476  IF (PRESENT(jrho1_set)) jrho1_set => current_env%jrho1_set
477  IF (PRESENT(rs_gauge)) rs_gauge => current_env%rs_gauge
478  IF (PRESENT(psi0_order)) psi0_order => current_env%psi0_order
479  IF (PRESENT(chi_pbc)) chi_pbc = current_env%chi_pbc
480  IF (PRESENT(gauge_atom_radius)) gauge_atom_radius = current_env%gauge_atom_radius
481  IF (PRESENT(use_old_gauge_atom)) use_old_gauge_atom = current_env%use_old_gauge_atom
482 
483  END SUBROUTINE get_current_env
484 
485 ! **************************************************************************************************
486 !> \brief ...
487 !> \param nmr_env ...
488 !> \param n_nics ...
489 !> \param cs_atom_list ...
490 !> \param do_calc_cs_atom ...
491 !> \param r_nics ...
492 !> \param chemical_shift ...
493 !> \param chemical_shift_loc ...
494 !> \param chemical_shift_nics_loc ...
495 !> \param chemical_shift_nics ...
496 !> \param shift_gapw_radius ...
497 !> \param do_nics ...
498 !> \param interpolate_shift ...
499 ! **************************************************************************************************
500  SUBROUTINE get_nmr_env(nmr_env, n_nics, cs_atom_list, do_calc_cs_atom, &
501  r_nics, chemical_shift, chemical_shift_loc, &
502  chemical_shift_nics_loc, chemical_shift_nics, &
503  shift_gapw_radius, do_nics, interpolate_shift)
504 
505  TYPE(nmr_env_type) :: nmr_env
506  INTEGER, INTENT(OUT), OPTIONAL :: n_nics
507  INTEGER, DIMENSION(:), OPTIONAL, POINTER :: cs_atom_list, do_calc_cs_atom
508  REAL(dp), DIMENSION(:, :), OPTIONAL, POINTER :: r_nics
509  REAL(dp), DIMENSION(:, :, :), OPTIONAL, POINTER :: chemical_shift, chemical_shift_loc, &
510  chemical_shift_nics_loc, &
511  chemical_shift_nics
512  REAL(dp), INTENT(OUT), OPTIONAL :: shift_gapw_radius
513  LOGICAL, INTENT(OUT), OPTIONAL :: do_nics, interpolate_shift
514 
515  IF (PRESENT(n_nics)) n_nics = nmr_env%n_nics
516  IF (PRESENT(cs_atom_list)) cs_atom_list => nmr_env%cs_atom_list
517  IF (PRESENT(do_calc_cs_atom)) do_calc_cs_atom => nmr_env%do_calc_cs_atom
518  IF (PRESENT(chemical_shift)) chemical_shift => nmr_env%chemical_shift
519  IF (PRESENT(chemical_shift_loc)) chemical_shift_loc => nmr_env%chemical_shift_loc
520  IF (PRESENT(chemical_shift_nics)) chemical_shift_nics => nmr_env%chemical_shift_nics
521  IF (PRESENT(r_nics)) r_nics => nmr_env%r_nics
522  IF (PRESENT(chemical_shift_nics_loc)) chemical_shift_nics_loc => nmr_env%chemical_shift_nics_loc
523  IF (PRESENT(shift_gapw_radius)) shift_gapw_radius = nmr_env%shift_gapw_radius
524  IF (PRESENT(do_nics)) do_nics = nmr_env%do_nics
525  IF (PRESENT(interpolate_shift)) interpolate_shift = nmr_env%interpolate_shift
526 
527  END SUBROUTINE get_nmr_env
528 
529 ! **************************************************************************************************
530 !> \brief ...
531 !> \param issc_env ...
532 !> \param issc_on_atom_list ...
533 !> \param issc_gapw_radius ...
534 !> \param issc_loc ...
535 !> \param do_fc ...
536 !> \param do_sd ...
537 !> \param do_pso ...
538 !> \param do_dso ...
539 !> \param issc ...
540 !> \param interpolate_issc ...
541 !> \param psi1_efg ...
542 !> \param psi1_pso ...
543 !> \param psi1_dso ...
544 !> \param psi1_fc ...
545 !> \param efg_psi0 ...
546 !> \param pso_psi0 ...
547 !> \param dso_psi0 ...
548 !> \param fc_psi0 ...
549 !> \param matrix_efg ...
550 !> \param matrix_pso ...
551 !> \param matrix_dso ...
552 !> \param matrix_fc ...
553 ! **************************************************************************************************
554  SUBROUTINE get_issc_env(issc_env, issc_on_atom_list, issc_gapw_radius, issc_loc, &
555  do_fc, do_sd, do_pso, do_dso, &
556  issc, interpolate_issc, psi1_efg, psi1_pso, psi1_dso, psi1_fc, efg_psi0, pso_psi0, dso_psi0, fc_psi0, &
557  matrix_efg, matrix_pso, matrix_dso, matrix_fc)
558 
559  TYPE(issc_env_type) :: issc_env
560  INTEGER, DIMENSION(:), OPTIONAL, POINTER :: issc_on_atom_list
561  REAL(dp), OPTIONAL :: issc_gapw_radius
562  REAL(dp), DIMENSION(:, :, :, :, :), OPTIONAL, &
563  POINTER :: issc_loc
564  LOGICAL, OPTIONAL :: do_fc, do_sd, do_pso, do_dso
565  REAL(dp), DIMENSION(:, :, :, :, :), OPTIONAL, &
566  POINTER :: issc
567  LOGICAL, OPTIONAL :: interpolate_issc
568  TYPE(cp_fm_type), DIMENSION(:, :), OPTIONAL, &
569  POINTER :: psi1_efg, psi1_pso, psi1_dso
570  TYPE(cp_fm_type), DIMENSION(:), OPTIONAL, POINTER :: psi1_fc
571  TYPE(cp_fm_type), DIMENSION(:, :), OPTIONAL, &
572  POINTER :: efg_psi0, pso_psi0, dso_psi0
573  TYPE(cp_fm_type), DIMENSION(:), OPTIONAL, POINTER :: fc_psi0
574  TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, &
575  POINTER :: matrix_efg, matrix_pso, matrix_dso, &
576  matrix_fc
577 
578  IF (PRESENT(issc_on_atom_list)) issc_on_atom_list => issc_env%issc_on_atom_list
579  IF (PRESENT(issc_gapw_radius)) issc_gapw_radius = issc_env%issc_gapw_radius
580  IF (PRESENT(issc_loc)) issc_loc => issc_env%issc_loc
581  IF (PRESENT(issc)) issc => issc_env%issc
582  IF (PRESENT(interpolate_issc)) interpolate_issc = issc_env%interpolate_issc
583  IF (PRESENT(psi1_efg)) psi1_efg => issc_env%psi1_efg
584  IF (PRESENT(psi1_pso)) psi1_pso => issc_env%psi1_pso
585  IF (PRESENT(psi1_dso)) psi1_dso => issc_env%psi1_dso
586  IF (PRESENT(psi1_fc)) psi1_fc => issc_env%psi1_fc
587  IF (PRESENT(efg_psi0)) efg_psi0 => issc_env%efg_psi0
588  IF (PRESENT(pso_psi0)) pso_psi0 => issc_env%pso_psi0
589  IF (PRESENT(dso_psi0)) dso_psi0 => issc_env%dso_psi0
590  IF (PRESENT(fc_psi0)) fc_psi0 => issc_env%fc_psi0
591  IF (PRESENT(matrix_efg)) matrix_efg => issc_env%matrix_efg
592  IF (PRESENT(matrix_pso)) matrix_pso => issc_env%matrix_pso
593  IF (PRESENT(matrix_fc)) matrix_fc => issc_env%matrix_fc
594  IF (PRESENT(matrix_dso)) matrix_dso => issc_env%matrix_dso
595  IF (PRESENT(do_fc)) do_fc = issc_env%do_fc
596  IF (PRESENT(do_sd)) do_sd = issc_env%do_sd
597  IF (PRESENT(do_pso)) do_pso = issc_env%do_pso
598  IF (PRESENT(do_dso)) do_dso = issc_env%do_dso
599 
600  END SUBROUTINE get_issc_env
601 
602 ! **************************************************************************************************
603 !> \brief ...
604 !> \param current_env ...
605 !> \param jrho1_atom_set ...
606 !> \param jrho1_set ...
607 ! **************************************************************************************************
608  SUBROUTINE set_current_env(current_env, jrho1_atom_set, jrho1_set)
609 
610  TYPE(current_env_type) :: current_env
611  TYPE(jrho_atom_type), DIMENSION(:), OPTIONAL, &
612  POINTER :: jrho1_atom_set
613  TYPE(qs_rho_p_type), DIMENSION(:), OPTIONAL, &
614  POINTER :: jrho1_set
615 
616  INTEGER :: idir
617 
618  IF (PRESENT(jrho1_atom_set)) THEN
619  IF (ASSOCIATED(current_env%jrho1_atom_set)) THEN
620  CALL deallocate_jrho_atom_set(current_env%jrho1_atom_set)
621  END IF
622  current_env%jrho1_atom_set => jrho1_atom_set
623  END IF
624 
625  IF (PRESENT(jrho1_set)) THEN
626  IF (ASSOCIATED(current_env%jrho1_set)) THEN
627  DO idir = 1, 3
628  CALL qs_rho_release(current_env%jrho1_set(idir)%rho)
629  DEALLOCATE (current_env%jrho1_set(idir)%rho)
630  END DO
631  END IF
632  current_env%jrho1_set => jrho1_set
633  END IF
634 
635  END SUBROUTINE set_current_env
636 
637 ! **************************************************************************************************
638 !> \brief ...
639 !> \param epr_env ...
640 !> \param g_total ...
641 !> \param g_so ...
642 !> \param g_soo ...
643 !> \param nablavks_set ...
644 !> \param nablavks_atom_set ...
645 !> \param bind_set ...
646 !> \param bind_atom_set ...
647 ! **************************************************************************************************
648  SUBROUTINE get_epr_env(epr_env, g_total, g_so, g_soo, nablavks_set, nablavks_atom_set, &
649  bind_set, bind_atom_set)
650 
651  TYPE(epr_env_type) :: epr_env
652  REAL(dp), DIMENSION(:, :), OPTIONAL, POINTER :: g_total, g_so, g_soo
653  TYPE(qs_rho_p_type), DIMENSION(:, :), OPTIONAL, &
654  POINTER :: nablavks_set
655  TYPE(nablavks_atom_type), DIMENSION(:), OPTIONAL, &
656  POINTER :: nablavks_atom_set
657  TYPE(qs_rho_p_type), DIMENSION(:, :), OPTIONAL, &
658  POINTER :: bind_set
659  TYPE(rho_atom_coeff), DIMENSION(:, :), OPTIONAL, &
660  POINTER :: bind_atom_set
661 
662  IF (PRESENT(g_total)) g_total => epr_env%g_total
663  IF (PRESENT(g_so)) g_so => epr_env%g_so
664  IF (PRESENT(g_soo)) g_soo => epr_env%g_soo
665  IF (PRESENT(nablavks_set)) nablavks_set => epr_env%nablavks_set
666  IF (PRESENT(nablavks_atom_set)) nablavks_atom_set => epr_env%nablavks_atom_set
667  IF (PRESENT(bind_set)) bind_set => epr_env%bind_set
668  IF (PRESENT(bind_atom_set)) bind_atom_set => epr_env%bind_atom_set
669 
670  END SUBROUTINE get_epr_env
671 
672 ! **************************************************************************************************
673 !> \brief ...
674 !> \param epr_env ...
675 !> \param g_free_factor ...
676 !> \param g_soo_chicorr_factor ...
677 !> \param g_soo_factor ...
678 !> \param g_so_factor ...
679 !> \param g_so_factor_gapw ...
680 !> \param g_zke_factor ...
681 !> \param nablavks_set ...
682 !> \param nablavks_atom_set ...
683 ! **************************************************************************************************
684  SUBROUTINE set_epr_env(epr_env, g_free_factor, g_soo_chicorr_factor, &
685  g_soo_factor, g_so_factor, g_so_factor_gapw, &
686  g_zke_factor, nablavks_set, nablavks_atom_set)
687 
688  TYPE(epr_env_type) :: epr_env
689  REAL(dp), INTENT(IN), OPTIONAL :: g_free_factor, g_soo_chicorr_factor, &
690  g_soo_factor, g_so_factor, &
691  g_so_factor_gapw, g_zke_factor
692  TYPE(qs_rho_p_type), DIMENSION(:, :), OPTIONAL, &
693  POINTER :: nablavks_set
694  TYPE(nablavks_atom_type), DIMENSION(:), OPTIONAL, &
695  POINTER :: nablavks_atom_set
696 
697  INTEGER :: idir, ispin
698 
699  IF (PRESENT(g_free_factor)) epr_env%g_free_factor = g_free_factor
700  IF (PRESENT(g_zke_factor)) epr_env%g_zke_factor = g_zke_factor
701  IF (PRESENT(g_so_factor)) epr_env%g_so_factor = g_so_factor
702  IF (PRESENT(g_so_factor_gapw)) epr_env%g_so_factor_gapw = g_so_factor_gapw
703  IF (PRESENT(g_soo_factor)) epr_env%g_soo_factor = g_soo_factor
704  IF (PRESENT(g_soo_chicorr_factor)) epr_env%g_soo_chicorr_factor = g_soo_chicorr_factor
705 
706  IF (PRESENT(nablavks_set)) THEN
707  IF (ASSOCIATED(epr_env%nablavks_set)) THEN
708  DO ispin = 1, 2
709  DO idir = 1, 3
710  CALL qs_rho_release(epr_env%nablavks_set(idir, ispin)%rho)
711  DEALLOCATE (epr_env%nablavks_set(idir, ispin)%rho)
712  END DO
713  END DO
714  END IF
715  epr_env%nablavks_set => nablavks_set
716  END IF
717 
718  IF (PRESENT(nablavks_atom_set)) THEN
719  IF (ASSOCIATED(epr_env%nablavks_atom_set)) THEN
720  CALL deallocate_nablavks_atom_set(epr_env%nablavks_atom_set)
721  END IF
722  epr_env%nablavks_atom_set => nablavks_atom_set
723  END IF
724 
725  END SUBROUTINE set_epr_env
726 
727 ! **************************************************************************************************
728 !> \brief ...
729 !> \param nablavks_atom_set ...
730 !> \param natom ...
731 ! **************************************************************************************************
732  SUBROUTINE allocate_nablavks_atom_set(nablavks_atom_set, natom)
733 
734  TYPE(nablavks_atom_type), DIMENSION(:), POINTER :: nablavks_atom_set
735  INTEGER, INTENT(IN) :: natom
736 
737  INTEGER :: iat
738 
739  ALLOCATE (nablavks_atom_set(natom))
740 
741  DO iat = 1, natom
742  NULLIFY (nablavks_atom_set(iat)%nablavks_vec_rad_h)
743  NULLIFY (nablavks_atom_set(iat)%nablavks_vec_rad_s)
744  END DO
745  END SUBROUTINE allocate_nablavks_atom_set
746 
747 ! **************************************************************************************************
748 !> \brief ...
749 !> \param nablavks_atom_set ...
750 ! **************************************************************************************************
751  SUBROUTINE deallocate_nablavks_atom_set(nablavks_atom_set)
752 
753  TYPE(nablavks_atom_type), DIMENSION(:), POINTER :: nablavks_atom_set
754 
755  INTEGER :: i, iat, idir, n, natom
756 
757  cpassert(ASSOCIATED(nablavks_atom_set))
758  natom = SIZE(nablavks_atom_set)
759 
760  DO iat = 1, natom
761  IF (ASSOCIATED(nablavks_atom_set(iat)%nablavks_vec_rad_h)) THEN
762  IF (ASSOCIATED(nablavks_atom_set(iat)%nablavks_vec_rad_h(1, 1)%r_coef)) THEN
763  n = SIZE(nablavks_atom_set(iat)%nablavks_vec_rad_h, 2)
764  DO i = 1, n
765  DO idir = 1, 3
766  DEALLOCATE (nablavks_atom_set(iat)%nablavks_vec_rad_h(idir, i)%r_coef)
767  DEALLOCATE (nablavks_atom_set(iat)%nablavks_vec_rad_s(idir, i)%r_coef)
768  END DO
769  END DO
770  END IF
771  DEALLOCATE (nablavks_atom_set(iat)%nablavks_vec_rad_h)
772  DEALLOCATE (nablavks_atom_set(iat)%nablavks_vec_rad_s)
773  END IF
774  END DO
775  DEALLOCATE (nablavks_atom_set)
776  END SUBROUTINE deallocate_nablavks_atom_set
777 
778 ! **************************************************************************************************
779 !> \brief ...
780 !> \param jrho_atom_set ...
781 ! **************************************************************************************************
782  SUBROUTINE deallocate_jrho_atom_set(jrho_atom_set)
783 
784  TYPE(jrho_atom_type), DIMENSION(:), POINTER :: jrho_atom_set
785 
786  INTEGER :: i, iat, idir, n, natom
787 
788  cpassert(ASSOCIATED(jrho_atom_set))
789  natom = SIZE(jrho_atom_set)
790 
791  DO iat = 1, natom
792  IF (ASSOCIATED(jrho_atom_set(iat)%cjc_h)) THEN
793  IF (ASSOCIATED(jrho_atom_set(iat)%cjc_h(1)%r_coef)) THEN
794  n = SIZE(jrho_atom_set(iat)%cjc_h)
795  DO i = 1, n
796  !
797  ! size = (nsotot,nsotot) replicated
798  DEALLOCATE (jrho_atom_set(iat)%cjc0_h(i)%r_coef, &
799  jrho_atom_set(iat)%cjc0_s(i)%r_coef, &
800  jrho_atom_set(iat)%cjc_h(i)%r_coef, &
801  jrho_atom_set(iat)%cjc_s(i)%r_coef, &
802  jrho_atom_set(iat)%cjc_ii_h(i)%r_coef, &
803  jrho_atom_set(iat)%cjc_ii_s(i)%r_coef, &
804  jrho_atom_set(iat)%cjc_iii_h(i)%r_coef, &
805  jrho_atom_set(iat)%cjc_iii_s(i)%r_coef)
806  END DO
807  END IF
808  DEALLOCATE (jrho_atom_set(iat)%cjc0_h, &
809  jrho_atom_set(iat)%cjc0_s, &
810  jrho_atom_set(iat)%cjc_h, &
811  jrho_atom_set(iat)%cjc_s, &
812  jrho_atom_set(iat)%cjc_ii_h, &
813  jrho_atom_set(iat)%cjc_ii_s, &
814  jrho_atom_set(iat)%cjc_iii_h, &
815  jrho_atom_set(iat)%cjc_iii_s)
816  END IF
817 
818  IF (ASSOCIATED(jrho_atom_set(iat)%jrho_a_h)) THEN
819  IF (ASSOCIATED(jrho_atom_set(iat)%jrho_a_h(1)%r_coef)) THEN
820  n = SIZE(jrho_atom_set(iat)%jrho_a_h)
821  DO i = 1, n
822  !
823  ! size = (nr,max_iso_not0) distributed
824  DEALLOCATE (jrho_atom_set(iat)%jrho_h(i)%r_coef, &
825  jrho_atom_set(iat)%jrho_s(i)%r_coef, &
826  jrho_atom_set(iat)%jrho_a_h(i)%r_coef, &
827  jrho_atom_set(iat)%jrho_a_s(i)%r_coef, &
828  jrho_atom_set(iat)%jrho_b_h(i)%r_coef, &
829  jrho_atom_set(iat)%jrho_b_s(i)%r_coef, &
830  jrho_atom_set(iat)%jrho_a_h_ii(i)%r_coef, &
831  jrho_atom_set(iat)%jrho_a_s_ii(i)%r_coef, &
832  jrho_atom_set(iat)%jrho_b_h_ii(i)%r_coef, &
833  jrho_atom_set(iat)%jrho_b_s_ii(i)%r_coef, &
834  jrho_atom_set(iat)%jrho_a_h_iii(i)%r_coef, &
835  jrho_atom_set(iat)%jrho_a_s_iii(i)%r_coef, &
836  jrho_atom_set(iat)%jrho_b_h_iii(i)%r_coef, &
837  jrho_atom_set(iat)%jrho_b_s_iii(i)%r_coef)
838  END DO
839  END IF
840  DEALLOCATE (jrho_atom_set(iat)%jrho_h, &
841  jrho_atom_set(iat)%jrho_s, &
842  jrho_atom_set(iat)%jrho_a_h, &
843  jrho_atom_set(iat)%jrho_a_s, &
844  jrho_atom_set(iat)%jrho_b_h, &
845  jrho_atom_set(iat)%jrho_b_s, &
846  jrho_atom_set(iat)%jrho_a_h_ii, &
847  jrho_atom_set(iat)%jrho_a_s_ii, &
848  jrho_atom_set(iat)%jrho_b_h_ii, &
849  jrho_atom_set(iat)%jrho_b_s_ii, &
850  jrho_atom_set(iat)%jrho_a_h_iii, &
851  jrho_atom_set(iat)%jrho_a_s_iii, &
852  jrho_atom_set(iat)%jrho_b_h_iii, &
853  jrho_atom_set(iat)%jrho_b_s_iii)
854  END IF
855 
856  IF (ASSOCIATED(jrho_atom_set(iat)%jrho_vec_rad_h)) THEN
857  IF (ASSOCIATED(jrho_atom_set(iat)%jrho_vec_rad_h(1, 1)%r_coef)) THEN
858  n = SIZE(jrho_atom_set(iat)%jrho_vec_rad_h, 2)
859  DO i = 1, n
860  DO idir = 1, 3
861  !
862  ! size =(nr,na) distributed
863  DEALLOCATE (jrho_atom_set(iat)%jrho_vec_rad_h(idir, i)%r_coef, &
864  jrho_atom_set(iat)%jrho_vec_rad_s(idir, i)%r_coef)
865  END DO
866  END DO
867  END IF
868  DEALLOCATE (jrho_atom_set(iat)%jrho_vec_rad_h, &
869  jrho_atom_set(iat)%jrho_vec_rad_s)
870  END IF
871  END DO
872  DEALLOCATE (jrho_atom_set)
873 
874  END SUBROUTINE deallocate_jrho_atom_set
875 
876 ! **************************************************************************************************
877 !> \brief ...
878 !> \param jrho1_atom ...
879 !> \param ispin ...
880 !> \param nr ...
881 !> \param na ...
882 !> \param max_iso_not0 ...
883 ! **************************************************************************************************
884  SUBROUTINE allocate_jrho_atom_rad(jrho1_atom, ispin, nr, na, max_iso_not0)
885 
886  TYPE(jrho_atom_type), POINTER :: jrho1_atom
887  INTEGER, INTENT(IN) :: ispin, nr, na, max_iso_not0
888 
889  CHARACTER(len=*), PARAMETER :: routinen = 'allocate_jrho_atom_rad'
890 
891  INTEGER :: handle, idir
892 
893  CALL timeset(routinen, handle)
894 
895  cpassert(ASSOCIATED(jrho1_atom))
896 
897  DO idir = 1, 3
898  ALLOCATE (jrho1_atom%jrho_vec_rad_h(idir, ispin)%r_coef(nr, na), &
899  jrho1_atom%jrho_vec_rad_s(idir, ispin)%r_coef(nr, na))
900  jrho1_atom%jrho_vec_rad_h(idir, ispin)%r_coef = 0.0_dp
901  jrho1_atom%jrho_vec_rad_s(idir, ispin)%r_coef = 0.0_dp
902  END DO
903 
904  ALLOCATE (jrho1_atom%jrho_h(ispin)%r_coef(nr, max_iso_not0), &
905  jrho1_atom%jrho_s(ispin)%r_coef(nr, max_iso_not0), &
906  jrho1_atom%jrho_a_h(ispin)%r_coef(nr, max_iso_not0), &
907  jrho1_atom%jrho_a_s(ispin)%r_coef(nr, max_iso_not0), &
908  jrho1_atom%jrho_b_h(ispin)%r_coef(nr, max_iso_not0), &
909  jrho1_atom%jrho_b_s(ispin)%r_coef(nr, max_iso_not0), &
910  jrho1_atom%jrho_a_h_ii(ispin)%r_coef(nr, max_iso_not0), &
911  jrho1_atom%jrho_a_s_ii(ispin)%r_coef(nr, max_iso_not0), &
912  jrho1_atom%jrho_b_h_ii(ispin)%r_coef(nr, max_iso_not0), &
913  jrho1_atom%jrho_b_s_ii(ispin)%r_coef(nr, max_iso_not0), &
914  jrho1_atom%jrho_a_h_iii(ispin)%r_coef(nr, max_iso_not0), &
915  jrho1_atom%jrho_a_s_iii(ispin)%r_coef(nr, max_iso_not0), &
916  jrho1_atom%jrho_b_h_iii(ispin)%r_coef(nr, max_iso_not0), &
917  jrho1_atom%jrho_b_s_iii(ispin)%r_coef(nr, max_iso_not0))
918  !
919  jrho1_atom%jrho_h(ispin)%r_coef = 0.0_dp
920  jrho1_atom%jrho_s(ispin)%r_coef = 0.0_dp
921  jrho1_atom%jrho_a_h(ispin)%r_coef = 0.0_dp
922  jrho1_atom%jrho_a_s(ispin)%r_coef = 0.0_dp
923  jrho1_atom%jrho_b_h(ispin)%r_coef = 0.0_dp
924  jrho1_atom%jrho_b_s(ispin)%r_coef = 0.0_dp
925  jrho1_atom%jrho_a_h_ii(ispin)%r_coef = 0.0_dp
926  jrho1_atom%jrho_a_s_ii(ispin)%r_coef = 0.0_dp
927  jrho1_atom%jrho_b_h_ii(ispin)%r_coef = 0.0_dp
928  jrho1_atom%jrho_b_s_ii(ispin)%r_coef = 0.0_dp
929  jrho1_atom%jrho_a_h_iii(ispin)%r_coef = 0.0_dp
930  jrho1_atom%jrho_a_s_iii(ispin)%r_coef = 0.0_dp
931  jrho1_atom%jrho_b_h_iii(ispin)%r_coef = 0.0_dp
932  jrho1_atom%jrho_b_s_iii(ispin)%r_coef = 0.0_dp
933  CALL timestop(handle)
934 
935  END SUBROUTINE allocate_jrho_atom_rad
936 
937 ! **************************************************************************************************
938 !> \brief ...
939 !> \param jrho1_atom ...
940 !> \param ispin ...
941 ! **************************************************************************************************
942  SUBROUTINE set2zero_jrho_atom_rad(jrho1_atom, ispin)
943  !
944  TYPE(jrho_atom_type), POINTER :: jrho1_atom
945  INTEGER, INTENT(IN) :: ispin
946 
947 !
948 
949  cpassert(ASSOCIATED(jrho1_atom))
950  !
951  jrho1_atom%jrho_h(ispin)%r_coef = 0.0_dp
952  jrho1_atom%jrho_s(ispin)%r_coef = 0.0_dp
953  !
954  jrho1_atom%jrho_a_h(ispin)%r_coef = 0.0_dp
955  jrho1_atom%jrho_a_s(ispin)%r_coef = 0.0_dp
956  jrho1_atom%jrho_b_h(ispin)%r_coef = 0.0_dp
957  jrho1_atom%jrho_b_s(ispin)%r_coef = 0.0_dp
958  !
959  jrho1_atom%jrho_a_h_ii(ispin)%r_coef = 0.0_dp
960  jrho1_atom%jrho_a_s_ii(ispin)%r_coef = 0.0_dp
961  jrho1_atom%jrho_b_h_ii(ispin)%r_coef = 0.0_dp
962  jrho1_atom%jrho_b_s_ii(ispin)%r_coef = 0.0_dp
963  !
964  jrho1_atom%jrho_a_h_iii(ispin)%r_coef = 0.0_dp
965  jrho1_atom%jrho_a_s_iii(ispin)%r_coef = 0.0_dp
966  jrho1_atom%jrho_b_h_iii(ispin)%r_coef = 0.0_dp
967  jrho1_atom%jrho_b_s_iii(ispin)%r_coef = 0.0_dp
968  !
969  END SUBROUTINE set2zero_jrho_atom_rad
970 
971 ! **************************************************************************************************
972 
973 ! **************************************************************************************************
974 !> \brief ...
975 !> \param jrho1_atom_set ...
976 !> \param iatom ...
977 !> \param nsotot ...
978 ! **************************************************************************************************
979  SUBROUTINE allocate_jrho_coeff(jrho1_atom_set, iatom, nsotot)
980 
981  TYPE(jrho_atom_type), DIMENSION(:), POINTER :: jrho1_atom_set
982  INTEGER, INTENT(IN) :: iatom, nsotot
983 
984  CHARACTER(len=*), PARAMETER :: routinen = 'allocate_jrho_coeff'
985 
986  INTEGER :: handle, i
987 
988  CALL timeset(routinen, handle)
989  cpassert(ASSOCIATED(jrho1_atom_set))
990  DO i = 1, SIZE(jrho1_atom_set(iatom)%cjc0_h, 1)
991  ALLOCATE (jrho1_atom_set(iatom)%cjc0_h(i)%r_coef(nsotot, nsotot), &
992  jrho1_atom_set(iatom)%cjc0_s(i)%r_coef(nsotot, nsotot), &
993  jrho1_atom_set(iatom)%cjc_h(i)%r_coef(nsotot, nsotot), &
994  jrho1_atom_set(iatom)%cjc_s(i)%r_coef(nsotot, nsotot), &
995  jrho1_atom_set(iatom)%cjc_ii_h(i)%r_coef(nsotot, nsotot), &
996  jrho1_atom_set(iatom)%cjc_ii_s(i)%r_coef(nsotot, nsotot), &
997  jrho1_atom_set(iatom)%cjc_iii_h(i)%r_coef(nsotot, nsotot), &
998  jrho1_atom_set(iatom)%cjc_iii_s(i)%r_coef(nsotot, nsotot))
999  jrho1_atom_set(iatom)%cjc0_h(i)%r_coef = 0.0_dp
1000  jrho1_atom_set(iatom)%cjc0_s(i)%r_coef = 0.0_dp
1001  jrho1_atom_set(iatom)%cjc_h(i)%r_coef = 0.0_dp
1002  jrho1_atom_set(iatom)%cjc_s(i)%r_coef = 0.0_dp
1003  jrho1_atom_set(iatom)%cjc_ii_h(i)%r_coef = 0.0_dp
1004  jrho1_atom_set(iatom)%cjc_ii_s(i)%r_coef = 0.0_dp
1005  jrho1_atom_set(iatom)%cjc_iii_h(i)%r_coef = 0.0_dp
1006  jrho1_atom_set(iatom)%cjc_iii_s(i)%r_coef = 0.0_dp
1007  END DO
1008  CALL timestop(handle)
1009  END SUBROUTINE allocate_jrho_coeff
1010 
1011 ! **************************************************************************************************
1012 
1013 ! **************************************************************************************************
1014 !> \brief ...
1015 !> \param jrho1_atom_set ...
1016 !> \param iatom ...
1017 ! **************************************************************************************************
1018  SUBROUTINE deallocate_jrho_coeff(jrho1_atom_set, iatom)
1019 
1020  TYPE(jrho_atom_type), DIMENSION(:), POINTER :: jrho1_atom_set
1021  INTEGER, INTENT(IN) :: iatom
1022 
1023  CHARACTER(len=*), PARAMETER :: routinen = 'deallocate_jrho_coeff'
1024 
1025  INTEGER :: handle, i
1026 
1027  CALL timeset(routinen, handle)
1028  cpassert(ASSOCIATED(jrho1_atom_set))
1029  DO i = 1, SIZE(jrho1_atom_set(iatom)%cjc0_h, 1)
1030  DEALLOCATE (jrho1_atom_set(iatom)%cjc0_h(i)%r_coef, &
1031  jrho1_atom_set(iatom)%cjc0_s(i)%r_coef, &
1032  jrho1_atom_set(iatom)%cjc_h(i)%r_coef, &
1033  jrho1_atom_set(iatom)%cjc_s(i)%r_coef, &
1034  jrho1_atom_set(iatom)%cjc_ii_h(i)%r_coef, &
1035  jrho1_atom_set(iatom)%cjc_ii_s(i)%r_coef, &
1036  jrho1_atom_set(iatom)%cjc_iii_h(i)%r_coef, &
1037  jrho1_atom_set(iatom)%cjc_iii_s(i)%r_coef)
1038  END DO
1039  CALL timestop(handle)
1040  END SUBROUTINE deallocate_jrho_coeff
1041 
1042 ! **************************************************************************************************
1043 
1044 ! **************************************************************************************************
1045 !> \brief ...
1046 !> \param jrho1_atom_set ...
1047 !> \param iatom ...
1048 !> \param cjc_h ...
1049 !> \param cjc_s ...
1050 !> \param cjc_ii_h ...
1051 !> \param cjc_ii_s ...
1052 !> \param cjc_iii_h ...
1053 !> \param cjc_iii_s ...
1054 !> \param jrho_vec_rad_h ...
1055 !> \param jrho_vec_rad_s ...
1056 ! **************************************************************************************************
1057  SUBROUTINE get_jrho_atom(jrho1_atom_set, iatom, cjc_h, cjc_s, cjc_ii_h, cjc_ii_s, &
1058  cjc_iii_h, cjc_iii_s, jrho_vec_rad_h, jrho_vec_rad_s)
1059 
1060  TYPE(jrho_atom_type), DIMENSION(:), POINTER :: jrho1_atom_set
1061  INTEGER, INTENT(IN) :: iatom
1062  TYPE(rho_atom_coeff), DIMENSION(:), OPTIONAL, &
1063  POINTER :: cjc_h, cjc_s, cjc_ii_h, cjc_ii_s, &
1064  cjc_iii_h, cjc_iii_s
1065  TYPE(rho_atom_coeff), DIMENSION(:, :), OPTIONAL, &
1066  POINTER :: jrho_vec_rad_h, jrho_vec_rad_s
1067 
1068  cpassert(ASSOCIATED(jrho1_atom_set))
1069 
1070  IF (PRESENT(cjc_h)) cjc_h => jrho1_atom_set(iatom)%cjc_h
1071  IF (PRESENT(cjc_s)) cjc_s => jrho1_atom_set(iatom)%cjc_s
1072  IF (PRESENT(cjc_ii_h)) cjc_ii_h => jrho1_atom_set(iatom)%cjc_ii_h
1073  IF (PRESENT(cjc_ii_s)) cjc_ii_s => jrho1_atom_set(iatom)%cjc_ii_s
1074  IF (PRESENT(cjc_iii_h)) cjc_iii_h => jrho1_atom_set(iatom)%cjc_iii_h
1075  IF (PRESENT(cjc_iii_s)) cjc_iii_s => jrho1_atom_set(iatom)%cjc_iii_s
1076  IF (PRESENT(jrho_vec_rad_h)) jrho_vec_rad_h => jrho1_atom_set(iatom)%jrho_vec_rad_h
1077  IF (PRESENT(jrho_vec_rad_s)) jrho_vec_rad_s => jrho1_atom_set(iatom)%jrho_vec_rad_s
1078 
1079  END SUBROUTINE get_jrho_atom
1080 
1081 ! **************************************************************************************************
1082 !> \brief ...
1083 !> \param jrho1_atom_set ...
1084 !> \param atomic_kind_set ...
1085 !> \param nspins ...
1086 ! **************************************************************************************************
1087  SUBROUTINE init_jrho_atom_set(jrho1_atom_set, atomic_kind_set, nspins)
1088  TYPE(jrho_atom_type), DIMENSION(:), POINTER :: jrho1_atom_set
1089  TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1090  INTEGER, INTENT(IN) :: nspins
1091 
1092  CHARACTER(len=*), PARAMETER :: routinen = 'init_jrho_atom_set'
1093 
1094  INTEGER :: handle, iat, iatom, ikind, nat, natom, &
1095  nkind
1096  INTEGER, DIMENSION(:), POINTER :: atom_list
1097 
1098  CALL timeset(routinen, handle)
1099 
1100  cpassert(ASSOCIATED(atomic_kind_set))
1101 
1102  IF (ASSOCIATED(jrho1_atom_set)) THEN
1103  CALL deallocate_jrho_atom_set(jrho1_atom_set)
1104  END IF
1105 
1106  CALL get_atomic_kind_set(atomic_kind_set, natom=natom)
1107  ALLOCATE (jrho1_atom_set(natom))
1108 
1109  nkind = SIZE(atomic_kind_set)
1110 
1111  DO ikind = 1, nkind
1112 
1113  CALL get_atomic_kind(atomic_kind_set(ikind), atom_list=atom_list, natom=nat)
1114 
1115  DO iat = 1, nat
1116  iatom = atom_list(iat)
1117 
1118  ! Allocate the radial density for each LM,for each atom
1119  ALLOCATE (jrho1_atom_set(iatom)%jrho_vec_rad_h(3, nspins), &
1120  jrho1_atom_set(iatom)%jrho_vec_rad_s(3, nspins), &
1121  jrho1_atom_set(iatom)%jrho_h(nspins), &
1122  jrho1_atom_set(iatom)%jrho_s(nspins), &
1123  jrho1_atom_set(iatom)%jrho_a_h(nspins), &
1124  jrho1_atom_set(iatom)%jrho_a_s(nspins), &
1125  jrho1_atom_set(iatom)%jrho_b_h(nspins), &
1126  jrho1_atom_set(iatom)%jrho_b_s(nspins), &
1127  jrho1_atom_set(iatom)%jrho_a_h_ii(nspins), &
1128  jrho1_atom_set(iatom)%jrho_a_s_ii(nspins), &
1129  jrho1_atom_set(iatom)%jrho_b_s_ii(nspins), &
1130  jrho1_atom_set(iatom)%jrho_b_h_ii(nspins), &
1131  jrho1_atom_set(iatom)%jrho_a_h_iii(nspins), &
1132  jrho1_atom_set(iatom)%jrho_a_s_iii(nspins), &
1133  jrho1_atom_set(iatom)%jrho_b_s_iii(nspins), &
1134  jrho1_atom_set(iatom)%jrho_b_h_iii(nspins), &
1135  jrho1_atom_set(iatom)%cjc0_h(nspins), &
1136  jrho1_atom_set(iatom)%cjc0_s(nspins), &
1137  jrho1_atom_set(iatom)%cjc_h(nspins), &
1138  jrho1_atom_set(iatom)%cjc_s(nspins), &
1139  jrho1_atom_set(iatom)%cjc_ii_h(nspins), &
1140  jrho1_atom_set(iatom)%cjc_ii_s(nspins), &
1141  jrho1_atom_set(iatom)%cjc_iii_h(nspins), &
1142  jrho1_atom_set(iatom)%cjc_iii_s(nspins))
1143 
1144  END DO ! iat
1145 
1146  END DO ! ikind
1147 
1148  CALL timestop(handle)
1149 
1150  END SUBROUTINE init_jrho_atom_set
1151 
1152 ! **************************************************************************************************
1153 !> \brief ...
1154 !> \param nablavks_atom_set ...
1155 !> \param atomic_kind_set ...
1156 !> \param qs_kind_set ...
1157 !> \param nspins ...
1158 ! **************************************************************************************************
1159  SUBROUTINE init_nablavks_atom_set(nablavks_atom_set, atomic_kind_set, qs_kind_set, nspins)
1160 
1161  TYPE(nablavks_atom_type), DIMENSION(:), POINTER :: nablavks_atom_set
1162  TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1163  TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1164  INTEGER, INTENT(IN) :: nspins
1165 
1166  CHARACTER(len=*), PARAMETER :: routinen = 'init_nablavks_atom_set'
1167 
1168  INTEGER :: handle, iat, iatom, idir, ikind, ispin, &
1169  max_iso_not0, maxso, na, nat, natom, &
1170  nkind, nr, nset, nsotot
1171  INTEGER, DIMENSION(:), POINTER :: atom_list
1172  TYPE(grid_atom_type), POINTER :: grid_atom
1173  TYPE(gto_basis_set_type), POINTER :: orb_basis_set
1174  TYPE(harmonics_atom_type), POINTER :: harmonics
1175 
1176  CALL timeset(routinen, handle)
1177 
1178  cpassert(ASSOCIATED(qs_kind_set))
1179 
1180  IF (ASSOCIATED(nablavks_atom_set)) THEN
1181  CALL deallocate_nablavks_atom_set(nablavks_atom_set)
1182  END IF
1183 
1184  CALL get_atomic_kind_set(atomic_kind_set, natom=natom)
1185 
1186  CALL allocate_nablavks_atom_set(nablavks_atom_set, natom)
1187 
1188  nkind = SIZE(atomic_kind_set)
1189 
1190  DO ikind = 1, nkind
1191  CALL get_atomic_kind(atomic_kind_set(ikind), atom_list=atom_list, natom=nat)
1192  CALL get_qs_kind(qs_kind_set(ikind), &
1193  basis_set=orb_basis_set, &
1194  harmonics=harmonics, &
1195  grid_atom=grid_atom)
1196 
1197  na = grid_atom%ng_sphere
1198  nr = grid_atom%nr
1199 
1200  CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
1201  maxso=maxso, nset=nset)
1202  nsotot = maxso*nset
1203  max_iso_not0 = harmonics%max_iso_not0
1204  DO iat = 1, nat
1205  iatom = atom_list(iat)
1206  !*** allocate the radial density for each LM,for each atom ***
1207 
1208  ALLOCATE (nablavks_atom_set(iatom)%nablavks_vec_rad_h(3, nspins))
1209  ALLOCATE (nablavks_atom_set(iatom)%nablavks_vec_rad_s(3, nspins))
1210  DO ispin = 1, nspins
1211  DO idir = 1, 3
1212  NULLIFY (nablavks_atom_set(iatom)%nablavks_vec_rad_h(idir, ispin)%r_coef)
1213  NULLIFY (nablavks_atom_set(iatom)%nablavks_vec_rad_s(idir, ispin)%r_coef)
1214  ALLOCATE (nablavks_atom_set(iatom)%nablavks_vec_rad_h(idir, ispin)%r_coef(nr, na))
1215  ALLOCATE (nablavks_atom_set(iatom)%nablavks_vec_rad_s(idir, ispin)%r_coef(nr, na))
1216  END DO
1217  END DO ! ispin
1218  END DO ! iat
1219 
1220  END DO ! ikind
1221 
1222  CALL timestop(handle)
1223 
1224  END SUBROUTINE init_nablavks_atom_set
1225 
1226 ! **************************************************************************************************
1227 !> \brief ...
1228 !> \param polar_env ...
1229 !> \param do_raman ...
1230 !> \param do_periodic ...
1231 !> \param dBerry_psi0 ...
1232 !> \param polar ...
1233 !> \param psi1_dBerry ...
1234 !> \param run_stopped ...
1235 !> \par History
1236 !> 06.2018 polar_env integrated into qs_env (MK)
1237 ! **************************************************************************************************
1238  SUBROUTINE get_polar_env(polar_env, do_raman, do_periodic, dBerry_psi0, polar, psi1_dBerry, run_stopped)
1239 
1240  TYPE(polar_env_type), INTENT(IN) :: polar_env
1241  LOGICAL, OPTIONAL :: do_raman, do_periodic
1242  TYPE(cp_fm_type), DIMENSION(:, :), OPTIONAL, &
1243  POINTER :: dberry_psi0
1244  REAL(dp), DIMENSION(:, :), OPTIONAL, POINTER :: polar
1245  TYPE(cp_fm_type), DIMENSION(:, :), OPTIONAL, &
1246  POINTER :: psi1_dberry
1247  LOGICAL, OPTIONAL :: run_stopped
1248 
1249  IF (PRESENT(polar)) polar => polar_env%polar
1250  IF (PRESENT(do_raman)) do_raman = polar_env%do_raman
1251  IF (PRESENT(do_periodic)) do_periodic = polar_env%do_periodic
1252  IF (PRESENT(dberry_psi0)) dberry_psi0 => polar_env%dBerry_psi0
1253  IF (PRESENT(psi1_dberry)) psi1_dberry => polar_env%psi1_dBerry
1254  IF (PRESENT(run_stopped)) run_stopped = polar_env%run_stopped
1255 
1256  END SUBROUTINE get_polar_env
1257 
1258 ! **************************************************************************************************
1259 !> \brief ...
1260 !> \param polar_env ...
1261 !> \param do_raman ...
1262 !> \param do_periodic ...
1263 !> \param dBerry_psi0 ...
1264 !> \param polar ...
1265 !> \param psi1_dBerry ...
1266 !> \param run_stopped ...
1267 ! **************************************************************************************************
1268  SUBROUTINE set_polar_env(polar_env, do_raman, do_periodic, dBerry_psi0, polar, &
1269  psi1_dBerry, run_stopped)
1270 
1271  TYPE(polar_env_type), INTENT(INOUT) :: polar_env
1272  LOGICAL, OPTIONAL :: do_raman, do_periodic
1273  TYPE(cp_fm_type), DIMENSION(:, :), OPTIONAL, &
1274  POINTER :: dberry_psi0
1275  REAL(dp), DIMENSION(:, :), OPTIONAL, POINTER :: polar
1276  TYPE(cp_fm_type), DIMENSION(:, :), OPTIONAL, &
1277  POINTER :: psi1_dberry
1278  LOGICAL, OPTIONAL :: run_stopped
1279 
1280  IF (PRESENT(polar)) polar_env%polar => polar
1281  IF (PRESENT(do_raman)) polar_env%do_raman = do_raman
1282  IF (PRESENT(do_periodic)) polar_env%do_periodic = do_periodic
1283  IF (PRESENT(psi1_dberry)) polar_env%psi1_dBerry => psi1_dberry
1284  IF (PRESENT(dberry_psi0)) polar_env%dBerry_psi0 => dberry_psi0
1285  IF (PRESENT(run_stopped)) polar_env%run_stopped = run_stopped
1286 
1287  END SUBROUTINE set_polar_env
1288 
1289 ! **************************************************************************************************
1290 !> \brief Deallocate the polar environment
1291 !> \param polar_env ...
1292 !> \par History
1293 !> 06.2018 polar_env integrated into qs_env (MK)
1294 ! **************************************************************************************************
1295  SUBROUTINE polar_env_release(polar_env)
1296 
1297  TYPE(polar_env_type), POINTER :: polar_env
1298 
1299  IF (ASSOCIATED(polar_env)) THEN
1300  IF (ASSOCIATED(polar_env%polar)) THEN
1301  DEALLOCATE (polar_env%polar)
1302  END IF
1303  CALL cp_fm_release(polar_env%dBerry_psi0)
1304  CALL cp_fm_release(polar_env%psi1_dBerry)
1305  DEALLOCATE (polar_env)
1306  NULLIFY (polar_env)
1307  END IF
1308 
1309  END SUBROUTINE polar_env_release
1310 
1311 END MODULE qs_linres_types
Define the atomic kind types and their sub types.
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.
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.
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)
...
various utilities that regard array of different kinds: output, allocation,... maybe it is not a good...
represent the structure of a full matrix
Definition: cp_fm_struct.F:14
represent a full matrix distributed on many processors
Definition: cp_fm_types.F:15
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public dp
Definition: kinds.F:34
Define the quickstep kind type and their sub types.
Definition: qs_kind_types.F:23
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, 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_r3d_rs_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_potentials, pao_descriptors, nelec)
Get attributes of an atomic kind.
Type definitiona for linear response calculations.
subroutine, public init_jrho_atom_set(jrho1_atom_set, atomic_kind_set, nspins)
...
subroutine, public deallocate_nablavks_atom_set(nablavks_atom_set)
...
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)
...
subroutine, public set_current_env(current_env, jrho1_atom_set, jrho1_set)
...
subroutine, public deallocate_jrho_atom_set(jrho_atom_set)
...
subroutine, public allocate_jrho_coeff(jrho1_atom_set, iatom, nsotot)
...
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)
...
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)
...
subroutine, public init_nablavks_atom_set(nablavks_atom_set, atomic_kind_set, qs_kind_set, nspins)
...
subroutine, public set2zero_jrho_atom_rad(jrho1_atom, ispin)
...
subroutine, public polar_env_release(polar_env)
Deallocate the polar environment.
subroutine, public get_polar_env(polar_env, do_raman, do_periodic, dBerry_psi0, polar, psi1_dBerry, run_stopped)
...
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)
...
subroutine, public set_polar_env(polar_env, do_raman, do_periodic, dBerry_psi0, polar, psi1_dBerry, run_stopped)
...
subroutine, public linres_control_release(linres_control)
...
subroutine, public get_epr_env(epr_env, g_total, g_so, g_soo, nablavks_set, nablavks_atom_set, bind_set, bind_atom_set)
...
subroutine, public allocate_jrho_atom_rad(jrho1_atom, ispin, nr, na, max_iso_not0)
...
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
subroutine, public qs_loc_env_release(qs_loc_env)
...
Definition: qs_loc_types.F:192
superstucture that hold various representations of the density and keeps track of which ones are vali...
Definition: qs_rho_types.F:18
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:113