grid: Move lgrid out of collocate_pgf_product

src/grid/colloc_int_kloop.fypp

@@ -102,13 +102,7 @@ $:  body.replace('kgrad',str(i))
 #:if FM_FLAT_GRID
                 grid(ii+ij+ik+1) = grid(ii+ij+ik+1) + p_v*res_k
 #:else
-                IF ( PRESENT ( lgrid ) ) THEN
-                  ig = ii * (l_bounds(2,2)-l_bounds(1,2)+1) * (l_bounds(2,1)-l_bounds(1,1)+1) + &
-                       ij * (l_bounds(2,2)-l_bounds(1,2)+1) + ik + 1
-                  lgrid%r(ig,ithread)=lgrid%r(ig,ithread) + p_v*res_k
-                ELSE
-                  grid(ik,ij,ii) = grid(ik,ij,ii) + p_v*res_k
-                END IF
+                grid(ik,ij,ii) = grid(ik,ij,ii) + p_v*res_k
 #:endif
 #:endif
 
@@ -156,13 +150,7 @@ $:  body.replace('kgrad',str(i))
 #:if FM_FLAT_GRID
                 grid(ii+ij+ik+1) = grid(ii+ij+ik+1) + p_v*res_k
 #:else
-                IF ( PRESENT ( lgrid ) ) THEN
-                  ig = ii * (l_bounds(2,2)-l_bounds(1,2)+1) * (l_bounds(2,1)-l_bounds(1,1)+1) + &
-                       ij * (l_bounds(2,2)-l_bounds(1,2)+1) + ik + 1
-                  lgrid%r(ig,ithread)=lgrid%r(ig,ithread) + p_v*res_k
-                ELSE
-                  grid(ik,ij,ii) = grid(ik,ij,ii) + p_v*res_k
-                END IF
+                grid(ik,ij,ii) = grid(ik,ij,ii) + p_v*res_k
 #:endif
 #:endif
                 ik=ik-1
@@ -206,13 +194,7 @@ $:  body.replace('kgrad',str(i))
 #:if FM_FLAT_GRID
                 grid(ii+ij+ik+1) = grid(ii+ij+ik+1) + p_v*res_k
 #:else
-                IF ( PRESENT ( lgrid ) ) THEN
-                  ig = ii * (l_bounds(2,2)-l_bounds(1,2)+1) * (l_bounds(2,1)-l_bounds(1,1)+1) + &
-                       ij * (l_bounds(2,2)-l_bounds(1,2)+1) + ik + 1
-                  lgrid%r(ig,ithread)=lgrid%r(ig,ithread) + p_v*res_k
-                ELSE
-                  grid(ik,ij,ii) = grid(ik,ij,ii) + p_v*res_k
-                END IF
+                grid(ik,ij,ii) = grid(ik,ij,ii) + p_v*res_k
 #:endif
 #:endif
 
@@ -258,13 +240,7 @@ $:  body.replace('kgrad',str(i))
 #:if FM_FLAT_GRID
                 grid(ii+ij+ik+1) = grid(ii+ij+ik+1) + p_v*res_k
 #:else
-                IF ( PRESENT ( lgrid ) ) THEN
-                  ig = ii * (l_bounds(2,2)-l_bounds(1,2)+1) * (l_bounds(2,1)-l_bounds(1,1)+1) + &
-                       ij * (l_bounds(2,2)-l_bounds(1,2)+1) + ik + 1
-                  lgrid%r(ig,ithread)=lgrid%r(ig,ithread) + p_v*res_k
-                ELSE
-                  grid(ik,ij,ii) = grid(ik,ij,ii) + p_v*res_k
-                END IF
+                grid(ik,ij,ii) = grid(ik,ij,ii) + p_v*res_k
 #:endif
 #:endif
                 ik=ik-1

src/grid/gauss_colloc.F

@@ -20,9 +20,7 @@ MODULE gauss_colloc
       poly_padd_uneval2b, poly_padd_uneval3b, poly_size1, poly_size2, poly_size3
    USE kinds, ONLY: dp, &
                     int_8
