(git:0de0cc2)
qs_loc_molecules.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 Set of routines handling the localization for molecular properties
10 ! **************************************************************************************************
12  USE cell_types, ONLY: pbc
14  cp_logger_type
15  USE distribution_1d_types, ONLY: distribution_1d_type
16  USE kinds, ONLY: dp
17  USE memory_utilities, ONLY: reallocate
18  USE message_passing, ONLY: mp_para_env_type
20  molecule_kind_type
21  USE molecule_types, ONLY: molecule_type
22  USE particle_types, ONLY: particle_type
23  USE qs_loc_types, ONLY: qs_loc_env_type
24 #include "./base/base_uses.f90"
25 
26  IMPLICIT NONE
27 
28  PRIVATE
29 
30  ! *** Public ***
31  PUBLIC :: wfc_to_molecule
32 
33  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_loc_molecules'
34 
35 CONTAINS
36 
37 ! **************************************************************************************************
38 !> \brief maps wfc's to molecules and also prints molecular dipoles
39 !> \param qs_loc_env ...
40 !> \param center ...
41 !> \param molecule_set ...
42 !> \param ispin ...
43 !> \param nspins ...
44 ! **************************************************************************************************
45  SUBROUTINE wfc_to_molecule(qs_loc_env, center, molecule_set, ispin, nspins)
46  TYPE(qs_loc_env_type), INTENT(IN) :: qs_loc_env
47  REAL(kind=dp), INTENT(IN) :: center(:, :)
48  TYPE(molecule_type), POINTER :: molecule_set(:)
49  INTEGER, INTENT(IN) :: ispin, nspins
50 
51  INTEGER :: counter, first_atom, i, iatom, ikind, imol, imol_now, istate, k, local_location, &
52  natom, natom_loc, natom_max, nkind, nmol, nstate
53  INTEGER, POINTER :: wfc_to_atom_map(:)
54  REAL(kind=dp) :: dr(3), mydist(2), ria(3)
55  REAL(kind=dp), POINTER :: distance(:), r(:, :)
56  TYPE(cp_logger_type), POINTER :: logger
57  TYPE(distribution_1d_type), POINTER :: local_molecules
58  TYPE(molecule_kind_type), POINTER :: molecule_kind
59  TYPE(mp_para_env_type), POINTER :: para_env
60  TYPE(particle_type), POINTER :: particle_set(:)
61 
62  logger => cp_get_default_logger()
63 
64  particle_set => qs_loc_env%particle_set
65  para_env => qs_loc_env%para_env
66  local_molecules => qs_loc_env%local_molecules
67  nstate = SIZE(center, 2)
68  ALLOCATE (wfc_to_atom_map(nstate))
69  !---------------------------------------------------------------------------
70  !---------------------------------------------------------------------------
71  nkind = SIZE(local_molecules%n_el)
72  natom = 0
73  natom_max = 0
74  DO ikind = 1, nkind
75  nmol = SIZE(local_molecules%list(ikind)%array)
76  DO imol = 1, nmol
77  i = local_molecules%list(ikind)%array(imol)
78  molecule_kind => molecule_set(i)%molecule_kind
79  CALL get_molecule_kind(molecule_kind=molecule_kind, natom=natom)
80  natom_max = natom_max + natom
81  IF (.NOT. ASSOCIATED(molecule_set(i)%lmi)) THEN
82  ALLOCATE (molecule_set(i)%lmi(nspins))
83  DO k = 1, nspins
84  NULLIFY (molecule_set(i)%lmi(k)%states)
85  END DO
86  END IF
87  molecule_set(i)%lmi(ispin)%nstates = 0
88  IF (ASSOCIATED(molecule_set(i)%lmi(ispin)%states)) THEN
89  DEALLOCATE (molecule_set(i)%lmi(ispin)%states)
90  END IF
91  END DO
92  END DO
93  natom_loc = natom_max
94  natom = natom_max
95 
96  CALL para_env%max(natom_max)
97 
98  ALLOCATE (r(3, natom_max))
99 
100  ALLOCATE (distance(natom_max))
101 
102  !Zero all the stuff
103  r(:, :) = 0.0_dp
104  distance(:) = 1.e10_dp
105 
106  !---------------------------------------------------------------------------
107  !---------------------------------------------------------------------------
108  counter = 0
109  nkind = SIZE(local_molecules%n_el)
110  DO ikind = 1, nkind
111  nmol = SIZE(local_molecules%list(ikind)%array)
112  DO imol = 1, nmol
113  i = local_molecules%list(ikind)%array(imol)
114  molecule_kind => molecule_set(i)%molecule_kind
115  first_atom = molecule_set(i)%first_atom
116  CALL get_molecule_kind(molecule_kind=molecule_kind, natom=natom)
117 
118  DO iatom = 1, natom
119  counter = counter + 1
120  r(:, counter) = particle_set(first_atom + iatom - 1)%r(:)
121  END DO
122  END DO
123  END DO
124 
125  !---------------------------------------------------------------------------
126  !---------------------------------------------------------------------------
127  DO istate = 1, nstate
128  distance(:) = 1.e10_dp
129  DO iatom = 1, natom_loc
130  dr(1) = r(1, iatom) - center(1, istate)
131  dr(2) = r(2, iatom) - center(2, istate)
132  dr(3) = r(3, iatom) - center(3, istate)
133  ria = pbc(dr, qs_loc_env%cell)
134  distance(iatom) = sqrt(dot_product(ria, ria))
135  END DO
136 
137  !combine distance() from all procs
138  local_location = max(1, minloc(distance, dim=1))
139 
140  mydist(1) = distance(local_location)
141  mydist(2) = para_env%mepos
142 
143  CALL para_env%minloc(mydist)
144 
145  IF (mydist(2) == para_env%mepos) THEN
146  wfc_to_atom_map(istate) = local_location
147  ELSE
148  wfc_to_atom_map(istate) = 0
149  END IF
150  END DO
151  !---------------------------------------------------------------------------
152  !---------------------------------------------------------------------------
153  IF (natom_loc /= 0) THEN
154  DO istate = 1, nstate
155  iatom = wfc_to_atom_map(istate)
156  IF (iatom /= 0) THEN
157  counter = 0
158  nkind = SIZE(local_molecules%n_el)
159  DO ikind = 1, nkind
160  nmol = SIZE(local_molecules%list(ikind)%array)
161  DO imol = 1, nmol
162  imol_now = local_molecules%list(ikind)%array(imol)
163  molecule_kind => molecule_set(imol_now)%molecule_kind
164  CALL get_molecule_kind(molecule_kind=molecule_kind, natom=natom)
165  counter = counter + natom
166  IF (counter >= iatom) EXIT
167  END DO
168  IF (counter >= iatom) EXIT
169  END DO
170  i = molecule_set(imol_now)%lmi(ispin)%nstates
171  i = i + 1
172  molecule_set(imol_now)%lmi(ispin)%nstates = i
173  CALL reallocate(molecule_set(imol_now)%lmi(ispin)%states, 1, i)
174  molecule_set(imol_now)%lmi(ispin)%states(i) = istate
175  END IF
176  END DO
177  END IF
178 
179  DEALLOCATE (distance)
180  DEALLOCATE (r)
181  DEALLOCATE (wfc_to_atom_map)
182 
183  END SUBROUTINE wfc_to_molecule
184  !------------------------------------------------------------------------------
185 
186 END MODULE qs_loc_molecules
187 
subroutine pbc(r, r_pbc, s, s_pbc, a, b, c, alpha, beta, gamma, debug, info, pbc0, h, hinv)
...
Definition: dumpdcd.F:1203
Handles all functions related to the CELL.
Definition: cell_types.F:15
various routines to log and control the output. The idea is that decisions about where to log should ...
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
stores a lists of integer that are local to a processor. The idea is that these integers represent ob...
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public dp
Definition: kinds.F:34
Utility routines for the memory handling.
Interface to the message passing library MPI.
Define the molecule kind structure types and the corresponding functionality.
subroutine, public get_molecule_kind(molecule_kind, atom_list, bond_list, bend_list, ub_list, impr_list, opbend_list, colv_list, fixd_list, g3x3_list, g4x6_list, vsite_list, torsion_list, shell_list, name, mass, charge, kind_number, natom, nbend, nbond, nub, nimpr, nopbend, nconstraint, nconstraint_fixd, nfixd, ncolv, ng3x3, ng4x6, nvsite, nfixd_restraint, ng3x3_restraint, ng4x6_restraint, nvsite_restraint, nrestraints, nmolecule, nsgf, nshell, ntorsion, molecule_list, nelectron, nelectron_alpha, nelectron_beta, bond_kind_set, bend_kind_set, ub_kind_set, impr_kind_set, opbend_kind_set, torsion_kind_set, molname_generated)
Get informations about a molecule kind.
Define the data structure for the molecule information.
Define the data structure for the particle information.
Set of routines handling the localization for molecular properties.
subroutine, public wfc_to_molecule(qs_loc_env, center, molecule_set, ispin, nspins)
maps wfc's to molecules and also prints molecular dipoles
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