24#include "./base/base_uses.f90"
29 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'negf_atom_map'
30 LOGICAL,
PARAMETER,
PRIVATE :: debug_this_module = .true.
42 INTEGER,
DIMENSION(3) :: cell = -1
45 PRIVATE :: qs_kind_group_type, qs_kind_groups_create, qs_kind_groups_release
50 TYPE qs_kind_group_type
52 CHARACTER(len=2) :: element_symbol =
""
54 INTEGER :: natoms = -1
58 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: atom_list
60 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: r
61 END TYPE qs_kind_group_type
77 INTENT(out) :: atom_map
78 INTEGER,
DIMENSION(:),
INTENT(in) :: atom_list
80 REAL(kind=
dp),
INTENT(in) :: eps_geometry
82 CHARACTER(len=*),
PARAMETER :: routinen =
'negf_map_atomic_indices'
84 CHARACTER(len=2) :: element_device
85 CHARACTER(len=default_string_length) :: atom_str
86 INTEGER :: atom_index_device, handle, iatom, &
87 iatom_kind, ikind, ikind_contact, &
88 natoms, nkinds_contact, nsgf_device
89 REAL(kind=
dp),
DIMENSION(3) :: coords, coords_error, coords_scaled
91 TYPE(
particle_type),
DIMENSION(:),
POINTER :: particle_set_contact, particle_set_device
92 TYPE(qs_kind_group_type),
ALLOCATABLE, &
93 DIMENSION(:) :: kind_groups_contact
94 TYPE(
qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set_contact, qs_kind_set_device
96 CALL timeset(routinen, handle)
98 natoms =
SIZE(atom_map, 1)
99 cpassert(
SIZE(atom_list) == natoms)
101 CALL qs_subsys_get(subsys_device, particle_set=particle_set_device, qs_kind_set=qs_kind_set_device)
102 CALL qs_subsys_get(subsys_contact, cell=cell_contact, particle_set=particle_set_contact, qs_kind_set=qs_kind_set_contact)
104 CALL qs_kind_groups_create(kind_groups_contact, particle_set_contact, qs_kind_set_contact)
105 nkinds_contact =
SIZE(kind_groups_contact)
108 atom_index_device = atom_list(iatom)
109 CALL get_atomic_kind(particle_set_device(atom_index_device)%atomic_kind, kind_number=ikind)
110 CALL get_qs_kind(qs_kind_set_device(ikind), element_symbol=element_device, nsgf=nsgf_device)
112 atom_map(iatom)%iatom = 0
114 iterate_kind:
DO ikind_contact = 1, nkinds_contact
116 IF (kind_groups_contact(ikind_contact)%element_symbol == element_device .AND. &
117 kind_groups_contact(ikind_contact)%nsgf == nsgf_device)
THEN
120 DO iatom_kind = 1, kind_groups_contact(ikind_contact)%natoms
121 coords(1:3) = particle_set_device(atom_index_device)%r(1:3) - &
122 kind_groups_contact(ikind_contact)%r(1:3, iatom_kind)
125 coords_error = coords_scaled - real(nint(coords_scaled), kind=
dp)
127 IF (sqrt(dot_product(coords_error, coords_error)) < eps_geometry)
THEN
128 atom_map(iatom)%iatom = kind_groups_contact(ikind_contact)%atom_list(iatom_kind)
129 atom_map(iatom)%cell = nint(coords_scaled)
136 IF (atom_map(iatom)%iatom == 0)
THEN
138 WRITE (atom_str,
'(A2,3(1X,F11.6))') element_device, particle_set_device(atom_index_device)%r
140 CALL cp_abort(__location__, &
141 "Unable to map the atom ("//trim(atom_str)//
") onto the atom from the corresponding FORCE_EVAL section")
145 CALL qs_kind_groups_release(kind_groups_contact)
147 CALL timestop(handle)
160 SUBROUTINE qs_kind_groups_create(kind_groups, particle_set, qs_kind_set)
161 TYPE(qs_kind_group_type),
ALLOCATABLE, &
162 DIMENSION(:),
INTENT(inout) :: kind_groups
164 TYPE(
qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
166 CHARACTER(len=*),
PARAMETER :: routinen =
'qs_kind_groups_create'
168 INTEGER :: handle, iatom, ikind, natoms, nkinds
170 CALL timeset(routinen, handle)
172 natoms =
SIZE(particle_set)
176 CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind)
177 IF (nkinds < ikind) nkinds = ikind
180 ALLOCATE (kind_groups(nkinds))
183 kind_groups(ikind)%natoms = 0
184 CALL get_qs_kind(qs_kind_set(ikind), element_symbol=kind_groups(ikind)%element_symbol, nsgf=kind_groups(ikind)%nsgf)
188 CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind)
189 kind_groups(ikind)%natoms = kind_groups(ikind)%natoms + 1
193 ALLOCATE (kind_groups(ikind)%atom_list(kind_groups(ikind)%natoms))
194 ALLOCATE (kind_groups(ikind)%r(3, kind_groups(ikind)%natoms))
196 kind_groups(ikind)%natoms = 0
200 CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind)
201 kind_groups(ikind)%natoms = kind_groups(ikind)%natoms + 1
203 kind_groups(ikind)%atom_list(kind_groups(ikind)%natoms) = iatom
204 kind_groups(ikind)%r(1:3, kind_groups(ikind)%natoms) = particle_set(iatom)%r(1:3)
207 CALL timestop(handle)
208 END SUBROUTINE qs_kind_groups_create
216 SUBROUTINE qs_kind_groups_release(kind_groups)
217 TYPE(qs_kind_group_type),
ALLOCATABLE, &
218 DIMENSION(:),
INTENT(inout) :: kind_groups
220 CHARACTER(len=*),
PARAMETER :: routinen =
'qs_kind_groups_release'
222 INTEGER :: handle, ikind
224 CALL timeset(routinen, handle)
226 IF (
ALLOCATED(kind_groups))
THEN
227 DO ikind =
SIZE(kind_groups), 1, -1
228 IF (
ALLOCATED(kind_groups(ikind)%atom_list))
DEALLOCATE (kind_groups(ikind)%atom_list)
229 IF (
ALLOCATED(kind_groups(ikind)%r))
DEALLOCATE (kind_groups(ikind)%r)
232 DEALLOCATE (kind_groups)
235 CALL timestop(handle)
236 END SUBROUTINE qs_kind_groups_release
Define the atomic kind types and their sub types.
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.
Handles all functions related to the CELL.
subroutine, public real_to_scaled(s, r, cell)
Transform real to scaled cell coordinates. s=h_inv*r.
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length
Map atoms between various force environments.
subroutine, public negf_map_atomic_indices(atom_map, atom_list, subsys_device, subsys_contact, eps_geometry)
Map atoms in the cell 'subsys_device' listed in 'atom_list' with the corresponding atoms in the cell ...
Define the data structure for the particle information.
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, zatom, zeff, elec_conf, mao, lmax_dftb, alpha_core_charge, ccore_charge, core_charge, core_charge_radius, paw_proj_set, paw_atom, hard_radius, hard0_radius, max_rad_local, covalent_radius, vdw_radius, gpw_type_forced, harmonics, max_iso_not0, max_s_harm, grid_atom, ngrid_ang, ngrid_rad, lmax_rho0, dft_plus_u_atom, l_of_dft_plus_u, n_of_dft_plus_u, u_minus_j, u_of_dft_plus_u, j_of_dft_plus_u, alpha_of_dft_plus_u, beta_of_dft_plus_u, j0_of_dft_plus_u, occupation_of_dft_plus_u, dispersion, bs_occupation, magnetization, no_optimize, addel, laddel, naddel, orbitals, max_scf, eps_scf, smear, u_ramping, u_minus_j_target, eps_u_ramping, init_u_ramping_each_scf, reltmat, ghost, floating, name, element_symbol, pao_basis_size, pao_model_file, pao_potentials, pao_descriptors, nelec)
Get attributes of an atomic kind.
types that represent a quickstep subsys
subroutine, public qs_subsys_get(subsys, atomic_kinds, atomic_kind_set, particles, particle_set, local_particles, molecules, molecule_set, molecule_kinds, molecule_kind_set, local_molecules, para_env, colvar_p, shell_particles, core_particles, gci, multipoles, natom, nparticle, ncore, nshell, nkind, atprop, virial, results, cell, cell_ref, use_ref_cell, energy, force, qs_kind_set, cp_subsys, nelectron_total, nelectron_spin)
...
Type defining parameters related to the simulation cell.
Structure that maps the given atom in the sourse FORCE_EVAL section with another atom from the target...
Provides all information about a quickstep kind.