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 9859 : SUBROUTINE create_orbital_pointers(maxl)
76 : INTEGER, INTENT(IN) :: maxl
77 :
78 : INTEGER :: iso, l, lx, ly, lz, m
79 :
80 9859 : 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 9859 : 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 9859 : !$ 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 29577 : ALLOCATE (nco(-1:maxl))
98 :
99 9859 : nco(-1) = 0
100 :
101 77201 : DO l = 0, maxl
102 77201 : nco(l) = (l + 1)*(l + 2)/2
103 : END DO
104 :
105 : ! *** Number of Cartesian orbitals up to l ***
106 :
107 29577 : ALLOCATE (ncoset(-1:maxl))
108 :
109 9859 : ncoset(-1) = 0
110 :
111 77201 : DO l = 0, maxl
112 77201 : ncoset(l) = ncoset(l - 1) + nco(l)
113 : END DO
114 :
115 : ! *** Build the Cartesian orbital pointer and the shell orbital pointer ***
116 :
117 49295 : ALLOCATE (co(0:maxl, 0:maxl, 0:maxl))
118 :
119 5006681 : co(:, :, :) = 0
120 :
121 49295 : ALLOCATE (coset(-1:maxl, -1:maxl, -1:maxl))
122 :
123 6880330 : coset(:, :, :) = 0
124 :
125 734057 : coset(-1, :, :) = 1
126 734057 : coset(:, -1, :) = 1
127 734057 : coset(:, :, -1) = 1
128 :
129 77201 : DO lx = 0, maxl
130 579655 : DO ly = 0, maxl
131 4996822 : DO lz = 0, maxl
132 4427026 : l = lx + ly + lz
133 4427026 : IF (l > maxl) CYCLE
134 1011512 : co(lx, ly, lz) = 1 + (l - lx)*(l - lx + 1)/2 + lz
135 4929480 : coset(lx, ly, lz) = ncoset(l - 1) + co(lx, ly, lz)
136 : END DO
137 : END DO
138 : END DO
139 :
140 29577 : ALLOCATE (indco(3, ncoset(maxl)))
141 :
142 4055907 : indco(:, :) = 0
143 :
144 77201 : DO l = 0, maxl
145 362099 : DO lx = 0, l
146 1363752 : DO ly = 0, l - lx
147 1011512 : lz = l - lx - ly
148 4330946 : 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 29577 : ALLOCATE (nso(-1:maxl))
156 :
157 9859 : nso(-1) = 0
158 :
159 77201 : DO l = 0, maxl
160 77201 : nso(l) = 2*l + 1
161 : END DO
162 :
163 : ! *** Number of spherical orbitals up to l ***
164 :
165 29577 : ALLOCATE (nsoset(-1:maxl))
166 9859 : nsoset(-1) = 0
167 :
168 77201 : DO l = 0, maxl
169 77201 : nsoset(l) = nsoset(l - 1) + nso(l)
170 : END DO
171 :
172 29577 : ALLOCATE (indso(2, nsoset(maxl)))
173 : ! indso_inv: inverse to indso
174 39436 : ALLOCATE (indso_inv(0:maxl, -maxl:maxl))
175 :
176 1517221 : indso(:, :) = 0
177 1072250 : indso_inv(:, :) = 0
178 :
179 : iso = 0
180 77201 : DO l = 0, maxl
181 579655 : DO m = -l, l
182 502454 : iso = iso + 1
183 1507362 : indso(1:2, iso) = [l, m]
184 569796 : indso_inv(l, m) = iso
185 : END DO
186 : END DO
187 :
188 69013 : ALLOCATE (so(0:maxl, -maxl:maxl), soset(0:maxl, -maxl:maxl))
189 :
190 1072250 : soset(:, :) = 0
191 77201 : DO l = 0, maxl
192 579655 : DO m = -l, l
193 502454 : so(l, m) = nso(l) - (l - m)
194 569796 : soset(l, m) = nsoset(l - 1) + nso(l) - (l - m)
195 : END DO
196 : END DO
197 :
198 : ! *** Save initialization status ***
199 :
200 9859 : current_maxl = maxl
201 :
202 9859 : 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 19545 : SUBROUTINE deallocate_orbital_pointers()
211 :
212 19545 : !$ IF (omp_get_level() > 0) &
213 0 : !$ CPABORT("deallocate_orbital_pointers is not thread-safe")
214 :
215 19545 : IF (current_maxl > -1) THEN
216 :
217 9859 : DEALLOCATE (co)
218 :
219 9859 : DEALLOCATE (coset)
220 :
221 9859 : DEALLOCATE (indco)
222 :
223 9859 : DEALLOCATE (indso)
224 :
225 9859 : DEALLOCATE (indso_inv)
226 :
227 9859 : DEALLOCATE (nco)
228 :
229 9859 : DEALLOCATE (ncoset)
230 :
231 9859 : DEALLOCATE (nso)
232 :
233 9859 : DEALLOCATE (nsoset)
234 :
235 9859 : DEALLOCATE (so)
236 :
237 9859 : DEALLOCATE (soset)
238 :
239 9859 : current_maxl = -1
240 :
241 : END IF
242 :
243 19545 : 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 3444789 : SUBROUTINE init_orbital_pointers(maxl)
253 : INTEGER, INTENT(IN) :: maxl
254 :
255 3444789 : !$ IF (omp_get_level() > 0) &
256 0 : !$ CPABORT("init_orbital_pointers is not thread-safe")
257 :
258 3444789 : 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 3444789 : IF (maxl > current_maxl) THEN
267 9859 : CALL deallocate_orbital_pointers()
268 9859 : CALL create_orbital_pointers(maxl)
269 : END IF
270 :
271 3444789 : END SUBROUTINE init_orbital_pointers
272 :
273 : END MODULE orbital_pointers
|