-   USE lgrid_types, ONLY: lgrid_type
 
-!$ USE OMP_LIB, ONLY: omp_get_max_threads, omp_get_thread_num, omp_get_num_threads
 #include "../base/base_uses.f90"
 
    IMPLICIT NONE
@@ -75,10 +73,9 @@ MODULE gauss_colloc
 !> \param poly_shift position of posi in the polynomial reference system.
 !>  Set it to posi to use the global reference system.
 !> \param scale a global scale factor
-!> \param lgrid ...
 ! **************************************************************************************************
    SUBROUTINE collocGauss(h, h_inv, grid, poly, alphai, posi, max_r2, &
-                          periodic, gdim, local_bounds, local_shift, poly_shift, scale, lgrid)
+                          periodic, gdim, local_bounds, local_shift, poly_shift, scale)
       REAL(dp), DIMENSION(0:2, 0:2), INTENT(in)          :: h, h_inv
       REAL(dp), DIMENSION(0:, 0:, 0:), INTENT(inout)     :: grid
       REAL(dp), DIMENSION(:), INTENT(inout)              :: poly
@@ -91,13 +88,12 @@ SUBROUTINE collocGauss(h, h_inv, grid, poly, alphai, posi, max_r2, &
       INTEGER, DIMENSION(0:2), INTENT(in), OPTIONAL      :: local_shift
       REAL(dp), DIMENSION(0:2), INTENT(in), OPTIONAL     :: poly_shift
       REAL(dp), INTENT(in), OPTIONAL                     :: scale
-      TYPE(lgrid_type), INTENT(inout), OPTIONAL          :: lgrid
 
       CHARACTER(len=*), PARAMETER :: routineN = 'collocGauss', routineP = moduleN//':'//routineN
 
       CALL colloc_int_body(h, h_inv, grid, poly, alphai, posi, max_r2, &
                            periodic, gdim, local_bounds, local_shift, &
-                           poly_shift, scale, lgrid, integrate=.FALSE.)
+                           poly_shift, scale, integrate=.FALSE.)
 
    END SUBROUTINE
 
@@ -159,11 +155,10 @@ SUBROUTINE integrateGaussFull(h, h_inv, grid, poly, alphai, posi, max_r2, &
 !> \param local_shift ...
 !> \param poly_shift ...
 !> \param scale ...
-!> \param lgrid ...
 !> \param integrate ...
 ! **************************************************************************************************
    SUBROUTINE colloc_int_body(h, h_inv, grid, poly, alphai, posi, max_r2, &
-                              periodic, gdim, local_bounds, local_shift, poly_shift, scale, lgrid, integrate)
+                              periodic, gdim, local_bounds, local_shift, poly_shift, scale, integrate)
       REAL(dp), DIMENSION(0:2, 0:2), &
          INTENT(in)                             :: h, h_inv
       REAL(dp), DIMENSION(0:, 0:, 0:), &
