Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief types that represent a quickstep subsys
10 : !> \author Ole Schuett
11 : ! **************************************************************************************************
12 : MODULE qs_subsys_types
13 : USE atomic_kind_list_types, ONLY: atomic_kind_list_type
14 : USE atomic_kind_types, ONLY: atomic_kind_type
15 : USE atprop_types, ONLY: atprop_type
16 : USE cell_types, ONLY: cell_release,&
17 : cell_retain,&
18 : cell_type
19 : USE colvar_types, ONLY: colvar_p_type
20 : USE cp_result_types, ONLY: cp_result_type
21 : USE cp_subsys_types, ONLY: cp_subsys_get,&
22 : cp_subsys_release,&
23 : cp_subsys_retain,&
24 : cp_subsys_set,&
25 : cp_subsys_type
26 : USE distribution_1d_types, ONLY: distribution_1d_type
27 : USE message_passing, ONLY: mp_para_env_type
28 : USE molecule_kind_list_types, ONLY: molecule_kind_list_type
29 : USE molecule_kind_types, ONLY: molecule_kind_type
30 : USE molecule_list_types, ONLY: molecule_list_type
31 : USE molecule_types, ONLY: global_constraint_type,&
32 : molecule_type
33 : USE multipole_types, ONLY: multipole_type
34 : USE particle_list_types, ONLY: particle_list_type
35 : USE particle_types, ONLY: particle_type
36 : USE qs_energy_types, ONLY: deallocate_qs_energy,&
37 : qs_energy_type
38 : USE qs_force_types, ONLY: deallocate_qs_force,&
39 : qs_force_type
40 : USE qs_kind_types, ONLY: deallocate_qs_kind_set,&
41 : qs_kind_type
42 : USE virial_types, ONLY: virial_type
43 : #include "./base/base_uses.f90"
44 :
45 : IMPLICIT NONE
46 : PRIVATE
47 :
48 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_subsys_types'
49 :
50 : PUBLIC :: qs_subsys_type
51 :
52 : PUBLIC :: qs_subsys_release, &
53 : qs_subsys_get, &
54 : qs_subsys_set
55 :
56 : TYPE qs_subsys_type
57 : PRIVATE
58 : INTEGER :: nelectron_total = -1
59 : INTEGER :: nelectron_spin(2) = -1
60 : TYPE(cp_subsys_type), POINTER :: cp_subsys => Null()
61 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set => Null()
62 : TYPE(cell_type), POINTER :: cell_ref => Null()
63 : LOGICAL :: use_ref_cell = .FALSE.
64 : TYPE(qs_energy_type), POINTER :: energy => Null()
65 : TYPE(qs_force_type), DIMENSION(:), POINTER :: force => Null()
66 : END TYPE qs_subsys_type
67 :
68 : CONTAINS
69 :
70 : ! **************************************************************************************************
71 : !> \brief releases a subsys (see doc/ReferenceCounting.html)
72 : !> \param subsys the subsys to release
73 : !> \author Ole Schuett
74 : ! **************************************************************************************************
75 7420 : SUBROUTINE qs_subsys_release(subsys)
76 : TYPE(qs_subsys_type), INTENT(INOUT) :: subsys
77 :
78 7420 : CALL cp_subsys_release(subsys%cp_subsys)
79 7420 : CALL cell_release(subsys%cell_ref)
80 7420 : IF (ASSOCIATED(subsys%qs_kind_set)) &
81 7420 : CALL deallocate_qs_kind_set(subsys%qs_kind_set)
82 7420 : IF (ASSOCIATED(subsys%energy)) &
83 7420 : CALL deallocate_qs_energy(subsys%energy)
84 7420 : IF (ASSOCIATED(subsys%force)) &
85 2895 : CALL deallocate_qs_force(subsys%force)
86 :
87 7420 : END SUBROUTINE qs_subsys_release
88 :
89 : ! **************************************************************************************************
90 : !> \brief ...
91 : !> \param subsys ...
92 : !> \param atomic_kinds ...
93 : !> \param atomic_kind_set ...
94 : !> \param particles ...
95 : !> \param particle_set ...
96 : !> \param local_particles ...
97 : !> \param molecules ...
98 : !> \param molecule_set ...
99 : !> \param molecule_kinds ...
100 : !> \param molecule_kind_set ...
101 : !> \param local_molecules ...
102 : !> \param para_env ...
103 : !> \param colvar_p ...
104 : !> \param shell_particles ...
105 : !> \param core_particles ...
106 : !> \param gci ...
107 : !> \param multipoles ...
108 : !> \param natom ...
109 : !> \param nparticle ...
110 : !> \param ncore ...
111 : !> \param nshell ...
112 : !> \param nkind ...
113 : !> \param atprop ...
114 : !> \param virial ...
115 : !> \param results ...
116 : !> \param cell ...
117 : !> \param cell_ref ...
118 : !> \param use_ref_cell ...
119 : !> \param energy ...
120 : !> \param force ...
121 : !> \param qs_kind_set ...
122 : !> \param cp_subsys ...
123 : !> \param nelectron_total ...
124 : !> \param nelectron_spin ...
125 : ! **************************************************************************************************
126 10698188 : SUBROUTINE qs_subsys_get(subsys, atomic_kinds, atomic_kind_set, particles, particle_set, &
127 : local_particles, molecules, molecule_set, &
128 : molecule_kinds, molecule_kind_set, &
129 : local_molecules, para_env, colvar_p, &
130 : shell_particles, core_particles, gci, multipoles, &
131 : natom, nparticle, ncore, nshell, nkind, atprop, virial, &
132 : results, cell, cell_ref, use_ref_cell, energy, force, &
133 : qs_kind_set, cp_subsys, nelectron_total, nelectron_spin)
134 : TYPE(qs_subsys_type), INTENT(IN) :: subsys
135 : TYPE(atomic_kind_list_type), OPTIONAL, POINTER :: atomic_kinds
136 : TYPE(atomic_kind_type), DIMENSION(:), OPTIONAL, &
137 : POINTER :: atomic_kind_set
138 : TYPE(particle_list_type), OPTIONAL, POINTER :: particles
139 : TYPE(particle_type), DIMENSION(:), OPTIONAL, &
140 : POINTER :: particle_set
141 : TYPE(distribution_1d_type), OPTIONAL, POINTER :: local_particles
142 : TYPE(molecule_list_type), OPTIONAL, POINTER :: molecules
143 : TYPE(molecule_type), DIMENSION(:), OPTIONAL, &
144 : POINTER :: molecule_set
145 : TYPE(molecule_kind_list_type), OPTIONAL, POINTER :: molecule_kinds
146 : TYPE(molecule_kind_type), DIMENSION(:), OPTIONAL, &
147 : POINTER :: molecule_kind_set
148 : TYPE(distribution_1d_type), OPTIONAL, POINTER :: local_molecules
149 : TYPE(mp_para_env_type), OPTIONAL, POINTER :: para_env
150 : TYPE(colvar_p_type), DIMENSION(:), OPTIONAL, &
151 : POINTER :: colvar_p
152 : TYPE(particle_list_type), OPTIONAL, POINTER :: shell_particles, core_particles
153 : TYPE(global_constraint_type), OPTIONAL, POINTER :: gci
154 : TYPE(multipole_type), OPTIONAL, POINTER :: multipoles
155 : INTEGER, INTENT(out), OPTIONAL :: natom, nparticle, ncore, nshell, nkind
156 : TYPE(atprop_type), OPTIONAL, POINTER :: atprop
157 : TYPE(virial_type), OPTIONAL, POINTER :: virial
158 : TYPE(cp_result_type), OPTIONAL, POINTER :: results
159 : TYPE(cell_type), OPTIONAL, POINTER :: cell, cell_ref
160 : LOGICAL, OPTIONAL :: use_ref_cell
161 : TYPE(qs_energy_type), OPTIONAL, POINTER :: energy
162 : TYPE(qs_force_type), DIMENSION(:), OPTIONAL, &
163 : POINTER :: force
164 : TYPE(qs_kind_type), DIMENSION(:), OPTIONAL, &
165 : POINTER :: qs_kind_set
166 : TYPE(cp_subsys_type), OPTIONAL, POINTER :: cp_subsys
167 : INTEGER, OPTIONAL :: nelectron_total
168 : INTEGER, DIMENSION(2), OPTIONAL :: nelectron_spin
169 :
170 : CALL cp_subsys_get(subsys%cp_subsys, &
171 : atomic_kinds=atomic_kinds, &
172 : atomic_kind_set=atomic_kind_set, &
173 : particles=particles, &
174 : particle_set=particle_set, &
175 : local_particles=local_particles, &
176 : molecules=molecules, &
177 : molecule_set=molecule_set, &
178 : molecule_kinds=molecule_kinds, &
179 : molecule_kind_set=molecule_kind_set, &
180 : local_molecules=local_molecules, &
181 : para_env=para_env, &
182 : colvar_p=colvar_p, &
183 : shell_particles=shell_particles, &
184 : core_particles=core_particles, &
185 : gci=gci, &
186 : multipoles=multipoles, &
187 : natom=natom, &
188 : nkind=nkind, &
189 : nparticle=nparticle, &
190 : ncore=ncore, &
191 : nshell=nshell, &
192 : atprop=atprop, &
193 : virial=virial, &
194 : results=results, &
195 10698188 : cell=cell)
196 :
197 10698188 : IF (PRESENT(cell_ref)) cell_ref => subsys%cell_ref
198 10698188 : IF (PRESENT(use_ref_cell)) use_ref_cell = subsys%use_ref_cell
199 10698188 : IF (PRESENT(energy)) energy => subsys%energy
200 10698188 : IF (PRESENT(force)) force => subsys%force
201 10698188 : IF (PRESENT(qs_kind_set)) qs_kind_set => subsys%qs_kind_set
202 10698188 : IF (PRESENT(cp_subsys)) cp_subsys => subsys%cp_subsys
203 10698188 : IF (PRESENT(nelectron_total)) nelectron_total = subsys%nelectron_total
204 10725899 : IF (PRESENT(nelectron_spin)) nelectron_spin = subsys%nelectron_spin
205 10698188 : END SUBROUTINE qs_subsys_get
206 :
207 : ! **************************************************************************************************
208 : !> \brief ...
209 : !> \param subsys ...
210 : !> \param cp_subsys ...
211 : !> \param local_particles ...
212 : !> \param local_molecules ...
213 : !> \param cell ...
214 : !> \param cell_ref ...
215 : !> \param use_ref_cell ...
216 : !> \param energy ...
217 : !> \param force ...
218 : !> \param qs_kind_set ...
219 : !> \param nelectron_total ...
220 : !> \param nelectron_spin ...
221 : ! **************************************************************************************************
222 34815 : SUBROUTINE qs_subsys_set(subsys, cp_subsys, &
223 : local_particles, local_molecules, cell, &
224 : cell_ref, use_ref_cell, energy, force, &
225 : qs_kind_set, nelectron_total, nelectron_spin)
226 : TYPE(qs_subsys_type), INTENT(INOUT) :: subsys
227 : TYPE(cp_subsys_type), OPTIONAL, POINTER :: cp_subsys
228 : TYPE(distribution_1d_type), OPTIONAL, POINTER :: local_particles, local_molecules
229 : TYPE(cell_type), OPTIONAL, POINTER :: cell, cell_ref
230 : LOGICAL, OPTIONAL :: use_ref_cell
231 : TYPE(qs_energy_type), OPTIONAL, POINTER :: energy
232 : TYPE(qs_force_type), DIMENSION(:), OPTIONAL, &
233 : POINTER :: force
234 : TYPE(qs_kind_type), DIMENSION(:), OPTIONAL, &
235 : POINTER :: qs_kind_set
236 : INTEGER, OPTIONAL :: nelectron_total
237 : INTEGER, DIMENSION(2), OPTIONAL :: nelectron_spin
238 :
239 34815 : IF (PRESENT(cp_subsys)) THEN
240 7420 : CALL cp_subsys_retain(cp_subsys)
241 7420 : CALL cp_subsys_release(subsys%cp_subsys)
242 7420 : subsys%cp_subsys => cp_subsys
243 : END IF
244 :
245 : CALL cp_subsys_set(subsys%cp_subsys, &
246 : local_particles=local_particles, &
247 : local_molecules=local_molecules, &
248 34815 : cell=cell)
249 :
250 34815 : IF (PRESENT(cell_ref)) THEN
251 14824 : CALL cell_retain(cell_ref)
252 14824 : CALL cell_release(subsys%cell_ref)
253 14824 : subsys%cell_ref => cell_ref
254 : END IF
255 :
256 34815 : IF (PRESENT(use_ref_cell)) subsys%use_ref_cell = use_ref_cell
257 34815 : IF (PRESENT(energy)) subsys%energy => energy
258 : ! if intels checking (-C) complains here, you have rediscovered a bug in the intel
259 : ! compiler (present in at least 10.0.025). A testcase has been submitted to intel.
260 34815 : IF (PRESENT(force)) subsys%force => force
261 34815 : IF (PRESENT(qs_kind_set)) subsys%qs_kind_set => qs_kind_set
262 34815 : IF (PRESENT(nelectron_total)) subsys%nelectron_total = nelectron_total
263 57027 : IF (PRESENT(nelectron_spin)) subsys%nelectron_spin = nelectron_spin
264 34815 : END SUBROUTINE qs_subsys_set
265 :
266 0 : END MODULE qs_subsys_types
|
