(git:0de0cc2)
orbital_pointers.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 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 ! **************************************************************************************************
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, &
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  SUBROUTINE create_orbital_pointers(maxl)
76  INTEGER, INTENT(IN) :: maxl
77 
78  INTEGER :: iso, l, lx, ly, lz, m
79 
80  IF (current_maxl > -1) THEN
81  CALL cp_abort(__location__, &
82  "Orbital pointers are already allocated. "// &
83  "Use the init routine for an update")
84  END IF
85 
86  IF (maxl < 0) THEN
87  CALL cp_abort(__location__, &
88  "A negative maximum angular momentum quantum "// &
89  "number is invalid")
90  END IF
91 
92 !$ IF (omp_get_level() > 0) &
93 !$ CPABORT("create_orbital_pointers is not thread-safe")
94 
95 ! *** Number of Cartesian orbitals for each l ***
96 
97  ALLOCATE (nco(-1:maxl))
98 
99  nco(-1) = 0
100 
101  DO l = 0, maxl
102  nco(l) = (l + 1)*(l + 2)/2
103  END DO
104 
105 ! *** Number of Cartesian orbitals up to l ***
106 
107  ALLOCATE (ncoset(-1:maxl))
108 
109  ncoset(-1) = 0
110 
111  DO l = 0, maxl
112  ncoset(l) = ncoset(l - 1) + nco(l)
113  END DO
114 
115 ! *** Build the Cartesian orbital pointer and the shell orbital pointer ***
116 
117  ALLOCATE (co(0:maxl, 0:maxl, 0:maxl))
118 
119  co(:, :, :) = 0
120 
121  ALLOCATE (coset(-1:maxl, -1:maxl, -1:maxl))
122 
123  coset(:, :, :) = 0
124 
125  coset(-1, :, :) = 1
126  coset(:, -1, :) = 1
127  coset(:, :, -1) = 1
128 
129  DO lx = 0, maxl
130  DO ly = 0, maxl
131  DO lz = 0, maxl
132  l = lx + ly + lz
133  IF (l > maxl) cycle
134  co(lx, ly, lz) = 1 + (l - lx)*(l - lx + 1)/2 + lz
135  coset(lx, ly, lz) = ncoset(l - 1) + co(lx, ly, lz)
136  END DO
137  END DO
138  END DO
139 
140  ALLOCATE (indco(3, ncoset(maxl)))
141 
142  indco(:, :) = 0
143 
144  DO l = 0, maxl
145  DO lx = 0, l
146  DO ly = 0, l - lx
147  lz = l - lx - ly
148  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  ALLOCATE (nso(-1:maxl))
156 
157  nso(-1) = 0
158 
159  DO l = 0, maxl
160  nso(l) = 2*l + 1
161  END DO
162 
163 ! *** Number of spherical orbitals up to l ***
164 
165  ALLOCATE (nsoset(-1:maxl))
166  nsoset(-1) = 0
167 
168  DO l = 0, maxl
169  nsoset(l) = nsoset(l - 1) + nso(l)
170  END DO
171 
172  ALLOCATE (indso(2, nsoset(maxl)))
173  ! indso_inv: inverse to indso
174  ALLOCATE (indso_inv(0:maxl, -maxl:maxl))
175 
176  indso(:, :) = 0
177  indso_inv(:, :) = 0
178 
179  iso = 0
180  DO l = 0, maxl
181  DO m = -l, l
182  iso = iso + 1
183  indso(1:2, iso) = (/l, m/)
184  indso_inv(l, m) = iso
185  END DO
186  END DO
187 
188  ALLOCATE (so(0:maxl, -maxl:maxl), soset(0:maxl, -maxl:maxl))
189 
190  soset(:, :) = 0
191  DO l = 0, maxl
192  DO m = -l, l
193  so(l, m) = nso(l) - (l - m)
194  soset(l, m) = nsoset(l - 1) + nso(l) - (l - m)
195  END DO
196  END DO
197 
198 ! *** Save initialization status ***
199 
200  current_maxl = maxl
201 
202  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 ! **************************************************************************************************
211 
212 !$ IF (omp_get_level() > 0) &
213 !$ CPABORT("deallocate_orbital_pointers is not thread-safe")
214 
215  IF (current_maxl > -1) THEN
216 
217  DEALLOCATE (co)
218 
219  DEALLOCATE (coset)
220 
221  DEALLOCATE (indco)
222 
223  DEALLOCATE (indso)
224 
225  DEALLOCATE (indso_inv)
226 
227  DEALLOCATE (nco)
228 
229  DEALLOCATE (ncoset)
230 
231  DEALLOCATE (nso)
232 
233  DEALLOCATE (nsoset)
234 
235  DEALLOCATE (so)
236 
237  DEALLOCATE (soset)
238 
239  current_maxl = -1
240 
241  END IF
242 
243  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  SUBROUTINE init_orbital_pointers(maxl)
253  INTEGER, INTENT(IN) :: maxl
254 
255 !$ IF (omp_get_level() > 0) &
256 !$ CPABORT("init_orbital_pointers is not thread-safe")
257 
258  IF (maxl < 0) THEN
259  CALL cp_abort(__location__, &
260  "A negative maximum angular momentum quantum "// &
261  "number is invalid")
262  END IF
263 
264 ! *** Check, if the current initialization is sufficient ***
265 
266  IF (maxl > current_maxl) THEN
268  CALL create_orbital_pointers(maxl)
269  END IF
270 
271  END SUBROUTINE init_orbital_pointers
272 
273 END MODULE orbital_pointers
Provides Cartesian and spherical orbital pointers and indices.
integer, save, public current_maxl
subroutine, public init_orbital_pointers(maxl)
Initialize or update the orbital pointers.
integer, dimension(:, :, :), allocatable, public co
subroutine, public deallocate_orbital_pointers()
Deallocate the orbital pointers.
integer, dimension(:), allocatable, public nco
integer, dimension(:), allocatable, public nsoset
integer, dimension(:, :), allocatable, public indso
integer, dimension(:), allocatable, public ncoset
integer, dimension(:, :), allocatable, public soset
integer, dimension(:, :, :), allocatable, public coset
integer, dimension(:, :), allocatable, public indco
integer, dimension(:), allocatable, public nso
integer, dimension(:, :), allocatable, public indso_inv