@@ -182,8 +177,6 @@ SUBROUTINE colloc_int_body(h, h_inv, grid, poly, alphai, posi, max_r2, &
       REAL(dp), DIMENSION(0:2), INTENT(in), &
          OPTIONAL                               :: poly_shift
       REAL(dp), INTENT(in), OPTIONAL           :: scale
-      TYPE(lgrid_type), INTENT(inout), &
-         OPTIONAL                               :: lgrid
       LOGICAL                                  :: integrate
 
       CHARACTER(len=*), PARAMETER :: routineN = 'colloc_int_body', &
@@ -194,7 +187,7 @@ SUBROUTINE colloc_int_body(h, h_inv, grid, poly, alphai, posi, max_r2, &
                  ijShift, iJump, ik, ikShift, ikShift2, ikstart, ikstart2, iend, iend2, &
                  imax, imax1, imin, imin1, istart, istart2, j, jend, jJump, jmax, jmax1, jmin, &
                  jmin1, jstart, k, kend, kend2, kgrad, kJump, kmax, kmax1, kmin, kmin1, &
-                 kstart, kstart2, max_j, size_jk, size_k, size_ijk, ig, ithread, nthread
+                 kstart, kstart2, max_j, size_jk, size_k, size_ijk
       INTEGER, ALLOCATABLE, DIMENSION(:, :, :) :: k_bounds
       INTEGER, DIMENSION(0:2)                  :: cellShift, l_shift, l_ub, &
                                                   ndim, period, shiftPos, ldim2
@@ -224,12 +217,6 @@ SUBROUTINE colloc_int_body(h, h_inv, grid, poly, alphai, posi, max_r2, &
 
 #define IF_FLAT(x,y) y
 
-      ithread = 0
-!$    ithread = omp_get_thread_num()
-
-      nthread = 1
-!$    nthread = omp_get_num_threads()
-
       IF (integrate) THEN
          poly = 0.0_dp
       ELSE

src/grid/grid_collocate.F

@@ -18,14 +18,10 @@ MODULE grid_collocate
         prepare_diadib, prepare_diiadiib, prepare_dijadijb
    USE kinds,                           ONLY: dp,&
                                               int_8
-   USE lgrid_types,                     ONLY: lgrid_type
    USE mathconstants,                   ONLY: fac
    USE orbital_pointers,                ONLY: coset,&
                                               ncoset
    USE realspace_grid_types,            ONLY: realspace_grid_type
-
-!$ USE OMP_LIB, ONLY: omp_get_max_threads, omp_get_thread_num, omp_get_num_threads
-
 #include "../base/base_uses.f90"
 
    IMPLICIT NONE
@@ -58,8 +54,6 @@ MODULE grid_collocate
 !> \param cube_info ...
 !> \param eps_rho_rspace ...
 !> \param ga_gb_function ...
-!> \param lgrid ...
-!> \param ithread ...
 !> \param map_consistent ...
 !> \param collocate_rho0 ...
 !> \param rpgf0_s ...
@@ -76,7 +70,6 @@ SUBROUTINE collocate_pgf_product(la_max, zeta, la_min, &
                                     ra, rab, rab2, scale, pab, o1, o2, &
                                     rsgrid, cell, cube_info, &
                                     eps_rho_rspace, ga_gb_function, &
-                                    lgrid, ithread, &
                                     map_consistent, &
                                     collocate_rho0, &
                                     rpgf0_s, idir, ir, rsgauge, rsbuf, &
@@ -92,13 +85,11 @@ SUBROUTINE collocate_pgf_product(la_max, zeta, la_min, &
       REAL(KIND=dp), INTENT(IN)                :: rab2, scale
       REAL(KIND=dp), DIMENSION(:, :), POINTER  :: pab
       INTEGER, INTENT(IN)                      :: o1, o2
-      TYPE(realspace_grid_type), POINTER       :: rsgrid
+      TYPE(realspace_grid_type)                :: rsgrid
       TYPE(cell_type), POINTER                 :: cell
       TYPE(cube_info_type), INTENT(IN)         :: cube_info
       REAL(KIND=dp), INTENT(IN)                :: eps_rho_rspace
       INTEGER, INTENT(IN)                      :: ga_gb_function
-      TYPE(lgrid_type), OPTIONAL               :: lgrid
-      INTEGER, INTENT(IN), OPTIONAL            :: ithread
       LOGICAL, INTENT(IN), OPTIONAL            :: map_consistent, collocate_rho0
       REAL(dp), INTENT(IN), OPTIONAL           :: rpgf0_s
       INTEGER, INTENT(IN), OPTIONAL            :: idir, ir
@@ -110,7 +101,7 @@ SUBROUTINE collocate_pgf_product(la_max, zeta, la_min, &
       CHARACTER(len=*), PARAMETER :: routineN = 'collocate_pgf_product', &
                                      routineP = moduleN//':'//routineN
 
-      INTEGER :: cmax, gridbounds(2, 3), i, ico, icoef, ider1, ider2, ig, ithread_l, &
+      INTEGER :: cmax, gridbounds(2, 3), i, ico, icoef, ider1, ider2, ig, &
                  jco, k, l, la_max_local, la_min_local, lb_max_local, lb_min_local, &
                  length, lxa, lxb, lxy, lxyz, lya, lyb, &
                  lza, lzb, o1_local, o2_local, offset, start
@@ -125,7 +116,6 @@ SUBROUTINE collocate_pgf_product(la_max, zeta, la_min, &
       REAL(KIND=dp), DIMENSION(:, :), POINTER  :: pab_local
       REAL(KIND=dp), DIMENSION(:, :, :), &
          POINTER                                :: grid
-
       INTEGER :: lxp, lyp, lzp, lp, lxpm, iaxis
       INTEGER, ALLOCATABLE, DIMENSION(:, :) :: map
       REAL(kind=dp) :: p_ele
@@ -150,12 +140,6 @@ SUBROUTINE collocate_pgf_product(la_max, zeta, la_min, &
          ENDIF
       ENDIF
 
-      IF (PRESENT(ithread)) THEN
-         ithread_l = ithread
-      ELSE
-         ithread_l = 0
-      ENDIF
-
       ! use identical radii for integrate and collocate ?
       IF (PRESENT(map_consistent)) THEN
          my_map_consistent = map_consistent
@@ -666,12 +650,7 @@ SUBROUTINE collocate_ortho()
          IF (PRESENT(ir) .AND. PRESENT(rsgauge)) CALL collocate_ortho_set_to_0()
 
 #include "prep.f90"
-
-         IF (PRESENT(lgrid)) THEN
-#include "call_collocate_omp.f90"
-         ELSE
 #include "call_collocate.f90"
-         END IF
 
          IF (PRESENT(ir) .AND. PRESENT(rsgauge)) CALL collocate_gauge_ortho()
 
@@ -977,12 +956,7 @@ SUBROUTINE collocate_general_opt()
                   res = res*exp2i
 
                   i_index = grid_map(i)
-                  IF (PRESENT(lgrid)) THEN
-                     ig = (k_index - 1)*ng(2)*ng(1) + (j_index - 1)*ng(1) + (i_index - 1) + 1
-                     lgrid%r(ig, ithread_l) = lgrid%r(ig, ithread_l) + res
-                  ELSE
-                     grid(i_index, j_index, k_index) = grid(i_index, j_index, k_index) + res
-                  ENDIF
+                  grid(i_index, j_index, k_index) = grid(i_index, j_index, k_index) + res
                ENDDO
             ENDDO
          ENDDO
@@ -1018,16 +992,9 @@ SUBROUTINE collocate_general_subpatch()
          IF (BTEST(subpatch_pattern, 0)) local_s(1) = local_s(1) - rsgrid%desc%border
          IF (BTEST(subpatch_pattern, 2)) local_s(2) = local_s(2) - rsgrid%desc%border
          IF (BTEST(subpatch_pattern, 4)) local_s(3) = local_s(3) - rsgrid%desc%border
-         IF (PRESENT(lgrid)) THEN
-            CALL collocGauss(h=cell%hmat, h_inv=cell%h_inv, &
-                             grid=grid, poly=poly_d3, alphai=zetp, posi=rp, max_r2=radius*radius, &
-                             periodic=periodic, gdim=ng, local_bounds=local_b, local_shift=local_s, &
-                             lgrid=lgrid)
-         ELSE
-            CALL collocGauss(h=cell%hmat, h_inv=cell%h_inv, &
-                             grid=grid, poly=poly_d3, alphai=zetp, posi=rp, max_r2=radius*radius, &
-                             periodic=periodic, gdim=ng, local_bounds=local_b, local_shift=local_s)
-         END IF
+         CALL collocGauss(h=cell%hmat, h_inv=cell%h_inv, &
+                          grid=grid, poly=poly_d3, alphai=zetp, posi=rp, max_r2=radius*radius, &
+                          periodic=periodic, gdim=ng, local_bounds=local_b, local_shift=local_s)
          ! defaults: local_shift=(/0,0,0/),poly_shift=(/0.0_dp,0.0_dp,0.0_dp/),scale=1.0_dp,
 
       END SUBROUTINE
@@ -1055,16 +1022,9 @@ SUBROUTINE collocate_general_wings()
          rShifted(3) = rp(3) + cell%hmat(3, 1)*local_shift(1) &
                        + cell%hmat(3, 2)*local_shift(2) &
                        + cell%hmat(3, 3)*local_shift(3)
-         IF (PRESENT(lgrid)) THEN
-            CALL collocGauss(h=cell%hmat, h_inv=cell%h_inv, &
-                             grid=grid, poly=poly_d3, alphai=zetp, posi=rShifted, max_r2=radius*radius, &
-                             periodic=periodic, gdim=ng, local_bounds=local_b, &
-                             lgrid=lgrid)
-         ELSE
-            CALL collocGauss(h=cell%hmat, h_inv=cell%h_inv, &
-                             grid=grid, poly=poly_d3, alphai=zetp, posi=rShifted, max_r2=radius*radius, &
-                             periodic=periodic, gdim=ng, local_bounds=local_b)
-         END IF
+         CALL collocGauss(h=cell%hmat, h_inv=cell%h_inv, &
+                          grid=grid, poly=poly_d3, alphai=zetp, posi=rShifted, max_r2=radius*radius, &
+                          periodic=periodic, gdim=ng, local_bounds=local_b)
          ! defaults: local_shift=(/0,0,0/),poly_shift=(/0.0_dp,0.0_dp,0.0_dp/),scale=1.0_dp,
 
       END SUBROUTINE
@@ -1102,12 +1062,7 @@ SUBROUTINE collocate_general()
             ! point on the grid (including pbc)
             ipoint = MODULO((/i, j, k/), ng) + 1
             ! add to grid
-            IF (PRESENT(lgrid)) THEN
-               ig = ipoint(3)*ng(2)*ng(1) + ipoint(2)*ng(1) + ipoint(1) + 1
-               lgrid%r(ig, ithread_l) = lgrid%r(ig, ithread_l) + primpt
-            ELSE
-               grid(ipoint(1), ipoint(2), ipoint(3)) = grid(ipoint(1), ipoint(2), ipoint(3)) + primpt
-            ENDIF
+            grid(ipoint(1), ipoint(2), ipoint(3)) = grid(ipoint(1), ipoint(2), ipoint(3)) + primpt
          ENDDO
          ENDDO
          ENDDO

src/hirshfeld_methods.F

@@ -484,7 +484,7 @@ SUBROUTINE calculate_hirshfeld_normalization(qs_env, hirshfeld_env)
                CALL collocate_pgf_product(0, alpha, 0, 0, 0.0_dp, 0, ra, &
                                           (/0.0_dp, 0.0_dp, 0.0_dp/), 0.0_dp, 1.0_dp, pab, 0, 0, rs_rho, &
                                           cell, cube_info, eps_rho_rspace, ga_gb_function=FUNC_AB, &
-                                          ithread=ithread, use_subpatch=.TRUE., subpatch_pattern=subpatch_pattern, &
+                                          use_subpatch=.TRUE., subpatch_pattern=subpatch_pattern, &
                                           lmax_global=0)
             END DO
          END DO

src/mixed_cdft_methods.F

@@ -2600,7 +2600,7 @@ SUBROUTINE mixed_becke_constraint_init(force_env, mixed_cdft, calculate_forces,
                                                 (/0.0_dp, 0.0_dp, 0.0_dp/), 0.0_dp, 1.0_dp, pab, 0, 0, &
                                                 rs_cavity, cell, mixed_cdft%pw_env%cube_info(1), &
                                                 mixed_cdft%eps_rho_rspace, ga_gb_function=FUNC_AB, &
-                                                ithread=ithread, use_subpatch=.TRUE., &
+                                                use_subpatch=.TRUE., &
                                                 subpatch_pattern=0_int_8, lmax_global=0)
                END DO
             END DO