parallel sections for dft_utils_in_r

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)
+    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_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)
    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(i,j,k)   = value of the kth component of the laplacian of jth ao on the ith 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
  !
  ! 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

src/dft_utils_in_r/dm_in_r.irp.f

@@ -29,6 +29,13 @@
  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)
@@ -72,6 +79,7 @@
                                                  * (dm_a(istate) + dm_b(istate))
   enddo
  enddo
+ !$OMP END PARALLEL DO
 
 END_PROVIDER
 

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

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_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_xyz(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_xyz(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_xyz(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_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_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(m,j,i)
     enddo
    enddo
   enddo

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_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_xyz(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_xyz(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_xyz(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_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_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(m,j,i)
     enddo
    enddo
   enddo

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_active_only
- call routine_full_mos
+! call routine_full_mos
+ call routine
 end
 
+subroutine routine
+ implicit none 
+ provide act_2_rdm_ab_mo
+end