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 Define the data structure for the molecule information.
10 : !> \par History
11 : !> JGH (22.05.2004) add last_atom information
12 : !> Teodoro Laino [tlaino] 12.2008 - Preparing for VIRTUAL SITE constraints
13 : !> (patch by Marcel Baer)
14 : !> \author Matthias Krack (29.08.2003)
15 : ! **************************************************************************************************
16 : MODULE molecule_types
17 :
18 : USE colvar_types, ONLY: colvar_counters,&
19 : colvar_release,&
20 : colvar_type
21 : USE kinds, ONLY: dp
22 : USE molecule_kind_types, ONLY: colvar_constraint_type,&
23 : fixd_constraint_type,&
24 : g3x3_constraint_type,&
25 : g4x6_constraint_type,&
26 : get_molecule_kind,&
27 : molecule_kind_type,&
28 : vsite_constraint_type
29 : #include "../base/base_uses.f90"
30 :
31 : IMPLICIT NONE
32 :
33 : PRIVATE
34 :
35 : ! Global parameters (in this module)
36 :
37 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'molecule_types'
38 :
39 : ! Molecular constraint types
40 : TYPE local_colvar_constraint_type
41 : TYPE(colvar_type), POINTER :: colvar => NULL(), &
42 : colvar_old => NULL()
43 : REAL(KIND=dp) :: lambda = 0.0_dp, &
44 : sigma = 0.0_dp
45 : LOGICAL :: init = .FALSE.
46 : END TYPE local_colvar_constraint_type
47 :
48 : TYPE local_g3x3_constraint_type
49 : LOGICAL :: init = .FALSE.
50 : REAL(KIND=dp) :: scale = 0.0_dp, &
51 : imass1 = 0.0_dp, &
52 : imass2 = 0.0_dp, &
53 : imass3 = 0.0_dp, &
54 : scale_old = 0.0_dp
55 : REAL(KIND=dp), DIMENSION(3) :: fa = 0.0_dp, &
56 : fb = 0.0_dp, &
57 : fc = 0.0_dp, &
58 : f_roll1 = 0.0_dp, &
59 : f_roll2 = 0.0_dp, &
60 : f_roll3 = 0.0_dp, &
61 : ra_old = 0.0_dp, &
62 : rb_old = 0.0_dp, &
63 : rc_old = 0.0_dp, &
64 : r0_12 = 0.0_dp, &
65 : r0_13 = 0.0_dp, &
66 : r0_23 = 0.0_dp, &
67 : va = 0.0_dp, &
68 : vb = 0.0_dp, &
69 : vc = 0.0_dp, &
70 : del_lambda = 0.0_dp, &
71 : lambda = 0.0_dp, &
72 : lambda_old = 0.0_dp
73 : REAL(KIND=dp), DIMENSION(3, 3) :: amat = 0.0_dp
74 : END TYPE local_g3x3_constraint_type
75 :
76 : TYPE local_g4x6_constraint_type
77 : LOGICAL :: init = .FALSE.
78 : REAL(KIND=dp) :: scale = 0.0_dp, &
79 : scale_old = 0.0_dp, &
80 : imass1 = 0.0_dp, &
81 : imass2 = 0.0_dp, &
82 : imass3 = 0.0_dp, &
83 : imass4 = 0.0_dp
84 : REAL(KIND=dp), DIMENSION(3) :: fa = 0.0_dp, &
85 : fb = 0.0_dp, &
86 : fc = 0.0_dp, &
87 : fd = 0.0_dp, &
88 : fe = 0.0_dp, &
89 : ff = 0.0_dp, &
90 : f_roll1 = 0.0_dp, &
91 : f_roll2 = 0.0_dp, &
92 : f_roll3 = 0.0_dp, &
93 : f_roll4 = 0.0_dp, &
94 : f_roll5 = 0.0_dp, &
95 : f_roll6 = 0.0_dp, &
96 : ra_old = 0.0_dp, &
97 : rb_old = 0.0_dp, &
98 : rc_old = 0.0_dp, &
99 : rd_old = 0.0_dp, &
100 : re_old = 0.0_dp, &
101 : rf_old = 0.0_dp, &
102 : va = 0.0_dp, &
103 : vb = 0.0_dp, &
104 : vc = 0.0_dp, &
105 : vd = 0.0_dp, &
106 : ve = 0.0_dp, &
107 : vf = 0.0_dp, &
108 : r0_12 = 0.0_dp, &
109 : r0_13 = 0.0_dp, &
110 : r0_14 = 0.0_dp, &
111 : r0_23 = 0.0_dp, &
112 : r0_24 = 0.0_dp, &
113 : r0_34 = 0.0_dp
114 : REAL(KIND=dp), DIMENSION(6) :: del_lambda = 0.0_dp, &
115 : lambda = 0.0_dp, &
116 : lambda_old = 0.0_dp
117 : REAL(KIND=dp), DIMENSION(6, 6) :: amat = 0.0_dp
118 : END TYPE local_g4x6_constraint_type
119 :
120 : TYPE local_states_type
121 : INTEGER :: nstates = 0 ! Kohn-Sham states for molecule
122 : INTEGER, DIMENSION(:), POINTER :: states => NULL() ! indices of Kohn-Sham states for molecule
123 : END TYPE local_states_type
124 :
125 : TYPE local_constraint_type
126 : TYPE(local_colvar_constraint_type), &
127 : DIMENSION(:), POINTER :: lcolv => NULL()
128 : TYPE(local_g3x3_constraint_type), DIMENSION(:), &
129 : POINTER :: lg3x3 => NULL()
130 : TYPE(local_g4x6_constraint_type), DIMENSION(:), &
131 : POINTER :: lg4x6 => NULL()
132 : END TYPE local_constraint_type
133 :
134 : TYPE global_constraint_type
135 : TYPE(colvar_counters) :: ncolv = colvar_counters()
136 : INTEGER :: ntot = 0, &
137 : nrestraint = 0, &
138 : ng3x3 = 0, &
139 : ng3x3_restraint = 0, &
140 : ng4x6 = 0, &
141 : ng4x6_restraint = 0, &
142 : nvsite = 0, &
143 : nvsite_restraint = 0
144 : TYPE(fixd_constraint_type), DIMENSION(:), POINTER :: fixd_list => NULL()
145 : TYPE(colvar_constraint_type), DIMENSION(:), &
146 : POINTER :: colv_list => NULL()
147 : TYPE(g3x3_constraint_type), DIMENSION(:), POINTER :: g3x3_list => NULL()
148 : TYPE(g4x6_constraint_type), DIMENSION(:), POINTER :: g4x6_list => NULL()
149 : TYPE(vsite_constraint_type), DIMENSION(:), POINTER :: vsite_list => NULL()
150 : TYPE(local_colvar_constraint_type), &
151 : DIMENSION(:), POINTER :: lcolv => NULL()
152 : TYPE(local_g3x3_constraint_type), DIMENSION(:), &
153 : POINTER :: lg3x3 => NULL()
154 : TYPE(local_g4x6_constraint_type), DIMENSION(:), &
155 : POINTER :: lg4x6 => NULL()
156 : END TYPE global_constraint_type
157 :
158 : ! Molecule type
159 : TYPE molecule_type
160 : TYPE(molecule_kind_type), POINTER :: molecule_kind => NULL() ! pointer to molecule kind information
161 : TYPE(local_states_type), DIMENSION(:), POINTER :: lmi => NULL() ! local (spin)-states information
162 : TYPE(local_constraint_type), POINTER :: lci => NULL() ! local molecule constraint info
163 : INTEGER :: first_atom = 0 ! global index of first atom in molecule
164 : INTEGER :: last_atom = 0 ! global index of last atom in molecule
165 : INTEGER :: first_shell = 0 ! global index of first shell atom in molecule
166 : INTEGER :: last_shell = 0 ! global index of last shell atom in molecule
167 : END TYPE molecule_type
168 :
169 : ! Public data types
170 :
171 : PUBLIC :: local_colvar_constraint_type, &
172 : local_g3x3_constraint_type, &
173 : local_g4x6_constraint_type, &
174 : local_constraint_type, &
175 : local_states_type, &
176 : global_constraint_type, &
177 : molecule_type
178 :
179 : ! Public subroutines
180 :
181 : PUBLIC :: deallocate_global_constraint, &
182 : allocate_molecule_set, &
183 : deallocate_molecule_set, &
184 : get_molecule, &
185 : set_molecule, &
186 : set_molecule_set, &
187 : molecule_of_atom, &
188 : get_molecule_set_info
189 :
190 : CONTAINS
191 :
192 : ! **************************************************************************************************
193 : !> \brief Deallocate a global constraint.
194 : !> \param gci ...
195 : !> \par History
196 : !> 07.2003 created [fawzi]
197 : !> 01.2014 moved from cp_subsys_release() into separate routine.
198 : !> \author Ole Schuett
199 : ! **************************************************************************************************
200 10274 : SUBROUTINE deallocate_global_constraint(gci)
201 : TYPE(global_constraint_type), POINTER :: gci
202 :
203 : INTEGER :: i
204 :
205 10274 : IF (ASSOCIATED(gci)) THEN
206 : ! List of constraints
207 9736 : IF (ASSOCIATED(gci%colv_list)) THEN
208 110 : DO i = 1, SIZE(gci%colv_list)
209 110 : DEALLOCATE (gci%colv_list(i)%i_atoms)
210 : END DO
211 44 : DEALLOCATE (gci%colv_list)
212 : END IF
213 :
214 9736 : IF (ASSOCIATED(gci%g3x3_list)) &
215 4 : DEALLOCATE (gci%g3x3_list)
216 :
217 9736 : IF (ASSOCIATED(gci%g4x6_list)) &
218 4 : DEALLOCATE (gci%g4x6_list)
219 :
220 : ! Local information
221 9736 : IF (ASSOCIATED(gci%lcolv)) THEN
222 110 : DO i = 1, SIZE(gci%lcolv)
223 66 : CALL colvar_release(gci%lcolv(i)%colvar)
224 110 : CALL colvar_release(gci%lcolv(i)%colvar_old)
225 : END DO
226 44 : DEALLOCATE (gci%lcolv)
227 : END IF
228 :
229 9736 : IF (ASSOCIATED(gci%lg3x3)) &
230 4 : DEALLOCATE (gci%lg3x3)
231 :
232 9736 : IF (ASSOCIATED(gci%lg4x6)) &
233 4 : DEALLOCATE (gci%lg4x6)
234 :
235 9736 : IF (ASSOCIATED(gci%fixd_list)) &
236 2 : DEALLOCATE (gci%fixd_list)
237 :
238 9736 : DEALLOCATE (gci)
239 : END IF
240 10274 : END SUBROUTINE deallocate_global_constraint
241 :
242 : ! **************************************************************************************************
243 : !> \brief Allocate a molecule set.
244 : !> \param molecule_set ...
245 : !> \param nmolecule ...
246 : !> \date 29.08.2003
247 : !> \author Matthias Krack
248 : !> \version 1.0
249 : ! **************************************************************************************************
250 10274 : SUBROUTINE allocate_molecule_set(molecule_set, nmolecule)
251 : TYPE(molecule_type), DIMENSION(:), POINTER :: molecule_set
252 : INTEGER, INTENT(IN) :: nmolecule
253 :
254 10274 : IF (ASSOCIATED(molecule_set)) CALL deallocate_molecule_set(molecule_set)
255 :
256 336094 : ALLOCATE (molecule_set(nmolecule))
257 :
258 10274 : END SUBROUTINE allocate_molecule_set
259 :
260 : ! **************************************************************************************************
261 : !> \brief Deallocate a molecule set.
262 : !> \param molecule_set ...
263 : !> \date 29.08.2003
264 : !> \author Matthias Krack
265 : !> \version 1.0
266 : ! **************************************************************************************************
267 10274 : SUBROUTINE deallocate_molecule_set(molecule_set)
268 : TYPE(molecule_type), DIMENSION(:), POINTER :: molecule_set
269 :
270 : INTEGER :: imolecule, j
271 :
272 10274 : IF (ASSOCIATED(molecule_set)) THEN
273 :
274 315546 : DO imolecule = 1, SIZE(molecule_set)
275 305272 : IF (ASSOCIATED(molecule_set(imolecule)%lmi)) THEN
276 49 : DO j = 1, SIZE(molecule_set(imolecule)%lmi)
277 49 : IF (ASSOCIATED(molecule_set(imolecule)%lmi(j)%states)) THEN
278 28 : DEALLOCATE (molecule_set(imolecule)%lmi(j)%states)
279 : END IF
280 : END DO
281 21 : DEALLOCATE (molecule_set(imolecule)%lmi)
282 : END IF
283 315546 : IF (ASSOCIATED(molecule_set(imolecule)%lci)) THEN
284 43692 : IF (ASSOCIATED(molecule_set(imolecule)%lci%lcolv)) THEN
285 4336 : DO j = 1, SIZE(molecule_set(imolecule)%lci%lcolv)
286 2228 : CALL colvar_release(molecule_set(imolecule)%lci%lcolv(j)%colvar)
287 4336 : CALL colvar_release(molecule_set(imolecule)%lci%lcolv(j)%colvar_old)
288 : END DO
289 2108 : DEALLOCATE (molecule_set(imolecule)%lci%lcolv)
290 : END IF
291 43692 : IF (ASSOCIATED(molecule_set(imolecule)%lci%lg3x3)) THEN
292 36354 : DEALLOCATE (molecule_set(imolecule)%lci%lg3x3)
293 : END IF
294 43692 : IF (ASSOCIATED(molecule_set(imolecule)%lci%lg4x6)) THEN
295 650 : DEALLOCATE (molecule_set(imolecule)%lci%lg4x6)
296 : END IF
297 43692 : DEALLOCATE (molecule_set(imolecule)%lci)
298 : END IF
299 : END DO
300 10274 : DEALLOCATE (molecule_set)
301 :
302 : END IF
303 10274 : NULLIFY (molecule_set)
304 :
305 10274 : END SUBROUTINE deallocate_molecule_set
306 :
307 : ! **************************************************************************************************
308 : !> \brief Get components from a molecule data set.
309 : !> \param molecule ...
310 : !> \param molecule_kind ...
311 : !> \param lmi ...
312 : !> \param lci ...
313 : !> \param lg3x3 ...
314 : !> \param lg4x6 ...
315 : !> \param lcolv ...
316 : !> \param first_atom ...
317 : !> \param last_atom ...
318 : !> \param first_shell ...
319 : !> \param last_shell ...
320 : !> \date 29.08.2003
321 : !> \author Matthias Krack
322 : !> \version 1.0
323 : ! **************************************************************************************************
324 8865165 : SUBROUTINE get_molecule(molecule, molecule_kind, lmi, lci, lg3x3, lg4x6, lcolv, &
325 : first_atom, last_atom, first_shell, last_shell)
326 :
327 : TYPE(molecule_type), INTENT(IN) :: molecule
328 : TYPE(molecule_kind_type), OPTIONAL, POINTER :: molecule_kind
329 : TYPE(local_states_type), DIMENSION(:), OPTIONAL, &
330 : POINTER :: lmi
331 : TYPE(local_constraint_type), OPTIONAL, POINTER :: lci
332 : TYPE(local_g3x3_constraint_type), OPTIONAL, &
333 : POINTER :: lg3x3(:)
334 : TYPE(local_g4x6_constraint_type), OPTIONAL, &
335 : POINTER :: lg4x6(:)
336 : TYPE(local_colvar_constraint_type), DIMENSION(:), &
337 : OPTIONAL, POINTER :: lcolv
338 : INTEGER, OPTIONAL :: first_atom, last_atom, first_shell, &
339 : last_shell
340 :
341 8865165 : IF (PRESENT(first_atom)) first_atom = molecule%first_atom
342 8865165 : IF (PRESENT(last_atom)) last_atom = molecule%last_atom
343 8865165 : IF (PRESENT(first_shell)) first_shell = molecule%first_shell
344 8865165 : IF (PRESENT(last_shell)) last_shell = molecule%last_shell
345 8865165 : IF (PRESENT(molecule_kind)) molecule_kind => molecule%molecule_kind
346 8865165 : IF (PRESENT(lmi)) lmi => molecule%lmi
347 8865165 : IF (PRESENT(lci)) lci => molecule%lci
348 8865165 : IF (PRESENT(lcolv)) THEN
349 928471 : IF (ASSOCIATED(molecule%lci)) THEN
350 928471 : lcolv => molecule%lci%lcolv
351 : ELSE
352 0 : CPABORT("The pointer lci is not associated")
353 : END IF
354 : END IF
355 8865165 : IF (PRESENT(lg3x3)) THEN
356 1530904 : IF (ASSOCIATED(molecule%lci)) THEN
357 1530904 : lg3x3 => molecule%lci%lg3x3
358 : ELSE
359 0 : CPABORT("The pointer lci is not associated")
360 : END IF
361 : END IF
362 8865165 : IF (PRESENT(lg4x6)) THEN
363 885788 : IF (ASSOCIATED(molecule%lci)) THEN
364 885788 : lg4x6 => molecule%lci%lg4x6
365 : ELSE
366 0 : CPABORT("The pointer lci is not associated")
367 : END IF
368 : END IF
369 :
370 8865165 : END SUBROUTINE get_molecule
371 :
372 : ! **************************************************************************************************
373 : !> \brief Set a molecule data set.
374 : !> \param molecule ...
375 : !> \param molecule_kind ...
376 : !> \param lmi ...
377 : !> \param lci ...
378 : !> \param lcolv ...
379 : !> \param lg3x3 ...
380 : !> \param lg4x6 ...
381 : !> \date 29.08.2003
382 : !> \author Matthias Krack
383 : !> \version 1.0
384 : ! **************************************************************************************************
385 951216 : SUBROUTINE set_molecule(molecule, molecule_kind, lmi, lci, lcolv, lg3x3, lg4x6)
386 : TYPE(molecule_type), INTENT(INOUT) :: molecule
387 : TYPE(molecule_kind_type), OPTIONAL, POINTER :: molecule_kind
388 : TYPE(local_states_type), DIMENSION(:), OPTIONAL, &
389 : POINTER :: lmi
390 : TYPE(local_constraint_type), OPTIONAL, POINTER :: lci
391 : TYPE(local_colvar_constraint_type), DIMENSION(:), &
392 : OPTIONAL, POINTER :: lcolv
393 : TYPE(local_g3x3_constraint_type), OPTIONAL, &
394 : POINTER :: lg3x3(:)
395 : TYPE(local_g4x6_constraint_type), OPTIONAL, &
396 : POINTER :: lg4x6(:)
397 :
398 951216 : IF (PRESENT(molecule_kind)) molecule%molecule_kind => molecule_kind
399 951216 : IF (PRESENT(lmi)) molecule%lmi => lmi
400 951216 : IF (PRESENT(lci)) molecule%lci => lci
401 951216 : IF (PRESENT(lcolv)) THEN
402 2108 : IF (ASSOCIATED(molecule%lci)) THEN
403 2108 : molecule%lci%lcolv => lcolv
404 : ELSE
405 0 : CPABORT("The pointer lci is not associated")
406 : END IF
407 : END IF
408 951216 : IF (PRESENT(lg3x3)) THEN
409 36354 : IF (ASSOCIATED(molecule%lci)) THEN
410 36354 : molecule%lci%lg3x3 => lg3x3
411 : ELSE
412 0 : CPABORT("The pointer lci is not associated")
413 : END IF
414 : END IF
415 951216 : IF (PRESENT(lg4x6)) THEN
416 650 : IF (ASSOCIATED(molecule%lci)) THEN
417 650 : molecule%lci%lg4x6 => lg4x6
418 : ELSE
419 0 : CPABORT("The pointer lci is not associated")
420 : END IF
421 : END IF
422 :
423 951216 : END SUBROUTINE set_molecule
424 :
425 : ! **************************************************************************************************
426 : !> \brief Set a molecule data set.
427 : !> \param molecule_set ...
428 : !> \param first_atom ...
429 : !> \param last_atom ...
430 : !> \date 29.08.2003
431 : !> \author Matthias Krack
432 : !> \version 1.0
433 : ! **************************************************************************************************
434 10274 : SUBROUTINE set_molecule_set(molecule_set, first_atom, last_atom)
435 : TYPE(molecule_type), DIMENSION(:), INTENT(INOUT) :: molecule_set
436 : INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: first_atom, last_atom
437 :
438 : INTEGER :: imolecule
439 :
440 10274 : IF (PRESENT(first_atom)) THEN
441 10274 : IF (SIZE(first_atom) /= SIZE(molecule_set)) THEN
442 : CALL cp_abort(__LOCATION__, &
443 : "The sizes of first_atom and molecule_set "// &
444 0 : "are different")
445 : END IF
446 :
447 315546 : DO imolecule = 1, SIZE(molecule_set)
448 315546 : molecule_set(imolecule)%first_atom = first_atom(imolecule)
449 : END DO
450 : END IF
451 :
452 10274 : IF (PRESENT(last_atom)) THEN
453 10274 : IF (SIZE(last_atom) /= SIZE(molecule_set)) THEN
454 : CALL cp_abort(__LOCATION__, &
455 : "The sizes of last_atom and molecule_set "// &
456 0 : "are different")
457 : END IF
458 :
459 315546 : DO imolecule = 1, SIZE(molecule_set)
460 315546 : molecule_set(imolecule)%last_atom = last_atom(imolecule)
461 : END DO
462 : END IF
463 :
464 10274 : END SUBROUTINE set_molecule_set
465 :
466 : ! **************************************************************************************************
467 : !> \brief finds for each atom the molecule it belongs to
468 : !> \param molecule_set ...
469 : !> \param atom_to_mol ...
470 : ! **************************************************************************************************
471 458 : SUBROUTINE molecule_of_atom(molecule_set, atom_to_mol)
472 : TYPE(molecule_type), DIMENSION(:), INTENT(IN) :: molecule_set
473 : INTEGER, DIMENSION(:), INTENT(OUT) :: atom_to_mol
474 :
475 : INTEGER :: first_atom, iatom, imol, last_atom
476 :
477 3090 : DO imol = 1, SIZE(molecule_set)
478 2632 : CALL get_molecule(molecule=molecule_set(imol), first_atom=first_atom, last_atom=last_atom)
479 9038 : DO iatom = first_atom, last_atom
480 8580 : atom_to_mol(iatom) = imol
481 : END DO ! iatom
482 : END DO ! imol
483 :
484 458 : END SUBROUTINE molecule_of_atom
485 :
486 : ! **************************************************************************************************
487 : !> \brief returns information about molecules in the set.
488 : !> \param molecule_set ...
489 : !> \param atom_to_mol ...
490 : !> \param mol_to_first_atom ...
491 : !> \param mol_to_last_atom ...
492 : !> \param mol_to_nelectrons ...
493 : !> \param mol_to_nbasis ...
494 : !> \param mol_to_charge ...
495 : !> \param mol_to_multiplicity ...
496 : !> \par History
497 : !> 2011.06 created [Rustam Z Khaliullin]
498 : !> \author Rustam Z Khaliullin
499 : ! **************************************************************************************************
500 726 : SUBROUTINE get_molecule_set_info(molecule_set, atom_to_mol, mol_to_first_atom, &
501 726 : mol_to_last_atom, mol_to_nelectrons, mol_to_nbasis, mol_to_charge, &
502 242 : mol_to_multiplicity)
503 :
504 : TYPE(molecule_type), DIMENSION(:), INTENT(IN) :: molecule_set
505 : INTEGER, DIMENSION(:), INTENT(OUT), OPTIONAL :: atom_to_mol, mol_to_first_atom, &
506 : mol_to_last_atom, mol_to_nelectrons, mol_to_nbasis, mol_to_charge, mol_to_multiplicity
507 :
508 : INTEGER :: first_atom, iatom, imol, last_atom, &
509 : nbasis, nelec
510 : REAL(KIND=dp) :: charge
511 : TYPE(molecule_kind_type), POINTER :: imol_kind
512 :
513 1894 : DO imol = 1, SIZE(molecule_set)
514 :
515 : CALL get_molecule(molecule=molecule_set(imol), molecule_kind=imol_kind, &
516 1652 : first_atom=first_atom, last_atom=last_atom)
517 :
518 1652 : IF (PRESENT(mol_to_nelectrons)) THEN
519 810 : CALL get_molecule_kind(imol_kind, nelectron=nelec)
520 810 : mol_to_nelectrons(imol) = nelec
521 : END IF
522 :
523 1652 : IF (PRESENT(mol_to_multiplicity)) THEN
524 : ! RZK-warning: At the moment we can only get the total number
525 : ! of electrons (alpha+beta) and we do not have a way to get the multiplicity of mols.
526 : ! Therefore, the best we can do is to assume the singlet state for even number of electrons
527 : ! and doublet state for odd number of electrons (assume ne_alpha > ne_beta).
528 : ! The best way to implement a correct multiplicity subroutine in the future is to get
529 : ! the number of alpha and beta e- for each atom from init_atom_electronic_state. This way (as opposed to
530 : ! reading the multiplicities from file) the number of occupied and virtual orbitals
531 : ! will be consistent with atomic guess. A guess with broken symmetry will be easy to
532 : ! implement as well.
533 842 : CALL get_molecule_kind(imol_kind, nelectron=nelec)
534 842 : IF (MOD(nelec, 2) == 0) THEN
535 838 : mol_to_multiplicity(imol) = 1
536 : ELSE
537 4 : mol_to_multiplicity(imol) = 2
538 : END IF
539 : END IF
540 :
541 1652 : IF (PRESENT(mol_to_charge)) THEN
542 842 : CALL get_molecule_kind(imol_kind, charge=charge)
543 842 : mol_to_charge(imol) = NINT(charge)
544 : END IF
545 :
546 1652 : IF (PRESENT(mol_to_nbasis)) THEN
547 810 : CALL get_molecule_kind(imol_kind, nsgf=nbasis)
548 810 : mol_to_nbasis(imol) = nbasis
549 : END IF
550 :
551 1652 : IF (PRESENT(mol_to_first_atom)) THEN
552 1652 : mol_to_first_atom(imol) = first_atom
553 : END IF
554 :
555 1652 : IF (PRESENT(mol_to_last_atom)) THEN
556 1652 : mol_to_last_atom(imol) = last_atom
557 : END IF
558 :
559 1894 : IF (PRESENT(atom_to_mol)) THEN
560 2766 : DO iatom = first_atom, last_atom
561 2766 : atom_to_mol(iatom) = imol
562 : END DO ! iatom
563 : END IF
564 :
565 : END DO ! imol
566 :
567 242 : END SUBROUTINE get_molecule_set_info
568 :
569 0 : END MODULE molecule_types
|
