1
0
mirror of https://github.com/TREX-CoE/irpjast.git synced 2024-11-03 20:54:10 +01:00
irpjast/el_nuc_el.irp.f

122 lines
2.9 KiB
FortranFixed
Raw Normal View History

2020-12-10 17:21:38 +01:00
BEGIN_PROVIDER [ double precision, factor_een ]
implicit none
BEGIN_DOC
2020-12-10 17:21:38 +01:00
!
END_DOC
2020-12-10 17:21:38 +01:00
integer :: i,j,a,p,k,l,lmax,m
double precision :: riam, rjam_cn, rial, rjal, rijk
double precision :: cn
2020-12-04 13:59:10 +01:00
factor_een = 0.0d0
2020-12-02 10:41:22 +01:00
2020-12-10 17:21:38 +01:00
do p=2,ncord
do k=0,p-1
if (k /= 0) then
lmax = p-k
else
lmax = p-k-2
endif
2020-11-25 18:09:13 +01:00
2020-12-10 17:21:38 +01:00
do l=0,lmax
if ( iand(p-k-l,1) == 1) then
cycle
endif
m = (p-k-l)/2
2020-12-10 14:16:39 +01:00
2020-12-10 17:21:38 +01:00
do a=1, nnuc
cn = cord_vect_lkp(l,k,p,typenuc_arr(a))
do j=1, nelec
rjal = rescale_een_n(j,a,l)
rjam_cn = rescale_een_n(j,a,m) * cn
do i=1, j-1
rial = rescale_een_n(i,a,l)
riam = rescale_een_n(i,a,m)
rijk = rescale_een_e(i,j,k)
factor_een = factor_een + &
rijk * (rial+rjal) * riam * rjam_cn
enddo
enddo
enddo
2020-12-10 14:16:39 +01:00
2020-12-10 17:21:38 +01:00
enddo
enddo
enddo
2020-12-10 14:16:39 +01:00
2020-12-10 17:21:38 +01:00
END_PROVIDER
BEGIN_PROVIDER [ double precision, factor_een_deriv_e, (4,nelec) ]
2020-12-10 14:16:39 +01:00
implicit none
BEGIN_DOC
2020-12-10 17:21:38 +01:00
! dimensions 1-3 : dx,dy,dz
2020-12-10 14:16:39 +01:00
!
2020-12-10 17:21:38 +01:00
! Rdimension 4 : d2x + d2y + d2z
2020-12-10 14:16:39 +01:00
END_DOC
integer :: i,j,a,p,k,l,lmax,m
double precision :: riam, rjam_cn, rial, rjal, rijk
2020-12-10 17:21:38 +01:00
double precision, dimension(4) :: driam, drjam_cn, drial, drjal, drijk
double precision :: cn, v1, v2, l1, l2, d1, d2
2020-12-10 14:16:39 +01:00
2020-12-10 17:21:38 +01:00
factor_een_deriv_e = 0.0d0
2020-12-10 14:16:39 +01:00
do p=2,ncord
do k=0,p-1
if (k /= 0) then
lmax = p-k
else
lmax = p-k-2
endif
do l=0,lmax
2020-12-10 17:21:38 +01:00
if ( iand(p-k-l,1) == 1) then
cycle
endif
2020-12-10 14:16:39 +01:00
m = (p-k-l)/2
do a=1, nnuc
cn = cord_vect_lkp(l,k,p,typenuc_arr(a))
do j=1, nelec
rjal = rescale_een_n(j,a,l)
rjam_cn = rescale_een_n(j,a,m) * cn
2020-12-10 17:21:38 +01:00
do ii=1,4
drjal(ii) = rescale_een_n_deriv_e(ii,j,a,l)
drjam_cn(ii) = rescale_een_n_deriv_e(ii,j,a,m) * cn
enddo
factor_een_deriv_e(:,j) = 0.d0
do i=1, nelec
2020-12-10 14:16:39 +01:00
rial = rescale_een_n(i,a,l)
riam = rescale_een_n(i,a,m)
rijk = rescale_een_e(i,j,k)
2020-12-10 17:21:38 +01:00
do ii=1,4
drijk(ii) = rescale_een_e_deriv_e(ii,i,j,k)
enddo
l1 = 0.d0
l2 = 0.d0
x(1:3) = 0.d0
x(4) = 2.d0
do ii=1,4
v1 = rijk * (rial+rjal)
v2 = rjam_cn * riam
d1 = drijk(ii) * (rial+rjal) + rijk * (rial+drjal(ii))
d2 = drjam_cn(ii) * riam
l1 = l1 + drijk(ii) * (rial+drjal(ii))
l2 = l2 + drjam_cn(ii) * riam
factor_een_deriv_e(ii,j) = factor_een_deriv_e(ii,j) + &
v1 * d2 + d1 * v2 + x(ii) * (l1 + l2)
enddo
factor_een_deriv_e(ii,j) = factor_een_deriv_e(ii,j) + &
v1 * d2 + d1 * v2
2020-12-10 14:16:39 +01:00
enddo
enddo
enddo
enddo
enddo
enddo
2020-12-10 17:21:38 +01:00
factor_een_deriv_e = 0.5d0 * factor_een_deriv_e
2020-12-10 14:16:39 +01:00
END_PROVIDER