LCPQ/qmcchem
10
1
Fork 1
mirror of https://gitlab.com/scemama/qmcchem.git synced 2024-12-22 12:23:30 +01:00
Code Releases Activity

Merge branch 'abdallah' into 'master'

Browse Source 
Fixed DGEMM

See merge request AbdAmmar/qmcchem!1
This commit is contained in:
Abdallah Ammar 2021-05-31 12:49:32 +00:00
commit b45010f15a
5 changed files with 614 additions and 317 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
configure.sh
View File

@ -39,11 +39,11 @@ export PATH="\${QMCCHEM_PATH}/bin:\${PATH}"
export LD_LIBRARY_PATH="\${QMCCHEM_PATH}/lib:\${LD_LIBRARY_PATH}"
export LIBRARY_PATH="\${QMCCHEM_PATH}/lib:\${LIBRARY_PATH}"
export QMCCHEM_MPIRUN="mpirun"
export QMCCHEM_MPIRUN_FLAGS="--bind-to-core"
export QMCCHEM_MPIRUN_FLAGS=""
export C_INCLUDE_PATH="\${QMCCHEM_PATH}/include:\${C_INCLUDE_PATH}"
#export QMCCHEM_NIC=ib0
source \${QMCCHEM_PATH}/irpf90/bin/irpman
#source \${QMCCHEM_PATH}/EZFIO/Bash/ezfio.sh
eval $(opam env)
eval \$(opam env)
EOF

312
src/PROPERTIES/properties_buildpsi.irp.f Normal file
View File

