LCPQ
/
qp2
mirror of https://github.com/QuantumPackage/qp2.git
9
1
Fork 0
Code Releases Activity

parallel sections for dft_utils_in_r

This commit is contained in:
Emmanuel Giner LCT 2020-04-05 13:58:17 +02:00
parent 408af98512
commit 6db77c320b
6 changed files with 134 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
src/dft_utils_in_r/ao_in_r.irp.f
View File

@ -1,13 +1,15 @@
BEGIN_PROVIDER[double precision, aos_in_r_array, (ao_num,n_points_final_grid)]
&BEGIN_PROVIDER[double precision, aos_in_r_array_transp, (n_points_final_grid,ao_num)]
implicit none
BEGIN_DOC
! aos_in_r_array(i,j) = value of the ith ao on the jth grid point
!
! aos_in_r_array_transp(i,j) = value of the jth ao on the ith grid point
END_DOC
integer :: i,j
double precision :: aos_array(ao_num), r(3)
!$OMP PARALLEL DO &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (i,r,aos_array,j) &
!$OMP SHARED(aos_in_r_array,n_points_final_grid,ao_num,final_grid_points)
do i = 1, n_points_final_grid
r(1) = final_grid_points(1,i)
r(2) = final_grid_points(2,i)
@ -15,11 +17,30 @@
call give_all_aos_at_r(r,aos_array)
do j = 1, ao_num
aos_in_r_array(j,i) = aos_array(j)
aos_in_r_array_transp(i,j) = aos_array(j)
enddo
enddo
!$OMP END PARALLEL DO
END_PROVIDER
BEGIN_PROVIDER[double precision, aos_in_r_array_transp, (n_points_final_grid,ao_num)]
implicit none
BEGIN_DOC
! aos_in_r_array_transp(i,j) = value of the jth ao on the ith grid point
END_DOC
integer :: i,j
double precision :: aos_array(ao_num), r(3)
do i = 1, n_points_final_grid
do j = 1, ao_num
aos_in_r_array_transp(i,j) = aos_in_r_array(j,i)
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER[double precision, aos_grad_in_r_array, (ao_num,n_points_final_grid,3)]
implicit none
BEGIN_DOC
@ -30,6 +51,10 @@
integer :: i,j,m
double precision :: aos_array(ao_num), r(3)
double precision :: aos_grad_array(3,ao_num)
!$OMP PARALLEL DO &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (i,r,aos_array,aos_grad_array,j,m) &
!$OMP SHARED(aos_grad_in_r_array,n_points_final_grid,ao_num,final_grid_points)
do i = 1, n_points_final_grid
r(1) = final_grid_points(1,i)
r(2) = final_grid_points(2,i)
@ -41,15 +66,16 @@
enddo
enddo
enddo
!$OMP END PARALLEL DO
END_PROVIDER
BEGIN_PROVIDER[double precision, aos_grad_in_r_array_transp, (n_points_final_grid,ao_num,3)]
BEGIN_PROVIDER[double precision, aos_grad_in_r_array_transp, (3,ao_num,n_points_final_grid)]
implicit none
BEGIN_DOC
! aos_grad_in_r_array_transp(i,j,k) = value of the kth component of the gradient of jth ao on the ith grid point
! aos_grad_in_r_array_transp(k,i,j) = value of the kth component of the gradient of jth ao on the ith grid point
!
! k = 1 : x, k= 2, y, k 3, z
END_DOC
@ -57,49 +83,18 @@
double precision :: aos_array(ao_num), r(3)
double precision :: aos_grad_array(3,ao_num)
do i = 1, n_points_final_grid
r(1) = final_grid_points(1,i)
r(2) = final_grid_points(2,i)
r(3) = final_grid_points(3,i)
call give_all_aos_and_grad_at_r(r,aos_array,aos_grad_array)
do m = 1, 3
do j = 1, ao_num
aos_grad_in_r_array_transp(i,j,m) = aos_grad_array(m,j)
enddo
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER[double precision, aos_grad_in_r_array_transp_xyz, (3,ao_num,n_points_final_grid)]
implicit none
BEGIN_DOC
! aos_grad_in_r_array_transp_xyz(k,i,j) = value of the kth component of the gradient of jth ao on the ith grid point
!
! k = 1 : x, k= 2, y, k 3, z
END_DOC
integer :: i,j,m
double precision :: aos_array(ao_num), r(3)
double precision :: aos_grad_array(3,ao_num)
do i = 1, n_points_final_grid
r(1) = final_grid_points(1,i)
r(2) = final_grid_points(2,i)
r(3) = final_grid_points(3,i)
call give_all_aos_and_grad_at_r(r,aos_array,aos_grad_array)
do m = 1, 3
do j = 1, ao_num
aos_grad_in_r_array_transp_xyz(m,j,i) = aos_grad_array(m,j)
aos_grad_in_r_array_transp(m,j,i) = aos_grad_in_r_array(j,i,m)
enddo
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER[double precision, aos_lapl_in_r_array, (ao_num,n_points_final_grid,3)]
&BEGIN_PROVIDER[double precision, aos_lapl_in_r_array_transp, (n_points_final_grid,ao_num,3)]
implicit none
BEGIN_DOC
! aos_lapl_in_r_array(i,j,k) = value of the kth component of the laplacian of ith ao on the jth grid point
!
! aos_lapl_in_r_array_transp(i,j,k) = value of the kth component of the laplacian of jth ao on the ith grid point
! aos_lapl_in_r_array(i,j,k) = value of the kth component of the laplacian of jth ao on the ith grid point
!
! k = 1 : x, k= 2, y, k 3, z
END_DOC
@ -107,6 +102,10 @@
double precision :: aos_array(ao_num), r(3)
double precision :: aos_grad_array(ao_num,3)
double precision :: aos_lapl_array(ao_num,3)
!$OMP PARALLEL DO &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (i,r,aos_array,aos_grad_array,aos_lapl_array,j,m) &
!$OMP SHARED(aos_lapl_in_r_array,n_points_final_grid,ao_num,final_grid_points)
do m = 1, 3
do i = 1, n_points_final_grid
r(1) = final_grid_points(1,i)
@ -115,7 +114,24 @@
call give_all_aos_and_grad_and_lapl_at_r(r,aos_array,aos_grad_array,aos_lapl_array)
do j = 1, ao_num
aos_lapl_in_r_array(j,i,m) = aos_lapl_array(j,m)
aos_lapl_in_r_array_transp(i,j,m) = aos_lapl_array(j,m)
enddo
enddo
enddo
!$OMP END PARALLEL DO
END_PROVIDER
BEGIN_PROVIDER[double precision, aos_lapl_in_r_array_transp, (n_points_final_grid,ao_num,3)]
implicit none
!
! aos_lapl_in_r_array_transp(i,j,k) = value of the kth component of the laplacian of jth ao on the ith grid point
!
! k = 1 : x, k= 2, y, k 3, z
integer :: i,j,m
do m = 1, 3
do i = 1, n_points_final_grid
do j = 1, ao_num
aos_lapl_in_r_array_transp(i,j,m) = aos_lapl_in_r_array(j,i,m)
enddo
enddo
enddo

