Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Provides Cartesian and spherical orbital pointers and indices
10 : !> \par History
11 : !> - reallocate eliminated (17.07.2002,MK)
12 : !> - restructured and cleaned (20.05.2004,MK)
13 : !> \author Matthias Krack (07.06.2000)
14 : ! **************************************************************************************************
15 : MODULE orbital_pointers
16 :
17 : ! co : Cartesian orbital pointer for a orbital shell.
18 : ! coset : Cartesian orbital pointer for a set of orbitals.
19 : ! nco : Number of Cartesian orbitals for the angular momentum quantum
20 : ! number l.
21 : ! ncoset: Number of Cartesian orbitals up to the angular momentum quantum
22 : ! number l.
23 : ! nso : Number of spherical orbitals for the angular momentum quantum
24 : ! number l.
25 : ! nsoset: Number of spherical orbitals up to the angular momentum quantum
26 : ! number l.
27 :
28 : !$ USE OMP_LIB, ONLY: omp_get_level
29 :
30 : #include "../base/base_uses.f90"
31 :
32 : IMPLICIT NONE
33 :
34 : PRIVATE
35 :
36 : ! *** Global parameters ***
37 :
38 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'orbital_pointers'
39 :
40 : INTEGER, SAVE :: current_maxl = -1
41 :
42 : INTEGER, DIMENSION(:), ALLOCATABLE :: nco, ncoset, nso, nsoset
43 : INTEGER, DIMENSION(:, :), ALLOCATABLE :: indco, indso, indso_inv
44 : INTEGER, DIMENSION(:, :), ALLOCATABLE :: so, soset
45 : INTEGER, DIMENSION(:, :, :), ALLOCATABLE :: co, coset
46 :
47 : ! *** Public subroutines ***
48 :
49 : PUBLIC :: deallocate_orbital_pointers, &
50 : init_orbital_pointers
51 :
52 : ! *** Public variables ***
53 :
54 : PUBLIC :: co, &
55 : coset, &
56 : current_maxl, &
57 : indco, &
58 : indso, &
59 : indso_inv, &
60 : nco, &
61 : ncoset, &
62 : nso, &
63 : nsoset, &
64 : soset
65 :
66 : CONTAINS
67 :
68 : ! **************************************************************************************************
69 : !> \brief Allocate and initialize the orbital pointers.
70 : !> \param maxl ...
71 : !> \date 20.05.2004
72 : !> \author MK
73 : !> \version 1.0
74 : ! **************************************************************************************************
75 9675 : SUBROUTINE create_orbital_pointers(maxl)
76 : INTEGER, INTENT(IN) :: maxl
77 :
78 : INTEGER :: iso, l, lx, ly, lz, m
79 :
80 9675 : IF (current_maxl > -1) THEN
81 : CALL cp_abort(__LOCATION__, &
82 : "Orbital pointers are already allocated. "// &
83 0 : "Use the init routine for an update")
84 : END IF
85 :
86 9675 : IF (maxl < 0) THEN
87 : CALL cp_abort(__LOCATION__, &
88 : "A negative maximum angular momentum quantum "// &
89 0 : "number is invalid")
90 : END IF
91 :
92 9675 : !$ IF (omp_get_level() > 0) &
93 0 : !$ CPABORT("create_orbital_pointers is not thread-safe")
94 :
95 : ! *** Number of Cartesian orbitals for each l ***
96 :
97 29025 : ALLOCATE (nco(-1:maxl))
98 :
99 9675 : nco(-1) = 0
100 :
101 75339 : DO l = 0, maxl
102 75339 : nco(l) = (l + 1)*(l + 2)/2
103 : END DO
104 :
105 : ! *** Number of Cartesian orbitals up to l ***
106 :
107 29025 : ALLOCATE (ncoset(-1:maxl))
108 :
109 9675 : ncoset(-1) = 0
110 :
111 75339 : DO l = 0, maxl
112 75339 : ncoset(l) = ncoset(l - 1) + nco(l)
113 : END DO
114 :
115 : ! *** Build the Cartesian orbital pointer and the shell orbital pointer ***
116 :
117 48375 : ALLOCATE (co(0:maxl, 0:maxl, 0:maxl))
118 :
119 4715043 : co(:, :, :) = 0
120 :
121 48375 : ALLOCATE (coset(-1:maxl, -1:maxl, -1:maxl))
122 :
123 6522864 : coset(:, :, :) = 0
124 :
125 709509 : coset(-1, :, :) = 1
126 709509 : coset(:, -1, :) = 1
127 709509 : coset(:, :, -1) = 1
128 :
129 75339 : DO lx = 0, maxl
130 558831 : DO ly = 0, maxl
131 4705368 : DO lz = 0, maxl
132 4156212 : l = lx + ly + lz
133 4156212 : IF (l > maxl) CYCLE
134 956336 : co(lx, ly, lz) = 1 + (l - lx)*(l - lx + 1)/2 + lz
135 4639704 : coset(lx, ly, lz) = ncoset(l - 1) + co(lx, ly, lz)
136 : END DO
137 : END DO
138 : END DO
139 :
140 29025 : ALLOCATE (indco(3, ncoset(maxl)))
141 :
142 3835019 : indco(:, :) = 0
143 :
144 75339 : DO l = 0, maxl
145 349917 : DO lx = 0, l
146 1296578 : DO ly = 0, l - lx
147 956336 : lz = l - lx - ly
148 4099922 : indco(1:3, coset(lx, ly, lz)) = (/lx, ly, lz/)
149 : END DO
150 : END DO
151 : END DO
152 :
153 : ! *** Number of spherical orbitals for each l ***
154 :
155 29025 : ALLOCATE (nso(-1:maxl))
156 :
157 9675 : nso(-1) = 0
158 :
159 75339 : DO l = 0, maxl
160 75339 : nso(l) = 2*l + 1
161 : END DO
162 :
163 : ! *** Number of spherical orbitals up to l ***
164 :
165 29025 : ALLOCATE (nsoset(-1:maxl))
166 9675 : nsoset(-1) = 0
167 :
168 75339 : DO l = 0, maxl
169 75339 : nsoset(l) = nsoset(l - 1) + nso(l)
170 : END DO
171 :
172 29025 : ALLOCATE (indso(2, nsoset(maxl)))
173 : ! indso_inv: inverse to indso
174 38700 : ALLOCATE (indso_inv(0:maxl, -maxl:maxl))
175 :
176 1460151 : indso(:, :) = 0
177 1032648 : indso_inv(:, :) = 0
178 :
179 : iso = 0
180 75339 : DO l = 0, maxl
181 558831 : DO m = -l, l
182 483492 : iso = iso + 1
183 1450476 : indso(1:2, iso) = (/l, m/)
184 549156 : indso_inv(l, m) = iso
185 : END DO
186 : END DO
187 :
188 67725 : ALLOCATE (so(0:maxl, -maxl:maxl), soset(0:maxl, -maxl:maxl))
189 :
190 1032648 : soset(:, :) = 0
191 75339 : DO l = 0, maxl
192 558831 : DO m = -l, l
193 483492 : so(l, m) = nso(l) - (l - m)
194 549156 : soset(l, m) = nsoset(l - 1) + nso(l) - (l - m)
195 : END DO
196 : END DO
197 :
198 : ! *** Save initialization status ***
199 :
200 9675 : current_maxl = maxl
201 :
202 9675 : END SUBROUTINE create_orbital_pointers
203 :
204 : ! **************************************************************************************************
205 : !> \brief Deallocate the orbital pointers.
206 : !> \date 20.05.2005
207 : !> \author MK
208 : !> \version 1.0
209 : ! **************************************************************************************************
210 19281 : SUBROUTINE deallocate_orbital_pointers()
211 :
212 19281 : !$ IF (omp_get_level() > 0) &
213 0 : !$ CPABORT("deallocate_orbital_pointers is not thread-safe")
214 :
215 19281 : IF (current_maxl > -1) THEN
216 :
217 9675 : DEALLOCATE (co)
218 :
219 9675 : DEALLOCATE (coset)
220 :
221 9675 : DEALLOCATE (indco)
222 :
223 9675 : DEALLOCATE (indso)
224 :
225 9675 : DEALLOCATE (indso_inv)
226 :
227 9675 : DEALLOCATE (nco)
228 :
229 9675 : DEALLOCATE (ncoset)
230 :
231 9675 : DEALLOCATE (nso)
232 :
233 9675 : DEALLOCATE (nsoset)
234 :
235 9675 : DEALLOCATE (so)
236 :
237 9675 : DEALLOCATE (soset)
238 :
239 9675 : current_maxl = -1
240 :
241 : END IF
242 :
243 19281 : END SUBROUTINE deallocate_orbital_pointers
244 :
245 : ! **************************************************************************************************
246 : !> \brief Initialize or update the orbital pointers.
247 : !> \param maxl ...
248 : !> \date 07.06.2000
249 : !> \author MK
250 : !> \version 1.0
251 : ! **************************************************************************************************
252 3091889 : SUBROUTINE init_orbital_pointers(maxl)
253 : INTEGER, INTENT(IN) :: maxl
254 :
255 3091889 : !$ IF (omp_get_level() > 0) &
256 0 : !$ CPABORT("init_orbital_pointers is not thread-safe")
257 :
258 3091889 : IF (maxl < 0) THEN
259 : CALL cp_abort(__LOCATION__, &
260 : "A negative maximum angular momentum quantum "// &
261 0 : "number is invalid")
262 : END IF
263 :
264 : ! *** Check, if the current initialization is sufficient ***
265 :
266 3091889 : IF (maxl > current_maxl) THEN
267 9675 : CALL deallocate_orbital_pointers()
268 9675 : CALL create_orbital_pointers(maxl)
269 : END IF
270 :
271 3091889 : END SUBROUTINE init_orbital_pointers
272 :
273 : END MODULE orbital_pointers
|
