Line data Source code
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 Calculation of the moment integrals over Cartesian Gaussian-type
10 : !> functions.
11 : !> \par Literature
12 : !> S. Obara and A. Saika, J. Chem. Phys. 84, 3963 (1986)
13 : !> \par History
14 : !> none
15 : !> \author J. Hutter (16.02.2005)
16 : ! **************************************************************************************************
17 : MODULE ai_moments
18 :
19 : ! ax,ay,az : Angular momentum index numbers of orbital a.
20 : ! bx,by,bz : Angular momentum index numbers of orbital b.
21 : ! coset : Cartesian orbital set pointer.
22 : ! dab : Distance between the atomic centers a and b.
23 : ! l{a,b} : Angular momentum quantum number of shell a or b.
24 : ! l{a,b}_max: Maximum angular momentum quantum number of shell a or b.
25 : ! l{a,b}_min: Minimum angular momentum quantum number of shell a or b.
26 : ! rac : Distance vector between the atomic center a and reference point c.
27 : ! rbc : Distance vector between the atomic center b and reference point c.
28 : ! rpgf{a,b} : Radius of the primitive Gaussian-type function a or b.
29 : ! zet{a,b} : Exponents of the Gaussian-type functions a or b.
30 : ! zetp : Reciprocal of the sum of the exponents of orbital a and b.
31 :
32 : USE ai_derivatives, ONLY: adbdr,&
33 : dabdr
34 : USE ai_overlap, ONLY: overlap
35 : USE kinds, ONLY: dp
36 : USE mathconstants, ONLY: pi
37 : USE orbital_pointers, ONLY: coset,&
38 : indco,&
39 : ncoset
40 : #include "../base/base_uses.f90"
41 :
42 : IMPLICIT NONE
43 :
44 : PRIVATE
45 :
46 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'ai_moments'
47 :
48 : PUBLIC :: cossin, moment, diffop, diff_momop, contract_cossin, dipole_force
49 : PUBLIC :: diff_momop2, diff_momop_velocity
50 :
51 : CONTAINS
52 :
53 : ! *****************************************************************************
54 : !> \brief This returns the derivative of the moment integrals [a|\mu|b], with respect
55 : !> to the primitive on the right
56 : !> difmab(:, :, beta, alpha) = < a | r_beta | ∂_alpha b > * (iatom - jatom)
57 : !> \param la_max ...
58 : !> \param npgfa ...
59 : !> \param zeta ...
60 : !> \param rpgfa ...
61 : !> \param la_min ...
62 : !> \param lb_max ...
63 : !> \param npgfb ...
64 : !> \param zetb ...
65 : !> \param rpgfb ...
66 : !> \param lb_min ...
67 : !> \param order ...
68 : !> \param rac ...
69 : !> \param rbc ...
70 : !> \param difmab ...
71 : !> \param lambda The atom on which we take the derivative
72 : !> \param iatom ...
73 : !> \param jatom ...
74 : !> \author Edward Ditler
75 : ! **************************************************************************************************
76 27 : SUBROUTINE diff_momop_velocity(la_max, npgfa, zeta, rpgfa, la_min, &
77 27 : lb_max, npgfb, zetb, rpgfb, lb_min, &
78 27 : order, rac, rbc, difmab, lambda, iatom, jatom)
79 :
80 : INTEGER, INTENT(IN) :: la_max, npgfa
81 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: zeta, rpgfa
82 : INTEGER, INTENT(IN) :: la_min, lb_max, npgfb
83 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: zetb, rpgfb
84 : INTEGER, INTENT(IN) :: lb_min, order
85 : REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: rac, rbc
86 : REAL(KIND=dp), DIMENSION(:, :, :, :), INTENT(OUT) :: difmab
87 : INTEGER, INTENT(IN) :: lambda
88 : INTEGER, INTENT(IN), OPTIONAL :: iatom, jatom
89 :
90 : INTEGER :: alpha, beta, lda, lda_min, ldb, ldb_min
91 : REAL(KIND=dp) :: dab, rab(3)
92 27 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: difmab_tmp, mab
93 :
94 108 : rab = rbc - rac
95 108 : dab = SQRT(SUM(rab**2))
96 :
97 27 : lda_min = MAX(0, la_min - 1)
98 27 : ldb_min = MAX(0, lb_min - 1)
99 27 : lda = ncoset(la_max)*npgfa
100 27 : ldb = ncoset(lb_max)*npgfb
101 135 : ALLOCATE (difmab_tmp(lda, ldb, 3))
102 :
103 135 : ALLOCATE (mab(npgfa*ncoset(la_max + 1), npgfb*ncoset(lb_max + 1), ncoset(order) - 1))
104 : ! *** Calculate the primitive overlap integrals ***
105 : ! mab(1:3) = < a | r_beta - RC_beta | b >
106 48708 : mab = 0.0_dp
107 : CALL moment(la_max + 1, npgfa, zeta, rpgfa, lda_min, &
108 : lb_max + 1, npgfb, zetb, rpgfb, &
109 27 : order, rac, rbc, mab)
110 :
111 17847 : difmab = 0.0_dp
112 108 : DO beta = 1, ncoset(order) - 1 ! beta was imom
113 :
114 17820 : difmab_tmp = 0.0_dp
115 : CALL adbdr(la_max, npgfa, rpgfa, la_min, &
116 : lb_max, npgfb, zetb, rpgfb, lb_min, &
117 : dab, mab(:, :, beta), difmab_tmp(:, :, 1), &
118 81 : difmab_tmp(:, :, 2), difmab_tmp(:, :, 3))
119 :
120 : ! difmab(beta, alpha) = < a | r_beta - RC_beta | ∂_alpha b > * [(a==lambda) - (b==lambda)]
121 351 : DO alpha = 1, 3
122 6075 : IF (iatom == lambda) difmab(:, :, beta, alpha) = difmab(:, :, beta, alpha) + difmab_tmp(:, :, alpha)
123 6156 : IF (jatom == lambda) difmab(:, :, beta, alpha) = difmab(:, :, beta, alpha) - difmab_tmp(:, :, alpha)
124 : END DO
125 : END DO
126 :
127 27 : DEALLOCATE (mab)
128 27 : DEALLOCATE (difmab_tmp)
129 27 : END SUBROUTINE diff_momop_velocity
130 :
131 : ! *****************************************************************************
132 : !> \brief This returns the derivative of the moment integrals [a|\mu|b], with respect
133 : !> to the position of the primitive on the left and right, i.e.
134 : !> [da/dR_ai|\mu|b] + [a|\mu|d/dR_bi]
135 : !> [da/dR_ai|\mu|b] = 2*zeta*[a+1i|\mu|b] - Ni(a)[a-1i|\mu|b]
136 : !> [a|\mu|d/dR_bi] = 2*zetb*[a|\mu|b+1i] - Ni(b)[a|\mu|b-1i]
137 : !> order indicates the max order of the moment operator to be calculated
138 : !> 1: dipole
139 : !> 2: quadrupole
140 : !> ...
141 : !> \param la_max ...
142 : !> \param npgfa ...
143 : !> \param zeta ...
144 : !> \param rpgfa ...
145 : !> \param la_min ...
146 : !> \param lb_max ...
147 : !> \param npgfb ...
148 : !> \param zetb ...
149 : !> \param rpgfb ...
150 : !> \param lb_min ...
151 : !> \param order ...
152 : !> \param rac ...
153 : !> \param rbc ...
154 : !> \param difmab ...
155 : !> \param mab_ext ...
156 : !> \param deltaR needed for weighted derivative
157 : !> \param iatom ...
158 : !> \param jatom ...
159 : !> SL August 2015, ED 2021
160 : ! **************************************************************************************************
161 2106 : SUBROUTINE diff_momop2(la_max, npgfa, zeta, rpgfa, la_min, &
162 2106 : lb_max, npgfb, zetb, rpgfb, lb_min, &
163 2106 : order, rac, rbc, difmab, mab_ext, deltaR, iatom, jatom)
164 :
165 : INTEGER, INTENT(IN) :: la_max, npgfa
166 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: zeta, rpgfa
167 : INTEGER, INTENT(IN) :: la_min, lb_max, npgfb
168 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: zetb, rpgfb
169 : INTEGER, INTENT(IN) :: lb_min, order
170 : REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: rac, rbc
171 : REAL(KIND=dp), DIMENSION(:, :, :, :), INTENT(OUT) :: difmab
172 : REAL(KIND=dp), DIMENSION(:, :, :), OPTIONAL, &
173 : POINTER :: mab_ext
174 : REAL(KIND=dp), DIMENSION(:, :), INTENT(IN), &
175 : OPTIONAL, POINTER :: deltaR
176 : INTEGER, INTENT(IN), OPTIONAL :: iatom, jatom
177 :
178 : INTEGER :: imom, lda, lda_min, ldb, ldb_min
179 : REAL(KIND=dp) :: dab, rab(3)
180 2106 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: difmab_tmp
181 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: mab
182 :
183 8424 : rab = rbc - rac
184 8424 : dab = SQRT(SUM(rab**2))
185 :
186 2106 : lda_min = MAX(0, la_min - 1)
187 2106 : ldb_min = MAX(0, lb_min - 1)
188 2106 : lda = ncoset(la_max)*npgfa
189 2106 : ldb = ncoset(lb_max)*npgfb
190 10530 : ALLOCATE (difmab_tmp(lda, ldb, 3))
191 :
192 2106 : IF (PRESENT(mab_ext)) THEN
193 0 : mab => mab_ext
194 : ELSE
195 : ALLOCATE (mab(npgfa*ncoset(la_max + 1), npgfb*ncoset(lb_max + 1), &
196 10530 : ncoset(order) - 1))
197 3799224 : mab = 0.0_dp
198 : ! *** Calculate the primitive moment integrals ***
199 : CALL moment(la_max + 1, npgfa, zeta, rpgfa, lda_min, &
200 : lb_max + 1, npgfb, zetb, rpgfb, &
201 2106 : order, rac, rbc, mab)
202 : END IF
203 8424 : DO imom = 1, ncoset(order) - 1
204 1389960 : difmab(:, :, imom, :) = 0.0_dp
205 :
206 1389960 : difmab_tmp = 0.0_dp
207 : CALL adbdr(la_max, npgfa, rpgfa, la_min, &
208 : lb_max, npgfb, zetb, rpgfb, lb_min, &
209 : dab, mab(:, :, imom), difmab_tmp(:, :, 1), &
210 6318 : difmab_tmp(:, :, 2), difmab_tmp(:, :, 3))
211 :
212 461214 : difmab(:, :, imom, 1) = difmab_tmp(:, :, 1)*deltaR(1, jatom)
213 461214 : difmab(:, :, imom, 2) = difmab_tmp(:, :, 2)*deltaR(2, jatom)
214 461214 : difmab(:, :, imom, 3) = difmab_tmp(:, :, 3)*deltaR(3, jatom)
215 :
216 1389960 : difmab_tmp = 0.0_dp
217 : CALL dabdr(la_max, npgfa, zeta, rpgfa, la_min, &
218 : lb_max, npgfb, rpgfb, lb_min, &
219 : dab, mab(:, :, imom), difmab_tmp(:, :, 1), &
220 6318 : difmab_tmp(:, :, 2), difmab_tmp(:, :, 3))
221 :
222 461214 : difmab(:, :, imom, 1) = difmab(:, :, imom, 1) + difmab_tmp(:, :, 1)*deltaR(1, iatom)
223 461214 : difmab(:, :, imom, 2) = difmab(:, :, imom, 2) + difmab_tmp(:, :, 2)*deltaR(2, iatom)
224 463320 : difmab(:, :, imom, 3) = difmab(:, :, imom, 3) + difmab_tmp(:, :, 3)*deltaR(3, iatom)
225 : END DO
226 :
227 2106 : IF (PRESENT(mab_ext)) THEN
228 : NULLIFY (mab)
229 : ELSE
230 2106 : DEALLOCATE (mab)
231 : END IF
232 2106 : DEALLOCATE (difmab_tmp)
233 2106 : END SUBROUTINE diff_momop2
234 :
235 : ! **************************************************************************************************
236 : !> \brief ...
237 : !> \param cos_block ...
238 : !> \param sin_block ...
239 : !> \param iatom ...
240 : !> \param ncoa ...
241 : !> \param nsgfa ...
242 : !> \param sgfa ...
243 : !> \param sphi_a ...
244 : !> \param ldsa ...
245 : !> \param jatom ...
246 : !> \param ncob ...
247 : !> \param nsgfb ...
248 : !> \param sgfb ...
249 : !> \param sphi_b ...
250 : !> \param ldsb ...
251 : !> \param cosab ...
252 : !> \param sinab ...
253 : !> \param ldab ...
254 : !> \param work ...
255 : !> \param ldwork ...
256 : ! **************************************************************************************************
257 2017135 : SUBROUTINE contract_cossin(cos_block, sin_block, &
258 4034270 : iatom, ncoa, nsgfa, sgfa, sphi_a, ldsa, &
259 4034270 : jatom, ncob, nsgfb, sgfb, sphi_b, ldsb, &
260 2017135 : cosab, sinab, ldab, work, ldwork)
261 :
262 : REAL(dp), DIMENSION(:, :), POINTER :: cos_block, sin_block
263 : INTEGER, INTENT(IN) :: iatom, ncoa, nsgfa, sgfa
264 : REAL(dp), DIMENSION(:, :), INTENT(IN) :: sphi_a
265 : INTEGER, INTENT(IN) :: ldsa, jatom, ncob, nsgfb, sgfb
266 : REAL(dp), DIMENSION(:, :), INTENT(IN) :: sphi_b
267 : INTEGER, INTENT(IN) :: ldsb
268 : REAL(dp), DIMENSION(:, :), INTENT(IN) :: cosab, sinab
269 : INTEGER, INTENT(IN) :: ldab
270 : REAL(dp), DIMENSION(:, :) :: work
271 : INTEGER, INTENT(IN) :: ldwork
272 :
273 : ! Calculate cosine
274 :
275 : CALL dgemm("N", "N", ncoa, nsgfb, ncob, &
276 : 1.0_dp, cosab(1, 1), ldab, &
277 : sphi_b(1, sgfb), ldsb, &
278 2017135 : 0.0_dp, work(1, 1), ldwork)
279 :
280 2017135 : IF (iatom <= jatom) THEN
281 : CALL dgemm("T", "N", nsgfa, nsgfb, ncoa, &
282 : 1.0_dp, sphi_a(1, sgfa), ldsa, &
283 : work(1, 1), ldwork, &
284 : 1.0_dp, cos_block(sgfa, sgfb), &
285 1157711 : SIZE(cos_block, 1))
286 : ELSE
287 : CALL dgemm("T", "N", nsgfb, nsgfa, ncoa, &
288 : 1.0_dp, work(1, 1), ldwork, &
289 : sphi_a(1, sgfa), ldsa, &
290 : 1.0_dp, cos_block(sgfb, sgfa), &
291 859424 : SIZE(cos_block, 1))
292 : END IF
293 :
294 : ! Calculate sine
295 : CALL dgemm("N", "N", ncoa, nsgfb, ncob, &
296 : 1.0_dp, sinab(1, 1), ldab, &
297 : sphi_b(1, sgfb), ldsb, &
298 2017135 : 0.0_dp, work(1, 1), ldwork)
299 :
300 2017135 : IF (iatom <= jatom) THEN
301 : CALL dgemm("T", "N", nsgfa, nsgfb, ncoa, &
302 : 1.0_dp, sphi_a(1, sgfa), ldsa, &
303 : work(1, 1), ldwork, &
304 : 1.0_dp, sin_block(sgfa, sgfb), &
305 1157711 : SIZE(sin_block, 1))
306 : ELSE
307 : CALL dgemm("T", "N", nsgfb, nsgfa, ncoa, &
308 : 1.0_dp, work(1, 1), ldwork, &
309 : sphi_a(1, sgfa), ldsa, &
310 : 1.0_dp, sin_block(sgfb, sgfa), &
311 859424 : SIZE(sin_block, 1))
312 : END IF
313 :
314 2017135 : END SUBROUTINE contract_cossin
315 :
316 : ! **************************************************************************************************
317 : !> \brief ...
318 : !> \param la_max_set ...
319 : !> \param npgfa ...
320 : !> \param zeta ...
321 : !> \param rpgfa ...
322 : !> \param la_min_set ...
323 : !> \param lb_max ...
324 : !> \param npgfb ...
325 : !> \param zetb ...
326 : !> \param rpgfb ...
327 : !> \param lb_min ...
328 : !> \param rac ...
329 : !> \param rbc ...
330 : !> \param kvec ...
331 : !> \param cosab ...
332 : !> \param sinab ...
333 : !> \param dcosab ...
334 : !> \param dsinab ...
335 : ! **************************************************************************************************
336 2025257 : SUBROUTINE cossin(la_max_set, npgfa, zeta, rpgfa, la_min_set, &
337 2025257 : lb_max, npgfb, zetb, rpgfb, lb_min, &
338 2025257 : rac, rbc, kvec, cosab, sinab, dcosab, dsinab)
339 :
340 : INTEGER, INTENT(IN) :: la_max_set, npgfa
341 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: zeta, rpgfa
342 : INTEGER, INTENT(IN) :: la_min_set, lb_max, npgfb
343 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: zetb, rpgfb
344 : INTEGER, INTENT(IN) :: lb_min
345 : REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: rac, rbc, kvec
346 : REAL(KIND=dp), DIMENSION(:, :), INTENT(INOUT) :: cosab, sinab
347 : REAL(KIND=dp), DIMENSION(:, :, :), INTENT(INOUT), &
348 : OPTIONAL :: dcosab, dsinab
349 :
350 : INTEGER :: ax, ay, az, bx, by, bz, cda, cdax, cday, cdaz, coa, coamx, coamy, coamz, coapx, &
351 : coapy, coapz, cob, da, da_max, dax, day, daz, i, ipgf, j, jpgf, k, la, la_max, la_min, &
352 : la_start, lb, lb_start, na, nb
353 : REAL(KIND=dp) :: dab, f0, f1, f2, f3, fax, fay, faz, ftz, &
354 : fx, fy, fz, k2, kdp, rab2, s, zetp
355 : REAL(KIND=dp), DIMENSION(3) :: rab, rap, rbp
356 : REAL(KIND=dp), DIMENSION(ncoset(la_max_set), &
357 4050514 : ncoset(lb_max), 3) :: dscos, dssin
358 : REAL(KIND=dp), &
359 2025257 : DIMENSION(ncoset(la_max_set+1), ncoset(lb_max)) :: sc, ss
360 :
361 8101028 : rab = rbc - rac
362 8101028 : rab2 = SUM(rab**2)
363 2025257 : dab = SQRT(rab2)
364 2025257 : k2 = kvec(1)*kvec(1) + kvec(2)*kvec(2) + kvec(3)*kvec(3)
365 :
366 2025257 : IF (PRESENT(dcosab)) THEN
367 7900 : da_max = 1
368 7900 : la_max = la_max_set + 1
369 7900 : la_min = MAX(0, la_min_set - 1)
370 384046 : dscos = 0.0_dp
371 384046 : dssin = 0.0_dp
372 : ELSE
373 2017357 : da_max = 0
374 2017357 : la_max = la_max_set
375 2017357 : la_min = la_min_set
376 : END IF
377 :
378 : ! initialize all matrix elements to zero
379 2025257 : IF (PRESENT(dcosab)) THEN
380 7900 : na = ncoset(la_max - 1)*npgfa
381 : ELSE
382 2017357 : na = ncoset(la_max)*npgfa
383 : END IF
384 2025257 : nb = ncoset(lb_max)*npgfb
385 275234211 : cosab(1:na, 1:nb) = 0.0_dp
386 275234211 : sinab(1:na, 1:nb) = 0.0_dp
387 2025257 : IF (PRESENT(dcosab)) THEN
388 1873150 : dcosab(1:na, 1:nb, :) = 0.0_dp
389 1873150 : dsinab(1:na, 1:nb, :) = 0.0_dp
390 : END IF
391 : ! *** Loop over all pairs of primitive Gaussian-type functions ***
392 :
393 2025257 : na = 0
394 10155280 : DO ipgf = 1, npgfa
395 :
396 : nb = 0
397 :
398 56112427 : DO jpgf = 1, npgfb
399 :
400 800944245 : ss = 0.0_dp
401 800944245 : sc = 0.0_dp
402 :
403 : ! *** Screening ***
404 47982404 : IF (rpgfa(ipgf) + rpgfb(jpgf) < dab) THEN
405 39416778 : nb = nb + ncoset(lb_max)
406 39416778 : CYCLE
407 : END IF
408 :
409 : ! *** Calculate some prefactors ***
410 :
411 8565626 : zetp = 1.0_dp/(zeta(ipgf) + zetb(jpgf))
412 :
413 8565626 : f0 = (pi*zetp)**1.5_dp
414 8565626 : f1 = zetb(jpgf)*zetp
415 8565626 : f2 = 0.5_dp*zetp
416 :
417 34262504 : kdp = zetp*DOT_PRODUCT(kvec, zeta(ipgf)*rac + zetb(jpgf)*rbc)
418 :
419 : ! *** Calculate the basic two-center cos/sin integral [s|cos/sin|s] ***
420 :
421 8565626 : s = f0*EXP(-zeta(ipgf)*f1*rab2)*EXP(-0.25_dp*k2*zetp)
422 8565626 : sc(1, 1) = s*COS(kdp)
423 8565626 : ss(1, 1) = s*SIN(kdp)
424 :
425 : ! *** Recurrence steps: [s|O|s] -> [a|O|b] ***
426 :
427 8565626 : IF (la_max > 0) THEN
428 :
429 : ! *** Vertical recurrence steps: [s|O|s] -> [a|O|s] ***
430 :
431 10424052 : rap(:) = f1*rab(:)
432 :
433 : ! *** [p|O|s] = (Pi - Ai)*[s|O|s] +[s|dO|s] (i = x,y,z) ***
434 :
435 2606013 : sc(2, 1) = rap(1)*sc(1, 1) - f2*kvec(1)*ss(1, 1)
436 2606013 : sc(3, 1) = rap(2)*sc(1, 1) - f2*kvec(2)*ss(1, 1)
437 2606013 : sc(4, 1) = rap(3)*sc(1, 1) - f2*kvec(3)*ss(1, 1)
438 2606013 : ss(2, 1) = rap(1)*ss(1, 1) + f2*kvec(1)*sc(1, 1)
439 2606013 : ss(3, 1) = rap(2)*ss(1, 1) + f2*kvec(2)*sc(1, 1)
440 2606013 : ss(4, 1) = rap(3)*ss(1, 1) + f2*kvec(3)*sc(1, 1)
441 :
442 : ! *** [a|O|s] = (Pi - Ai)*[a-1i|O|s] + f2*Ni(a-1i)*[a-2i|s] ***
443 : ! *** + [a-1i|dO|s] ***
444 :
445 3151957 : DO la = 2, la_max
446 :
447 : ! *** Increase the angular momentum component z of function a ***
448 :
449 : sc(coset(0, 0, la), 1) = rap(3)*sc(coset(0, 0, la - 1), 1) + &
450 : f2*REAL(la - 1, dp)*sc(coset(0, 0, la - 2), 1) - &
451 545944 : f2*kvec(3)*ss(coset(0, 0, la - 1), 1)
452 : ss(coset(0, 0, la), 1) = rap(3)*ss(coset(0, 0, la - 1), 1) + &
453 : f2*REAL(la - 1, dp)*ss(coset(0, 0, la - 2), 1) + &
454 545944 : f2*kvec(3)*sc(coset(0, 0, la - 1), 1)
455 :
456 : ! *** Increase the angular momentum component y of function a ***
457 :
458 545944 : az = la - 1
459 : sc(coset(0, 1, az), 1) = rap(2)*sc(coset(0, 0, az), 1) - &
460 545944 : f2*kvec(2)*ss(coset(0, 0, az), 1)
461 : ss(coset(0, 1, az), 1) = rap(2)*ss(coset(0, 0, az), 1) + &
462 545944 : f2*kvec(2)*sc(coset(0, 0, az), 1)
463 :
464 1102470 : DO ay = 2, la
465 556526 : az = la - ay
466 : sc(coset(0, ay, az), 1) = rap(2)*sc(coset(0, ay - 1, az), 1) + &
467 : f2*REAL(ay - 1, dp)*sc(coset(0, ay - 2, az), 1) - &
468 556526 : f2*kvec(2)*ss(coset(0, ay - 1, az), 1)
469 : ss(coset(0, ay, az), 1) = rap(2)*ss(coset(0, ay - 1, az), 1) + &
470 : f2*REAL(ay - 1, dp)*ss(coset(0, ay - 2, az), 1) + &
471 1102470 : f2*kvec(2)*sc(coset(0, ay - 1, az), 1)
472 : END DO
473 :
474 : ! *** Increase the angular momentum component x of function a ***
475 :
476 1648414 : DO ay = 0, la - 1
477 1102470 : az = la - 1 - ay
478 : sc(coset(1, ay, az), 1) = rap(1)*sc(coset(0, ay, az), 1) - &
479 1102470 : f2*kvec(1)*ss(coset(0, ay, az), 1)
480 : ss(coset(1, ay, az), 1) = rap(1)*ss(coset(0, ay, az), 1) + &
481 1648414 : f2*kvec(1)*sc(coset(0, ay, az), 1)
482 : END DO
483 :
484 3708483 : DO ax = 2, la
485 556526 : f3 = f2*REAL(ax - 1, dp)
486 1669839 : DO ay = 0, la - ax
487 567369 : az = la - ax - ay
488 : sc(coset(ax, ay, az), 1) = rap(1)*sc(coset(ax - 1, ay, az), 1) + &
489 : f3*sc(coset(ax - 2, ay, az), 1) - &
490 567369 : f2*kvec(1)*ss(coset(ax - 1, ay, az), 1)
491 : ss(coset(ax, ay, az), 1) = rap(1)*ss(coset(ax - 1, ay, az), 1) + &
492 : f3*ss(coset(ax - 2, ay, az), 1) + &
493 1123895 : f2*kvec(1)*sc(coset(ax - 1, ay, az), 1)
494 : END DO
495 : END DO
496 :
497 : END DO
498 :
499 : ! *** Recurrence steps: [a|O|s] -> [a|O|b] ***
500 :
501 2606013 : IF (lb_max > 0) THEN
502 :
503 8874224 : DO j = 2, ncoset(lb_max)
504 54545897 : DO i = 1, ncoset(la_max)
505 45671673 : sc(i, j) = 0.0_dp
506 52995420 : ss(i, j) = 0.0_dp
507 : END DO
508 : END DO
509 :
510 : ! *** Horizontal recurrence steps ***
511 :
512 6201908 : rbp(:) = rap(:) - rab(:)
513 :
514 : ! *** [a|O|p] = [a+1i|O|s] - (Bi - Ai)*[a|O|s] ***
515 :
516 1550477 : IF (lb_max == 1) THEN
517 : la_start = la_min
518 : ELSE
519 436836 : la_start = MAX(0, la_min - 1)
520 : END IF
521 :
522 2978850 : DO la = la_start, la_max - 1
523 4691033 : DO ax = 0, la
524 5138748 : DO ay = 0, la - ax
525 1998192 : az = la - ax - ay
526 : sc(coset(ax, ay, az), 2) = sc(coset(ax + 1, ay, az), 1) - &
527 1998192 : rab(1)*sc(coset(ax, ay, az), 1)
528 : sc(coset(ax, ay, az), 3) = sc(coset(ax, ay + 1, az), 1) - &
529 1998192 : rab(2)*sc(coset(ax, ay, az), 1)
530 : sc(coset(ax, ay, az), 4) = sc(coset(ax, ay, az + 1), 1) - &
531 1998192 : rab(3)*sc(coset(ax, ay, az), 1)
532 : ss(coset(ax, ay, az), 2) = ss(coset(ax + 1, ay, az), 1) - &
533 1998192 : rab(1)*ss(coset(ax, ay, az), 1)
534 : ss(coset(ax, ay, az), 3) = ss(coset(ax, ay + 1, az), 1) - &
535 1998192 : rab(2)*ss(coset(ax, ay, az), 1)
536 : ss(coset(ax, ay, az), 4) = ss(coset(ax, ay, az + 1), 1) - &
537 3710375 : rab(3)*ss(coset(ax, ay, az), 1)
538 : END DO
539 : END DO
540 : END DO
541 :
542 : ! *** Vertical recurrence step ***
543 :
544 : ! *** [a|O|p] = (Pi - Bi)*[a|O|s] + f2*Ni(a)*[a-1i|O|s] ***
545 : ! *** + [a|dO|s] ***
546 :
547 5099062 : DO ax = 0, la_max
548 3548585 : fx = f2*REAL(ax, dp)
549 11099446 : DO ay = 0, la_max - ax
550 6000384 : fy = f2*REAL(ay, dp)
551 6000384 : az = la_max - ax - ay
552 6000384 : fz = f2*REAL(az, dp)
553 6000384 : IF (ax == 0) THEN
554 : sc(coset(ax, ay, az), 2) = rbp(1)*sc(coset(ax, ay, az), 1) - &
555 3548585 : f2*kvec(1)*ss(coset(ax, ay, az), 1)
556 : ss(coset(ax, ay, az), 2) = rbp(1)*ss(coset(ax, ay, az), 1) + &
557 3548585 : f2*kvec(1)*sc(coset(ax, ay, az), 1)
558 : ELSE
559 : sc(coset(ax, ay, az), 2) = rbp(1)*sc(coset(ax, ay, az), 1) + &
560 : fx*sc(coset(ax - 1, ay, az), 1) - &
561 2451799 : f2*kvec(1)*ss(coset(ax, ay, az), 1)
562 : ss(coset(ax, ay, az), 2) = rbp(1)*ss(coset(ax, ay, az), 1) + &
563 : fx*ss(coset(ax - 1, ay, az), 1) + &
564 2451799 : f2*kvec(1)*sc(coset(ax, ay, az), 1)
565 : END IF
566 6000384 : IF (ay == 0) THEN
567 : sc(coset(ax, ay, az), 3) = rbp(2)*sc(coset(ax, ay, az), 1) - &
568 3548585 : f2*kvec(2)*ss(coset(ax, ay, az), 1)
569 : ss(coset(ax, ay, az), 3) = rbp(2)*ss(coset(ax, ay, az), 1) + &
570 3548585 : f2*kvec(2)*sc(coset(ax, ay, az), 1)
571 : ELSE
572 : sc(coset(ax, ay, az), 3) = rbp(2)*sc(coset(ax, ay, az), 1) + &
573 : fy*sc(coset(ax, ay - 1, az), 1) - &
574 2451799 : f2*kvec(2)*ss(coset(ax, ay, az), 1)
575 : ss(coset(ax, ay, az), 3) = rbp(2)*ss(coset(ax, ay, az), 1) + &
576 : fy*ss(coset(ax, ay - 1, az), 1) + &
577 2451799 : f2*kvec(2)*sc(coset(ax, ay, az), 1)
578 : END IF
579 9548969 : IF (az == 0) THEN
580 : sc(coset(ax, ay, az), 4) = rbp(3)*sc(coset(ax, ay, az), 1) - &
581 3548585 : f2*kvec(3)*ss(coset(ax, ay, az), 1)
582 : ss(coset(ax, ay, az), 4) = rbp(3)*ss(coset(ax, ay, az), 1) + &
583 3548585 : f2*kvec(3)*sc(coset(ax, ay, az), 1)
584 : ELSE
585 : sc(coset(ax, ay, az), 4) = rbp(3)*sc(coset(ax, ay, az), 1) + &
586 : fz*sc(coset(ax, ay, az - 1), 1) - &
587 2451799 : f2*kvec(3)*ss(coset(ax, ay, az), 1)
588 : ss(coset(ax, ay, az), 4) = rbp(3)*ss(coset(ax, ay, az), 1) + &
589 : fz*ss(coset(ax, ay, az - 1), 1) + &
590 2451799 : f2*kvec(3)*sc(coset(ax, ay, az), 1)
591 : END IF
592 : END DO
593 : END DO
594 :
595 : ! *** Recurrence steps: [a|O|p] -> [a|O|b] ***
596 :
597 1992380 : DO lb = 2, lb_max
598 :
599 : ! *** Horizontal recurrence steps ***
600 :
601 : ! *** [a|O|b] = [a+1i|O|b-1i] - (Bi - Ai)*[a|O|b-1i] ***
602 :
603 441903 : IF (lb == lb_max) THEN
604 : la_start = la_min
605 : ELSE
606 5067 : la_start = MAX(0, la_min - 1)
607 : END IF
608 :
609 953258 : DO la = la_start, la_max - 1
610 1632671 : DO ax = 0, la
611 2038756 : DO ay = 0, la - ax
612 847988 : az = la - ax - ay
613 :
614 : ! *** Shift of angular momentum component z from a to b ***
615 :
616 : sc(coset(ax, ay, az), coset(0, 0, lb)) = &
617 : sc(coset(ax, ay, az + 1), coset(0, 0, lb - 1)) - &
618 847988 : rab(3)*sc(coset(ax, ay, az), coset(0, 0, lb - 1))
619 : ss(coset(ax, ay, az), coset(0, 0, lb)) = &
620 : ss(coset(ax, ay, az + 1), coset(0, 0, lb - 1)) - &
621 847988 : rab(3)*ss(coset(ax, ay, az), coset(0, 0, lb - 1))
622 :
623 : ! *** Shift of angular momentum component y from a to b ***
624 :
625 2546643 : DO by = 1, lb
626 1698655 : bz = lb - by
627 : sc(coset(ax, ay, az), coset(0, by, bz)) = &
628 : sc(coset(ax, ay + 1, az), coset(0, by - 1, bz)) - &
629 1698655 : rab(2)*sc(coset(ax, ay, az), coset(0, by - 1, bz))
630 : ss(coset(ax, ay, az), coset(0, by, bz)) = &
631 : ss(coset(ax, ay + 1, az), coset(0, by - 1, bz)) - &
632 2546643 : rab(2)*ss(coset(ax, ay, az), coset(0, by - 1, bz))
633 : END DO
634 :
635 : ! *** Shift of angular momentum component x from a to b ***
636 :
637 3226056 : DO bx = 1, lb
638 5098644 : DO by = 0, lb - bx
639 2552001 : bz = lb - bx - by
640 : sc(coset(ax, ay, az), coset(bx, by, bz)) = &
641 : sc(coset(ax + 1, ay, az), coset(bx - 1, by, bz)) - &
642 2552001 : rab(1)*sc(coset(ax, ay, az), coset(bx - 1, by, bz))
643 : ss(coset(ax, ay, az), coset(bx, by, bz)) = &
644 : ss(coset(ax + 1, ay, az), coset(bx - 1, by, bz)) - &
645 4250656 : rab(1)*ss(coset(ax, ay, az), coset(bx - 1, by, bz))
646 : END DO
647 : END DO
648 :
649 : END DO
650 : END DO
651 : END DO
652 :
653 : ! *** Vertical recurrence step ***
654 :
655 : ! *** [a|O|b] = (Pi - Bi)*[a|O|b-1i] + f2*Ni(a)*[a-1i|O|b-1i] + ***
656 : ! *** f2*Ni(b-1i)*[a|O|b-2i] + [a|dO|b-1i] ***
657 :
658 3102545 : DO ax = 0, la_max
659 1110165 : fx = f2*REAL(ax, dp)
660 3558724 : DO ay = 0, la_max - ax
661 2006656 : fy = f2*REAL(ay, dp)
662 2006656 : az = la_max - ax - ay
663 2006656 : fz = f2*REAL(az, dp)
664 :
665 : ! *** Increase the angular momentum component z of function b ***
666 :
667 2006656 : f3 = f2*REAL(lb - 1, dp)
668 :
669 2006656 : IF (az == 0) THEN
670 : sc(coset(ax, ay, az), coset(0, 0, lb)) = &
671 : rbp(3)*sc(coset(ax, ay, az), coset(0, 0, lb - 1)) + &
672 : f3*sc(coset(ax, ay, az), coset(0, 0, lb - 2)) - &
673 1110165 : f2*kvec(3)*ss(coset(ax, ay, az), coset(0, 0, lb - 1))
674 : ss(coset(ax, ay, az), coset(0, 0, lb)) = &
675 : rbp(3)*ss(coset(ax, ay, az), coset(0, 0, lb - 1)) + &
676 : f3*ss(coset(ax, ay, az), coset(0, 0, lb - 2)) + &
677 1110165 : f2*kvec(3)*sc(coset(ax, ay, az), coset(0, 0, lb - 1))
678 : ELSE
679 : sc(coset(ax, ay, az), coset(0, 0, lb)) = &
680 : rbp(3)*sc(coset(ax, ay, az), coset(0, 0, lb - 1)) + &
681 : fz*sc(coset(ax, ay, az - 1), coset(0, 0, lb - 1)) + &
682 : f3*sc(coset(ax, ay, az), coset(0, 0, lb - 2)) - &
683 896491 : f2*kvec(3)*ss(coset(ax, ay, az), coset(0, 0, lb - 1))
684 : ss(coset(ax, ay, az), coset(0, 0, lb)) = &
685 : rbp(3)*ss(coset(ax, ay, az), coset(0, 0, lb - 1)) + &
686 : fz*ss(coset(ax, ay, az - 1), coset(0, 0, lb - 1)) + &
687 : f3*ss(coset(ax, ay, az), coset(0, 0, lb - 2)) + &
688 896491 : f2*kvec(3)*sc(coset(ax, ay, az), coset(0, 0, lb - 1))
689 : END IF
690 :
691 : ! *** Increase the angular momentum component y of function b ***
692 :
693 2006656 : IF (ay == 0) THEN
694 1110165 : bz = lb - 1
695 : sc(coset(ax, ay, az), coset(0, 1, bz)) = &
696 : rbp(2)*sc(coset(ax, ay, az), coset(0, 0, bz)) - &
697 1110165 : f2*kvec(2)*ss(coset(ax, ay, az), coset(0, 0, bz))
698 : ss(coset(ax, ay, az), coset(0, 1, bz)) = &
699 : rbp(2)*ss(coset(ax, ay, az), coset(0, 0, bz)) + &
700 1110165 : f2*kvec(2)*sc(coset(ax, ay, az), coset(0, 0, bz))
701 2232516 : DO by = 2, lb
702 1122351 : bz = lb - by
703 1122351 : f3 = f2*REAL(by - 1, dp)
704 : sc(coset(ax, ay, az), coset(0, by, bz)) = &
705 : rbp(2)*sc(coset(ax, ay, az), coset(0, by - 1, bz)) + &
706 : f3*sc(coset(ax, ay, az), coset(0, by - 2, bz)) - &
707 1122351 : f2*kvec(2)*ss(coset(ax, ay, az), coset(0, by - 1, bz))
708 : ss(coset(ax, ay, az), coset(0, by, bz)) = &
709 : rbp(2)*ss(coset(ax, ay, az), coset(0, by - 1, bz)) + &
710 : f3*ss(coset(ax, ay, az), coset(0, by - 2, bz)) + &
711 2232516 : f2*kvec(2)*sc(coset(ax, ay, az), coset(0, by - 1, bz))
712 : END DO
713 : ELSE
714 896491 : bz = lb - 1
715 : sc(coset(ax, ay, az), coset(0, 1, bz)) = &
716 : rbp(2)*sc(coset(ax, ay, az), coset(0, 0, bz)) + &
717 : fy*sc(coset(ax, ay - 1, az), coset(0, 0, bz)) - &
718 896491 : f2*kvec(2)*ss(coset(ax, ay, az), coset(0, 0, bz))
719 : ss(coset(ax, ay, az), coset(0, 1, bz)) = &
720 : rbp(2)*ss(coset(ax, ay, az), coset(0, 0, bz)) + &
721 : fy*ss(coset(ax, ay - 1, az), coset(0, 0, bz)) + &
722 896491 : f2*kvec(2)*sc(coset(ax, ay, az), coset(0, 0, bz))
723 1802261 : DO by = 2, lb
724 905770 : bz = lb - by
725 905770 : f3 = f2*REAL(by - 1, dp)
726 : sc(coset(ax, ay, az), coset(0, by, bz)) = &
727 : rbp(2)*sc(coset(ax, ay, az), coset(0, by - 1, bz)) + &
728 : fy*sc(coset(ax, ay - 1, az), coset(0, by - 1, bz)) + &
729 : f3*sc(coset(ax, ay, az), coset(0, by - 2, bz)) - &
730 905770 : f2*kvec(2)*ss(coset(ax, ay, az), coset(0, by - 1, bz))
731 : ss(coset(ax, ay, az), coset(0, by, bz)) = &
732 : rbp(2)*ss(coset(ax, ay, az), coset(0, by - 1, bz)) + &
733 : fy*ss(coset(ax, ay - 1, az), coset(0, by - 1, bz)) + &
734 : f3*ss(coset(ax, ay, az), coset(0, by - 2, bz)) + &
735 1802261 : f2*kvec(2)*sc(coset(ax, ay, az), coset(0, by - 1, bz))
736 : END DO
737 : END IF
738 :
739 : ! *** Increase the angular momentum component x of function b ***
740 :
741 3116821 : IF (ax == 0) THEN
742 3342681 : DO by = 0, lb - 1
743 2232516 : bz = lb - 1 - by
744 : sc(coset(ax, ay, az), coset(1, by, bz)) = &
745 : rbp(1)*sc(coset(ax, ay, az), coset(0, by, bz)) - &
746 2232516 : f2*kvec(1)*ss(coset(ax, ay, az), coset(0, by, bz))
747 : ss(coset(ax, ay, az), coset(1, by, bz)) = &
748 : rbp(1)*ss(coset(ax, ay, az), coset(0, by, bz)) + &
749 3342681 : f2*kvec(1)*sc(coset(ax, ay, az), coset(0, by, bz))
750 : END DO
751 2232516 : DO bx = 2, lb
752 1122351 : f3 = f2*REAL(bx - 1, dp)
753 3367395 : DO by = 0, lb - bx
754 1134879 : bz = lb - bx - by
755 : sc(coset(ax, ay, az), coset(bx, by, bz)) = &
756 : rbp(1)*sc(coset(ax, ay, az), &
757 : coset(bx - 1, by, bz)) + &
758 : f3*sc(coset(ax, ay, az), coset(bx - 2, by, bz)) - &
759 1134879 : f2*kvec(1)*ss(coset(ax, ay, az), coset(bx - 1, by, bz))
760 : ss(coset(ax, ay, az), coset(bx, by, bz)) = &
761 : rbp(1)*ss(coset(ax, ay, az), &
762 : coset(bx - 1, by, bz)) + &
763 : f3*ss(coset(ax, ay, az), coset(bx - 2, by, bz)) + &
764 2257230 : f2*kvec(1)*sc(coset(ax, ay, az), coset(bx - 1, by, bz))
765 : END DO
766 : END DO
767 : ELSE
768 2698752 : DO by = 0, lb - 1
769 1802261 : bz = lb - 1 - by
770 : sc(coset(ax, ay, az), coset(1, by, bz)) = &
771 : rbp(1)*sc(coset(ax, ay, az), coset(0, by, bz)) + &
772 : fx*sc(coset(ax - 1, ay, az), coset(0, by, bz)) - &
773 1802261 : f2*kvec(1)*ss(coset(ax, ay, az), coset(0, by, bz))
774 : ss(coset(ax, ay, az), coset(1, by, bz)) = &
775 : rbp(1)*ss(coset(ax, ay, az), coset(0, by, bz)) + &
776 : fx*ss(coset(ax - 1, ay, az), coset(0, by, bz)) + &
777 2698752 : f2*kvec(1)*sc(coset(ax, ay, az), coset(0, by, bz))
778 : END DO
779 1802261 : DO bx = 2, lb
780 905770 : f3 = f2*REAL(bx - 1, dp)
781 2717661 : DO by = 0, lb - bx
782 915400 : bz = lb - bx - by
783 : sc(coset(ax, ay, az), coset(bx, by, bz)) = &
784 : rbp(1)*sc(coset(ax, ay, az), &
785 : coset(bx - 1, by, bz)) + &
786 : fx*sc(coset(ax - 1, ay, az), coset(bx - 1, by, bz)) + &
787 : f3*sc(coset(ax, ay, az), coset(bx - 2, by, bz)) - &
788 915400 : f2*kvec(1)*ss(coset(ax, ay, az), coset(bx - 1, by, bz))
789 : ss(coset(ax, ay, az), coset(bx, by, bz)) = &
790 : rbp(1)*ss(coset(ax, ay, az), &
791 : coset(bx - 1, by, bz)) + &
792 : fx*ss(coset(ax - 1, ay, az), coset(bx - 1, by, bz)) + &
793 : f3*ss(coset(ax, ay, az), coset(bx - 2, by, bz)) + &
794 1821170 : f2*kvec(1)*sc(coset(ax, ay, az), coset(bx - 1, by, bz))
795 : END DO
796 : END DO
797 : END IF
798 :
799 : END DO
800 : END DO
801 :
802 : END DO
803 :
804 : END IF
805 :
806 : ELSE
807 :
808 5959613 : IF (lb_max > 0) THEN
809 :
810 : ! *** Vertical recurrence steps: [s|O|s] -> [s|O|b] ***
811 :
812 4152156 : rbp(:) = (f1 - 1.0_dp)*rab(:)
813 :
814 : ! *** [s|O|p] = (Pi - Bi)*[s|O|s] + [s|dO|s] ***
815 :
816 1038039 : sc(1, 2) = rbp(1)*sc(1, 1) - f2*kvec(1)*ss(1, 1)
817 1038039 : sc(1, 3) = rbp(2)*sc(1, 1) - f2*kvec(2)*ss(1, 1)
818 1038039 : sc(1, 4) = rbp(3)*sc(1, 1) - f2*kvec(3)*ss(1, 1)
819 1038039 : ss(1, 2) = rbp(1)*ss(1, 1) + f2*kvec(1)*sc(1, 1)
820 1038039 : ss(1, 3) = rbp(2)*ss(1, 1) + f2*kvec(2)*sc(1, 1)
821 1038039 : ss(1, 4) = rbp(3)*ss(1, 1) + f2*kvec(3)*sc(1, 1)
822 :
823 : ! *** [s|O|b] = (Pi - Bi)*[s|O|b-1i] + f2*Ni(b-1i)*[s|O|b-2i] ***
824 : ! *** + [s|dO|b-1i] ***
825 :
826 1130253 : DO lb = 2, lb_max
827 :
828 : ! *** Increase the angular momentum component z of function b ***
829 :
830 : sc(1, coset(0, 0, lb)) = rbp(3)*sc(1, coset(0, 0, lb - 1)) + &
831 : f2*REAL(lb - 1, dp)*sc(1, coset(0, 0, lb - 2)) - &
832 92214 : f2*kvec(3)*ss(1, coset(0, 0, lb - 1))
833 : ss(1, coset(0, 0, lb)) = rbp(3)*ss(1, coset(0, 0, lb - 1)) + &
834 : f2*REAL(lb - 1, dp)*ss(1, coset(0, 0, lb - 2)) + &
835 92214 : f2*kvec(3)*sc(1, coset(0, 0, lb - 1))
836 :
837 : ! *** Increase the angular momentum component y of function b ***
838 :
839 92214 : bz = lb - 1
840 : sc(1, coset(0, 1, bz)) = rbp(2)*sc(1, coset(0, 0, bz)) - &
841 92214 : f2*kvec(2)*ss(1, coset(0, 0, bz))
842 : ss(1, coset(0, 1, bz)) = rbp(2)*ss(1, coset(0, 0, bz)) + &
843 92214 : f2*kvec(2)*sc(1, coset(0, 0, bz))
844 :
845 188586 : DO by = 2, lb
846 96372 : bz = lb - by
847 : sc(1, coset(0, by, bz)) = rbp(2)*sc(1, coset(0, by - 1, bz)) + &
848 : f2*REAL(by - 1, dp)*sc(1, coset(0, by - 2, bz)) - &
849 96372 : f2*kvec(2)*ss(1, coset(0, by - 1, bz))
850 : ss(1, coset(0, by, bz)) = rbp(2)*ss(1, coset(0, by - 1, bz)) + &
851 : f2*REAL(by - 1, dp)*ss(1, coset(0, by - 2, bz)) + &
852 188586 : f2*kvec(2)*sc(1, coset(0, by - 1, bz))
853 : END DO
854 :
855 : ! *** Increase the angular momentum component x of function b ***
856 :
857 280800 : DO by = 0, lb - 1
858 188586 : bz = lb - 1 - by
859 : sc(1, coset(1, by, bz)) = rbp(1)*sc(1, coset(0, by, bz)) - &
860 188586 : f2*kvec(1)*ss(1, coset(0, by, bz))
861 : ss(1, coset(1, by, bz)) = rbp(1)*ss(1, coset(0, by, bz)) + &
862 280800 : f2*kvec(1)*sc(1, coset(0, by, bz))
863 : END DO
864 :
865 1226625 : DO bx = 2, lb
866 96372 : f3 = f2*REAL(bx - 1, dp)
867 289251 : DO by = 0, lb - bx
868 100665 : bz = lb - bx - by
869 : sc(1, coset(bx, by, bz)) = rbp(1)*sc(1, coset(bx - 1, by, bz)) + &
870 : f3*sc(1, coset(bx - 2, by, bz)) - &
871 100665 : f2*kvec(1)*ss(1, coset(bx - 1, by, bz))
872 : ss(1, coset(bx, by, bz)) = rbp(1)*ss(1, coset(bx - 1, by, bz)) + &
873 : f3*ss(1, coset(bx - 2, by, bz)) + &
874 197037 : f2*kvec(1)*sc(1, coset(bx - 1, by, bz))
875 : END DO
876 : END DO
877 :
878 : END DO
879 :
880 : END IF
881 :
882 : END IF
883 :
884 25870089 : DO j = ncoset(lb_min - 1) + 1, ncoset(lb_max)
885 81313243 : DO i = ncoset(la_min_set - 1) + 1, ncoset(la_max_set)
886 55443154 : cosab(na + i, nb + j) = sc(i, j)
887 72747617 : sinab(na + i, nb + j) = ss(i, j)
888 : END DO
889 : END DO
890 :
891 8565626 : IF (PRESENT(dcosab)) THEN
892 : la_start = 0
893 : lb_start = 0
894 : ELSE
895 8547274 : la_start = la_min
896 8547274 : lb_start = lb_min
897 : END IF
898 :
899 8583978 : DO da = 0, da_max - 1
900 18352 : ftz = 2.0_dp*zeta(ipgf)
901 8602330 : DO dax = 0, da
902 55056 : DO day = 0, da - dax
903 18352 : daz = da - dax - day
904 18352 : cda = coset(dax, day, daz) - 1
905 18352 : cdax = coset(dax + 1, day, daz) - 1
906 18352 : cday = coset(dax, day + 1, daz) - 1
907 18352 : cdaz = coset(dax, day, daz + 1) - 1
908 : !*** [da/dAi|O|b] = 2*zeta*[a+1i|O|b] - Ni(a)[a-1i|O|b] ***
909 :
910 65337 : DO la = la_start, la_max - da - 1
911 87160 : DO ax = 0, la
912 40175 : fax = REAL(ax, dp)
913 121786 : DO ay = 0, la - ax
914 52978 : fay = REAL(ay, dp)
915 52978 : az = la - ax - ay
916 52978 : faz = REAL(az, dp)
917 52978 : coa = coset(ax, ay, az)
918 52978 : coamx = coset(ax - 1, ay, az)
919 52978 : coamy = coset(ax, ay - 1, az)
920 52978 : coamz = coset(ax, ay, az - 1)
921 52978 : coapx = coset(ax + 1, ay, az)
922 52978 : coapy = coset(ax, ay + 1, az)
923 52978 : coapz = coset(ax, ay, az + 1)
924 180050 : DO lb = lb_start, lb_max
925 264924 : DO bx = 0, lb
926 379380 : DO by = 0, lb - bx
927 167434 : bz = lb - bx - by
928 167434 : cob = coset(bx, by, bz)
929 167434 : dscos(coa, cob, cdax) = ftz*sc(coapx, cob) - fax*sc(coamx, cob)
930 167434 : dscos(coa, cob, cday) = ftz*sc(coapy, cob) - fay*sc(coamy, cob)
931 167434 : dscos(coa, cob, cdaz) = ftz*sc(coapz, cob) - faz*sc(coamz, cob)
932 167434 : dssin(coa, cob, cdax) = ftz*ss(coapx, cob) - fax*ss(coamx, cob)
933 167434 : dssin(coa, cob, cday) = ftz*ss(coapy, cob) - fay*ss(coamy, cob)
934 292483 : dssin(coa, cob, cdaz) = ftz*ss(coapz, cob) - faz*ss(coamz, cob)
935 : END DO
936 : END DO
937 : END DO
938 : END DO
939 : END DO
940 : END DO
941 :
942 : END DO
943 : END DO
944 : END DO
945 :
946 8565626 : IF (PRESENT(dcosab)) THEN
947 73408 : DO k = 1, 3
948 230560 : DO j = 1, ncoset(lb_max)
949 714510 : DO i = 1, ncoset(la_max_set)
950 502302 : dcosab(na + i, nb + j, k) = dscos(i, j, k)
951 659454 : dsinab(na + i, nb + j, k) = dssin(i, j, k)
952 : END DO
953 : END DO
954 : END DO
955 : END IF
956 :
957 16695649 : nb = nb + ncoset(lb_max)
958 :
959 : END DO
960 :
961 10155280 : na = na + ncoset(la_max_set)
962 :
963 : END DO
964 :
965 2025257 : END SUBROUTINE cossin
966 :
967 : ! **************************************************************************************************
968 : !> \brief ...
969 : !> \param la_max ...
970 : !> \param npgfa ...
971 : !> \param zeta ...
972 : !> \param rpgfa ...
973 : !> \param la_min ...
974 : !> \param lb_max ...
975 : !> \param npgfb ...
976 : !> \param zetb ...
977 : !> \param rpgfb ...
978 : !> \param lc_max ...
979 : !> \param rac ...
980 : !> \param rbc ...
981 : !> \param mab ...
982 : ! **************************************************************************************************
983 623363 : SUBROUTINE moment(la_max, npgfa, zeta, rpgfa, la_min, &
984 1246726 : lb_max, npgfb, zetb, rpgfb, &
985 623363 : lc_max, rac, rbc, mab)
986 :
987 : INTEGER, INTENT(IN) :: la_max, npgfa
988 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: zeta, rpgfa
989 : INTEGER, INTENT(IN) :: la_min, lb_max, npgfb
990 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: zetb, rpgfb
991 : INTEGER, INTENT(IN) :: lc_max
992 : REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: rac, rbc
993 : REAL(KIND=dp), DIMENSION(:, :, :), INTENT(INOUT) :: mab
994 :
995 : INTEGER :: ax, ay, az, bx, by, bz, i, ipgf, j, &
996 : jpgf, k, l, l1, l2, la, la_start, lb, &
997 : lx, lx1, ly, ly1, lz, lz1, na, nb, ni
998 : REAL(KIND=dp) :: dab, f0, f1, f2, f2x, f2y, f2z, f3, fx, &
999 : fy, fz, rab2, zetp
1000 : REAL(KIND=dp), DIMENSION(3) :: rab, rap, rbp, rpc
1001 : REAL(KIND=dp), DIMENSION(ncoset(la_max), ncoset(&
1002 623363 : lb_max), ncoset(lc_max)) :: s
1003 :
1004 2493452 : rab = rbc - rac
1005 2493452 : rab2 = SUM(rab**2)
1006 623363 : dab = SQRT(rab2)
1007 :
1008 : ! *** Loop over all pairs of primitive Gaussian-type functions ***
1009 :
1010 623363 : na = 0
1011 :
1012 2003632 : DO ipgf = 1, npgfa
1013 :
1014 1380269 : nb = 0
1015 :
1016 5075903 : DO jpgf = 1, npgfb
1017 :
1018 2855978578 : s = 0.0_dp
1019 : ! *** Screening ***
1020 :
1021 3695634 : IF (rpgfa(ipgf) + rpgfb(jpgf) < dab) THEN
1022 23505761 : DO k = 1, ncoset(lc_max) - 1
1023 192825546 : DO j = nb + 1, nb + ncoset(lb_max)
1024 1694365362 : DO i = na + 1, na + ncoset(la_max)
1025 1673214989 : mab(i, j, k) = 0.0_dp
1026 : END DO
1027 : END DO
1028 : END DO
1029 2355388 : nb = nb + ncoset(lb_max)
1030 2355388 : CYCLE
1031 : END IF
1032 :
1033 : ! *** Calculate some prefactors ***
1034 :
1035 1340246 : zetp = 1.0_dp/(zeta(ipgf) + zetb(jpgf))
1036 :
1037 1340246 : f0 = (pi*zetp)**1.5_dp
1038 1340246 : f1 = zetb(jpgf)*zetp
1039 1340246 : f2 = 0.5_dp*zetp
1040 :
1041 : ! *** Calculate the basic two-center moment integral [s|M|s] ***
1042 :
1043 5360984 : rpc = zetp*(zeta(ipgf)*rac + zetb(jpgf)*rbc)
1044 1340246 : s(1, 1, 1) = f0*EXP(-zeta(ipgf)*f1*rab2)
1045 12063643 : DO l = 2, ncoset(lc_max)
1046 10723397 : lx = indco(1, l)
1047 10723397 : ly = indco(2, l)
1048 10723397 : lz = indco(3, l)
1049 10723397 : l2 = 0
1050 10723397 : IF (lz > 0) THEN
1051 4692097 : l1 = coset(lx, ly, lz - 1)
1052 4692097 : IF (lz > 1) l2 = coset(lx, ly, lz - 2)
1053 : ni = lz - 1
1054 : i = 3
1055 6031300 : ELSE IF (ly > 0) THEN
1056 3574267 : l1 = coset(lx, ly - 1, lz)
1057 3574267 : IF (ly > 1) l2 = coset(lx, ly - 2, lz)
1058 : ni = ly - 1
1059 : i = 2
1060 2457033 : ELSE IF (lx > 0) THEN
1061 2457033 : l1 = coset(lx - 1, ly, lz)
1062 2457033 : IF (lx > 1) l2 = coset(lx - 2, ly, lz)
1063 : ni = lx - 1
1064 : i = 1
1065 : END IF
1066 10723397 : s(1, 1, l) = rpc(i)*s(1, 1, l1)
1067 12063643 : IF (l2 > 0) s(1, 1, l) = s(1, 1, l) + f2*REAL(ni, dp)*s(1, 1, l2)
1068 : END DO
1069 :
1070 : ! *** Recurrence steps: [s|M|s] -> [a|M|b] ***
1071 :
1072 13403889 : DO l = 1, ncoset(lc_max)
1073 :
1074 12063643 : lx = indco(1, l)
1075 12063643 : ly = indco(2, l)
1076 12063643 : lz = indco(3, l)
1077 12063643 : IF (lx > 0) THEN
1078 4692097 : lx1 = coset(lx - 1, ly, lz)
1079 : ELSE
1080 : lx1 = -1
1081 : END IF
1082 12063643 : IF (ly > 0) THEN
1083 4692097 : ly1 = coset(lx, ly - 1, lz)
1084 : ELSE
1085 : ly1 = -1
1086 : END IF
1087 12063643 : IF (lz > 0) THEN
1088 4692097 : lz1 = coset(lx, ly, lz - 1)
1089 : ELSE
1090 : lz1 = -1
1091 : END IF
1092 12063643 : f2x = f2*REAL(lx, dp)
1093 12063643 : f2y = f2*REAL(ly, dp)
1094 12063643 : f2z = f2*REAL(lz, dp)
1095 :
1096 13403889 : IF (la_max > 0) THEN
1097 :
1098 : ! *** Vertical recurrence steps: [s|M|s] -> [a|M|s] ***
1099 :
1100 46732704 : rap(:) = f1*rab(:)
1101 :
1102 : ! *** [p|M|s] = (Pi - Ai)*[s|M|s] + f2*Ni(m-1i)[s|M-1i|s] ***
1103 :
1104 11683176 : s(2, 1, l) = rap(1)*s(1, 1, l)
1105 11683176 : s(3, 1, l) = rap(2)*s(1, 1, l)
1106 11683176 : s(4, 1, l) = rap(3)*s(1, 1, l)
1107 11683176 : IF (lx1 > 0) s(2, 1, l) = s(2, 1, l) + f2x*s(1, 1, lx1)
1108 11683176 : IF (ly1 > 0) s(3, 1, l) = s(3, 1, l) + f2y*s(1, 1, ly1)
1109 11683176 : IF (lz1 > 0) s(4, 1, l) = s(4, 1, l) + f2z*s(1, 1, lz1)
1110 :
1111 : ! *** [a|M|s] = (Pi - Ai)*[a-1i|M|s] + f2*Ni(a-1i)*[a-2i|M|s] ***
1112 : ! *** + f2*Ni(m-1i)*[a-1i|M-1i|s] ***
1113 :
1114 19228218 : DO la = 2, la_max
1115 :
1116 : ! *** Increase the angular momentum component z of function a ***
1117 :
1118 : s(coset(0, 0, la), 1, l) = rap(3)*s(coset(0, 0, la - 1), 1, l) + &
1119 7545042 : f2*REAL(la - 1, dp)*s(coset(0, 0, la - 2), 1, l)
1120 7545042 : IF (lz1 > 0) s(coset(0, 0, la), 1, l) = s(coset(0, 0, la), 1, l) + &
1121 2999337 : f2z*s(coset(0, 0, la - 1), 1, lz1)
1122 :
1123 : ! *** Increase the angular momentum component y of function a ***
1124 :
1125 7545042 : az = la - 1
1126 7545042 : s(coset(0, 1, az), 1, l) = rap(2)*s(coset(0, 0, az), 1, l)
1127 7545042 : IF (ly1 > 0) s(coset(0, 1, az), 1, l) = s(coset(0, 1, az), 1, l) + &
1128 2999337 : f2y*s(coset(0, 0, az), 1, ly1)
1129 :
1130 15911474 : DO ay = 2, la
1131 8366432 : az = la - ay
1132 : s(coset(0, ay, az), 1, l) = rap(2)*s(coset(0, ay - 1, az), 1, l) + &
1133 8366432 : f2*REAL(ay - 1, dp)*s(coset(0, ay - 2, az), 1, l)
1134 8366432 : IF (ly1 > 0) s(coset(0, ay, az), 1, l) = s(coset(0, ay, az), 1, l) + &
1135 10872410 : f2y*s(coset(0, ay - 1, az), 1, ly1)
1136 : END DO
1137 :
1138 : ! *** Increase the angular momentum component x of function a ***
1139 :
1140 23456516 : DO ay = 0, la - 1
1141 15911474 : az = la - 1 - ay
1142 15911474 : s(coset(1, ay, az), 1, l) = rap(1)*s(coset(0, ay, az), 1, l)
1143 15911474 : IF (lx1 > 0) s(coset(1, ay, az), 1, l) = s(coset(1, ay, az), 1, l) + &
1144 13871747 : f2x*s(coset(0, ay, az), 1, lx1)
1145 : END DO
1146 :
1147 27594650 : DO ax = 2, la
1148 8366432 : f3 = f2*REAL(ax - 1, dp)
1149 25099296 : DO ay = 0, la - ax
1150 9187822 : az = la - ax - ay
1151 : s(coset(ax, ay, az), 1, l) = rap(1)*s(coset(ax - 1, ay, az), 1, l) + &
1152 9187822 : f3*s(coset(ax - 2, ay, az), 1, l)
1153 9187822 : IF (lx1 > 0) s(coset(ax, ay, az), 1, l) = s(coset(ax, ay, az), 1, l) + &
1154 12021831 : f2x*s(coset(ax - 1, ay, az), 1, lx1)
1155 : END DO
1156 : END DO
1157 :
1158 : END DO
1159 :
1160 : ! *** Recurrence steps: [a|M|s] -> [a|M|b] ***
1161 :
1162 11683176 : IF (lb_max > 0) THEN
1163 :
1164 94617608 : DO j = 2, ncoset(lb_max)
1165 860267412 : DO i = 1, ncoset(la_max)
1166 848723622 : s(i, j, l) = 0.0_dp
1167 : END DO
1168 : END DO
1169 :
1170 : ! *** Horizontal recurrence steps ***
1171 :
1172 46175160 : rbp(:) = rap(:) - rab(:)
1173 :
1174 : ! *** [a|M|p] = [a+1i|M|s] - (Bi - Ai)*[a|M|s] ***
1175 :
1176 11543790 : IF (lb_max == 1) THEN
1177 4838672 : la_start = la_min
1178 : ELSE
1179 6705118 : la_start = MAX(0, la_min - 1)
1180 : END IF
1181 :
1182 30460236 : DO la = la_start, la_max - 1
1183 57703567 : DO ax = 0, la
1184 82551383 : DO ay = 0, la - ax
1185 36391606 : az = la - ax - ay
1186 : s(coset(ax, ay, az), 2, l) = s(coset(ax + 1, ay, az), 1, l) - &
1187 36391606 : rab(1)*s(coset(ax, ay, az), 1, l)
1188 : s(coset(ax, ay, az), 3, l) = s(coset(ax, ay + 1, az), 1, l) - &
1189 36391606 : rab(2)*s(coset(ax, ay, az), 1, l)
1190 : s(coset(ax, ay, az), 4, l) = s(coset(ax, ay, az + 1), 1, l) - &
1191 63634937 : rab(3)*s(coset(ax, ay, az), 1, l)
1192 : END DO
1193 : END DO
1194 : END DO
1195 :
1196 : ! *** Vertical recurrence step ***
1197 :
1198 : ! *** [a|M|p] = (Pi - Bi)*[a|M|s] + f2*Ni(a)*[a-1i|M|s] ***
1199 : ! *** + f2*Ni(m)*[a|M-1i|s] ***
1200 :
1201 42159182 : DO ax = 0, la_max
1202 30615392 : fx = f2*REAL(ax, dp)
1203 100195378 : DO ay = 0, la_max - ax
1204 58036196 : fy = f2*REAL(ay, dp)
1205 58036196 : az = la_max - ax - ay
1206 58036196 : fz = f2*REAL(az, dp)
1207 58036196 : IF (ax == 0) THEN
1208 30615392 : s(coset(ax, ay, az), 2, l) = rbp(1)*s(coset(ax, ay, az), 1, l)
1209 : ELSE
1210 : s(coset(ax, ay, az), 2, l) = rbp(1)*s(coset(ax, ay, az), 1, l) + &
1211 27420804 : fx*s(coset(ax - 1, ay, az), 1, l)
1212 : END IF
1213 58036196 : IF (lx1 > 0) s(coset(ax, ay, az), 2, l) = s(coset(ax, ay, az), 2, l) + &
1214 22988336 : f2x*s(coset(ax, ay, az), 1, lx1)
1215 58036196 : IF (ay == 0) THEN
1216 30615392 : s(coset(ax, ay, az), 3, l) = rbp(2)*s(coset(ax, ay, az), 1, l)
1217 : ELSE
1218 : s(coset(ax, ay, az), 3, l) = rbp(2)*s(coset(ax, ay, az), 1, l) + &
1219 27420804 : fy*s(coset(ax, ay - 1, az), 1, l)
1220 : END IF
1221 58036196 : IF (ly1 > 0) s(coset(ax, ay, az), 3, l) = s(coset(ax, ay, az), 3, l) + &
1222 22988336 : f2y*s(coset(ax, ay, az), 1, ly1)
1223 58036196 : IF (az == 0) THEN
1224 30615392 : s(coset(ax, ay, az), 4, l) = rbp(3)*s(coset(ax, ay, az), 1, l)
1225 : ELSE
1226 : s(coset(ax, ay, az), 4, l) = rbp(3)*s(coset(ax, ay, az), 1, l) + &
1227 27420804 : fz*s(coset(ax, ay, az - 1), 1, l)
1228 : END IF
1229 58036196 : IF (lz1 > 0) s(coset(ax, ay, az), 4, l) = s(coset(ax, ay, az), 4, l) + &
1230 53603728 : f2z*s(coset(ax, ay, az), 1, lz1)
1231 : END DO
1232 : END DO
1233 :
1234 : ! *** Recurrence steps: [a|M|p] -> [a|M|b] ***
1235 :
1236 19070082 : DO lb = 2, lb_max
1237 :
1238 : ! *** Horizontal recurrence steps ***
1239 :
1240 : ! *** [a|M|b] = [a+1i|M|b-1i] - (Bi - Ai)*[a|M|b-1i] ***
1241 :
1242 7526292 : IF (lb == lb_max) THEN
1243 6705118 : la_start = la_min
1244 : ELSE
1245 821174 : la_start = MAX(0, la_min - 1)
1246 : END IF
1247 :
1248 21208408 : DO la = la_start, la_max - 1
1249 42591258 : DO ax = 0, la
1250 64949208 : DO ay = 0, la - ax
1251 29884242 : az = la - ax - ay
1252 :
1253 : ! *** Shift of angular momentum component z from a to b ***
1254 :
1255 : s(coset(ax, ay, az), coset(0, 0, lb), l) = &
1256 : s(coset(ax, ay, az + 1), coset(0, 0, lb - 1), l) - &
1257 29884242 : rab(3)*s(coset(ax, ay, az), coset(0, 0, lb - 1), l)
1258 :
1259 : ! *** Shift of angular momentum component y from a to b ***
1260 :
1261 93000276 : DO by = 1, lb
1262 63116034 : bz = lb - by
1263 : s(coset(ax, ay, az), coset(0, by, bz), l) = &
1264 : s(coset(ax, ay + 1, az), coset(0, by - 1, bz), l) - &
1265 93000276 : rab(2)*s(coset(ax, ay, az), coset(0, by - 1, bz), l)
1266 : END DO
1267 :
1268 : ! *** Shift of angular momentum component x from a to b ***
1269 :
1270 114383126 : DO bx = 1, lb
1271 192695652 : DO by = 0, lb - bx
1272 99695376 : bz = lb - bx - by
1273 : s(coset(ax, ay, az), coset(bx, by, bz), l) = &
1274 : s(coset(ax + 1, ay, az), coset(bx - 1, by, bz), l) - &
1275 162811410 : rab(1)*s(coset(ax, ay, az), coset(bx - 1, by, bz), l)
1276 : END DO
1277 : END DO
1278 :
1279 : END DO
1280 : END DO
1281 : END DO
1282 :
1283 : ! *** Vertical recurrence step ***
1284 :
1285 : ! *** [a|M|b] = (Pi - Bi)*[a|M|b-1i] + f2*Ni(a)*[a-1i|M|b-1i] + ***
1286 : ! *** f2*Ni(b-1i)*[a|M|b-2i] + f2*Ni(m)[a|M-1i|b-1i] ***
1287 :
1288 41027727 : DO ax = 0, la_max
1289 21957645 : fx = f2*REAL(ax, dp)
1290 73578654 : DO ay = 0, la_max - ax
1291 44094717 : fy = f2*REAL(ay, dp)
1292 44094717 : az = la_max - ax - ay
1293 44094717 : fz = f2*REAL(az, dp)
1294 :
1295 : ! *** Shift of angular momentum component z from a to b ***
1296 :
1297 44094717 : f3 = f2*REAL(lb - 1, dp)
1298 :
1299 44094717 : IF (az == 0) THEN
1300 : s(coset(ax, ay, az), coset(0, 0, lb), l) = &
1301 : rbp(3)*s(coset(ax, ay, az), coset(0, 0, lb - 1), l) + &
1302 21957645 : f3*s(coset(ax, ay, az), coset(0, 0, lb - 2), l)
1303 : ELSE
1304 : s(coset(ax, ay, az), coset(0, 0, lb), l) = &
1305 : rbp(3)*s(coset(ax, ay, az), coset(0, 0, lb - 1), l) + &
1306 : fz*s(coset(ax, ay, az - 1), coset(0, 0, lb - 1), l) + &
1307 22137072 : f3*s(coset(ax, ay, az), coset(0, 0, lb - 2), l)
1308 : END IF
1309 44094717 : IF (lz1 > 0) s(coset(ax, ay, az), coset(0, 0, lb), l) = &
1310 : s(coset(ax, ay, az), coset(0, 0, lb), l) + &
1311 17570466 : f2z*s(coset(ax, ay, az), coset(0, 0, lb - 1), lz1)
1312 :
1313 : ! *** Shift of angular momentum component y from a to b ***
1314 :
1315 44094717 : IF (ay == 0) THEN
1316 21957645 : bz = lb - 1
1317 : s(coset(ax, ay, az), coset(0, 1, bz), l) = &
1318 21957645 : rbp(2)*s(coset(ax, ay, az), coset(0, 0, bz), l)
1319 21957645 : IF (ly1 > 0) s(coset(ax, ay, az), coset(0, 1, bz), l) = &
1320 : s(coset(ax, ay, az), coset(0, 1, bz), l) + &
1321 8744688 : f2y*s(coset(ax, ay, az), coset(0, 0, bz), ly1)
1322 46358268 : DO by = 2, lb
1323 24400623 : bz = lb - by
1324 24400623 : f3 = f2*REAL(by - 1, dp)
1325 : s(coset(ax, ay, az), coset(0, by, bz), l) = &
1326 : rbp(2)*s(coset(ax, ay, az), coset(0, by - 1, bz), l) + &
1327 24400623 : f3*s(coset(ax, ay, az), coset(0, by - 2, bz), l)
1328 24400623 : IF (ly1 > 0) s(coset(ax, ay, az), coset(0, by, bz), l) = &
1329 : s(coset(ax, ay, az), coset(0, by, bz), l) + &
1330 31678176 : f2y*s(coset(ax, ay, az), coset(0, by - 1, bz), ly1)
1331 : END DO
1332 : ELSE
1333 22137072 : bz = lb - 1
1334 : s(coset(ax, ay, az), coset(0, 1, bz), l) = &
1335 : rbp(2)*s(coset(ax, ay, az), coset(0, 0, bz), l) + &
1336 22137072 : fy*s(coset(ax, ay - 1, az), coset(0, 0, bz), l)
1337 22137072 : IF (ly1 > 0) s(coset(ax, ay, az), coset(0, 1, bz), l) = &
1338 : s(coset(ax, ay, az), coset(0, 1, bz), l) + &
1339 8825778 : f2y*s(coset(ax, ay, az), coset(0, 0, bz), ly1)
1340 46758086 : DO by = 2, lb
1341 24621014 : bz = lb - by
1342 24621014 : f3 = f2*REAL(by - 1, dp)
1343 : s(coset(ax, ay, az), coset(0, by, bz), l) = &
1344 : rbp(2)*s(coset(ax, ay, az), coset(0, by - 1, bz), l) + &
1345 : fy*s(coset(ax, ay - 1, az), coset(0, by - 1, bz), l) + &
1346 24621014 : f3*s(coset(ax, ay, az), coset(0, by - 2, bz), l)
1347 24621014 : IF (ly1 > 0) s(coset(ax, ay, az), coset(0, by, bz), l) = &
1348 : s(coset(ax, ay, az), coset(0, by, bz), l) + &
1349 31955153 : f2y*s(coset(ax, ay, az), coset(0, by - 1, bz), ly1)
1350 : END DO
1351 : END IF
1352 :
1353 : ! *** Shift of angular momentum component x from a to b ***
1354 :
1355 66052362 : IF (ax == 0) THEN
1356 68315913 : DO by = 0, lb - 1
1357 46358268 : bz = lb - 1 - by
1358 : s(coset(ax, ay, az), coset(1, by, bz), l) = &
1359 46358268 : rbp(1)*s(coset(ax, ay, az), coset(0, by, bz), l)
1360 46358268 : IF (lx1 > 0) s(coset(ax, ay, az), coset(1, by, bz), l) = &
1361 : s(coset(ax, ay, az), coset(1, by, bz), l) + &
1362 40422864 : f2x*s(coset(ax, ay, az), coset(0, by, bz), lx1)
1363 : END DO
1364 46358268 : DO bx = 2, lb
1365 24400623 : f3 = f2*REAL(bx - 1, dp)
1366 73201869 : DO by = 0, lb - bx
1367 26843601 : bz = lb - bx - by
1368 : s(coset(ax, ay, az), coset(bx, by, bz), l) = &
1369 : rbp(1)*s(coset(ax, ay, az), coset(bx - 1, by, bz), l) + &
1370 26843601 : f3*s(coset(ax, ay, az), coset(bx - 2, by, bz), l)
1371 26843601 : IF (lx1 > 0) s(coset(ax, ay, az), coset(bx, by, bz), l) = &
1372 : s(coset(ax, ay, az), coset(bx, by, bz), l) + &
1373 35096997 : f2x*s(coset(ax, ay, az), coset(bx - 1, by, bz), lx1)
1374 : END DO
1375 : END DO
1376 : ELSE
1377 68895158 : DO by = 0, lb - 1
1378 46758086 : bz = lb - 1 - by
1379 : s(coset(ax, ay, az), coset(1, by, bz), l) = &
1380 : rbp(1)*s(coset(ax, ay, az), coset(0, by, bz), l) + &
1381 46758086 : fx*s(coset(ax - 1, ay, az), coset(0, by, bz), l)
1382 46758086 : IF (lx1 > 0) s(coset(ax, ay, az), coset(1, by, bz), l) = &
1383 : s(coset(ax, ay, az), coset(1, by, bz), l) + &
1384 40780931 : f2x*s(coset(ax, ay, az), coset(0, by, bz), lx1)
1385 : END DO
1386 46758086 : DO bx = 2, lb
1387 24621014 : f3 = f2*REAL(bx - 1, dp)
1388 73863042 : DO by = 0, lb - bx
1389 27104956 : bz = lb - bx - by
1390 : s(coset(ax, ay, az), coset(bx, by, bz), l) = &
1391 : rbp(1)*s(coset(ax, ay, az), coset(bx - 1, by, bz), l) + &
1392 : fx*s(coset(ax - 1, ay, az), coset(bx - 1, by, bz), l) + &
1393 27104956 : f3*s(coset(ax, ay, az), coset(bx - 2, by, bz), l)
1394 27104956 : IF (lx1 > 0) s(coset(ax, ay, az), coset(bx, by, bz), l) = &
1395 : s(coset(ax, ay, az), coset(bx, by, bz), l) + &
1396 35431398 : f2x*s(coset(ax, ay, az), coset(bx - 1, by, bz), lx1)
1397 : END DO
1398 : END DO
1399 : END IF
1400 :
1401 : END DO
1402 : END DO
1403 :
1404 : END DO
1405 :
1406 : END IF
1407 :
1408 : ELSE
1409 :
1410 380467 : IF (lb_max > 0) THEN
1411 :
1412 : ! *** Vertical recurrence steps: [s|M|s] -> [s|M|b] ***
1413 :
1414 529360 : rbp(:) = (f1 - 1.0_dp)*rab(:)
1415 :
1416 : ! *** [s|M|p] = (Pi - Bi)*[s|M|s] + f2*Ni(m)*[s|M-1i|s] ***
1417 :
1418 132340 : s(1, 2, l) = rbp(1)*s(1, 1, l)
1419 132340 : s(1, 3, l) = rbp(2)*s(1, 1, l)
1420 132340 : s(1, 4, l) = rbp(3)*s(1, 1, l)
1421 132340 : IF (lx1 > 0) s(1, 2, l) = s(1, 2, l) + f2x*s(1, 1, lx1)
1422 132340 : IF (ly1 > 0) s(1, 3, l) = s(1, 3, l) + f2y*s(1, 1, ly1)
1423 132340 : IF (lz1 > 0) s(1, 4, l) = s(1, 4, l) + f2z*s(1, 1, lz1)
1424 :
1425 : ! *** [s|M|b] = (Pi - Bi)*[s|M|b-1i] + f2*Ni(b-1i)*[s|M|b-2i] ***
1426 : ! *** + f2*Ni(m)*[s|M-1i|b-1i] ***
1427 :
1428 148084 : DO lb = 2, lb_max
1429 :
1430 : ! *** Increase the angular momentum component z of function b ***
1431 :
1432 : s(1, coset(0, 0, lb), l) = rbp(3)*s(1, coset(0, 0, lb - 1), l) + &
1433 15744 : f2*REAL(lb - 1, dp)*s(1, coset(0, 0, lb - 2), l)
1434 15744 : IF (lz1 > 0) s(1, coset(0, 0, lb), l) = s(1, coset(0, 0, lb), l) + &
1435 4020 : f2z*s(1, coset(0, 0, lb - 1), lz1)
1436 :
1437 : ! *** Increase the angular momentum component y of function b ***
1438 :
1439 15744 : bz = lb - 1
1440 15744 : s(1, coset(0, 1, bz), l) = rbp(2)*s(1, coset(0, 0, bz), l)
1441 15744 : IF (ly1 > 0) s(1, coset(0, 1, bz), l) = s(1, coset(0, 1, bz), l) + &
1442 4020 : f2y*s(1, coset(0, 0, bz), ly1)
1443 :
1444 31488 : DO by = 2, lb
1445 15744 : bz = lb - by
1446 : s(1, coset(0, by, bz), l) = rbp(2)*s(1, coset(0, by - 1, bz), l) + &
1447 15744 : f2*REAL(by - 1, dp)*s(1, coset(0, by - 2, bz), l)
1448 15744 : IF (ly1 > 0) s(1, coset(0, by, bz), l) = s(1, coset(0, by, bz), l) + &
1449 19764 : f2y*s(1, coset(0, by - 1, bz), ly1)
1450 : END DO
1451 :
1452 : ! *** Increase the angular momentum component x of function b ***
1453 :
1454 47232 : DO by = 0, lb - 1
1455 31488 : bz = lb - 1 - by
1456 31488 : s(1, coset(1, by, bz), l) = rbp(1)*s(1, coset(0, by, bz), l)
1457 31488 : IF (lx1 > 0) s(1, coset(1, by, bz), l) = s(1, coset(1, by, bz), l) + &
1458 23784 : f2x*s(1, coset(0, by, bz), lx1)
1459 : END DO
1460 :
1461 163828 : DO bx = 2, lb
1462 15744 : f3 = f2*REAL(bx - 1, dp)
1463 47232 : DO by = 0, lb - bx
1464 15744 : bz = lb - bx - by
1465 : s(1, coset(bx, by, bz), l) = rbp(1)*s(1, coset(bx - 1, by, bz), l) + &
1466 15744 : f3*s(1, coset(bx - 2, by, bz), l)
1467 15744 : IF (lx1 > 0) s(1, coset(bx, by, bz), l) = s(1, coset(bx, by, bz), l) + &
1468 19764 : f2x*s(1, coset(bx - 1, by, bz), lx1)
1469 : END DO
1470 : END DO
1471 :
1472 : END DO
1473 :
1474 : END IF
1475 :
1476 : END IF
1477 :
1478 : END DO
1479 :
1480 12063643 : DO k = 2, ncoset(lc_max)
1481 97649091 : DO j = 1, ncoset(lb_max)
1482 869734056 : DO i = 1, ncoset(la_max)
1483 859010659 : mab(na + i, nb + j, k - 1) = s(i, j, k)
1484 : END DO
1485 : END DO
1486 : END DO
1487 :
1488 2720515 : nb = nb + ncoset(lb_max)
1489 :
1490 : END DO
1491 :
1492 2003632 : na = na + ncoset(la_max)
1493 :
1494 : END DO
1495 :
1496 623363 : END SUBROUTINE moment
1497 :
1498 : ! **************************************************************************************************
1499 : !> \brief This returns the derivative of the overlap integrals [a|b], with respect
1500 : !> to the position of the primitive on the left, i.e.
1501 : !> [da/dR_ai|b] = 2*zeta*[a+1i|b] - Ni(a)[a-1i|b]
1502 : !> \param la_max ...
1503 : !> \param npgfa ...
1504 : !> \param zeta ...
1505 : !> \param rpgfa ...
1506 : !> \param la_min ...
1507 : !> \param lb_max ...
1508 : !> \param npgfb ...
1509 : !> \param zetb ...
1510 : !> \param rpgfb ...
1511 : !> \param lb_min ...
1512 : !> \param rab ...
1513 : !> \param difab ...
1514 : ! **************************************************************************************************
1515 22848 : SUBROUTINE diffop(la_max, npgfa, zeta, rpgfa, la_min, &
1516 22848 : lb_max, npgfb, zetb, rpgfb, lb_min, &
1517 22848 : rab, difab)
1518 :
1519 : INTEGER, INTENT(IN) :: la_max, npgfa
1520 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: zeta, rpgfa
1521 : INTEGER, INTENT(IN) :: la_min, lb_max, npgfb
1522 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: zetb, rpgfb
1523 : INTEGER, INTENT(IN) :: lb_min
1524 : REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: rab
1525 : REAL(KIND=dp), DIMENSION(:, :, :), INTENT(OUT) :: difab
1526 :
1527 : INTEGER :: lda_min, ldb_min, lds, lmax
1528 : REAL(KIND=dp) :: dab, rab2
1529 22848 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: s
1530 : REAL(KIND=dp), DIMENSION(npgfa*ncoset(la_max+1), &
1531 22848 : npgfb*ncoset(lb_max+1)) :: sab
1532 :
1533 91392 : rab2 = SUM(rab**2)
1534 22848 : dab = SQRT(rab2)
1535 :
1536 22848 : lda_min = MAX(0, la_min - 1)
1537 22848 : ldb_min = MAX(0, lb_min - 1)
1538 22848 : lmax = MAX(la_max + 1, lb_max + 1)
1539 22848 : lds = ncoset(lmax + 1)
1540 114240 : ALLOCATE (s(lds, lds, ncoset(1)))
1541 3930425 : sab = 0.0_dp
1542 44797168 : s = 0.0_dp
1543 : CALL overlap(la_max + 1, lda_min, npgfa, rpgfa, zeta, &
1544 : lb_max + 1, ldb_min, npgfb, rpgfb, zetb, &
1545 22848 : rab, dab, sab, 0, .FALSE., s, lds)
1546 :
1547 : CALL dabdr(la_max, npgfa, zeta, rpgfa, la_min, &
1548 : lb_max, npgfb, rpgfb, lb_min, &
1549 22848 : dab, sab, difab(:, :, 1), difab(:, :, 2), difab(:, :, 3))
1550 :
1551 22848 : DEALLOCATE (s)
1552 :
1553 22848 : END SUBROUTINE diffop
1554 :
1555 : ! **************************************************************************************************
1556 : !> \brief This returns the derivative of the moment integrals [a|\mu|b], with respect
1557 : !> to the position of the primitive on the left, i.e.
1558 : !> [da/dR_ai|\mu|b] = 2*zeta*[a+1i|\mu|b] - Ni(a)[a-1i|\mu|b]
1559 : !> order indicates the max order of the moment operator to be calculated
1560 : !> 1: dipole
1561 : !> 2: quadrupole
1562 : !> ...
1563 : !> \param la_max ...
1564 : !> \param npgfa ...
1565 : !> \param zeta ...
1566 : !> \param rpgfa ...
1567 : !> \param la_min ...
1568 : !> \param lb_max ...
1569 : !> \param npgfb ...
1570 : !> \param zetb ...
1571 : !> \param rpgfb ...
1572 : !> \param lb_min ...
1573 : !> \param order ...
1574 : !> \param rac ...
1575 : !> \param rbc ...
1576 : !> \param difmab ...
1577 : !> \param mab_ext ...
1578 : !> \note
1579 : ! **************************************************************************************************
1580 597138 : SUBROUTINE diff_momop(la_max, npgfa, zeta, rpgfa, la_min, &
1581 597138 : lb_max, npgfb, zetb, rpgfb, lb_min, &
1582 597138 : order, rac, rbc, difmab, mab_ext)
1583 :
1584 : INTEGER, INTENT(IN) :: la_max, npgfa
1585 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: zeta, rpgfa
1586 : INTEGER, INTENT(IN) :: la_min, lb_max, npgfb
1587 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: zetb, rpgfb
1588 : INTEGER, INTENT(IN) :: lb_min, order
1589 : REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: rac, rbc
1590 : REAL(KIND=dp), DIMENSION(:, :, :, :), INTENT(OUT) :: difmab
1591 : REAL(KIND=dp), DIMENSION(:, :, :), OPTIONAL, &
1592 : POINTER :: mab_ext
1593 :
1594 : INTEGER :: imom, lda, lda_min, ldb, ldb_min, lmax
1595 : REAL(KIND=dp) :: dab, rab(3), rab2
1596 597138 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: difmab_tmp
1597 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: mab
1598 :
1599 2388552 : rab = rbc - rac
1600 2388552 : rab2 = SUM(rab**2)
1601 597138 : dab = SQRT(rab2)
1602 :
1603 597138 : lda_min = MAX(0, la_min - 1)
1604 597138 : ldb_min = MAX(0, lb_min - 1)
1605 597138 : lmax = MAX(la_max + 1, lb_max + 1)
1606 597138 : lda = ncoset(la_max)*npgfa
1607 597138 : ldb = ncoset(lb_max)*npgfb
1608 2958858 : ALLOCATE (difmab_tmp(lda, ldb, 3))
1609 :
1610 597138 : IF (PRESENT(mab_ext)) THEN
1611 597138 : mab => mab_ext
1612 : ELSE
1613 : ALLOCATE (mab(npgfa*ncoset(la_max + 1), npgfb*ncoset(lb_max + 1), &
1614 0 : ncoset(order) - 1))
1615 0 : mab = 0.0_dp
1616 : ! *** Calculate the primitive overlap integrals ***
1617 : CALL moment(la_max + 1, npgfa, zeta, rpgfa, lda_min, &
1618 : lb_max + 1, npgfb, zetb, rpgfb, &
1619 0 : order, rac, rbc, mab)
1620 :
1621 : END IF
1622 5970480 : DO imom = 1, ncoset(order) - 1
1623 1205477604 : difmab_tmp = 0.0_dp
1624 : CALL adbdr(la_max, npgfa, rpgfa, la_min, &
1625 : lb_max, npgfb, zetb, rpgfb, lb_min, &
1626 : dab, mab(:, :, imom), difmab_tmp(:, :, 1), &
1627 5373342 : difmab_tmp(:, :, 2), difmab_tmp(:, :, 3))
1628 400034754 : difmab(1:lda, 1:ldb, imom, 1) = difmab_tmp(1:lda, 1:ldb, 1)
1629 400034754 : difmab(1:lda, 1:ldb, imom, 2) = difmab_tmp(1:lda, 1:ldb, 2)
1630 400631892 : difmab(1:lda, 1:ldb, imom, 3) = difmab_tmp(1:lda, 1:ldb, 3)
1631 : END DO
1632 :
1633 597138 : IF (PRESENT(mab_ext)) THEN
1634 : NULLIFY (mab)
1635 : ELSE
1636 0 : DEALLOCATE (mab)
1637 : END IF
1638 597138 : DEALLOCATE (difmab_tmp)
1639 :
1640 597138 : END SUBROUTINE diff_momop
1641 :
1642 : ! **************************************************************************************************
1643 : !> \brief This returns the derivative of the dipole integrals [a|x|b], with respect
1644 : !> to the position of the primitive on the left and right, i.e.
1645 : !> [da/dR_ai|\mu|b] = 2*zeta*[a+1i|\mu|b] - Ni(a)[a-1i|\mu|b]
1646 : !> \param la_max ...
1647 : !> \param npgfa ...
1648 : !> \param zeta ...
1649 : !> \param rpgfa ...
1650 : !> \param la_min ...
1651 : !> \param lb_max ...
1652 : !> \param npgfb ...
1653 : !> \param zetb ...
1654 : !> \param rpgfb ...
1655 : !> \param lb_min ...
1656 : !> \param order ...
1657 : !> \param rac ...
1658 : !> \param rbc ...
1659 : !> \param pab ...
1660 : !> \param forcea ...
1661 : !> \param forceb ...
1662 : !> \note
1663 : ! **************************************************************************************************
1664 1662 : SUBROUTINE dipole_force(la_max, npgfa, zeta, rpgfa, la_min, &
1665 1662 : lb_max, npgfb, zetb, rpgfb, lb_min, &
1666 1662 : order, rac, rbc, pab, forcea, forceb)
1667 :
1668 : INTEGER, INTENT(IN) :: la_max, npgfa
1669 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: zeta, rpgfa
1670 : INTEGER, INTENT(IN) :: la_min, lb_max, npgfb
1671 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: zetb, rpgfb
1672 : INTEGER, INTENT(IN) :: lb_min, order
1673 : REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: rac, rbc
1674 : REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: pab
1675 : REAL(KIND=dp), DIMENSION(:, :), INTENT(INOUT) :: forcea, forceb
1676 :
1677 : INTEGER :: i, imom, ipgf, j, jpgf, lda, lda_min, &
1678 : ldb, ldb_min, lmax, na, nb
1679 : REAL(KIND=dp) :: dab, rab(3), rab2
1680 1662 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: difmab, mab
1681 :
1682 1662 : CPASSERT(order == 1)
1683 : MARK_USED(order)
1684 :
1685 6648 : rab = rbc - rac
1686 6648 : rab2 = SUM(rab**2)
1687 1662 : dab = SQRT(rab2)
1688 :
1689 1662 : lda_min = MAX(0, la_min - 1)
1690 1662 : ldb_min = MAX(0, lb_min - 1)
1691 1662 : lmax = MAX(la_max + 1, lb_max + 1)
1692 1662 : lda = ncoset(la_max)*npgfa
1693 1662 : ldb = ncoset(lb_max)*npgfb
1694 8310 : ALLOCATE (difmab(lda, ldb, 3))
1695 8310 : ALLOCATE (mab(npgfa*ncoset(la_max + 1), npgfb*ncoset(lb_max + 1), 3))
1696 2566704 : mab = 0.0_dp
1697 : CALL moment(la_max + 1, npgfa, zeta, rpgfa, lda_min, &
1698 1662 : lb_max + 1, npgfb, zetb, rpgfb, 1, rac, rbc, mab)
1699 :
1700 6648 : DO imom = 1, 3
1701 1226664 : difmab = 0.0_dp
1702 : CALL adbdr(la_max, npgfa, rpgfa, la_min, lb_max, npgfb, zetb, rpgfb, lb_min, &
1703 4986 : dab, mab(:, :, imom), difmab(:, :, 1), difmab(:, :, 2), difmab(:, :, 3))
1704 4986 : na = 0
1705 19419 : DO ipgf = 1, npgfa
1706 : nb = 0
1707 56622 : DO jpgf = 1, npgfb
1708 137625 : DO j = nb + ncoset(lb_min - 1) + 1, nb + ncoset(lb_max)
1709 414651 : DO i = na + ncoset(la_min - 1) + 1, na + ncoset(la_max)
1710 277026 : forceb(imom, 1) = forceb(imom, 1) + pab(i, j)*difmab(i, j, 1)
1711 277026 : forceb(imom, 2) = forceb(imom, 2) + pab(i, j)*difmab(i, j, 2)
1712 372462 : forceb(imom, 3) = forceb(imom, 3) + pab(i, j)*difmab(i, j, 3)
1713 : END DO
1714 : END DO
1715 56622 : nb = nb + ncoset(lb_max)
1716 : END DO
1717 19419 : na = na + ncoset(la_max)
1718 : END DO
1719 :
1720 1226664 : difmab = 0.0_dp
1721 : CALL dabdr(la_max, npgfa, zeta, rpgfa, la_min, lb_max, npgfb, rpgfb, lb_min, &
1722 4986 : dab, mab(:, :, imom), difmab(:, :, 1), difmab(:, :, 2), difmab(:, :, 3))
1723 4986 : na = 0
1724 21081 : DO ipgf = 1, npgfa
1725 : nb = 0
1726 56622 : DO jpgf = 1, npgfb
1727 137625 : DO j = nb + ncoset(lb_min - 1) + 1, nb + ncoset(lb_max)
1728 414651 : DO i = na + ncoset(la_min - 1) + 1, na + ncoset(la_max)
1729 277026 : forcea(imom, 1) = forcea(imom, 1) + pab(i, j)*difmab(i, j, 1)
1730 277026 : forcea(imom, 2) = forcea(imom, 2) + pab(i, j)*difmab(i, j, 2)
1731 372462 : forcea(imom, 3) = forcea(imom, 3) + pab(i, j)*difmab(i, j, 3)
1732 : END DO
1733 : END DO
1734 56622 : nb = nb + ncoset(lb_max)
1735 : END DO
1736 19419 : na = na + ncoset(la_max)
1737 : END DO
1738 : END DO
1739 :
1740 1662 : DEALLOCATE (mab, difmab)
1741 :
1742 1662 : END SUBROUTINE dipole_force
1743 :
1744 : END MODULE ai_moments
|