14
src/dft_utils_in_r/dm_in_r.irp.f
View File

@ -29,11 +29,18 @@
double precision, allocatable :: dm_a(:),dm_b(:), dm_a_grad(:,:), dm_b_grad(:,:)
allocate(dm_a(N_states),dm_b(N_states), dm_a_grad(3,N_states), dm_b_grad(3,N_states))
allocate(aos_array(ao_num),grad_aos_array(3,ao_num))
!$OMP PARALLEL DO &
!$OMP DEFAULT (NONE) &
!$OMP SHARED(n_points_final_grid,final_grid_points,N_states, &
!$OMP one_e_dm_and_grad_alpha_in_r,one_e_dm_and_grad_beta_in_r, &
!$OMP one_e_grad_2_dm_alpha_at_r,one_e_grad_2_dm_beta_at_r, &
!$OMP scal_prod_grad_one_e_dm_ab,one_e_stuff_for_pbe) &
!$OMP PRIVATE (istate,i,r,dm_a,dm_b,dm_a_grad,dm_b_grad,aos_array, grad_aos_array)
do istate = 1, N_states
do i = 1, n_points_final_grid
r(1) = final_grid_points(1,i)
r(2) = final_grid_points(2,i)
r(3) = final_grid_points(3,i)
r(1) = final_grid_points(1,i)
r(2) = final_grid_points(2,i)
r(3) = final_grid_points(3,i)
call density_and_grad_alpha_beta_and_all_aos_and_grad_aos_at_r(r,dm_a,dm_b, dm_a_grad, dm_b_grad, aos_array, grad_aos_array)
@ -72,6 +79,7 @@
* (dm_a(istate) + dm_b(istate))
enddo
enddo
!$OMP END PARALLEL DO
END_PROVIDER

