(git:0de0cc2)
topology_multiple_unit_cell.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 Handles the multiple unit cell option regarding atomic coordinates
10 !> \author Teodoro Laino [tlaino] - 05.2009
11 ! **************************************************************************************************
13  USE cell_types, ONLY: cell_type
17  section_vals_type,&
20  USE kinds, ONLY: default_string_length,&
21  dp
22  USE memory_utilities, ONLY: reallocate
24 #include "./base/base_uses.f90"
25 
26  IMPLICIT NONE
27 
28  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'topology_multiple_unit_cell'
29 
30  PRIVATE
31 
32 ! *** Public parameters ***
33  PUBLIC :: topology_muc
34 
35 CONTAINS
36 
37 ! **************************************************************************************************
38 !> \brief Handles the multiple_unit_cell for the atomic coordinates..
39 !> \param topology ...
40 !> \param subsys_section ...
41 !> \author Teodoro Laino [tlaino] - 05.2009
42 ! **************************************************************************************************
43  SUBROUTINE topology_muc(topology, subsys_section)
44  TYPE(topology_parameters_type), INTENT(INOUT) :: topology
45  TYPE(section_vals_type), POINTER :: subsys_section
46 
47  CHARACTER(len=*), PARAMETER :: routinen = 'topology_muc'
48 
49  CHARACTER(LEN=default_string_length) :: unit_str
50  INTEGER :: handle, i, ind, j, k, m, n, natoms, nrep
51  INTEGER, DIMENSION(:), POINTER :: iwork, multiple_unit_cell
52  LOGICAL :: check, explicit, scale
53  REAL(kind=dp), DIMENSION(3) :: trsl, trsl_i, trsl_j, trsl_k
54  TYPE(cell_type), POINTER :: cell
55  TYPE(section_vals_type), POINTER :: work_section
56 
57  CALL timeset(routinen, handle)
58  NULLIFY (multiple_unit_cell, iwork, cell)
59  CALL section_vals_val_get(subsys_section, "TOPOLOGY%MULTIPLE_UNIT_CELL", &
60  i_vals=multiple_unit_cell)
61  ! Fail is one of the value is set to zero..
62  IF (any(multiple_unit_cell <= 0)) &
63  CALL cp_abort(__location__, "SUBSYS%TOPOLOGY%MULTIPLE_UNIT_CELL accepts "// &
64  "only integer values larger than 0! A value of 0 or negative is meaningless!")
65  IF (any(multiple_unit_cell /= 1)) THEN
66  ! Check that the setup between CELL and TOPOLOGY is the same..
67  CALL section_vals_val_get(subsys_section, "CELL%MULTIPLE_UNIT_CELL", &
68  i_vals=iwork)
69  IF (any(iwork /= multiple_unit_cell)) &
70  CALL cp_abort(__location__, "SUBSYS%TOPOLOGY%MULTIPLE_UNIT_CELL and "// &
71  "SUBSYS%CELL%MULTIPLE_UNIT_CELL have been "// &
72  "setup to two different values!! Correct this error!!")
73  cell => topology%cell_muc
74  natoms = topology%natoms*product(multiple_unit_cell)
75 
76  ! Check, if velocities are provided, that they are consistent in number with the atoms...
77  work_section => section_vals_get_subs_vals(subsys_section, "VELOCITY")
78  CALL section_vals_get(work_section, explicit=explicit)
79  IF (explicit) THEN
80  CALL section_vals_val_get(work_section, '_DEFAULT_KEYWORD_', n_rep_val=nrep)
81  check = nrep == natoms
82  IF (.NOT. check) &
83  CALL cp_abort(__location__, &
84  "Number of available entries in VELOCITY section is not compatible with the number of atoms!")
85  END IF
86 
87  CALL reallocate(topology%atom_info%id_molname, 1, natoms)
88  CALL reallocate(topology%atom_info%id_resname, 1, natoms)
89  CALL reallocate(topology%atom_info%resid, 1, natoms)
90  CALL reallocate(topology%atom_info%id_atmname, 1, natoms)
91  CALL reallocate(topology%atom_info%r, 1, 3, 1, natoms)
92  CALL reallocate(topology%atom_info%atm_mass, 1, natoms)
93  CALL reallocate(topology%atom_info%atm_charge, 1, natoms)
94  CALL reallocate(topology%atom_info%occup, 1, natoms)
95  CALL reallocate(topology%atom_info%beta, 1, natoms)
96  CALL reallocate(topology%atom_info%id_element, 1, natoms)
97  ind = 0
98  DO k = 1, multiple_unit_cell(3)
99  trsl_k = cell%hmat(:, 3)*real(k - 1, kind=dp)
100  DO j = 1, multiple_unit_cell(2)
101  trsl_j = cell%hmat(:, 2)*real(j - 1, kind=dp)
102  DO i = 1, multiple_unit_cell(1)
103  trsl_i = cell%hmat(:, 1)*real(i - 1, kind=dp)
104  trsl = trsl_i + trsl_j + trsl_k
105  ind = ind + 1
106  IF (ind == 1) cycle
107 
108  ! loop over atoms
109  n = (ind - 1)*topology%natoms
110  DO m = 1, topology%natoms
111  topology%atom_info%id_atmname(n + m) = topology%atom_info%id_atmname(m)
112  topology%atom_info%r(1, n + m) = topology%atom_info%r(1, m) + trsl(1)
113  topology%atom_info%r(2, n + m) = topology%atom_info%r(2, m) + trsl(2)
114  topology%atom_info%r(3, n + m) = topology%atom_info%r(3, m) + trsl(3)
115  topology%atom_info%id_molname(n + m) = topology%atom_info%id_molname(m)
116  topology%atom_info%id_resname(n + m) = topology%atom_info%id_resname(m)
117  topology%atom_info%resid(n + m) = topology%atom_info%resid(m)
118  topology%atom_info%id_element(n + m) = topology%atom_info%id_element(m)
119  topology%atom_info%atm_mass(n + m) = topology%atom_info%atm_mass(m)
120  topology%atom_info%atm_charge(n + m) = topology%atom_info%atm_charge(m)
121  END DO
122  END DO
123  END DO
124  END DO
125  topology%natoms = natoms
126 
127  ! Deallocate the coordinate section (will be rebuilt later with the whole atomic set)
128  work_section => section_vals_get_subs_vals(subsys_section, "COORD")
129  CALL section_vals_get(work_section, explicit=explicit)
130  IF (explicit) THEN
131  CALL section_vals_val_get(work_section, "UNIT", c_val=unit_str)
132  CALL section_vals_val_get(work_section, "SCALED", l_val=scale)
133  END IF
134  CALL section_vals_remove_values(work_section)
135  IF (explicit) THEN
136  CALL section_vals_val_set(work_section, "UNIT", c_val=unit_str)
137  CALL section_vals_val_set(work_section, "SCALED", l_val=scale)
138  END IF
139  END IF
140  CALL timestop(handle)
141  END SUBROUTINE topology_muc
142 
Handles all functions related to the CELL.
Definition: cell_types.F:15
objects that represent the structure of input sections and the data contained in an input section
subroutine, public section_vals_val_set(section_vals, keyword_name, i_rep_section, i_rep_val, val, l_val, i_val, r_val, c_val, l_vals_ptr, i_vals_ptr, r_vals_ptr, c_vals_ptr)
sets the requested value
subroutine, public section_vals_remove_values(section_vals)
removes the values of a repetition of the section
recursive type(section_vals_type) function, pointer, public section_vals_get_subs_vals(section_vals, subsection_name, i_rep_section, can_return_null)
returns the values of the requested subsection
subroutine, public section_vals_get(section_vals, ref_count, n_repetition, n_subs_vals_rep, section, explicit)
returns various attributes about the section_vals
subroutine, public section_vals_val_get(section_vals, keyword_name, i_rep_section, i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, c_vals, explicit)
returns the requested value
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public dp
Definition: kinds.F:34
integer, parameter, public default_string_length
Definition: kinds.F:57
Utility routines for the memory handling.
Handles the multiple unit cell option regarding atomic coordinates.
subroutine, public topology_muc(topology, subsys_section)
Handles the multiple_unit_cell for the atomic coordinates..
Control for reading in different topologies and coordinates.
Definition: topology.F:13