24 USE dbcsr_api,
ONLY: dbcsr_p_type
37 #include "./base/base_uses.f90"
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
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
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
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
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
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
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
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
249 INTEGER :: orb_center = -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
303 TYPE(dcdr_env_type) :: dcdr_env = dcdr_env_type()
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.
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()
322 TYPE(dbcsr_p_type),
DIMENSION(:),
POINTER :: matrix_dSdV => null(), &
323 matrix_drpnl => null(), &
324 matrix_hxc_dsdv => null(), &
326 dipvel_ao => null(), &
327 dipvel_ao_delta => null(), &
328 matrix_rxrv => null(), &
329 matrix_dsdb => null()
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()
346 TYPE(cp_fm_type),
DIMENSION(:),
POINTER :: dCV => null(), &
347 dcv_prime => null(), &
350 dcb_prime => null(), &
352 END TYPE vcd_env_type
354 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'qs_linres_types'
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, &
380 TYPE(linres_control_type),
INTENT(INOUT) :: linres_control
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)
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, &
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, &
443 TYPE(jrho_atom_type),
DIMENSION(:),
OPTIONAL, &
444 POINTER :: jrho1_atom_set
445 TYPE(qs_rho_p_type),
DIMENSION(:),
OPTIONAL, &
447 REAL(dp),
INTENT(OUT),
OPTIONAL :: chi_tensor(3, 3, 2), &
448 chi_tensor_loc(3, 3, 2), &
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
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
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)
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, &
512 REAL(dp),
INTENT(OUT),
OPTIONAL :: shift_gapw_radius
513 LOGICAL,
INTENT(OUT),
OPTIONAL :: do_nics, interpolate_shift
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
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)
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, &
564 LOGICAL,
OPTIONAL :: do_fc, do_sd, do_pso, do_dso
565 REAL(dp),
DIMENSION(:, :, :, :, :),
OPTIONAL, &
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, &
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
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, &
618 IF (
PRESENT(jrho1_atom_set))
THEN
619 IF (
ASSOCIATED(current_env%jrho1_atom_set))
THEN
622 current_env%jrho1_atom_set => jrho1_atom_set
625 IF (
PRESENT(jrho1_set))
THEN
626 IF (
ASSOCIATED(current_env%jrho1_set))
THEN
628 CALL qs_rho_release(current_env%jrho1_set(idir)%rho)
629 DEALLOCATE (current_env%jrho1_set(idir)%rho)
632 current_env%jrho1_set => jrho1_set
648 SUBROUTINE get_epr_env(epr_env, g_total, g_so, g_soo, nablavks_set, nablavks_atom_set, &
649 bind_set, bind_atom_set)
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, &
659 TYPE(rho_atom_coeff),
DIMENSION(:, :),
OPTIONAL, &
660 POINTER :: bind_atom_set
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
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)
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
697 INTEGER :: idir, ispin
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
706 IF (
PRESENT(nablavks_set))
THEN
707 IF (
ASSOCIATED(epr_env%nablavks_set))
THEN
710 CALL qs_rho_release(epr_env%nablavks_set(idir, ispin)%rho)
711 DEALLOCATE (epr_env%nablavks_set(idir, ispin)%rho)
715 epr_env%nablavks_set => nablavks_set
718 IF (
PRESENT(nablavks_atom_set))
THEN
719 IF (
ASSOCIATED(epr_env%nablavks_atom_set))
THEN
722 epr_env%nablavks_atom_set => nablavks_atom_set
732 SUBROUTINE allocate_nablavks_atom_set(nablavks_atom_set, natom)
734 TYPE(nablavks_atom_type),
DIMENSION(:),
POINTER :: nablavks_atom_set
735 INTEGER,
INTENT(IN) :: natom
739 ALLOCATE (nablavks_atom_set(natom))
742 NULLIFY (nablavks_atom_set(iat)%nablavks_vec_rad_h)
743 NULLIFY (nablavks_atom_set(iat)%nablavks_vec_rad_s)
745 END SUBROUTINE allocate_nablavks_atom_set
753 TYPE(nablavks_atom_type),
DIMENSION(:),
POINTER :: nablavks_atom_set
755 INTEGER :: i, iat, idir, n, natom
757 cpassert(
ASSOCIATED(nablavks_atom_set))
758 natom =
SIZE(nablavks_atom_set)
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)
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)
771 DEALLOCATE (nablavks_atom_set(iat)%nablavks_vec_rad_h)
772 DEALLOCATE (nablavks_atom_set(iat)%nablavks_vec_rad_s)
775 DEALLOCATE (nablavks_atom_set)
784 TYPE(jrho_atom_type),
DIMENSION(:),
POINTER :: jrho_atom_set
786 INTEGER :: i, iat, idir, n, natom
788 cpassert(
ASSOCIATED(jrho_atom_set))
789 natom =
SIZE(jrho_atom_set)
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)
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)
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)
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)
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)
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)
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)
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)
868 DEALLOCATE (jrho_atom_set(iat)%jrho_vec_rad_h, &
869 jrho_atom_set(iat)%jrho_vec_rad_s)
872 DEALLOCATE (jrho_atom_set)
886 TYPE(jrho_atom_type),
POINTER :: jrho1_atom
887 INTEGER,
INTENT(IN) :: ispin, nr, na, max_iso_not0
889 CHARACTER(len=*),
PARAMETER :: routinen =
'allocate_jrho_atom_rad'
891 INTEGER :: handle, idir
893 CALL timeset(routinen, handle)
895 cpassert(
ASSOCIATED(jrho1_atom))
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
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))
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)
944 TYPE(jrho_atom_type),
POINTER :: jrho1_atom
945 INTEGER,
INTENT(IN) :: ispin
949 cpassert(
ASSOCIATED(jrho1_atom))
951 jrho1_atom%jrho_h(ispin)%r_coef = 0.0_dp
952 jrho1_atom%jrho_s(ispin)%r_coef = 0.0_dp
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
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
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
981 TYPE(jrho_atom_type),
DIMENSION(:),
POINTER :: jrho1_atom_set
982 INTEGER,
INTENT(IN) :: iatom, nsotot
984 CHARACTER(len=*),
PARAMETER :: routinen =
'allocate_jrho_coeff'
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
1008 CALL timestop(handle)
1018 SUBROUTINE deallocate_jrho_coeff(jrho1_atom_set, iatom)
1020 TYPE(jrho_atom_type),
DIMENSION(:),
POINTER :: jrho1_atom_set
1021 INTEGER,
INTENT(IN) :: iatom
1023 CHARACTER(len=*),
PARAMETER :: routinen =
'deallocate_jrho_coeff'
1025 INTEGER :: handle, i
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)
1039 CALL timestop(handle)
1040 END SUBROUTINE deallocate_jrho_coeff
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)
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
1068 cpassert(
ASSOCIATED(jrho1_atom_set))
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
1079 END SUBROUTINE get_jrho_atom
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
1092 CHARACTER(len=*),
PARAMETER :: routinen =
'init_jrho_atom_set'
1094 INTEGER :: handle, iat, iatom, ikind, nat, natom, &
1096 INTEGER,
DIMENSION(:),
POINTER :: atom_list
1098 CALL timeset(routinen, handle)
1100 cpassert(
ASSOCIATED(atomic_kind_set))
1102 IF (
ASSOCIATED(jrho1_atom_set))
THEN
1106 CALL get_atomic_kind_set(atomic_kind_set, natom=natom)
1107 ALLOCATE (jrho1_atom_set(natom))
1109 nkind =
SIZE(atomic_kind_set)
1113 CALL get_atomic_kind(atomic_kind_set(ikind), atom_list=atom_list, natom=nat)
1116 iatom = atom_list(iat)
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))
1148 CALL timestop(handle)
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
1166 CHARACTER(len=*),
PARAMETER :: routinen =
'init_nablavks_atom_set'
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
1176 CALL timeset(routinen, handle)
1178 cpassert(
ASSOCIATED(qs_kind_set))
1180 IF (
ASSOCIATED(nablavks_atom_set))
THEN
1184 CALL get_atomic_kind_set(atomic_kind_set, natom=natom)
1186 CALL allocate_nablavks_atom_set(nablavks_atom_set, natom)
1188 nkind =
SIZE(atomic_kind_set)
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)
1197 na = grid_atom%ng_sphere
1200 CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
1201 maxso=maxso, nset=nset)
1203 max_iso_not0 = harmonics%max_iso_not0
1205 iatom = atom_list(iat)
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
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))
1222 CALL timestop(handle)
1238 SUBROUTINE get_polar_env(polar_env, do_raman, do_periodic, dBerry_psi0, polar, psi1_dBerry, run_stopped)
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
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
1268 SUBROUTINE set_polar_env(polar_env, do_raman, do_periodic, dBerry_psi0, polar, &
1269 psi1_dBerry, run_stopped)
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
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
1297 TYPE(polar_env_type),
POINTER :: polar_env
1299 IF (
ASSOCIATED(polar_env))
THEN
1300 IF (
ASSOCIATED(polar_env%polar))
THEN
1301 DEALLOCATE (polar_env%polar)
1303 CALL cp_fm_release(polar_env%dBerry_psi0)
1304 CALL cp_fm_release(polar_env%psi1_dBerry)
1305 DEALLOCATE (polar_env)
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
represent a full matrix distributed on many processors
Defines the basic variable types.
integer, parameter, public dp
Define the quickstep kind type and their sub types.
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...
subroutine, public qs_loc_env_release(qs_loc_env)
...
superstucture that hold various representations of the density and keeps track of which ones are vali...
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...