54
src/dft_utils_in_r/mo_in_r.irp.f
View File

@ -1,10 +1,7 @@
BEGIN_PROVIDER[double precision, mos_in_r_array, (mo_num,n_points_final_grid)]
&BEGIN_PROVIDER[double precision, mos_in_r_array_transp,(n_points_final_grid,mo_num)]
implicit none
BEGIN_DOC
! mos_in_r_array(i,j) = value of the ith mo on the jth grid point
!
! mos_in_r_array_transp(i,j) = value of the jth mo on the ith grid point
END_DOC
integer :: i,j
double precision :: mos_array(mo_num), r(3)
@ -15,14 +12,49 @@
call give_all_mos_at_r(r,mos_array)
do j = 1, mo_num
mos_in_r_array(j,i) = mos_array(j)
mos_in_r_array_transp(i,j) = mos_array(j)
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER[double precision, mos_in_r_array_omp, (mo_num,n_points_final_grid)]
implicit none
BEGIN_DOC
! mos_in_r_array(i,j) = value of the ith mo on the jth grid point
END_DOC
integer :: i,j
double precision :: mos_array(mo_num), r(3)
!$OMP PARALLEL DO &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (i,r,mos_array,j) &
!$OMP SHARED(mos_in_r_array_omp,n_points_final_grid,mo_num,final_grid_points)
do i = 1, n_points_final_grid
r(1) = final_grid_points(1,i)
r(2) = final_grid_points(2,i)
r(3) = final_grid_points(3,i)
call give_all_mos_at_r(r,mos_array)
do j = 1, mo_num
mos_in_r_array_omp(j,i) = mos_array(j)
enddo
enddo
!$OMP END PARALLEL DO
END_PROVIDER
BEGIN_PROVIDER[double precision, mos_in_r_array_transp,(n_points_final_grid,mo_num)]
implicit none
BEGIN_DOC
! mos_in_r_array_transp(i,j) = value of the jth mo on the ith grid point
END_DOC
integer :: i,j
do i = 1, n_points_final_grid
do j = 1, mo_num
mos_in_r_array_transp(i,j) = mos_in_r_array(j,i)
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER[double precision, mos_grad_in_r_array,(mo_num,n_points_final_grid,3)]
&BEGIN_PROVIDER[double precision, mos_grad_in_r_array_tranp,(3,mo_num,n_points_final_grid)]
implicit none
BEGIN_DOC
! mos_grad_in_r_array(i,j,k) = value of the kth component of the gradient of ith mo on the jth grid point
@ -32,12 +64,22 @@
! k = 1 : x, k= 2, y, k 3, z
END_DOC
integer :: m
print*,'mo_num,n_points_final_grid',mo_num,n_points_final_grid
mos_grad_in_r_array = 0.d0
do m=1,3
call dgemm('N','N',mo_num,n_points_final_grid,ao_num,1.d0,mo_coef_transp,mo_num,aos_grad_in_r_array(1,1,m),ao_num,0.d0,mos_grad_in_r_array(1,1,m),mo_num)
enddo
END_PROVIDER
BEGIN_PROVIDER[double precision, mos_grad_in_r_array_tranp,(3,mo_num,n_points_final_grid)]
implicit none
BEGIN_DOC
! mos_grad_in_r_array_transp(i,j,k) = value of the kth component of the gradient of jth mo on the ith grid point
!
! k = 1 : x, k= 2, y, k 3, z
END_DOC
integer :: m
integer :: i,j
mos_grad_in_r_array = 0.d0
do i = 1, n_points_final_grid
do j = 1, mo_num
do m = 1, 3

12
src/functionals/pbe.irp.f
View File

