79 SUBROUTINE pso(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rpgfb, zetb, &
80 rac, rbc, rab, vab, ldrr1, ldrr2, rr)
81 INTEGER,
INTENT(IN) :: la_max, la_min, npgfa
82 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: rpgfa, zeta
83 INTEGER,
INTENT(IN) :: lb_max, lb_min, npgfb
84 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: rpgfb, zetb
85 REAL(kind=
dp),
DIMENSION(3),
INTENT(IN) :: rac, rbc, rab
86 REAL(kind=
dp),
DIMENSION(:, :, :),
INTENT(INOUT) :: vab
87 INTEGER,
INTENT(IN) :: ldrr1, ldrr2
88 REAL(
dp),
DIMENSION(0:ldrr1-1, ldrr2, *), &
91 INTEGER :: ax, ay, az, bx, by, bz, coa, coam1x, coam1y, coam1z, coap1x, coap1y, coap1z, cob, &
92 cobm1x, cobm1y, cobm1z, cobp1x, cobp1y, cobp1z, i, ipgf, j, jpgf, la, lb, ma, mb, na, nb
93 REAL(
dp) :: dab, dum1, dum2, f0, rab2, xhi, zet, &
95 REAL(
dp),
DIMENSION(3) :: rap, rbp, rcp
99 rab2 = rab(1)**2 + rab(2)**2 + rab(3)**2
114 IF (rpgfa(ipgf) + rpgfb(jpgf) < dab)
THEN
115 DO j = nb + 1, nb +
ncoset(lb_max)
116 DO i = na + 1, na +
ncoset(la_max)
117 vab(i, j, 1) = 0.0_dp
118 vab(i, j, 2) = 0.0_dp
119 vab(i, j, 3) = 0.0_dp
128 zetab = zeta(ipgf)*zetb(jpgf)
129 zet = zeta(ipgf) + zetb(jpgf)
131 rap = zetb(jpgf)*rab/zet
132 rbp = -zeta(ipgf)*rab/zet
133 rcp = -(zeta(ipgf)*rac + zetb(jpgf)*rbc)/zet
135 f0 = 2.0_dp*sqrt(zet/
pi)*(
pi/zet)**(1.5_dp)*exp(-xhi*rab2)
139 CALL os_rr_coul(rap, la_max + 1, rbp, lb_max + 1, rcp, zet, ldrr1, ldrr2, rr)
143 DO lb = lb_min, lb_max
147 cob =
coset(bx, by, bz)
148 cobm1x =
coset(max(bx - 1, 0), by, bz)
149 cobm1y =
coset(bx, max(by - 1, 0), bz)
150 cobm1z =
coset(bx, by, max(bz - 1, 0))
151 cobp1x =
coset(bx + 1, by, bz)
152 cobp1y =
coset(bx, by + 1, bz)
153 cobp1z =
coset(bx, by, bz + 1)
155 DO la = la_min, la_max
159 coa =
coset(ax, ay, az)
160 coam1x =
coset(max(ax - 1, 0), ay, az)
161 coam1y =
coset(ax, max(ay - 1, 0), az)
162 coam1z =
coset(ax, ay, max(az - 1, 0))
163 coap1x =
coset(ax + 1, ay, az)
164 coap1y =
coset(ax, ay + 1, az)
165 coap1z =
coset(ax, ay, az + 1)
175 dum1 = 4.0_dp*zeta(ipgf)*zetb(jpgf)*rr(0, coap1y, cobp1z)
176 IF (bz .GT. 0) dum1 = dum1 - 2.0_dp*zeta(ipgf)*real(bz,
dp)*rr(0, coap1y, cobm1z)
177 IF (ay .GT. 0) dum1 = dum1 - 2.0_dp*zetb(jpgf)*real(ay,
dp)*rr(0, coam1y, cobp1z)
178 IF (ay .GT. 0 .AND. bz .GT. 0) dum1 = dum1 + real(ay,
dp)*real(bz,
dp)*rr(0, coam1y, cobm1z)
180 dum2 = 4.0_dp*zeta(ipgf)*zetb(jpgf)*rr(0, coap1z, cobp1y)
181 IF (by .GT. 0) dum2 = dum2 - 2.0_dp*zeta(ipgf)*real(by,
dp)*rr(0, coap1z, cobm1y)
182 IF (az .GT. 0) dum2 = dum2 - 2.0_dp*zetb(jpgf)*real(az,
dp)*rr(0, coam1z, cobp1y)
183 IF (az .GT. 0 .AND. by .GT. 0) dum2 = dum2 + real(az,
dp)*real(by,
dp)*rr(0, coam1z, cobm1y)
184 vab(ma, mb, 1) = f0*(dum1 - dum2)
193 dum1 = 4.0_dp*zeta(ipgf)*zetb(jpgf)*rr(0, coap1z, cobp1x)
194 IF (bx .GT. 0) dum1 = dum1 - 2.0_dp*zeta(ipgf)*real(bx,
dp)*rr(0, coap1z, cobm1x)
195 IF (az .GT. 0) dum1 = dum1 - 2.0_dp*zetb(jpgf)*real(az,
dp)*rr(0, coam1z, cobp1x)
196 IF (az .GT. 0 .AND. bx .GT. 0) dum1 = dum1 + real(az,
dp)*real(bx,
dp)*rr(0, coam1z, cobm1x)
198 dum2 = 4.0_dp*zeta(ipgf)*zetb(jpgf)*rr(0, coap1x, cobp1z)
199 IF (bz .GT. 0) dum2 = dum2 - 2.0_dp*zeta(ipgf)*real(bz,
dp)*rr(0, coap1x, cobm1z)
200 IF (ax .GT. 0) dum2 = dum2 - 2.0_dp*zetb(jpgf)*real(ax,
dp)*rr(0, coam1x, cobp1z)
201 IF (ax .GT. 0 .AND. bz .GT. 0) dum2 = dum2 + real(ax,
dp)*real(bz,
dp)*rr(0, coam1x, cobm1z)
202 vab(ma, mb, 2) = f0*(dum1 - dum2)
211 dum1 = 4.0_dp*zeta(ipgf)*zetb(jpgf)*rr(0, coap1x, cobp1y)
212 IF (by .GT. 0) dum1 = dum1 - 2.0_dp*zeta(ipgf)*real(by,
dp)*rr(0, coap1x, cobm1y)
213 IF (ax .GT. 0) dum1 = dum1 - 2.0_dp*zetb(jpgf)*real(ax,
dp)*rr(0, coam1x, cobp1y)
214 IF (ax .GT. 0 .AND. by .GT. 0) dum1 = dum1 + real(ax,
dp)*real(by,
dp)*rr(0, coam1x, cobm1y)
216 dum2 = 4.0_dp*zeta(ipgf)*zetb(jpgf)*rr(0, coap1y, cobp1x)
217 IF (bx .GT. 0) dum2 = dum2 - 2.0_dp*zeta(ipgf)*real(bx,
dp)*rr(0, coap1y, cobm1x)
218 IF (ay .GT. 0) dum2 = dum2 - 2.0_dp*zetb(jpgf)*real(ay,
dp)*rr(0, coam1y, cobp1x)
219 IF (ay .GT. 0 .AND. bx .GT. 0) dum2 = dum2 + real(ay,
dp)*real(bx,
dp)*rr(0, coam1y, cobm1x)
220 vab(ma, mb, 3) = f0*(dum1 - dum2)
subroutine, public pso(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rpgfb, zetb, rac, rbc, rab, vab, ldrr1, ldrr2, rr)
Calculation of the primitive paramagnetic spin orbit integrals over Cartesian Gaussian-type functions...