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
30 : REAL(KIND=dp), DIMENSION(3) :: s_max, s_min
31 : INTEGER, DIMENSION(:), POINTER :: atom_list
32 : REAL(KIND=dp), DIMENSION(3, 8) :: corners
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 444270 : 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 444270 : na = nsubcell(1)
66 444270 : nb = nsubcell(2)
67 444270 : nc = nsubcell(3)
68 :
69 2221350 : ALLOCATE (subcell(na, nb, nc))
70 :
71 444270 : delta_a = 1.0_dp/REAL(na, dp)
72 444270 : delta_b = 1.0_dp/REAL(nb, dp)
73 444270 : delta_c = 1.0_dp/REAL(nc, dp)
74 :
75 444270 : c_min = -0.5_dp
76 :
77 1330974 : DO k = 1, nc
78 886704 : c_max = c_min + delta_c
79 886704 : b_min = -0.5_dp
80 2991456 : DO j = 1, nb
81 2104752 : b_max = b_min + delta_b
82 2104752 : a_min = -0.5_dp
83 9988542 : DO i = 1, na
84 7883790 : a_max = a_min + delta_a
85 7883790 : subcell(i, j, k)%s_min(1) = a_min
86 7883790 : subcell(i, j, k)%s_min(2) = b_min
87 7883790 : subcell(i, j, k)%s_min(3) = c_min
88 7883790 : subcell(i, j, k)%s_max(1) = a_max
89 7883790 : subcell(i, j, k)%s_max(2) = b_max
90 7883790 : subcell(i, j, k)%s_max(3) = c_max
91 7883790 : subcell(i, j, k)%natom = 0
92 7883790 : IF (PRESENT(cell)) THEN
93 14405896 : CALL scaled_to_real(subcell(i, j, k)%corners(:, 1), (/a_min, b_min, c_min/), cell)
94 14405896 : CALL scaled_to_real(subcell(i, j, k)%corners(:, 2), (/a_max, b_min, c_min/), cell)
95 14405896 : CALL scaled_to_real(subcell(i, j, k)%corners(:, 3), (/a_min, b_max, c_min/), cell)
96 14405896 : CALL scaled_to_real(subcell(i, j, k)%corners(:, 4), (/a_max, b_max, c_min/), cell)
97 14405896 : CALL scaled_to_real(subcell(i, j, k)%corners(:, 5), (/a_min, b_min, c_max/), cell)
98 14405896 : CALL scaled_to_real(subcell(i, j, k)%corners(:, 6), (/a_max, b_min, c_max/), cell)
99 14405896 : CALL scaled_to_real(subcell(i, j, k)%corners(:, 7), (/a_min, b_max, c_max/), cell)
100 14405896 : CALL scaled_to_real(subcell(i, j, k)%corners(:, 8), (/a_max, b_max, c_max/), cell)
101 : END IF
102 7883790 : IF (PRESENT(maxatom)) THEN
103 0 : ALLOCATE (subcell(i, j, k)%atom_list(maxatom))
104 : END IF
105 9988542 : a_min = a_max
106 : END DO
107 2991456 : b_min = b_max
108 : END DO
109 1330974 : c_min = c_max
110 : END DO
111 :
112 444270 : 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 444270 : SUBROUTINE deallocate_subcell(subcell)
122 :
123 : TYPE(subcell_type), DIMENSION(:, :, :), POINTER :: subcell
124 :
125 : INTEGER :: i, j, k
126 :
127 444270 : IF (ASSOCIATED(subcell)) THEN
128 :
129 1330974 : DO k = 1, SIZE(subcell, 3)
130 3435726 : DO j = 1, SIZE(subcell, 2)
131 10875246 : DO i = 1, SIZE(subcell, 1)
132 9988542 : DEALLOCATE (subcell(i, j, k)%atom_list)
133 : END DO
134 : END DO
135 : END DO
136 :
137 444270 : DEALLOCATE (subcell)
138 : ELSE
139 0 : CPABORT("")
140 : END IF
141 :
142 444270 : 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 3601474 : 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 3601474 : i0 = 1
162 3601474 : j0 = SIZE(atom_list)
163 3601474 : i1 = j0 + 1
164 3601474 : j1 = 2*j0
165 3601474 : i2 = j1 + 1
166 3601474 : j2 = 3*j0
167 : ! Sort kind
168 6089498 : DO i = 1, SIZE(atom_list)
169 6089498 : work(i0 + i - 1) = kind_of(atom_list(i))
170 : END DO
171 3601474 : CALL sort(work(i0:j0), SIZE(atom_list), work(i1:j1))
172 6089498 : work(i2:j2) = atom_list
173 6089498 : DO i = 1, SIZE(atom_list)
174 6089498 : atom_list(i) = work(i2 + work(i1 + i - 1) - 1)
175 : END DO
176 3601474 : 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 6230846 : 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 6230846 : r_pbc = r
199 6230846 : CALL real_to_scaled(s_pbc, r_pbc, cell)
200 24923384 : s(:) = s_pbc + 0.5_dp
201 6230846 : i = INT(s(1)*REAL(nsubcell(1), KIND=dp)) + 1
202 6230846 : j = INT(s(2)*REAL(nsubcell(2), KIND=dp)) + 1
203 6230846 : k = INT(s(3)*REAL(nsubcell(3), KIND=dp)) + 1
204 6230846 : i = MIN(MAX(i, 1), nsubcell(1))
205 6230846 : j = MIN(MAX(j, 1), nsubcell(2))
206 6230846 : k = MIN(MAX(k, 1), nsubcell(3))
207 :
208 6230846 : END SUBROUTINE give_ijk_subcell
209 :
210 0 : END MODULE subcell_types
|
