From 6db77c320b9f4de3e75aa9d3dc3ba1da3901ba8a Mon Sep 17 00:00:00 2001 From: Emmanuel Giner LCT Date: Sun, 5 Apr 2020 13:58:17 +0200 Subject: [PATCH] parallel sections for dft_utils_in_r --- src/dft_utils_in_r/ao_in_r.irp.f | 96 ++++++++++++++++++------------- src/dft_utils_in_r/dm_in_r.irp.f | 14 ++++- src/dft_utils_in_r/mo_in_r.irp.f | 54 +++++++++++++++-- src/functionals/pbe.irp.f | 12 ++-- src/functionals/sr_pbe.irp.f | 12 ++-- src/two_body_rdm/test_2_rdm.irp.f | 9 ++- 6 files changed, 134 insertions(+), 63 deletions(-) diff --git a/src/dft_utils_in_r/ao_in_r.irp.f b/src/dft_utils_in_r/ao_in_r.irp.f index 767f329c..4b1526dd 100644 --- a/src/dft_utils_in_r/ao_in_r.irp.f +++ b/src/dft_utils_in_r/ao_in_r.irp.f @@ -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 diff --git a/src/dft_utils_in_r/dm_in_r.irp.f b/src/dft_utils_in_r/dm_in_r.irp.f index 7b0b1e0f..53e15b06 100644 --- a/src/dft_utils_in_r/dm_in_r.irp.f +++ b/src/dft_utils_in_r/dm_in_r.irp.f @@ -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 diff --git a/src/dft_utils_in_r/mo_in_r.irp.f b/src/dft_utils_in_r/mo_in_r.irp.f index bfcc8abb..81863c3a 100644 --- a/src/dft_utils_in_r/mo_in_r.irp.f +++ b/src/dft_utils_in_r/mo_in_r.irp.f @@ -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 diff --git a/src/functionals/pbe.irp.f b/src/functionals/pbe.irp.f index 23b3925b..1515532e 100644 --- a/src/functionals/pbe.irp.f +++ b/src/functionals/pbe.irp.f @@ -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 diff --git a/src/functionals/sr_pbe.irp.f b/src/functionals/sr_pbe.irp.f index 674a1ffb..93c51067 100644 --- a/src/functionals/sr_pbe.irp.f +++ b/src/functionals/sr_pbe.irp.f @@ -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 diff --git a/src/two_body_rdm/test_2_rdm.irp.f b/src/two_body_rdm/test_2_rdm.irp.f index 123261d8..5c8054ff 100644 --- a/src/two_body_rdm/test_2_rdm.irp.f +++ b/src/two_body_rdm/test_2_rdm.irp.f @@ -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