diff --git a/deriv_num b/deriv_num index 39109ee..0f56468 100755 Binary files a/deriv_num and b/deriv_num differ diff --git a/el_nuc_el.irp.f b/el_nuc_el.irp.f index 73e500c..688ee9d 100644 --- a/el_nuc_el.irp.f +++ b/el_nuc_el.irp.f @@ -8,8 +8,8 @@ BEGIN_PROVIDER [ double precision, factor_een ] integer :: i, j, a, p, k, l, lmax, m, n double precision :: cn, accu2, accu - factor_een = factor_een_blas - return +! factor_een = factor_een_blas +! return factor_een = 0.0d0 diff --git a/el_nuc_el_blas.irp.f b/el_nuc_el_blas.irp.f index fdf1c47..9330ff8 100644 --- a/el_nuc_el_blas.irp.f +++ b/el_nuc_el_blas.irp.f @@ -1,57 +1,5 @@ -BEGIN_PROVIDER [ double precision, factor_een_blas ] - implicit none - BEGIN_DOC - ! ElectronE-electron-nuclei contribution to Jastrow factor - ! - ! 4124.84239750000 - END_DOC - integer :: i, j, a, p, k, l, lmax, m, n - double precision :: cn(nnuc), accu - double precision :: f(nnuc,0:ncord-2,0:ncord-2) - double precision :: tmp_c(nelec,nnuc,0:ncord,0:ncord-1) - - factor_een_blas = 0.0d0 - - ! r_{ij}^k . R_{ja}^l -> tmp_c_{ia}^{kl} - do k=0,ncord-1 - call dgemm('N','N', nelec, nnuc*(ncord+1), nelec, 1.d0, & - rescale_een_e(1,1,k), size(rescale_een_e,1), & - rescale_een_n(1,1,0), size(rescale_een_n,1), 0.d0, & - tmp_c(1,1,0,k), size(tmp_c,1)) - enddo - - do p = 2, ncord - do k = 0, p - 1 - m = p-k - if (k > 0) then - lmax = m - else - lmax = m - 2 - endif - - n = shiftr(m,1) - do l = iand(m, 1), lmax, 2 - - do a = 1, nnuc - cn(a) = cord_vect_lkp(l, k, p, typenuc_arr(a)) - enddo - - do a = 1, nnuc - accu = 0.d0 - do i=1,nelec - accu = accu + rescale_een_n(i,a,n) * tmp_c(i,a,n+l,k) - enddo - factor_een_blas = factor_een_blas + accu * cn(a) - enddo - n = n-1 - - enddo - enddo - enddo - -END_PROVIDER - -BEGIN_PROVIDER [ double precision, factor_een_deriv_e_blas, (4, nelec) ] + BEGIN_PROVIDER [ double precision, factor_een_blas ] +&BEGIN_PROVIDER [ double precision, factor_een_deriv_e_blas, (4, nelec) ] implicit none BEGIN_DOC ! Dimensions 1-3 : dx, dy, dz @@ -59,11 +7,12 @@ BEGIN_PROVIDER [ double precision, factor_een_deriv_e_blas, (4, nelec) ] END_DOC integer :: i, j, a, p, k, l, lmax, m, n - double precision :: cn(ncord), x + double precision :: cn(ncord), accu double precision :: f(nnuc,0:ncord-2,0:ncord-2) double precision :: tmp_c(nelec,nnuc,0:ncord,0:ncord-1) double precision :: dtmp_c(4,nelec,nnuc,0:ncord,0:ncord-1) + factor_een_blas = 0.0d0 factor_een_deriv_e_blas(1:4,1:nelec) = 0.0d0 ! r_{ij}^k . R_{ja}^l -> tmp_c_{ia}^{kl} @@ -100,7 +49,10 @@ BEGIN_PROVIDER [ double precision, factor_een_deriv_e_blas, (4, nelec) ] 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) 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) + & @@ -109,16 +61,18 @@ BEGIN_PROVIDER [ double precision, factor_een_deriv_e_blas, (4, nelec) ] tmp_c(j,a,n+l,k)*rescale_een_n_deriv_e(1:4,j,a,n) & ) * cn(a) - factor_een_deriv_e_blas(4,j) = factor_een_deriv_e_blas(4,j) + 2.d0*(& + 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 )& - )*cn(a) + )*cn(a)*2.d0 enddo + factor_een_blas = factor_een_blas + accu * cn(a) + enddo n = n-1 diff --git a/jastrow b/jastrow index bc2fd37..b1b7d3b 100755 Binary files a/jastrow and b/jastrow differ