LCPQ/qmcchem
10
1
Fork 1
mirror of https://gitlab.com/scemama/qmcchem.git synced 2024-12-21 20:03:31 +01:00
Code Releases Activity

Split mo_grad_lapl in alpha/beta

Browse Source
This commit is contained in:
Anthony Scemama 2016-06-03 14:19:35 +02:00
parent 052b2db389
commit 6208018b4a
2 changed files with 39 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

102
src/det.irp.f
View File

@ -221,11 +221,9 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
!DIR$ ASSUME (LDS >= $n)
integer :: i,j
!$OMP SIMD
do i=1,$n
u(i) = m(i) - S(i,l)
enddo
!$OMP END SIMD
z(l) = S_inv($n,l)*u($n)
!DIR$ VECTOR ALIGNED
@ -255,23 +253,19 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
enddo
enddo
!$OMP SIMD
do i=1,$n
w(i) = S_inv(i,l)*d_inv
S(i,l) = m(i)
enddo
!$OMP END SIMD
do i=1,$n,4
!DIR$ VECTOR ALIGNED
!$OMP SIMD
do j=1,$n
S_inv(j,i ) = S_inv(j,i )*lambda -z(i )*w(j)
S_inv(j,i+1) = S_inv(j,i+1)*lambda -z(i+1)*w(j)
S_inv(j,i+2) = S_inv(j,i+2)*lambda -z(i+2)*w(j)
S_inv(j,i+3) = S_inv(j,i+3)*lambda -z(i+3)*w(j)
enddo
!$OMP END SIMD
enddo
end
@ -354,14 +348,12 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
enddo
do i=1,$n-1,4
!$OMP SIMD
do j=1,$n-1
S_inv(j,i ) = S_inv(j,i )*lambda - w(j)*z(i )
S_inv(j,i+1) = S_inv(j,i+1)*lambda - w(j)*z(i+1)
S_inv(j,i+2) = S_inv(j,i+2)*lambda - w(j)*z(i+2)
S_inv(j,i+3) = S_inv(j,i+3)*lambda - w(j)*z(i+3)
enddo
!$OMP END SIMD
enddo
do i=1,$n-1,4
@ -416,11 +408,9 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
!DIR$ ASSUME (LDS >= $n)
integer :: i,j
!$OMP SIMD
do i=1,$n
u(i) = m(i) - S(i,l)
enddo
!$OMP END SIMD
z(l) = S_inv($n,l)*u($n)
!DIR$ VECTOR ALIGNED
@ -459,33 +449,27 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
z(j+1) = z(j+1) + S_inv(i,j+1)*u(i)
enddo
!$OMP SIMD
do i=1,$n
w(i) = S_inv(i,l)*d_inv
S(i,l) = m(i)
enddo
!$OMP END SIMD
do i=1,$n-2,4
!DIR$ VECTOR ALIGNED
!$OMP SIMD
do j=1,$n
S_inv(j,i ) = S_inv(j,i )*lambda -z(i )*w(j)
S_inv(j,i+1) = S_inv(j,i+1)*lambda -z(i+1)*w(j)
S_inv(j,i+2) = S_inv(j,i+2)*lambda -z(i+2)*w(j)
S_inv(j,i+3) = S_inv(j,i+3)*lambda -z(i+3)*w(j)
enddo
!$OMP END SIMD
enddo
i=$n-1
!DIR$ VECTOR ALIGNED
!$OMP SIMD
do j=1,$n
S_inv(j,i ) = S_inv(j,i )*lambda -z(i )*w(j)
S_inv(j,i+1) = S_inv(j,i+1)*lambda -z(i+1)*w(j)
enddo
!$OMP END SIMD
end
@ -575,24 +559,20 @@ subroutine det_update$n(n,LDS,m,l,S,S_inv,d)
enddo
do i=1,$n-3,4
!$OMP SIMD
do j=1,$n
S_inv(j,i ) = S_inv(j,i )*lambda - w(j)*z(i )
S_inv(j,i+1) = S_inv(j,i+1)*lambda - w(j)*z(i+1)
S_inv(j,i+2) = S_inv(j,i+2)*lambda - w(j)*z(i+2)
S_inv(j,i+3) = S_inv(j,i+3)*lambda - w(j)*z(i+3)
enddo
!$OMP END SIMD
enddo
i=$n-2
!$OMP SIMD
do j=1,$n
S_inv(j,i ) = S_inv(j,i )*lambda - w(j)*z(i )
S_inv(j,i+1) = S_inv(j,i+1)*lambda - w(j)*z(i+1)
S_inv(j,i+2) = S_inv(j,i+2)*lambda - w(j)*z(i+2)
enddo
!$OMP END SIMD
end
@ -634,11 +614,9 @@ subroutine det_update_general(n,LDS,m,l,S,S_inv,d)
!DIR$ ASSUME (MOD(LDS,$IRP_ALIGN/8) == 0)
integer :: i,j,n4
!$OMP SIMD
do i=1,n
u(i) = m(i) - S(i,l)
enddo
!$OMP END SIMD
z(l) = 0.d0
!DIR$ VECTOR ALIGNED
@ -686,20 +664,16 @@ subroutine det_update_general(n,LDS,m,l,S,S_inv,d)
enddo
enddo
!$OMP SIMD
do i=1,n
w(i) = S_inv(i,l)*d_inv
S(i,l) = m(i)
enddo
!$OMP END SIMD
do i=1,n
!DIR$ VECTOR ALIGNED
!$OMP SIMD aligned(S_inv,z)
do j=1,n
S_inv(j,i) = S_inv(j,i)*lambda -z(i)*w(j)
enddo
!$OMP END SIMD
enddo
end
@ -1034,11 +1008,9 @@ END_PROVIDER
det_alpha_value(det_i) = det_alpha_value_curr
do i=1,elec_alpha_num
!$OMP SIMD
do k=1,4
det_alpha_grad_lapl(k,i,det_i) = det_alpha_grad_lapl_curr(k,i)
enddo
!$OMP END SIMD
if (do_pseudo) then
det_alpha_pseudo(i,det_i) = det_alpha_pseudo_curr(i)
endif
@ -1088,11 +1060,9 @@ END_PROVIDER
det_beta_value(det_j) = det_beta_value_curr
!DIR$ LOOP COUNT (200)
do i=elec_alpha_num+1,elec_num
!$OMP SIMD
do k=1,4
det_beta_grad_lapl(k,i,det_j) = det_beta_grad_lapl_curr(k,i)
enddo
!$OMP END SIMD
if (do_pseudo) then
det_beta_pseudo(i,det_j) = det_beta_pseudo_curr(i)
endif
@ -1223,11 +1193,9 @@ END_PROVIDER
! -----
psidet_value = 0.d0
!$OMP SIMD reduction(+:psidet_value)
do j=1,det_beta_num
psidet_value = psidet_value + det_beta_value(j) * DaC(j)
enddo
!$OMP END SIMD
if (psidet_value == 0.d0) then
@ -1246,22 +1214,18 @@ END_PROVIDER
do i=1,det_alpha_num
do j=1,elec_alpha_num
!$OMP SIMD
do k=1,4
psidet_grad_lapl(k,j) = psidet_grad_lapl(k,j) + det_alpha_grad_lapl(k,j,i)*CDb(i)
enddo
!$OMP END SIMD
pseudo_non_local(j) = pseudo_non_local(j) + det_alpha_pseudo(j,i)*CDb(i)
enddo
enddo
do i=1,det_beta_num
do j=elec_alpha_num+1,elec_num
!$OMP SIMD
do k=1,4
psidet_grad_lapl(k,j) = psidet_grad_lapl(k,j) + det_beta_grad_lapl(k,j,i)*DaC(i)
enddo
!$OMP END SIMD
pseudo_non_local(j) = pseudo_non_local(j) + det_beta_pseudo(j,i)*DaC(i)
enddo
enddo
@ -1278,21 +1242,17 @@ END_PROVIDER
do i=1,det_alpha_num
do j=1,elec_alpha_num
!$OMP SIMD
do k=1,4
psidet_grad_lapl(k,j) = psidet_grad_lapl(k,j) + det_alpha_grad_lapl(k,j,i)*CDb(i)
enddo
!$OMP END SIMD
enddo
enddo
do i=1,det_beta_num
do j=elec_alpha_num+1,elec_num
!$OMP SIMD
do k=1,4
psidet_grad_lapl(k,j) = psidet_grad_lapl(k,j) + det_beta_grad_lapl(k,j,i)*DaC(i)
enddo
!$OMP END SIMD
enddo
enddo
@ -1392,14 +1352,12 @@ BEGIN_PROVIDER [ double precision, det_alpha_grad_lapl_curr, (4,elec_alpha_num)
imo = mo_list_alpha_curr(j )
imo2 = mo_list_alpha_curr(j+1)
do i=1,elec_alpha_num,2
!$OMP SIMD
do k=1,4
det_alpha_grad_lapl_curr(k,i ) = det_alpha_grad_lapl_curr(k,i ) + mo_grad_lapl(k,i ,imo )*slater_matrix_alpha_inv_det(i ,j ) &
+ mo_grad_lapl(k,i ,imo2)*slater_matrix_alpha_inv_det(i ,j+1)
det_alpha_grad_lapl_curr(k,i+1) = det_alpha_grad_lapl_curr(k,i+1) + mo_grad_lapl(k,i+1,imo )*slater_matrix_alpha_inv_det(i+1,j ) &
+ mo_grad_lapl(k,i+1,imo2)*slater_matrix_alpha_inv_det(i+1,j+1)
det_alpha_grad_lapl_curr(k,i ) = det_alpha_grad_lapl_curr(k,i ) + mo_grad_lapl_alpha(k,i ,imo )*slater_matrix_alpha_inv_det(i ,j ) &
+ mo_grad_lapl_alpha(k,i ,imo2)*slater_matrix_alpha_inv_det(i ,j+1)
det_alpha_grad_lapl_curr(k,i+1) = det_alpha_grad_lapl_curr(k,i+1) + mo_grad_lapl_alpha(k,i+1,imo )*slater_matrix_alpha_inv_det(i+1,j ) &
+ mo_grad_lapl_alpha(k,i+1,imo2)*slater_matrix_alpha_inv_det(i+1,j+1)
enddo
!$OMP END SIMD
enddo
enddo
@ -1409,32 +1367,26 @@ BEGIN_PROVIDER [ double precision, det_alpha_grad_lapl_curr, (4,elec_alpha_num)
imo = mo_list_alpha_curr(j )
imo2 = mo_list_alpha_curr(j+1)
do i=1,elec_alpha_num-1,2
!$OMP SIMD
do k=1,4
det_alpha_grad_lapl_curr(k,i ) = det_alpha_grad_lapl_curr(k,i ) + mo_grad_lapl(k,i ,imo )*slater_matrix_alpha_inv_det(i ,j ) &
+ mo_grad_lapl(k,i ,imo2)*slater_matrix_alpha_inv_det(i ,j+1)
det_alpha_grad_lapl_curr(k,i+1) = det_alpha_grad_lapl_curr(k,i+1) + mo_grad_lapl(k,i+1,imo )*slater_matrix_alpha_inv_det(i+1,j ) &
+ mo_grad_lapl(k,i+1,imo2)*slater_matrix_alpha_inv_det(i+1,j+1)
det_alpha_grad_lapl_curr(k,i ) = det_alpha_grad_lapl_curr(k,i ) + mo_grad_lapl_alpha(k,i ,imo )*slater_matrix_alpha_inv_det(i ,j ) &
+ mo_grad_lapl_alpha(k,i ,imo2)*slater_matrix_alpha_inv_det(i ,j+1)
det_alpha_grad_lapl_curr(k,i+1) = det_alpha_grad_lapl_curr(k,i+1) + mo_grad_lapl_alpha(k,i+1,imo )*slater_matrix_alpha_inv_det(i+1,j ) &
+ mo_grad_lapl_alpha(k,i+1,imo2)*slater_matrix_alpha_inv_det(i+1,j+1)
enddo
!$OMP END SIMD
enddo
i=elec_alpha_num
!$OMP SIMD
do k=1,4
det_alpha_grad_lapl_curr(k,i) = det_alpha_grad_lapl_curr(k,i) + mo_grad_lapl(k,i,imo )*slater_matrix_alpha_inv_det(i,j ) &
+ mo_grad_lapl(k,i,imo2)*slater_matrix_alpha_inv_det(i,j+1)
det_alpha_grad_lapl_curr(k,i) = det_alpha_grad_lapl_curr(k,i) + mo_grad_lapl_alpha(k,i,imo )*slater_matrix_alpha_inv_det(i,j ) &
+ mo_grad_lapl_alpha(k,i,imo2)*slater_matrix_alpha_inv_det(i,j+1)
enddo
!$OMP END SIMD
enddo
j=elec_alpha_num
imo = mo_list_alpha_curr(j)
do i=1,elec_alpha_num
!$OMP SIMD
do k=1,4
det_alpha_grad_lapl_curr(k,i ) = det_alpha_grad_lapl_curr(k,i ) + mo_grad_lapl(k,i ,imo)*slater_matrix_alpha_inv_det(i ,j)
det_alpha_grad_lapl_curr(k,i ) = det_alpha_grad_lapl_curr(k,i ) + mo_grad_lapl_alpha(k,i ,imo)*slater_matrix_alpha_inv_det(i ,j)
enddo
!$OMP END SIMD
enddo
endif
@ -1469,7 +1421,7 @@ BEGIN_PROVIDER [ double precision, det_beta_grad_lapl_curr, (4,elec_alpha_num+1
! do i=elec_alpha_num+1,elec_num
! do k=1,4
! det_beta_grad_lapl_curr(k,i) = det_beta_grad_lapl_curr(k,i) +&
! mo_grad_lapl(k,i,imo)*slater_matrix_beta_inv_det(i-elec_alpha_num,j)
! mo_grad_lapl_alpha(k,i,imo)*slater_matrix_beta_inv_det(i-elec_alpha_num,j)
! enddo
! enddo
! enddo
@ -1484,16 +1436,14 @@ BEGIN_PROVIDER [ double precision, det_beta_grad_lapl_curr, (4,elec_alpha_num+1
!DIR$ LOOP COUNT (16)
do i=elec_alpha_num+1,elec_num,2
l = i-elec_alpha_num
!$OMP SIMD
do k=1,4
det_beta_grad_lapl_curr(k,i) = det_beta_grad_lapl_curr(k,i) +&
mo_grad_lapl(k,i,imo )*slater_matrix_beta_inv_det(l,j ) + &
mo_grad_lapl(k,i,imo2)*slater_matrix_beta_inv_det(l,j+1)
mo_grad_lapl_beta(k,i,imo )*slater_matrix_beta_inv_det(l,j ) + &
mo_grad_lapl_beta(k,i,imo2)*slater_matrix_beta_inv_det(l,j+1)
det_beta_grad_lapl_curr(k,i+1) = det_beta_grad_lapl_curr(k,i+1) +&
mo_grad_lapl(k,i+1,imo )*slater_matrix_beta_inv_det(l+1,j ) + &
mo_grad_lapl(k,i+1,imo2)*slater_matrix_beta_inv_det(l+1,j+1)
mo_grad_lapl_beta(k,i+1,imo )*slater_matrix_beta_inv_det(l+1,j ) + &
mo_grad_lapl_beta(k,i+1,imo2)*slater_matrix_beta_inv_det(l+1,j+1)
enddo
!$OMP END SIMD
enddo
enddo
@ -1505,26 +1455,22 @@ BEGIN_PROVIDER [ double precision, det_beta_grad_lapl_curr, (4,elec_alpha_num+1
!DIR$ LOOP COUNT (16)
do i=elec_alpha_num+1,elec_num-1,2
l = i-elec_alpha_num
!$OMP SIMD
do k=1,4
det_beta_grad_lapl_curr(k,i) = det_beta_grad_lapl_curr(k,i) +&
mo_grad_lapl(k,i,imo )*slater_matrix_beta_inv_det(l,j ) + &
mo_grad_lapl(k,i,imo2)*slater_matrix_beta_inv_det(l,j+1)
mo_grad_lapl_beta(k,i,imo )*slater_matrix_beta_inv_det(l,j ) + &
mo_grad_lapl_beta(k,i,imo2)*slater_matrix_beta_inv_det(l,j+1)
det_beta_grad_lapl_curr(k,i+1) = det_beta_grad_lapl_curr(k,i+1) +&
mo_grad_lapl(k,i+1,imo )*slater_matrix_beta_inv_det(l+1,j ) + &
mo_grad_lapl(k,i+1,imo2)*slater_matrix_beta_inv_det(l+1,j+1)
mo_grad_lapl_beta(k,i+1,imo )*slater_matrix_beta_inv_det(l+1,j ) + &
mo_grad_lapl_beta(k,i+1,imo2)*slater_matrix_beta_inv_det(l+1,j+1)
enddo
!$OMP END SIMD
enddo
i = elec_num
l = elec_num-elec_alpha_num
!$OMP SIMD
do k=1,4
det_beta_grad_lapl_curr(k,i) = det_beta_grad_lapl_curr(k,i) +&
mo_grad_lapl(k,i,imo )*slater_matrix_beta_inv_det(l,j ) + &
mo_grad_lapl(k,i,imo2)*slater_matrix_beta_inv_det(l,j+1)
mo_grad_lapl_beta(k,i,imo )*slater_matrix_beta_inv_det(l,j ) + &
mo_grad_lapl_beta(k,i,imo2)*slater_matrix_beta_inv_det(l,j+1)
enddo
!$OMP END SIMD
enddo
j = elec_beta_num
@ -1532,12 +1478,10 @@ BEGIN_PROVIDER [ double precision, det_beta_grad_lapl_curr, (4,elec_alpha_num+1
!DIR$ LOOP COUNT (16)
do i=elec_alpha_num+1,elec_num
l = i-elec_alpha_num
!$OMP SIMD
do k=1,4
det_beta_grad_lapl_curr(k,i) = det_beta_grad_lapl_curr(k,i) +&
mo_grad_lapl(k,i,imo)*slater_matrix_beta_inv_det(l,j)
mo_grad_lapl_beta(k,i,imo)*slater_matrix_beta_inv_det(l,j)
enddo
!$OMP END SIMD
enddo
endif

23
src/mo.irp.f
View File

@ -349,19 +349,28 @@ BEGIN_PROVIDER [ double precision, mo_lapl, (elec_num_8,mo_num) ]
END_PROVIDER
BEGIN_PROVIDER [ double precision, mo_grad_lapl, (4,elec_num,mo_num) ]
BEGIN_PROVIDER [ double precision, mo_grad_lapl_alpha, (4,elec_alpha_num,mo_num) ]
&BEGIN_PROVIDER [ double precision, mo_grad_lapl_beta , (4,elec_alpha_num+1:elec_num,mo_num) ]
implicit none
BEGIN_DOC
! Gradients and laplacian
END_DOC
integer :: i,j
do j=1,mo_num
do i=1,elec_num
mo_grad_lapl(1,i,j) = mo_grad_transp_x(j,i)
mo_grad_lapl(2,i,j) = mo_grad_transp_y(j,i)
mo_grad_lapl(3,i,j) = mo_grad_transp_z(j,i)
mo_grad_lapl(4,i,j) = mo_lapl_transp (j,i)
enddo
do i=1,elec_alpha_num
mo_grad_lapl_alpha(1,i,j) = mo_grad_transp_x(j,i)
mo_grad_lapl_alpha(2,i,j) = mo_grad_transp_y(j,i)
mo_grad_lapl_alpha(3,i,j) = mo_grad_transp_z(j,i)
mo_grad_lapl_alpha(4,i,j) = mo_lapl_transp (j,i)
enddo
enddo
do j=1,mo_num
do i=elec_alpha_num+1,elec_num
mo_grad_lapl_beta(1,i,j) = mo_grad_transp_x(j,i)
mo_grad_lapl_beta(2,i,j) = mo_grad_transp_y(j,i)
mo_grad_lapl_beta(3,i,j) = mo_grad_transp_z(j,i)
mo_grad_lapl_beta(4,i,j) = mo_lapl_transp (j,i)
enddo
enddo
END_PROVIDER