@ -0,0 +1,312 @@
BEGIN_PROVIDER [ double precision, hij_fm, (size_hij_fm) ]
implicit none
BEGIN_DOC
! !!!
! hij = < psi_svd J | H | J l l' > / < psi_svd J | psi_svd J >
! = < H (J l l')/(psi_svd J) > ( first method: fm )
! = < E_loc (l l') / psi_svd > ( secnd method: sm )
! Dimensions : n_svd_toselect
END_DOC
integer :: i, l, lp, e
double precision :: f, g, h, T, V
do i = 1, n_svd_toselect
l = psi_svd_alpha_numtoselect(i,1)
lp = psi_svd_beta_numtoselect (i,1)
! Lapl D
g = 0.d0
do e = 1, elec_alpha_num
g += det_alpha_grad_lapl_SVD_unique(4,e,l) * det_beta_value_SVD_unique(lp)
enddo
do e = elec_alpha_num+1, elec_num
g += det_alpha_value_SVD_unique(l) * det_beta_grad_lapl_SVD_unique(4,e,lp)
enddo
T = g
! D (Lapl J)/J
g = 0.d0
do e = 1, elec_num
g += jast_lapl_jast_inv(e)
enddo
T += det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp) * g
! 2 (grad D).(Grad J)/J
g = 0.d0
do e = 1, elec_alpha_num
g += det_alpha_grad_lapl_SVD_unique(1,e,l) * jast_grad_jast_inv_x(e) + &
det_alpha_grad_lapl_SVD_unique(2,e,l) * jast_grad_jast_inv_y(e) + &
det_alpha_grad_lapl_SVD_unique(3,e,l) * jast_grad_jast_inv_z(e)
enddo
h = 0.d0
do e = elec_alpha_num+1, elec_num
h += det_beta_grad_lapl_SVD_unique(1,e,lp) * jast_grad_jast_inv_x(e) + &
det_beta_grad_lapl_SVD_unique(2,e,lp) * jast_grad_jast_inv_y(e) + &
det_beta_grad_lapl_SVD_unique(3,e,lp) * jast_grad_jast_inv_z(e)
enddo
T += 2.d0 * ( g * det_beta_value_SVD_unique(lp) + h * det_alpha_value_SVD_unique(l) )
g = det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp)
V = E_pot * g
! TODO
!do e = 1, elec_alpha_num
! V -= pseudo_non_local_SVD(e) * g
! V += det_alpha_pseudo_SVD_unique(e,l) * det_beta_value_SVD_unique(lp)
!enddo
!do e = elec_alpha_num+1, elec_num
! V -= pseudo_non_local_SVD(e) * g
! V += det_alpha_value_SVD_unique(l) * det_beta_pseudo_SVD_unique(e,lp)
!enddo
f = -0.5d0*T + V
f *= psidet_inv_SVD
hij_fm(i) = f
enddo
hij_fm_min = min( hij_fm_min, minval(hij_fm) )
hij_fm_max = max( hij_fm_max, maxval(hij_fm) )
SOFT_TOUCH hij_fm_min hij_fm_max
END_PROVIDER
BEGIN_PROVIDER [ double precision, hij_sm, (size_hij_sm) ]
implicit none
BEGIN_DOC
! !!!
! hij = < psi_svd J | H | J l l' > / < psi_svd J | psi_svd J >
! = < H (J l l')/(psi_svd J) > ( first method: fm)
! = < E_loc (l l') / psi_svd > ( secnd method: sm)
! Dimensions : n_svd_toselect
END_DOC
integer :: i, l, lp
do i = 1, n_svd_toselect
l = psi_svd_alpha_numtoselect(i,1)
lp = psi_svd_beta_numtoselect (i,1)
hij_sm(i) = E_loc * det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp) * psidet_inv_SVD
enddo
hij_sm_min = min( hij_sm_min, minval(hij_sm) )
hij_sm_max = max( hij_sm_max, maxval(hij_sm) )
SOFT_TOUCH hij_sm_min hij_sm_max
END_PROVIDER
BEGIN_PROVIDER [ double precision, xij_diag, (size_xij_diag) ]
implicit none
BEGIN_DOC
! !!!
! < l l' | H | l l' >
! Dimensions : n_svd_toselect
END_DOC
integer :: i, l, lp, e
double precision :: f, g, h, T, V
do i = 1, n_svd_toselect
l = psi_svd_alpha_numtoselect(i,1)
lp = psi_svd_beta_numtoselect (i,1)
! Lapl D
g = 0.d0
do e = 1, elec_alpha_num
g += det_alpha_grad_lapl_SVD_unique(4,e,l) * det_beta_value_SVD_unique(lp)
enddo
do e = elec_alpha_num+1, elec_num
g += det_alpha_value_SVD_unique(l) * det_beta_grad_lapl_SVD_unique(4,e,lp)
enddo
T = g
! D (Lapl J)/J
g = 0.d0
do e = 1, elec_num
g += jast_lapl_jast_inv(e)
enddo
T += det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp) * g
! 2 (grad D).(Grad J)/J
g = 0.d0
do e = 1, elec_alpha_num
g += det_alpha_grad_lapl_SVD_unique(1,e,l) * jast_grad_jast_inv_x(e) + &
det_alpha_grad_lapl_SVD_unique(2,e,l) * jast_grad_jast_inv_y(e) + &
det_alpha_grad_lapl_SVD_unique(3,e,l) * jast_grad_jast_inv_z(e)
enddo
h = 0.d0
do e = elec_alpha_num+1, elec_num
h += det_beta_grad_lapl_SVD_unique(1,e,lp) * jast_grad_jast_inv_x(e) + &
det_beta_grad_lapl_SVD_unique(2,e,lp) * jast_grad_jast_inv_y(e) + &
det_beta_grad_lapl_SVD_unique(3,e,lp) * jast_grad_jast_inv_z(e)
enddo
T += 2.d0 * ( g * det_beta_value_SVD_unique(lp) + h * det_alpha_value_SVD_unique(l) )
g = det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp)
V = E_pot * g
! TODO
!do e = 1, elec_alpha_num
! V -= pseudo_non_local_SVD(e) * g
! V += det_alpha_pseudo_SVD_unique(e,l) * det_beta_value_SVD_unique(lp)
!enddo
!do e = elec_alpha_num+1, elec_num
! V -= pseudo_non_local_SVD(e) * g
! V += det_alpha_value_SVD_unique(l) * det_beta_pseudo_SVD_unique(e,lp)
!enddo
f = -0.5d0*T + V
f *= psidet_inv_SVD * psidet_inv_SVD
xij_diag(i) = f * det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp)
enddo
xij_diag_min = min( xij_diag_min, minval(xij_diag) )
xij_diag_max = max( xij_diag_max, maxval(xij_diag) )
SOFT_TOUCH xij_diag_min xij_diag_max
END_PROVIDER
BEGIN_PROVIDER [ double precision, overlop_selected_matrix, (size_overlop_selected_matrix) ]
implicit none
BEGIN_DOC
! !!!
! < k_selected k'_selected | l_selected l'_selected >
! Dimensions : n_svd_selected * n_svd_selected
END_DOC
integer :: k, kp, l, lp
integer :: i, j, ii0, ii
double precision :: f
do i = 1, n_svd_selected
ii0 = (i-1)*n_svd_selected
l = psi_svd_alpha_numselected(i,1)
lp = psi_svd_beta_numselected (i,1)
f = det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp) * psidet_inv_SVD * psidet_inv_SVD
do j = 1, n_svd_selected
ii = ii0 + j
k = psi_svd_alpha_numselected(j,1)
kp = psi_svd_beta_numselected (j,1)
overlop_selected_matrix(ii) = det_alpha_value_SVD_unique(k) * det_beta_value_SVD_unique(kp) * f
enddo
enddo
overlop_selected_matrix_min = min(overlop_selected_matrix_min,minval(overlop_selected_matrix))
overlop_selected_matrix_max = max(overlop_selected_matrix_max,maxval(overlop_selected_matrix))
SOFT_TOUCH overlop_selected_matrix_min overlop_selected_matrix_max
END_PROVIDER
BEGIN_PROVIDER [ double precision, h_selected_matrix, (size_h_selected_matrix) ]
implicit none
BEGIN_DOC
! !!!
! < k_selected k'_selected | H | l_selected l'_selected >
! Dimensions : n_svd_selected * n_svd_selected
END_DOC
integer :: k, kp, l, lp
integer :: i, j, ii0, ii
integer :: e
double precision :: f, g, h, T, V
do i = 1, n_svd_selected
ii0 = (i-1)*n_svd_selected
l = psi_svd_alpha_numselected(i,1)
lp = psi_svd_beta_numselected (i,1)
! Lapl D
g = 0.d0
do e = 1, elec_alpha_num
g += det_alpha_grad_lapl_SVD_unique(4,e,l) * det_beta_value_SVD_unique(lp)
enddo
do e = elec_alpha_num+1, elec_num
g += det_alpha_value_SVD_unique(l) * det_beta_grad_lapl_SVD_unique(4,e,lp)
enddo
T = g
! D (Lapl J)/J
g = 0.d0
do e = 1, elec_num
g += jast_lapl_jast_inv(e)
enddo
T += det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp) * g
! 2 (grad D).(Grad J)/J
g = 0.d0
do e = 1, elec_alpha_num
g += det_alpha_grad_lapl_SVD_unique(1,e,l) * jast_grad_jast_inv_x(e) + &
det_alpha_grad_lapl_SVD_unique(2,e,l) * jast_grad_jast_inv_y(e) + &
det_alpha_grad_lapl_SVD_unique(3,e,l) * jast_grad_jast_inv_z(e)
enddo
h = 0.d0
do e = elec_alpha_num+1, elec_num
h += det_beta_grad_lapl_SVD_unique(1,e,lp) * jast_grad_jast_inv_x(e) + &
det_beta_grad_lapl_SVD_unique(2,e,lp) * jast_grad_jast_inv_y(e) + &
det_beta_grad_lapl_SVD_unique(3,e,lp) * jast_grad_jast_inv_z(e)
enddo
T += 2.d0 * ( g * det_beta_value_SVD_unique(lp) + h * det_alpha_value_SVD_unique(l) )
g = det_alpha_value_SVD_unique(l) * det_beta_value_SVD_unique(lp)
V = E_pot * g
! TODO
! ajouter le terme pseudo
!do e = 1, elec_alpha_num
! V -= pseudo_non_local_SVD(e) * g
! V += det_alpha_pseudo_SVD_unique(e,l) * det_beta_value_SVD_unique(lp)
!enddo
!do e = elec_alpha_num+1, elec_num
! V -= pseudo_non_local_SVD(e) * g
! V += det_alpha_value_SVD_unique(l) * det_beta_pseudo_SVD_unique(e,lp)
!enddo
f = -0.5d0*T + V
f *= psidet_inv_SVD * psidet_inv_SVD
do j = 1, n_svd_selected
ii = ii0 + j
k = psi_svd_alpha_numselected(j,1)
kp = psi_svd_beta_numselected (j,1)
h_selected_matrix(ii) = f * det_alpha_value_SVD_unique(k) * det_beta_value_SVD_unique(kp)
enddo
enddo
h_selected_matrix_min = min(h_selected_matrix_min,minval(h_selected_matrix))
h_selected_matrix_max = max(h_selected_matrix_max,maxval(h_selected_matrix))
SOFT_TOUCH h_selected_matrix_min h_selected_matrix_max
END_PROVIDER

