1
0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2025-04-30 04:15:00 +02:00

Optimized delta_p

This commit is contained in:
Anthony Scemama 2024-12-10 19:50:47 +01:00
parent ebbc31eafa
commit 1867c186ce

View File

@ -1771,11 +1771,10 @@ integer function qmckl_compute_jastrow_champ_delta_p_doc_f( &
double precision , intent(in) :: een_rescaled_single_e(elec_num, 0:cord_num, walk_num)
double precision , intent(out) :: delta_p(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
double precision :: een_rescaled_delta_n(nucl_num, 0:cord_num, walk_num)
double precision :: een_rescaled_delta_e(elec_num, 0:cord_num, walk_num)
integer*8 :: i, a, j, l, k, p, m, n, nw, num
double precision :: accu, accu2, cn
integer*8 :: i, a, c, j, l, k, p, m, n, nw, num
double precision :: dn, dn2
integer*8 :: LDA, LDB, LDC
num = num_in + 1
@ -1791,19 +1790,21 @@ integer function qmckl_compute_jastrow_champ_delta_p_doc_f( &
if (cord_num == 0) return
! First calculate delta p
do nw=1, walk_num
een_rescaled_delta_n(:,:,nw) = een_rescaled_single_n(:,:,nw) - een_rescaled_n(num,:,:,nw)
een_rescaled_delta_e(:,:,nw) = een_rescaled_single_e(:,:,nw) - een_rescaled_e(:,num,:,nw)
do i=0, cord_num-1
info = qmckl_dgemm(context, 'N', 'N', elec_num, nucl_num * (cord_num+1), 1_8, 1.0d0, &
een_rescaled_delta_e(1,i,nw),elec_num, &
een_rescaled_n(num,1,0,nw),elec_num, &
0.0d0, &
delta_p(1,1,0,i,nw),elec_num)
een_rescaled_delta_e(:,i,nw) = een_rescaled_single_e(:,i,nw) - een_rescaled_e(:,num,i,nw)
do c=0,cord_num
do a=1,nucl_num
dn = een_rescaled_single_n(a,c,nw) - een_rescaled_n(num,a,c,nw)
dn2 = dn + een_rescaled_n(num,a,c,nw)
do j=1,elec_num
delta_p(j,a,c,i,nw) = een_rescaled_e(j,num,i,nw)*dn + een_rescaled_delta_e(j,i,nw) * dn2
end do
end do
end do
info = qmckl_dgemm(context, 'T', 'N', 1_8, nucl_num * (cord_num+1_8), elec_num, 1.0d0, &
een_rescaled_delta_e(1,i,nw),elec_num, &
@ -1811,22 +1812,10 @@ integer function qmckl_compute_jastrow_champ_delta_p_doc_f( &
1.0d0, &
delta_p(num,1,0,i,nw),elec_num)
info = qmckl_dgemm(context, 'N', 'T', elec_num, nucl_num * (cord_num+1), 1_8, 1.0d0, &
een_rescaled_e(1,num,i,nw),elec_num, &
een_rescaled_delta_n(1,1,nw),nucl_num* (cord_num+1), &
1.0d0, &
delta_p(1,1,0,i,nw),elec_num)
enddo
info = qmckl_dgemm(context, 'N', 'T', elec_num, nucl_num * (cord_num+1), 1_8, 1.0d0, &
een_rescaled_delta_e(1,i,nw),elec_num, &
een_rescaled_delta_n(1,1,nw),nucl_num* (cord_num+1), &
1.0d0, &
delta_p(1,1,0,i,nw),elec_num)
end do
end do
end function qmckl_compute_jastrow_champ_delta_p_doc_f
#+end_src