TREX/irpjast
1
0
Fork 0
mirror of https://github.com/TREX-CoE/irpjast.git synced 2024-07-03 01:46:12 +02:00
Code Issues Projects Releases Wiki Activity

Reduced loops

Browse Source
This commit is contained in:
Anthony Scemama 2021-01-25 00:16:09 +01:00
parent 1583fff817
commit e4fa71430c
5 changed files with 186 additions and 142 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
deriv_num
View File

Binary file not shown.

68
el_nuc_el.irp.f
View File

@ -1,33 +1,48 @@
BEGIN_PROVIDER [ double precision, factor_een ]
implicit none
BEGIN_DOC
! ElectronE-electron-nuclei contribution to Jastrow factor
! Electron -electron-nuclei contribution to Jastrow factor
!
! 5436.20340250000
END_DOC
integer :: i, j, a, p, k, l, lmax, m, n
double precision :: cn, accu2, accu
! double precision :: ria_tmp(nelec,dim_cord_vect,nnuc)
! double precision :: rja_tmp(nelec,dim_cord_vect,nnuc)
!
! do a = 1, nnuc
! do n = 1, dim_cord_vect
!
! l = lkpm_of_cindex(1,n)
! k = lkpm_of_cindex(2,n)
! p = lkpm_of_cindex(3,n)
! m = lkpm_of_cindex(4,n)
!
! do i = 1, nelec
! ria_tmp(i,n,a) = rescale_een_n(i,a,m)
! rja_tmp(i,n,a) = rescale_een_n(i,a,m+l)
! enddo
! enddo
!
! enddo
! factor_een = factor_een_blas
! return
factor_een = 0.0d0
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
if ( iand(p - k - l, 1) == 1) cycle
do n = 1, dim_cord_vect
m = (p - k - l) / 2
l = lkpm_of_cindex(1,n)
k = lkpm_of_cindex(2,n)
p = lkpm_of_cindex(3,n)
m = lkpm_of_cindex(4,n)
do a = 1, nnuc
accu2 = 0.d0
cn = cord_vect_lkp(l, k, p, typenuc_arr(a))
cn = cord_vect_full(n, a)
do j = 1, nelec
accu = 0.d0
do i = 1, nelec
@ -41,35 +56,32 @@ BEGIN_PROVIDER [ double precision, factor_een ]
enddo
enddo
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, factor_een_deriv_e, (4, nelec) ]
implicit none
BEGIN_DOC
! Derivative of the Jeen
! 35533.115255
END_DOC
integer :: i, j, a, p, k, l, lmax, m, n
double precision :: cn, accu, accu2, daccu(1:4), daccu2(1:4)
factor_een_deriv_e(1:4,1:nelec) = factor_een_deriv_e_blas(1:4,1:nelec)
return
! factor_een_deriv_e(1:4,1:nelec) = factor_een_deriv_e_blas(1:4,1:nelec)
! return
factor_een_deriv_e(1:4,1:nelec) = 0.0d0
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
if ( iand(p - k - l, 1) == 1) cycle
do n = 1, dim_cord_vect
m = (p - k - l) / 2
l = lkpm_of_cindex(1,n)
k = lkpm_of_cindex(2,n)
p = lkpm_of_cindex(3,n)
m = lkpm_of_cindex(4,n)
do a = 1, nnuc
cn = cord_vect_lkp(l, k, p, typenuc_arr(a))
cn = cord_vect_full(n, a)
do j = 1, nelec
accu=0.d0
accu2 = 0.d0
@ -104,8 +116,6 @@ BEGIN_PROVIDER [ double precision, factor_een_deriv_e, (4, nelec) ]
enddo
enddo
enddo
enddo
enddo
END_PROVIDER

44
el_nuc_el_blas.irp.f
View File

