(git:0de0cc2)
subcell_types.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 subcell types and allocation routines
10 !> \par History
11 !> - Separated from qs_neighbor_lists (25.07.2010,jhu)
12 !> \author Matthias Krack
13 ! **************************************************************************************************
15 
16  USE cell_types, ONLY: cell_type,&
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
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  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  na = nsubcell(1)
66  nb = nsubcell(2)
67  nc = nsubcell(3)
68 
69  ALLOCATE (subcell(na, nb, nc))
70 
71  delta_a = 1.0_dp/real(na, dp)
72  delta_b = 1.0_dp/real(nb, dp)
73  delta_c = 1.0_dp/real(nc, dp)
74 
75  c_min = -0.5_dp
76 
77  DO k = 1, nc
78  c_max = c_min + delta_c
79  b_min = -0.5_dp
80  DO j = 1, nb
81  b_max = b_min + delta_b
82  a_min = -0.5_dp
83  DO i = 1, na
84  a_max = a_min + delta_a
85  subcell(i, j, k)%s_min(1) = a_min
86  subcell(i, j, k)%s_min(2) = b_min
87  subcell(i, j, k)%s_min(3) = c_min
88  subcell(i, j, k)%s_max(1) = a_max
89  subcell(i, j, k)%s_max(2) = b_max
90  subcell(i, j, k)%s_max(3) = c_max
91  subcell(i, j, k)%natom = 0
92  IF (PRESENT(cell)) THEN
93  CALL scaled_to_real(subcell(i, j, k)%corners(:, 1), (/a_min, b_min, c_min/), cell)
94  CALL scaled_to_real(subcell(i, j, k)%corners(:, 2), (/a_max, b_min, c_min/), cell)
95  CALL scaled_to_real(subcell(i, j, k)%corners(:, 3), (/a_min, b_max, c_min/), cell)
96  CALL scaled_to_real(subcell(i, j, k)%corners(:, 4), (/a_max, b_max, c_min/), cell)
97  CALL scaled_to_real(subcell(i, j, k)%corners(:, 5), (/a_min, b_min, c_max/), cell)
98  CALL scaled_to_real(subcell(i, j, k)%corners(:, 6), (/a_max, b_min, c_max/), cell)
99  CALL scaled_to_real(subcell(i, j, k)%corners(:, 7), (/a_min, b_max, c_max/), cell)
100  CALL scaled_to_real(subcell(i, j, k)%corners(:, 8), (/a_max, b_max, c_max/), cell)
101  END IF
102  IF (PRESENT(maxatom)) THEN
103  ALLOCATE (subcell(i, j, k)%atom_list(maxatom))
104  END IF
105  a_min = a_max
106  END DO
107  b_min = b_max
108  END DO
109  c_min = c_max
110  END DO
111 
112  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  SUBROUTINE deallocate_subcell(subcell)
122 
123  TYPE(subcell_type), DIMENSION(:, :, :), POINTER :: subcell
124 
125  INTEGER :: i, j, k
126 
127  IF (ASSOCIATED(subcell)) THEN
128 
129  DO k = 1, SIZE(subcell, 3)
130  DO j = 1, SIZE(subcell, 2)
131  DO i = 1, SIZE(subcell, 1)
132  DEALLOCATE (subcell(i, j, k)%atom_list)
133  END DO
134  END DO
135  END DO
136 
137  DEALLOCATE (subcell)
138  ELSE
139  cpabort("")
140  END IF
141 
142  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  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  i0 = 1
162  j0 = SIZE(atom_list)
163  i1 = j0 + 1
164  j1 = 2*j0
165  i2 = j1 + 1
166  j2 = 3*j0
167  ! Sort kind
168  DO i = 1, SIZE(atom_list)
169  work(i0 + i - 1) = kind_of(atom_list(i))
170  END DO
171  CALL sort(work(i0:j0), SIZE(atom_list), work(i1:j1))
172  work(i2:j2) = atom_list
173  DO i = 1, SIZE(atom_list)
174  atom_list(i) = work(i2 + work(i1 + i - 1) - 1)
175  END DO
176  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  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  r_pbc = r
199  CALL real_to_scaled(s_pbc, r_pbc, cell)
200  s(:) = s_pbc + 0.5_dp
201  i = int(s(1)*real(nsubcell(1), kind=dp)) + 1
202  j = int(s(2)*real(nsubcell(2), kind=dp)) + 1
203  k = int(s(3)*real(nsubcell(3), kind=dp)) + 1
204  i = min(max(i, 1), nsubcell(1))
205  j = min(max(j, 1), nsubcell(2))
206  k = min(max(k, 1), nsubcell(3))
207 
208  END SUBROUTINE give_ijk_subcell
209 
210 END MODULE subcell_types
Handles all functions related to the CELL.
Definition: cell_types.F:15
subroutine, public scaled_to_real(r, s, cell)
Transform scaled cell coordinates real coordinates. r=h*s.
Definition: cell_types.F:516
subroutine, public real_to_scaled(s, r, cell)
Transform real to scaled cell coordinates. s=h_inv*r.
Definition: cell_types.F:486
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public dp
Definition: kinds.F:34
subcell types and allocation routines
Definition: subcell_types.F:14
subroutine, public deallocate_subcell(subcell)
Deallocate a subcell grid structure.
subroutine, public give_ijk_subcell(r, i, j, k, cell, nsubcell)
...
subroutine, public reorder_atoms_subcell(atom_list, kind_of, work)
...
subroutine, public allocate_subcell(subcell, nsubcell, maxatom, cell)
Allocate and initialize a subcell grid structure for the atomic neighbor search.
Definition: subcell_types.F:55
All kind of helpful little routines.
Definition: util.F:14