@ -159,10 +159,10 @@ END_PROVIDER
enddo
do j = 1, ao_num
do m = 1,3
aos_d_vc_alpha_pbe_w(j,i,istate) += contrib_grad_ca(m) * aos_grad_in_r_array_transp_xyz(m,j,i)
aos_d_vc_beta_pbe_w (j,i,istate) += contrib_grad_cb(m) * aos_grad_in_r_array_transp_xyz(m,j,i)
aos_d_vx_alpha_pbe_w(j,i,istate) += contrib_grad_xa(m) * aos_grad_in_r_array_transp_xyz(m,j,i)
aos_d_vx_beta_pbe_w (j,i,istate) += contrib_grad_xb(m) * aos_grad_in_r_array_transp_xyz(m,j,i)
aos_d_vc_alpha_pbe_w(j,i,istate) += contrib_grad_ca(m) * aos_grad_in_r_array_transp(m,j,i)
aos_d_vc_beta_pbe_w (j,i,istate) += contrib_grad_cb(m) * aos_grad_in_r_array_transp(m,j,i)
aos_d_vx_alpha_pbe_w(j,i,istate) += contrib_grad_xa(m) * aos_grad_in_r_array_transp(m,j,i)
aos_d_vx_beta_pbe_w (j,i,istate) += contrib_grad_xb(m) * aos_grad_in_r_array_transp(m,j,i)
enddo
enddo
enddo
@ -315,8 +315,8 @@ END_PROVIDER
enddo
do j = 1, ao_num
do m = 1,3
aos_d_vxc_alpha_pbe_w(j,i,istate) += ( contrib_grad_ca(m) + contrib_grad_xa(m) ) * aos_grad_in_r_array_transp_xyz(m,j,i)
aos_d_vxc_beta_pbe_w (j,i,istate) += ( contrib_grad_cb(m) + contrib_grad_xb(m) ) * aos_grad_in_r_array_transp_xyz(m,j,i)
aos_d_vxc_alpha_pbe_w(j,i,istate) += ( contrib_grad_ca(m) + contrib_grad_xa(m) ) * aos_grad_in_r_array_transp(m,j,i)
aos_d_vxc_beta_pbe_w (j,i,istate) += ( contrib_grad_cb(m) + contrib_grad_xb(m) ) * aos_grad_in_r_array_transp(m,j,i)
enddo
enddo
enddo

12
src/functionals/sr_pbe.irp.f
View File

@ -157,10 +157,10 @@ END_PROVIDER
enddo
do j = 1, ao_num
do m = 1,3
aos_d_vc_alpha_sr_pbe_w(j,i,istate) += contrib_grad_ca(m) * aos_grad_in_r_array_transp_xyz(m,j,i)
aos_d_vc_beta_sr_pbe_w (j,i,istate) += contrib_grad_cb(m) * aos_grad_in_r_array_transp_xyz(m,j,i)
aos_d_vx_alpha_sr_pbe_w(j,i,istate) += contrib_grad_xa(m) * aos_grad_in_r_array_transp_xyz(m,j,i)
aos_d_vx_beta_sr_pbe_w (j,i,istate) += contrib_grad_xb(m) * aos_grad_in_r_array_transp_xyz(m,j,i)
aos_d_vc_alpha_sr_pbe_w(j,i,istate) += contrib_grad_ca(m) * aos_grad_in_r_array_transp(m,j,i)
aos_d_vc_beta_sr_pbe_w (j,i,istate) += contrib_grad_cb(m) * aos_grad_in_r_array_transp(m,j,i)
aos_d_vx_alpha_sr_pbe_w(j,i,istate) += contrib_grad_xa(m) * aos_grad_in_r_array_transp(m,j,i)
aos_d_vx_beta_sr_pbe_w (j,i,istate) += contrib_grad_xb(m) * aos_grad_in_r_array_transp(m,j,i)
enddo
enddo
enddo
@ -312,8 +312,8 @@ END_PROVIDER
enddo
do j = 1, ao_num
do m = 1,3
aos_d_vxc_alpha_sr_pbe_w(j,i,istate) += ( contrib_grad_ca(m) + contrib_grad_xa(m) ) * aos_grad_in_r_array_transp_xyz(m,j,i)
aos_d_vxc_beta_sr_pbe_w (j,i,istate) += ( contrib_grad_cb(m) + contrib_grad_xb(m) ) * aos_grad_in_r_array_transp_xyz(m,j,i)
aos_d_vxc_alpha_sr_pbe_w(j,i,istate) += ( contrib_grad_ca(m) + contrib_grad_xa(m) ) * aos_grad_in_r_array_transp(m,j,i)
aos_d_vxc_beta_sr_pbe_w (j,i,istate) += ( contrib_grad_cb(m) + contrib_grad_xb(m) ) * aos_grad_in_r_array_transp(m,j,i)
enddo
enddo
enddo

9
src/two_body_rdm/test_2_rdm.irp.f
View File

@ -2,7 +2,12 @@ program test_2_rdm
implicit none
read_wf = .True.
touch read_wf
call routine_active_only
call routine_full_mos
! call routine_active_only
! call routine_full_mos
call routine
end
subroutine routine
implicit none
provide act_2_rdm_ab_mo
end