34 #include "../base/base_uses.f90"
40 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'ai_overlap_aabb'
80 SUBROUTINE overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, &
81 la_max_set2, la_min_set2, npgfa2, rpgfa2, zeta2, &
82 lb_max_set1, lb_min_set1, npgfb1, rpgfb1, zetb1, &
83 lb_max_set2, lb_min_set2, npgfb2, rpgfb2, zetb2, &
84 asets_equal, bsets_equal, rab, dab, saabb, s, lds)
86 INTEGER,
INTENT(IN) :: la_max_set1, la_min_set1, npgfa1
87 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: rpgfa1, zeta1
88 INTEGER,
INTENT(IN) :: la_max_set2, la_min_set2, npgfa2
89 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: rpgfa2, zeta2
90 INTEGER,
INTENT(IN) :: lb_max_set1, lb_min_set1, npgfb1
91 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: rpgfb1, zetb1
92 INTEGER,
INTENT(IN) :: lb_max_set2, lb_min_set2, npgfb2
93 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: rpgfb2, zetb2
94 LOGICAL,
INTENT(IN) :: asets_equal, bsets_equal
95 REAL(kind=
dp),
DIMENSION(3),
INTENT(IN) :: rab
96 REAL(kind=
dp),
INTENT(IN) :: dab
97 REAL(kind=
dp),
DIMENSION(:, :, :, :), &
98 INTENT(INOUT) :: saabb
99 INTEGER,
INTENT(IN) :: lds
100 REAL(kind=
dp),
DIMENSION(lds, lds),
INTENT(INOUT) :: s
102 CHARACTER(len=*),
PARAMETER :: routinen =
'overlap_aabb'
104 INTEGER :: ax, ay, az, bx, by, bz, coa, coamx, coamy, coamz, coapx, coapy, coapz, cob, &
105 cobm2x, cobm2y, cobm2z, cobmx, cobmy, cobmz, handle, i, ia, ib, ipgf, j, ja, jb, jpgf, &
106 jpgf_start, kpgf, la, la_max, la_min, la_start, lb, lb_max, lb_min, lpgf, lpgf_start, &
107 ncoa1, ncoa2, ncob1, ncob2
108 INTEGER,
DIMENSION(3) :: na, naa, nb, nbb, nia, nib, nja, njb
109 REAL(kind=
dp) :: f0, f1, f2, f3, f4, fax, fay, faz, zeta, &
111 REAL(kind=
dp),
DIMENSION(3) :: rap, rbp
113 CALL timeset(routinen, handle)
126 IF (asets_equal)
THEN
128 DO i = 1, jpgf_start - 1
129 ncoa2 = ncoa2 +
ncoset(la_max_set2)
135 DO jpgf = jpgf_start, npgfa2
138 zeta = zeta1(ipgf) + zeta2(jpgf)
139 la_max = la_max_set1 + la_max_set2
140 la_min = la_min_set1 + la_min_set2
146 IF (bsets_equal)
THEN
148 DO i = 1, lpgf_start - 1
149 ncob2 = ncob2 +
ncoset(lb_max_set2)
155 DO lpgf = lpgf_start, npgfb2
158 IF ((rpgfa1(ipgf) + rpgfb1(kpgf) < dab) .OR. &
159 (rpgfa2(jpgf) + rpgfb1(kpgf) < dab) .OR. &
160 (rpgfa1(ipgf) + rpgfb2(lpgf) < dab) .OR. &
161 (rpgfa2(jpgf) + rpgfb2(lpgf) < dab))
THEN
162 DO jb =
ncoset(lb_min_set2 - 1) + 1,
ncoset(lb_max_set2)
163 DO ib =
ncoset(lb_min_set1 - 1) + 1,
ncoset(lb_max_set1)
164 DO ja =
ncoset(la_min_set2 - 1) + 1,
ncoset(la_max_set2)
165 DO ia =
ncoset(la_min_set1 - 1) + 1,
ncoset(la_max_set1)
166 saabb(ncoa1 + ia, ncoa2 + ja, ncob1 + ib, ncob2 + jb) = 0._dp
167 IF (asets_equal) saabb(ncoa2 + ja, ncoa1 + ia, ncob1 + ib, ncob2 + jb) = 0._dp
168 IF (bsets_equal) saabb(ncoa1 + ia, ncoa2 + ja, ncob2 + jb, ncob1 + ib) = 0._dp
169 IF (asets_equal .AND. bsets_equal)
THEN
170 saabb(ncoa2 + ja, ncoa1 + ia, ncob1 + ib, ncob2 + jb) = 0._dp
171 saabb(ncoa1 + ia, ncoa2 + ja, ncob2 + jb, ncob1 + ib) = 0._dp
172 saabb(ncoa2 + ja, ncoa1 + ia, ncob2 + jb, ncob1 + ib) = 0._dp
178 ncob2 = ncob2 +
ncoset(lb_max_set2)
182 zetb = zetb1(kpgf) + zetb2(lpgf)
183 lb_max = lb_max_set1 + lb_max_set2
184 lb_min = lb_min_set1 + lb_min_set2
188 zetp = 1.0_dp/(zeta + zetb)
190 f0 = sqrt((
pi*zetp)**3)
196 s(1, 1) = f0*exp(-zeta*f1*dab*dab)
208 s(2, 1) = rap(1)*s(1, 1)
209 s(3, 1) = rap(2)*s(1, 1)
210 s(4, 1) = rap(3)*s(1, 1)
218 s(5, 1) = rap(1)*s(2, 1) + f3
219 s(6, 1) = rap(1)*s(3, 1)
220 s(7, 1) = rap(1)*s(4, 1)
221 s(8, 1) = rap(2)*s(3, 1) + f3
222 s(9, 1) = rap(2)*s(4, 1)
223 s(10, 1) = rap(3)*s(4, 1) + f3
231 s(11, 1) = rap(1)*s(5, 1) + f3*s(2, 1)
232 s(12, 1) = rap(1)*s(6, 1) + f2*s(3, 1)
233 s(13, 1) = rap(1)*s(7, 1) + f2*s(4, 1)
234 s(14, 1) = rap(1)*s(8, 1)
235 s(15, 1) = rap(1)*s(9, 1)
236 s(16, 1) = rap(1)*s(10, 1)
237 s(17, 1) = rap(2)*s(8, 1) + f3*s(3, 1)
238 s(18, 1) = rap(2)*s(9, 1) + f2*s(4, 1)
239 s(19, 1) = rap(2)*s(10, 1)
240 s(20, 1) = rap(3)*s(10, 1) + f3*s(4, 1)
248 s(21, 1) = rap(1)*s(11, 1) + f4*s(5, 1)
249 s(22, 1) = rap(1)*s(12, 1) + f3*s(6, 1)
250 s(23, 1) = rap(1)*s(13, 1) + f3*s(7, 1)
251 s(24, 1) = rap(1)*s(14, 1) + f2*s(8, 1)
252 s(25, 1) = rap(1)*s(15, 1) + f2*s(9, 1)
253 s(26, 1) = rap(1)*s(16, 1) + f2*s(10, 1)
254 s(27, 1) = rap(1)*s(17, 1)
255 s(28, 1) = rap(1)*s(18, 1)
256 s(29, 1) = rap(1)*s(19, 1)
257 s(30, 1) = rap(1)*s(20, 1)
258 s(31, 1) = rap(2)*s(17, 1) + f4*s(8, 1)
259 s(32, 1) = rap(2)*s(18, 1) + f3*s(9, 1)
260 s(33, 1) = rap(2)*s(19, 1) + f2*s(10, 1)
261 s(34, 1) = rap(2)*s(20, 1)
262 s(35, 1) = rap(3)*s(20, 1) + f4*s(10, 1)
270 s(
coset(0, 0, la), 1) = &
271 rap(3)*s(
coset(0, 0, la - 1), 1) + &
272 f2*real(la - 1,
dp)*s(
coset(0, 0, la - 2), 1)
277 s(
coset(0, 1, az), 1) = rap(2)*s(
coset(0, 0, az), 1)
280 s(
coset(0, ay, az), 1) = &
281 rap(2)*s(
coset(0, ay - 1, az), 1) + &
282 f2*real(ay - 1,
dp)*s(
coset(0, ay - 2, az), 1)
289 s(
coset(1, ay, az), 1) = rap(1)*s(
coset(0, ay, az), 1)
292 f3 = f2*real(ax - 1,
dp)
295 s(
coset(ax, ay, az), 1) = &
296 rap(1)*s(
coset(ax - 1, ay, az), 1) + &
297 f3*s(
coset(ax - 2, ay, az), 1)
321 rbp(:) = rap(:) - rab(:)
325 IF (lb_max == 1)
THEN
328 la_start = max(0, la_min - 1)
331 DO la = la_start, la_max - 1
335 coa =
coset(ax, ay, az)
336 coapx =
coset(ax + 1, ay, az)
337 coapy =
coset(ax, ay + 1, az)
338 coapz =
coset(ax, ay, az + 1)
339 s(coa, 2) = s(coapx, 1) - rab(1)*s(coa, 1)
340 s(coa, 3) = s(coapy, 1) - rab(2)*s(coa, 1)
341 s(coa, 4) = s(coapz, 1) - rab(3)*s(coa, 1)
351 fax = f2*real(ax,
dp)
352 DO ay = 0, la_max - ax
353 fay = f2*real(ay,
dp)
354 az = la_max - ax - ay
355 faz = f2*real(az,
dp)
356 coa =
coset(ax, ay, az)
357 coamx =
coset(ax - 1, ay, az)
358 coamy =
coset(ax, ay - 1, az)
359 coamz =
coset(ax, ay, az - 1)
360 s(coa, 2) = rbp(1)*s(coa, 1) + fax*s(coamx, 1)
361 s(coa, 3) = rbp(2)*s(coa, 1) + fay*s(coamy, 1)
362 s(coa, 4) = rbp(3)*s(coa, 1) + faz*s(coamz, 1)
374 IF (lb == lb_max)
THEN
377 la_start = max(0, la_min - 1)
380 DO la = la_start, la_max - 1
384 coa =
coset(ax, ay, az)
385 coapx =
coset(ax + 1, ay, az)
386 coapy =
coset(ax, ay + 1, az)
387 coapz =
coset(ax, ay, az + 1)
391 cob =
coset(0, 0, lb)
392 cobmz =
coset(0, 0, lb - 1)
393 s(coa, cob) = s(coapz, cobmz) - rab(3)*s(coa, cobmz)
399 cob =
coset(0, by, bz)
400 cobmy =
coset(0, by - 1, bz)
401 s(coa, cob) = s(coapy, cobmy) - rab(2)*s(coa, cobmy)
409 cob =
coset(bx, by, bz)
410 cobmx =
coset(bx - 1, by, bz)
411 s(coa, cob) = s(coapx, cobmx) - rab(1)*s(coa, cobmx)
425 fax = f2*real(ax,
dp)
426 DO ay = 0, la_max - ax
427 fay = f2*real(ay,
dp)
428 az = la_max - ax - ay
429 faz = f2*real(az,
dp)
430 coa =
coset(ax, ay, az)
431 coamx =
coset(ax - 1, ay, az)
432 coamy =
coset(ax, ay - 1, az)
433 coamz =
coset(ax, ay, az - 1)
437 f3 = f2*real(lb - 1,
dp)
438 cob =
coset(0, 0, lb)
439 cobmz =
coset(0, 0, lb - 1)
440 cobm2z =
coset(0, 0, lb - 2)
441 s(coa, cob) = rbp(3)*s(coa, cobmz) + &
442 faz*s(coamz, cobmz) + &
448 cob =
coset(0, 1, bz)
449 cobmy =
coset(0, 0, bz)
450 s(coa, cob) = rbp(2)*s(coa, cobmy) + &
454 f3 = f2*real(by - 1,
dp)
455 cob =
coset(0, by, bz)
456 cobmy =
coset(0, by - 1, bz)
457 cobm2y =
coset(0, by - 2, bz)
458 s(coa, cob) = rbp(2)*s(coa, cobmy) + &
459 fay*s(coamy, cobmy) + &
467 cob =
coset(1, by, bz)
468 cobmx =
coset(0, by, bz)
469 s(coa, cob) = rbp(1)*s(coa, cobmx) + &
473 f3 = f2*real(bx - 1,
dp)
476 cob =
coset(bx, by, bz)
477 cobmx =
coset(bx - 1, by, bz)
478 cobm2x =
coset(bx - 2, by, bz)
479 s(coa, cob) = rbp(1)*s(coa, cobmx) + &
480 fax*s(coamx, cobmx) + &
498 rbp(:) = (f1 - 1.0_dp)*rab(:)
502 s(1, 2) = rbp(1)*s(1, 1)
503 s(1, 3) = rbp(2)*s(1, 1)
504 s(1, 4) = rbp(3)*s(1, 1)
512 s(1, 5) = rbp(1)*s(1, 2) + f3
513 s(1, 6) = rbp(1)*s(1, 3)
514 s(1, 7) = rbp(1)*s(1, 4)
515 s(1, 8) = rbp(2)*s(1, 3) + f3
516 s(1, 9) = rbp(2)*s(1, 4)
517 s(1, 10) = rbp(3)*s(1, 4) + f3
525 s(1,
coset(0, 0, lb)) = &
526 rbp(3)*s(1,
coset(0, 0, lb - 1)) + &
527 f2*real(lb - 1,
dp)*s(1,
coset(0, 0, lb - 2))
532 s(1,
coset(0, 1, bz)) = rbp(2)*s(1,
coset(0, 0, bz))
535 s(1,
coset(0, by, bz)) = &
536 rbp(2)*s(1,
coset(0, by - 1, bz)) + &
537 f2*real(by - 1,
dp)*s(1,
coset(0, by - 2, bz))
544 s(1,
coset(1, by, bz)) = rbp(1)*s(1,
coset(0, by, bz))
547 f3 = f2*real(bx - 1,
dp)
550 s(1,
coset(bx, by, bz)) = &
551 rbp(1)*s(1,
coset(bx - 1, by, bz)) + &
552 f3*s(1,
coset(bx - 2, by, bz))
565 DO jb =
ncoset(lb_min_set2 - 1) + 1,
ncoset(lb_max_set2)
566 njb(1:3) =
indco(1:3, jb)
567 DO ib =
ncoset(lb_min_set1 - 1) + 1,
ncoset(lb_max_set1)
568 nib(1:3) =
indco(1:3, ib)
570 DO ja =
ncoset(la_min_set2 - 1) + 1,
ncoset(la_max_set2)
571 nja(1:3) =
indco(1:3, ja)
572 DO ia =
ncoset(la_min_set1 - 1) + 1,
ncoset(la_max_set1)
573 nia(1:3) =
indco(1:3, ia)
577 nb(1:3) =
indco(1:3, j)
579 na(1:3) =
indco(1:3, i)
580 IF (all(na == naa) .AND. all(nb == nbb))
THEN
581 saabb(ncoa1 + ia, ncoa2 + ja, ncob1 + ib, ncob2 + jb) = s(i, j)
582 IF (asets_equal) saabb(ncoa2 + ja, ncoa1 + ia, ncob1 + ib, ncob2 + jb) = s(i, j)
583 IF (bsets_equal) saabb(ncoa1 + ia, ncoa2 + ja, ncob2 + jb, ncob1 + ib) = s(i, j)
584 IF (asets_equal .AND. bsets_equal)
THEN
585 saabb(ncoa2 + ja, ncoa1 + ia, ncob1 + ib, ncob2 + jb) = s(i, j)
586 saabb(ncoa1 + ia, ncoa2 + ja, ncob2 + jb, ncob1 + ib) = s(i, j)
587 saabb(ncoa2 + ja, ncoa1 + ia, ncob2 + jb, ncob1 + ib) = s(i, j)
597 ncob2 = ncob2 +
ncoset(lb_max_set2)
601 ncob1 = ncob1 +
ncoset(lb_max_set1)
605 ncoa2 = ncoa2 +
ncoset(la_max_set2)
609 ncoa1 = ncoa1 +
ncoset(la_max_set1)
613 CALL timestop(handle)
Calculation of the overlap integrals over Cartesian Gaussian-type functions.
subroutine, public overlap_aabb(la_max_set1, la_min_set1, npgfa1, rpgfa1, zeta1, la_max_set2, la_min_set2, npgfa2, rpgfa2, zeta2, lb_max_set1, lb_min_set1, npgfb1, rpgfb1, zetb1, lb_max_set2, lb_min_set2, npgfb2, rpgfb2, zetb2, asets_equal, bsets_equal, rab, dab, saabb, s, lds)
Purpose: Calculation of the two-center overlap integrals [aa|bb] over Cartesian Gaussian-type functio...
Defines the basic variable types.
integer, parameter, public dp
Definition of mathematical constants and functions.
real(kind=dp), parameter, public pi
Provides Cartesian and spherical orbital pointers and indices.
integer, dimension(:), allocatable, public ncoset
integer, dimension(:, :, :), allocatable, public coset
integer, dimension(:, :), allocatable, public indco