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