Line data Source code
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 subcell types and allocation routines
10 : !> \par History
11 : !> - Separated from qs_neighbor_lists (25.07.2010,jhu)
12 : !> \author Matthias Krack
13 : ! **************************************************************************************************
14 : MODULE subcell_types
15 :
16 : USE cell_types, ONLY: cell_type,&
17 : real_to_scaled,&
18 : scaled_to_real
19 : USE kinds, ONLY: dp
20 : USE util, ONLY: sort
21 : #include "./base/base_uses.f90"
22 :
23 : IMPLICIT NONE
24 :
25 : PRIVATE
26 :
27 : ! **************************************************************************************************
28 : TYPE subcell_type
29 : INTEGER :: natom = -1
30 : REAL(KIND=dp), DIMENSION(3) :: s_max = -1.0_dp, s_min = -1.0_dp
31 : INTEGER, DIMENSION(:), POINTER :: atom_list => NULL()
32 : REAL(KIND=dp), DIMENSION(3, 8) :: corners = -1.0_dp
33 : END TYPE subcell_type
34 :
35 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'subcell_types'
36 :
37 : PUBLIC :: subcell_type, allocate_subcell, deallocate_subcell
38 : PUBLIC :: reorder_atoms_subcell, give_ijk_subcell
39 :
40 : ! **************************************************************************************************
41 :
42 : CONTAINS
43 :
44 : ! **************************************************************************************************
45 : !> \brief Allocate and initialize a subcell grid structure for the atomic neighbor search.
46 : !> \param subcell ...
47 : !> \param nsubcell ...
48 : !> \param maxatom ...
49 : !> \param cell ...
50 : !> \date 12.06.2003
51 : !> \author MK
52 : !> \version 1.0
53 : ! **************************************************************************************************
54 501023 : SUBROUTINE allocate_subcell(subcell, nsubcell, maxatom, cell)
55 :
56 : TYPE(subcell_type), DIMENSION(:, :, :), POINTER :: subcell
57 : INTEGER, DIMENSION(3), INTENT(IN) :: nsubcell
58 : INTEGER, INTENT(IN), OPTIONAL :: maxatom
59 : TYPE(cell_type), OPTIONAL, POINTER :: cell
60 :
61 : INTEGER :: i, j, k, na, nb, nc
62 : REAL(dp) :: a_max, a_min, b_max, b_min, c_max, &
63 : c_min, delta_a, delta_b, delta_c
64 :
65 501023 : na = nsubcell(1)
66 501023 : nb = nsubcell(2)
67 501023 : nc = nsubcell(3)
68 :
69 35160264 : ALLOCATE (subcell(na, nb, nc))
70 :
71 501023 : delta_a = 1.0_dp/REAL(na, dp)
72 501023 : delta_b = 1.0_dp/REAL(nb, dp)
73 501023 : delta_c = 1.0_dp/REAL(nc, dp)
74 :
75 501023 : c_min = -0.5_dp
76 :
77 1519792 : DO k = 1, nc
78 1018769 : c_max = c_min + delta_c
79 1018769 : b_min = -0.5_dp
80 3495334 : DO j = 1, nb
81 2476565 : b_max = b_min + delta_b
82 2476565 : a_min = -0.5_dp
83 11595460 : DO i = 1, na
84 9118895 : a_max = a_min + delta_a
85 9118895 : subcell(i, j, k)%s_min(1) = a_min
86 9118895 : subcell(i, j, k)%s_min(2) = b_min
87 9118895 : subcell(i, j, k)%s_min(3) = c_min
88 9118895 : subcell(i, j, k)%s_max(1) = a_max
89 9118895 : subcell(i, j, k)%s_max(2) = b_max
90 9118895 : subcell(i, j, k)%s_max(3) = c_max
91 9118895 : subcell(i, j, k)%natom = 0
92 9118895 : IF (PRESENT(cell)) THEN
93 14433648 : CALL scaled_to_real(subcell(i, j, k)%corners(:, 1), (/a_min, b_min, c_min/), cell)
94 14433648 : CALL scaled_to_real(subcell(i, j, k)%corners(:, 2), (/a_max, b_min, c_min/), cell)
95 14433648 : CALL scaled_to_real(subcell(i, j, k)%corners(:, 3), (/a_min, b_max, c_min/), cell)
96 14433648 : CALL scaled_to_real(subcell(i, j, k)%corners(:, 4), (/a_max, b_max, c_min/), cell)
97 14433648 : CALL scaled_to_real(subcell(i, j, k)%corners(:, 5), (/a_min, b_min, c_max/), cell)
98 14433648 : CALL scaled_to_real(subcell(i, j, k)%corners(:, 6), (/a_max, b_min, c_max/), cell)
99 14433648 : CALL scaled_to_real(subcell(i, j, k)%corners(:, 7), (/a_min, b_max, c_max/), cell)
100 14433648 : CALL scaled_to_real(subcell(i, j, k)%corners(:, 8), (/a_max, b_max, c_max/), cell)
101 : END IF
102 9118895 : IF (PRESENT(maxatom)) THEN
103 0 : ALLOCATE (subcell(i, j, k)%atom_list(maxatom))
104 : END IF
105 11595460 : a_min = a_max
106 : END DO
107 3495334 : b_min = b_max
108 : END DO
109 1519792 : c_min = c_max
110 : END DO
111 :
112 501023 : END SUBROUTINE allocate_subcell
113 :
114 : ! **************************************************************************************************
115 : !> \brief Deallocate a subcell grid structure.
116 : !> \param subcell ...
117 : !> \date 16.06.2003
118 : !> \author MK
119 : !> \version 1.0
120 : ! **************************************************************************************************
121 501023 : SUBROUTINE deallocate_subcell(subcell)
122 :
123 : TYPE(subcell_type), DIMENSION(:, :, :), POINTER :: subcell
124 :
125 : INTEGER :: i, j, k
126 :
127 501023 : IF (ASSOCIATED(subcell)) THEN
128 :
129 1519792 : DO k = 1, SIZE(subcell, 3)
130 3996357 : DO j = 1, SIZE(subcell, 2)
131 12614229 : DO i = 1, SIZE(subcell, 1)
132 11595460 : DEALLOCATE (subcell(i, j, k)%atom_list)
133 : END DO
134 : END DO
135 : END DO
136 :
137 501023 : DEALLOCATE (subcell)
138 : ELSE
139 0 : CPABORT("")
140 : END IF
141 :
142 501023 : END SUBROUTINE deallocate_subcell
143 :
144 : ! **************************************************************************************************
145 : !> \brief ...
146 : !> \param atom_list ...
147 : !> \param kind_of ...
148 : !> \param work ...
149 : !> \par History
150 : !> 08.2006 created [tlaino]
151 : !> \author Teodoro Laino
152 : ! **************************************************************************************************
153 3608412 : SUBROUTINE reorder_atoms_subcell(atom_list, kind_of, work)
154 : ! work needs to be dimensioned 3xSIZE(atom_list)
155 : INTEGER, DIMENSION(:), POINTER :: atom_list
156 : INTEGER, DIMENSION(:), INTENT(IN) :: kind_of
157 : INTEGER, DIMENSION(:) :: work
158 :
159 : INTEGER :: i, i0, i1, i2, j0, j1, j2
160 :
161 3608412 : i0 = 1
162 3608412 : j0 = SIZE(atom_list)
163 3608412 : i1 = j0 + 1
164 3608412 : j1 = 2*j0
165 3608412 : i2 = j1 + 1
166 3608412 : j2 = 3*j0
167 : ! Sort kind
168 6091966 : DO i = 1, SIZE(atom_list)
169 6091966 : work(i0 + i - 1) = kind_of(atom_list(i))
170 : END DO
171 3608412 : CALL sort(work(i0:j0), SIZE(atom_list), work(i1:j1))
172 6091966 : work(i2:j2) = atom_list
173 6091966 : DO i = 1, SIZE(atom_list)
174 6091966 : atom_list(i) = work(i2 + work(i1 + i - 1) - 1)
175 : END DO
176 3608412 : END SUBROUTINE reorder_atoms_subcell
177 :
178 : ! **************************************************************************************************
179 : !> \brief ...
180 : !> \param r ...
181 : !> \param i ...
182 : !> \param j ...
183 : !> \param k ...
184 : !> \param cell ...
185 : !> \param nsubcell ...
186 : !> \par History
187 : !> 08.2006 created [tlaino]
188 : !> \author Teodoro Laino
189 : ! **************************************************************************************************
190 6366956 : SUBROUTINE give_ijk_subcell(r, i, j, k, cell, nsubcell)
191 : REAL(KIND=dp) :: r(3)
192 : INTEGER, INTENT(OUT) :: i, j, k
193 : TYPE(cell_type), POINTER :: cell
194 : INTEGER, DIMENSION(3), INTENT(IN) :: nsubcell
195 :
196 : REAL(KIND=dp) :: r_pbc(3), s(3), s_pbc(3)
197 :
198 6366956 : r_pbc = r
199 6366956 : CALL real_to_scaled(s_pbc, r_pbc, cell)
200 25467824 : s(:) = s_pbc + 0.5_dp
201 6366956 : i = INT(s(1)*REAL(nsubcell(1), KIND=dp)) + 1
202 6366956 : j = INT(s(2)*REAL(nsubcell(2), KIND=dp)) + 1
203 6366956 : k = INT(s(3)*REAL(nsubcell(3), KIND=dp)) + 1
204 6366956 : i = MIN(MAX(i, 1), nsubcell(1))
205 6366956 : j = MIN(MAX(j, 1), nsubcell(2))
206 6366956 : k = MIN(MAX(k, 1), nsubcell(3))
207 :
208 6366956 : END SUBROUTINE give_ijk_subcell
209 :
210 0 : END MODULE subcell_types
|