8
src/PROPERTIES/properties_energy.irp.f
View File

@ -252,12 +252,10 @@ BEGIN_PROVIDER [ double precision, E_loc ]
enddo
! Avoid divergence of E_loc and population explosion
if (do_pseudo) then
if (do_pseudo .and. (qmc_method == t_DMC) ) then
double precision :: delta_e
! delta_e = E_loc-E_ref
! E_loc = E_ref + erf(delta_e*time_step_sq)/time_step_sq
E_loc = max(2.d0*E_ref, E_loc)
! continue
delta_e = E_loc-E_ref
E_loc = E_ref + delta_e * dexp(-dabs(delta_e)*time_step_sq)
endif
E_loc_min = min(E_loc,E_loc_min)
E_loc_max = max(E_loc,E_loc_max)

121
src/det.irp.f
View File

@ -323,7 +323,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
double precision :: zj, zj1, zj2, zj3
!DIR$ NOPREFETCH
!DIR$ SIMD NOVECREMAINDER
!OMP$ SIMD NOVECREMAINDER
do i=1,$n
u(i) = m(i) - S(i,l)
enddo
@ -331,7 +331,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj = 0.d0
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD REDUCTION(+:zj) NOVECREMAINDER
!OMP$ SIMD REDUCTION(+:zj) NOVECREMAINDER
do i=1,$n-1,4
zj = zj + S_inv(i,l)*u(i) + S_inv(i+1,l)*u(i+1) &
+ S_inv(i+2,l)*u(i+2) + S_inv(i+3,l)*u(i+3)
@ -353,7 +353,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj3 = 0.d0
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD REDUCTION(+:zj,zj1,zj2,zj3) NOVECREMAINDER
!OMP$ SIMD REDUCTION(+:zj,zj1,zj2,zj3) NOVECREMAINDER
do i=1,$n
zj = zj + S_inv(i,j )*u(i)
zj1 = zj1 + S_inv(i,j+1)*u(i)
@ -367,7 +367,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
enddo
!DIR$ NOPREFETCH
!DIR$ SIMD FIRSTPRIVATE(d_inv) NOVECREMAINDER
!OMP$ SIMD FIRSTPRIVATE(d_inv) NOVECREMAINDER
do i=1,$n
w(i) = S_inv(i,l)*d_inv
S(i,l) = m(i)
@ -380,7 +380,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj3 = z(i+3)
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD FIRSTPRIVATE(lambda,zj,zj1,zj2,zj3) NOVECREMAINDER
!OMP$ SIMD FIRSTPRIVATE(lambda,zj,zj1,zj2,zj3) NOVECREMAINDER
do j=1,$n
S_inv(j,i ) = S_inv(j,i )*lambda - w(j)*zj
S_inv(j,i+1) = S_inv(j,i+1)*lambda - w(j)*zj1
@ -459,7 +459,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj = 0.d0
!DIR$ NOPREFETCH
!DIR$ SIMD REDUCTION(+:zj)
!OMP$ SIMD REDUCTION(+:zj)
do i=1,$n-1,4
zj = zj + S_inv(i,l)*u(i) + S_inv(i+1,l)*u(i+1) &
+ S_inv(i+2,l)*u(i+2) + S_inv(i+3,l)*u(i+3)
@ -482,7 +482,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj3 = 0.d0
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD REDUCTION(+:zj,zj1,zj2,zj3) NOVECREMAINDER
!OMP$ SIMD REDUCTION(+:zj,zj1,zj2,zj3) NOVECREMAINDER
do i=1,$n-1
zj = zj + S_inv(i,j )*u(i)
zj1 = zj1 + S_inv(i,j+1)*u(i)
@ -498,14 +498,14 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj = 0.d0
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD REDUCTION(+:zj) NOVECREMAINDER
!OMP$ SIMD REDUCTION(+:zj) NOVECREMAINDER
do i=1,$n-1
zj = zj + S_inv(i,$n)*u(i)
enddo
z($n) = zj + S_inv($n,$n)*u($n)
!DIR$ NOPREFETCH
!DIR$ SIMD FIRSTPRIVATE(d_inv) NOVECREMAINDER
!OMP$ SIMD FIRSTPRIVATE(d_inv) NOVECREMAINDER
do i=1,$n
w(i) = S_inv(i,l)*d_inv
S(i,l) = m(i)
@ -518,7 +518,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj3 = z(i+3)
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD FIRSTPRIVATE(lambda,zj,zj1,zj2,zj3) NOVECREMAINDER
!OMP$ SIMD FIRSTPRIVATE(lambda,zj,zj1,zj2,zj3) NOVECREMAINDER
do j=1,$n-1
S_inv(j,i ) = S_inv(j,i )*lambda - w(j)*zj
S_inv(j,i+1) = S_inv(j,i+1)*lambda - w(j)*zj1
@ -534,7 +534,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj = z($n)
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD FIRSTPRIVATE(lambda,zj) NOVECREMAINDER
!OMP$ SIMD FIRSTPRIVATE(lambda,zj) NOVECREMAINDER
do i=1,$n
S_inv(i,$n) = S_inv(i,$n)*lambda -w(i)*zj
enddo
@ -607,7 +607,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
double precision :: zj, zj1, zj2, zj3
!DIR$ NOPREFETCH
!DIR$ SIMD NOVECREMAINDER
!OMP$ SIMD NOVECREMAINDER
do i=1,$n
u(i) = m(i) - S(i,l)
enddo
@ -615,7 +615,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj = 0.d0
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD REDUCTION(+:zj) NOVECREMAINDER
!OMP$ SIMD REDUCTION(+:zj) NOVECREMAINDER
do i=1,$n-2,4
zj = zj + S_inv(i,l)*u(i) + S_inv(i+1,l)*u(i+1) &
+ S_inv(i+2,l)*u(i+2) + S_inv(i+3,l)*u(i+3)
@ -638,7 +638,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj2 = 0.d0
zj3 = 0.d0
!DIR$ VECTOR ALIGNED
!DIR$ SIMD REDUCTION(+:zj,zj1,zj2,zj3) NOVECREMAINDER
!OMP$ SIMD REDUCTION(+:zj,zj1,zj2,zj3) NOVECREMAINDER
do i=1,$n-2
zj = zj + S_inv(i,j )*u(i)
zj1 = zj1 + S_inv(i,j+1)*u(i)
@ -660,7 +660,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj1 = 0.d0
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD REDUCTION(+:zj,zj1) NOVECREMAINDER
!OMP$ SIMD REDUCTION(+:zj,zj1) NOVECREMAINDER
do i=1,$n-2
zj = zj + S_inv(i,j )*u(i)
zj1 = zj1 + S_inv(i,j+1)*u(i)
@ -671,7 +671,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
z(j+1) = z(j+1) + S_inv($n,j+1)*u($n)
!DIR$ NOPREFETCH
!DIR$ SIMD FIRSTPRIVATE(d_inv) NOVECREMAINDER
!OMP$ SIMD FIRSTPRIVATE(d_inv) NOVECREMAINDER
do i=1,$n
w(i) = S_inv(i,l)*d_inv
S(i,l) = m(i)
@ -683,7 +683,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj2 = z(i+2)
zj3 = z(i+3)
!DIR$ VECTOR ALIGNED
!DIR$ SIMD FIRSTPRIVATE(lambda,zj,zj1,zj2,zj3) NOVECREMAINDER
!OMP$ SIMD FIRSTPRIVATE(lambda,zj,zj1,zj2,zj3) NOVECREMAINDER
do j=1,$n-2
S_inv(j,i ) = S_inv(j,i )*lambda -zj *w(j)
S_inv(j,i+1) = S_inv(j,i+1)*lambda -zj1*w(j)
@ -704,7 +704,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj = z(i)
zj1= z(i+1)
!DIR$ VECTOR ALIGNED
!DIR$ SIMD FIRSTPRIVATE(lambda,zj,zj1)
!OMP$ SIMD FIRSTPRIVATE(lambda,zj,zj1)
do j=1,$n-2
S_inv(j,i ) = S_inv(j,i )*lambda -zj*w(j)
S_inv(j,i+1) = S_inv(j,i+1)*lambda -zj1*w(j)
@ -780,7 +780,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
double precision :: zj, zj1, zj2, zj3
!DIR$ SIMD
!OMP$ SIMD
do i=1,$n
u(i) = m(i) - S(i,l)
enddo
@ -788,7 +788,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj = 0.d0
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD REDUCTION(+:zj) NOVECREMAINDER
!OMP$ SIMD REDUCTION(+:zj) NOVECREMAINDER
do i=1,$n-3,4
zj = zj + S_inv(i,l)*u(i) + S_inv(i+1,l)*u(i+1) &
+ S_inv(i+2,l)*u(i+2) + S_inv(i+3,l)*u(i+3)
@ -812,7 +812,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj2 = 0.d0
zj3 = 0.d0
!DIR$ VECTOR ALIGNED
!DIR$ SIMD REDUCTION(+:zj,zj1,zj2,zj3)
!OMP$ SIMD REDUCTION(+:zj,zj1,zj2,zj3)
do i=1,$n-3
zj = zj + S_inv(i,j )*u(i)
zj1 = zj1 + S_inv(i,j+1)*u(i)
@ -839,7 +839,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj2 = 0.d0
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD REDUCTION(+:zj,zj1,zj2)
!OMP$ SIMD REDUCTION(+:zj,zj1,zj2)
do i=1,$n-3
zj = zj + S_inv(i,j )*u(i)
zj1 = zj1 + S_inv(i,j+1)*u(i)
@ -856,7 +856,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
z(j+2) = z(j+2) + S_inv($n,j+2)*u($n)
!DIR$ NOPREFETCH
!DIR$ SIMD FIRSTPRIVATE(d_inv)
!OMP$ SIMD FIRSTPRIVATE(d_inv)
do i=1,$n
w(i) = S_inv(i,l)*d_inv
S(i,l) = m(i)
@ -869,7 +869,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj3 = z(i+3)
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD FIRSTPRIVATE(lambda,zj,zj1,zj2,zj3)
!OMP$ SIMD FIRSTPRIVATE(lambda,zj,zj1,zj2,zj3)
do j=1,$n-3
S_inv(j,i ) = S_inv(j,i )*lambda - w(j)*zj
S_inv(j,i+1) = S_inv(j,i+1)*lambda - w(j)*zj1
@ -896,7 +896,7 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
zj2 = z(i+2)
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD FIRSTPRIVATE(lambda,zj,zj1,zj2)
!OMP$ SIMD FIRSTPRIVATE(lambda,zj,zj1,zj2)
do j=1,$n
S_inv(j,i ) = S_inv(j,i )*lambda - w(j)*zj
S_inv(j,i+1) = S_inv(j,i+1)*lambda - w(j)*zj1
@ -980,7 +980,7 @@ subroutine det_update_general(n,LDS,m,l,S,S_inv,d)
zl = 0.d0
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD REDUCTION(+:zl)
!OMP$ SIMD REDUCTION(+:zl)
do i=1,n
zl = zl + S_inv(i,l)*u(i)
enddo
@ -1006,7 +1006,7 @@ subroutine det_update_general(n,LDS,m,l,S,S_inv,d)
zj3 = 0.d0
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD REDUCTION(+:zj,zj1,zj2,zj3)
!OMP$ SIMD REDUCTION(+:zj,zj1,zj2,zj3)
do i=1,n
zj = zj + S_inv(i,j )*u(i)
zj1 = zj1 + S_inv(i,j+1)*u(i)
@ -1023,7 +1023,7 @@ subroutine det_update_general(n,LDS,m,l,S,S_inv,d)
zj = 0.d0
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD REDUCTION(+:zj)
!OMP$ SIMD REDUCTION(+:zj)
do i=1,n
zj = zj + S_inv(i,j)*u(i)
enddo
@ -1031,14 +1031,14 @@ subroutine det_update_general(n,LDS,m,l,S,S_inv,d)
enddo
!DIR$ NOPREFETCH
!DIR$ SIMD FIRSTPRIVATE(d_inv)
!OMP$ SIMD FIRSTPRIVATE(d_inv)
do i=1,n
w(i) = S_inv(i,l)*d_inv
S(i,l) = m(i)
enddo
!DIR$ NOPREFETCH
!DIR$ SIMD FIRSTPRIVATE(d_inv)
!OMP$ SIMD FIRSTPRIVATE(d_inv)
do i=1,n
w(i) = S_inv(i,l)*d_inv
S(i,l) = m(i)
@ -1051,7 +1051,7 @@ subroutine det_update_general(n,LDS,m,l,S,S_inv,d)
zj3 = z(i+3)
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD FIRSTPRIVATE(lambda,zj,zj1,zj2,zj3)
!OMP$ SIMD FIRSTPRIVATE(lambda,zj,zj1,zj2,zj3)
do j=1,n
S_inv(j,i ) = S_inv(j,i )*lambda -zj *w(j)
S_inv(j,i+1) = S_inv(j,i+1)*lambda -zj1*w(j)
@ -1064,7 +1064,7 @@ subroutine det_update_general(n,LDS,m,l,S,S_inv,d)
zj = z(i)
!DIR$ VECTOR ALIGNED
!DIR$ NOPREFETCH
!DIR$ SIMD FIRSTPRIVATE(lambda,zj)
!OMP$ SIMD FIRSTPRIVATE(lambda,zj)
do j=1,n
S_inv(j,i) = S_inv(j,i)*lambda -zj*w(j)
enddo
@ -1703,30 +1703,20 @@ END_PROVIDER
, 1.d0, psi_svd_beta_unique(:,:,1), size(psi_svd_beta_unique,1), det_beta_value, 1 &
, 0.d0, det_beta_value_SVD_unique, 1)
do mm = 1, 4
call dgemm('N', 'N', elec_alpha_num, n_svd_coefs_unique, det_alpha_num, 1.d0 &
, det_alpha_grad_lapl(mm,:,:), size(det_alpha_grad_lapl,2) &
, psi_svd_alpha_unique(:,:,1), size(psi_svd_alpha_unique,1) &
, 0.d0, det_alpha_grad_lapl_SVD_unique(mm,:,:), size(det_alpha_grad_lapl_SVD_unique,2) )
call dgemm('N', 'N', 4*elec_alpha_num, n_svd_coefs_unique, det_alpha_num, 1.d0 &
, det_alpha_grad_lapl, 4*size(det_alpha_grad_lapl,2) &
, psi_svd_alpha_unique, size(psi_svd_alpha_unique,1) &
, 0.d0, det_alpha_grad_lapl_SVD_unique, 4*size(det_alpha_grad_lapl_SVD_unique,2) )
if (elec_beta_num /= 0) then
call dgemm('N', 'N', elec_beta_num, n_svd_coefs_unique, det_beta_num, 1.d0 &
, det_beta_grad_lapl(mm,:,:), size(det_beta_grad_lapl,2) &
, psi_svd_beta_unique(:,:,1), size(psi_svd_beta_unique,1) &
, 0.d0, det_beta_grad_lapl_SVD_unique(mm,:,:), size(det_beta_grad_lapl_SVD_unique,2) )
call dgemm('N', 'N', 4*elec_beta_num, n_svd_coefs_unique, det_beta_num, 1.d0 &
, det_beta_grad_lapl, 4*size(det_beta_grad_lapl,2) &
, psi_svd_beta_unique, size(psi_svd_beta_unique,1) &
, 0.d0, det_beta_grad_lapl_SVD_unique, 4*size(det_beta_grad_lapl_SVD_unique,2) )
endif
enddo
END_PROVIDER
BEGIN_PROVIDER [ logical, utilise_SVD ]
&BEGIN_PROVIDER [ integer, n_svd_coefs ]
implicit none
@ -1853,14 +1843,15 @@ END_PROVIDER
! !!!
if (do_pseudo) then
! det_alpha_pseudo_SVD = det_alpha_pseudo @ psi_svd_alpha * psidet_inv_SVD
call dgemm('N', 'N', elec_alpha_num, n_svd_coefs , det_alpha_num, psidet_inv_SVD &
, det_alpha_pseudo, size(det_alpha_pseudo,1), psi_svd_alpha(:,:,1), size(psi_svd_alpha,1) &
, 0.d0, det_alpha_pseudo_SVD, size(det_alpha_pseudo_SVD,1) )
call dgemm('N', 'N', 4*elec_alpha_num, n_svd_coefs , det_alpha_num, psidet_inv_SVD &
, det_alpha_pseudo, size(det_alpha_pseudo,1), psi_svd_alpha(1,1,1) &
, size(psi_svd_alpha,1), 0.d0, det_alpha_pseudo_SVD, size(det_alpha_pseudo_SVD,1) )
! !!!
if (elec_beta_num /= 0) then
! det_beta_pseudo_SVD = det_beta_pseudo @ psi_svd_beta * psidet_inv_SVD
call dgemm('N', 'N', elec_beta_num, n_svd_coefs , det_beta_num, psidet_inv_SVD &
, det_beta_pseudo(elec_alpha_num+1,1), size(det_beta_pseudo,1), psi_svd_beta(:,:,1), size(psi_svd_beta,1) &
call dgemm('N', 'N', 4*elec_beta_num, n_svd_coefs , det_beta_num, psidet_inv_SVD &
, det_beta_pseudo(elec_alpha_num+1,1), size(det_beta_pseudo,1) &
, psi_svd_beta(1,1,1), size(psi_svd_beta,1) &
, 0.d0, det_beta_pseudo_SVD(elec_alpha_num+1,1), size(det_beta_pseudo_SVD,1) )
endif
endif
@ -1909,22 +1900,18 @@ END_PROVIDER
! -~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~
! !!!
do mm = 1, 4
! !!!
call dgemm('N', 'N', elec_alpha_num, n_svd_coefs, det_alpha_num, 1.d0 &
, det_alpha_grad_lapl(mm,:,:), size(det_alpha_grad_lapl,2) &
, psi_svd_alpha(:,:,1), size(psi_svd_alpha,1) &
, 0.d0, det_alpha_grad_lapl_SVD(mm,:,:), size(det_alpha_grad_lapl_SVD,2) )
call dgemm('N', 'N', 4*elec_alpha_num, n_svd_coefs, det_alpha_num, 1.d0 &
, det_alpha_grad_lapl, 4*size(det_alpha_grad_lapl,2) &
, psi_svd_alpha, size(psi_svd_alpha,1) &
, 0.d0, det_alpha_grad_lapl_SVD, 4*size(det_alpha_grad_lapl_SVD,2) )
! !!!
if (elec_beta_num /= 0) then
call dgemm('N', 'N', elec_beta_num, n_svd_coefs, det_beta_num, 1.d0 &
, det_beta_grad_lapl(mm,:,:), size(det_beta_grad_lapl,2) &
, psi_svd_beta(:,:,1), size(psi_svd_beta,1) &
, 0.d0, det_beta_grad_lapl_SVD(mm,:,:), size(det_beta_grad_lapl_SVD,2) )
call dgemm('N', 'N', 4*elec_beta_num, n_svd_coefs, det_beta_num, 1.d0 &
, det_beta_grad_lapl, 4*size(det_beta_grad_lapl,2) &
, psi_svd_beta, size(psi_svd_beta,1) &
, 0.d0, det_beta_grad_lapl_SVD, 4*size(det_beta_grad_lapl_SVD,2) )
endif
! !!!
enddo
! !!!
! -~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~
!do l = 1, n_svd_coefs

10
src/mo.irp.f
View File

@ -709,7 +709,7 @@ subroutine sparse_full_mv(A,LDA, &
! call MM_PREFETCH (A(1,indices(4)),3)
! IRP_ENDIF
!DIR$ SIMD
!OMP$ SIMD
do j=1,LDC
C1(j) = 0.
C2(j) = 0.
@ -755,7 +755,7 @@ subroutine sparse_full_mv(A,LDA, &
do k=0,LDA-1,$IRP_ALIGN/4
!DIR$ VECTOR ALIGNED
!DIR$ SIMD FIRSTPRIVATE(d11,d21,d31,d41)
!OMP$ SIMD FIRSTPRIVATE(d11,d21,d31,d41)
do j=1,$IRP_ALIGN/4
! IRP_IF NO_PREFETCH
! IRP_ELSE
@ -769,7 +769,7 @@ subroutine sparse_full_mv(A,LDA, &
enddo
!DIR$ VECTOR ALIGNED
!DIR$ SIMD FIRSTPRIVATE(d12,d22,d32,d42,d13,d23,d33,d43)
!OMP$ SIMD FIRSTPRIVATE(d12,d22,d32,d42,d13,d23,d33,d43)
do j=1,$IRP_ALIGN/4
C2(j+k) = C2(j+k) + A(j+k,k_vec(1))*d12 + A(j+k,k_vec(2))*d22&
+ A(j+k,k_vec(3))*d32 + A(j+k,k_vec(4))*d42
@ -778,7 +778,7 @@ subroutine sparse_full_mv(A,LDA, &
enddo
!DIR$ VECTOR ALIGNED
!DIR$ SIMD FIRSTPRIVATE(d14,d24,d34,d44,d15,d25,d35,d45)
!OMP$ SIMD FIRSTPRIVATE(d14,d24,d34,d44,d15,d25,d35,d45)
do j=1,$IRP_ALIGN/4
C4(j+k) = C4(j+k) + A(j+k,k_vec(1))*d14 + A(j+k,k_vec(2))*d24&
+ A(j+k,k_vec(3))*d34 + A(j+k,k_vec(4))*d44
@ -799,7 +799,7 @@ subroutine sparse_full_mv(A,LDA, &
!DIR$ VECTOR ALIGNED
do k=0,LDA-1,$IRP_ALIGN/4
!DIR$ VECTOR ALIGNED
!DIR$ SIMD FIRSTPRIVATE(d11,d12,d13,d14,d15)
!OMP$ SIMD FIRSTPRIVATE(d11,d12,d13,d14,d15)
do j=1,$IRP_ALIGN/4
C1(j+k) = C1(j+k) + A(j+k,k_vec(1))*d11
C2(j+k) = C2(j+k) + A(j+k,k_vec(1))*d12