@ -32,51 +32,43 @@
enddo
do p = 2, ncord
do k = 0, p - 1
m = p-k
if (k > 0) then
lmax = m
else
lmax = m - 2
endif
do n = 1, dim_cord_vect
n = shiftr(m,1)
do l = iand(m, 1), lmax, 2
l = lkpm_of_cindex(1,n)
k = lkpm_of_cindex(2,n)
p = lkpm_of_cindex(3,n)
m = lkpm_of_cindex(4,n)
do a = 1, nnuc
cn(a) = cord_vect_lkp(l, k, p, typenuc_arr(a))
cn(a) = cord_vect_full(n, a)
enddo
do a = 1, nnuc
accu = 0.d0
do j=1,nelec
accu = accu + rescale_een_n(j,a,n) * tmp_c(j,a,n+l,k)
accu = accu + rescale_een_n(j,a,m) * tmp_c(j,a,m+l,k)
factor_een_deriv_e_blas(1:4,j) = factor_een_deriv_e_blas(1:4,j) + (&
tmp_c(j,a,n,k) * rescale_een_n_deriv_e(1:4,j,a,n+l) + &
dtmp_c(1:4,j,a,n,k) * rescale_een_n(j,a,n+l) + &
dtmp_c(1:4,j,a,n+l,k) * rescale_een_n(j,a,n) + &
tmp_c(j,a,n+l,k)*rescale_een_n_deriv_e(1:4,j,a,n) &
tmp_c(j,a,m,k) * rescale_een_n_deriv_e(1:4,j,a,m+l) + &
dtmp_c(1:4,j,a,m,k) * rescale_een_n(j,a,m+l) + &
dtmp_c(1:4,j,a,m+l,k) * rescale_een_n(j,a,m) + &
tmp_c(j,a,m+l,k)*rescale_een_n_deriv_e(1:4,j,a,m) &
) * cn(a)
factor_een_deriv_e_blas(4,j) = factor_een_deriv_e_blas(4,j) + (&
dtmp_c(1,j,a,n ,k) * rescale_een_n_deriv_e(1,j,a,n+l) +&
dtmp_c(2,j,a,n ,k) * rescale_een_n_deriv_e(2,j,a,n+l) +&
dtmp_c(3,j,a,n ,k) * rescale_een_n_deriv_e(3,j,a,n+l) +&
dtmp_c(1,j,a,n+l,k) * rescale_een_n_deriv_e(1,j,a,n ) +&
dtmp_c(2,j,a,n+l,k) * rescale_een_n_deriv_e(2,j,a,n ) +&
dtmp_c(3,j,a,n+l,k) * rescale_een_n_deriv_e(3,j,a,n )&
dtmp_c(1,j,a,m ,k) * rescale_een_n_deriv_e(1,j,a,m+l) + &
dtmp_c(2,j,a,m ,k) * rescale_een_n_deriv_e(2,j,a,m+l) + &
dtmp_c(3,j,a,m ,k) * rescale_een_n_deriv_e(3,j,a,m+l) + &
dtmp_c(1,j,a,m+l,k) * rescale_een_n_deriv_e(1,j,a,m ) + &
dtmp_c(2,j,a,m+l,k) * rescale_een_n_deriv_e(2,j,a,m ) + &
dtmp_c(3,j,a,m+l,k) * rescale_een_n_deriv_e(3,j,a,m ) &
)*cn(a)*2.d0
enddo
factor_een_blas = factor_een_blas + accu * cn(a)
enddo
n = n-1
enddo
enddo
enddo
enddo
END_PROVIDER

BIN
jastrow
View File

Binary file not shown.

48
orders.irp.f
View File

@ -32,13 +32,14 @@ BEGIN_PROVIDER [integer, dim_cord_vect]
dim_cord_vect = 0
do p = 2, ncord
do k = 0, p - 1
do k = p - 1, 0, -1
if ( k /= 0 ) then
lmax = p - k
else
lmax = p - k - 2
end if
do l = iand(p - k, 1), lmax, 2
do l = lmax, 0, -1
if (iand(p - k - l, 1) == 1) cycle
dim_cord_vect = dim_cord_vect + 1
end do
end do
@ -47,6 +48,35 @@ BEGIN_PROVIDER [integer, dim_cord_vect]
END_PROVIDER
BEGIN_PROVIDER [ integer, lkpm_of_cindex, (4,dim_cord_vect) ]
implicit none
BEGIN_DOC
! Transform l,k,p into a consecutive index
END_DOC
integer :: p,k,l,lmax,m
integer :: kk
kk=0
do p = 2, ncord
do k = p - 1, 0, -1
if ( k /= 0 ) then
lmax = p - k
else
lmax = p - k - 2
end if
do l = lmax, 0, -1
if (iand(p - k - l, 1) == 1) cycle
m = (p - k - l) / 2
kk = kk+1
lkpm_of_cindex(1,kk) = l
lkpm_of_cindex(2,kk) = k
lkpm_of_cindex(3,kk) = p
lkpm_of_cindex(4,kk) = m
enddo
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [double precision, aord_vect, (naord + 1, typenuc)]
&BEGIN_PROVIDER [double precision, bord_vect, (nbord + 1)]
&BEGIN_PROVIDER [double precision, cord_vect, (dim_cord_vect, typenuc)]
@ -70,6 +100,18 @@ BEGIN_PROVIDER [double precision, aord_vect, (naord + 1, typenuc)]
END_PROVIDER
BEGIN_PROVIDER [ double precision, cord_vect_full, (dim_cord_vect, nnuc) ]
implicit none
BEGIN_DOC
! cord_vect for all atoms
END_DOC
integer :: a
do a=1,nnuc
cord_vect_full(1:dim_cord_vect,a) = cord_vect(1:dim_cord_vect,typenuc_arr(a))
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, cord_vect_lkp, (0:ncord-1, 0:ncord-1, 2:ncord, typenuc) ]
implicit none
BEGIN_DOC
@ -78,8 +120,8 @@ BEGIN_PROVIDER [ double precision, cord_vect_lkp, (0:ncord-1, 0:ncord-1, 2:ncord
integer :: alpha, l, k, p, lmax, cindex
cord_vect_lkp = 0.0d0
cindex = 0
do alpha = 1, typenuc
cindex = 0
do p = 2, ncord
do k = p - 1, 0, -1
if ( k /= 0 ) then