mirror of
https://github.com/TREX-CoE/irpjast.git
synced 2024-10-02 14:31:07 +02:00
Simplified non-blas
This commit is contained in:
parent
cfc329b2f8
commit
7b9db3808b
@ -10,42 +10,41 @@ BEGIN_PROVIDER [ double precision, factor_een ]
|
|||||||
double precision :: f(nnuc,0:ncord-2,0:ncord-2)
|
double precision :: f(nnuc,0:ncord-2,0:ncord-2)
|
||||||
double precision :: tmp_c(nelec,nnuc,0:ncord,0:ncord-1)
|
double precision :: tmp_c(nelec,nnuc,0:ncord,0:ncord-1)
|
||||||
|
|
||||||
factor_een = factor_een_blas
|
! factor_een = factor_een_blas
|
||||||
return
|
! return
|
||||||
|
|
||||||
|
|
||||||
factor_een = 0.0d0
|
factor_een = 0.0d0
|
||||||
|
|
||||||
do p = 2, ncord
|
do p = 2, ncord
|
||||||
do k = 0, p - 1
|
do k = 0, p - 1
|
||||||
if (k /= 0) then
|
if (k /= 0) then
|
||||||
lmax = p - k
|
lmax = p - k
|
||||||
else
|
else
|
||||||
lmax = p - k - 2
|
lmax = p - k - 2
|
||||||
endif
|
endif
|
||||||
do l = 0, lmax
|
do l = 0, lmax
|
||||||
if ( iand(p - k - l, 1) == 1) cycle
|
if ( iand(p - k - l, 1) == 1) cycle
|
||||||
|
|
||||||
m = (p - k - l) / 2
|
m = (p - k - l) / 2
|
||||||
|
|
||||||
do a = 1, nnuc
|
|
||||||
accu2 = 0.d0
|
|
||||||
cn = cord_vect_lkp(l, k, p, typenuc_arr(a))
|
|
||||||
do j = 2, nelec
|
|
||||||
accu = 0.d0
|
|
||||||
do i = 1, j-1
|
|
||||||
accu = accu + rescale_een_e(i,j,k) * &
|
|
||||||
rescale_een_n(i,a,m) * rescale_een_n(j,a,m+l) + &
|
|
||||||
rescale_een_e(i,j,k) * &
|
|
||||||
rescale_een_n(i,a,m+l) * rescale_een_n(j,a,m)
|
|
||||||
enddo
|
|
||||||
accu2 = accu2 + accu
|
|
||||||
enddo
|
|
||||||
factor_een = factor_een + accu2 * cn
|
|
||||||
enddo
|
|
||||||
|
|
||||||
|
do a = 1, nnuc
|
||||||
|
accu2 = 0.d0
|
||||||
|
cn = cord_vect_lkp(l, k, p, typenuc_arr(a))
|
||||||
|
do j = 1, nelec
|
||||||
|
accu = 0.d0
|
||||||
|
do i = 1, nelec
|
||||||
|
accu = accu + &
|
||||||
|
rescale_een_e(i,j,k) * &
|
||||||
|
rescale_een_n(i,a,m) * &
|
||||||
|
rescale_een_n(j,a,m+l)
|
||||||
|
enddo
|
||||||
|
accu2 = accu2 + accu
|
||||||
|
enddo
|
||||||
|
factor_een = factor_een + accu2 * cn
|
||||||
enddo
|
enddo
|
||||||
enddo
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
Loading…
Reference in New Issue
Block a user