Redirect intermediate routines to the new ones, Convert R1D and C3D e…

…ntirely
cp2k · Feb 13, 2024 · 8bd29a5 · 8bd29a5
1 parent 29fe219
commit 8bd29a5
Show file tree

Hide file tree

Showing 43 changed files with 4,098 additions and 7,289 deletions.
diff --git a/src/cp_ddapc_util.F b/src/cp_ddapc_util.F
@@ -49,6 +49,7 @@ MODULE cp_ddapc_util
    USE pw_pool_types,                   ONLY: pw_pool_type
    USE pw_types,                        ONLY: COMPLEXDATA1D,&
                                               RECIPROCALSPACE,&
+                                              pw_c1d_type,&
                                               pw_type
    USE qs_charges_types,                ONLY: qs_charges_type
    USE qs_environment_types,            ONLY: get_qs_env,&
@@ -232,11 +233,12 @@ RECURSIVE SUBROUTINE get_ddapc(qs_env, calc_force, density_fit_section, &
       TYPE(cp_logger_type), POINTER                      :: logger
       TYPE(dft_control_type), POINTER                    :: dft_control
       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
+      TYPE(pw_c1d_type), POINTER                         :: rho_core
       TYPE(pw_env_type), POINTER                         :: pw_env
       TYPE(pw_pool_type), POINTER                        :: auxbas_pool
       TYPE(pw_type)                                      :: rho_tot_g
       TYPE(pw_type), DIMENSION(:), POINTER               :: rho_g, rho_r
-      TYPE(pw_type), POINTER                             :: rho0_s_gs, rho_core
+      TYPE(pw_type), POINTER                             :: rho0_s_gs
       TYPE(qs_charges_type), POINTER                     :: qs_charges
       TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
       TYPE(qs_rho_type), POINTER                         :: rho

diff --git a/src/cp_realspace_grid_cube.F b/src/cp_realspace_grid_cube.F
@@ -14,7 +14,8 @@ MODULE cp_realspace_grid_cube
    USE cp_output_handling,              ONLY: cp_mpi_io_get
    USE kinds,                           ONLY: dp
    USE particle_list_types,             ONLY: particle_list_type
-   USE pw_types,                        ONLY: pw_type
+   USE pw_types,                        ONLY: pw_r3d_type,&
+                                              pw_type
    USE realspace_grid_cube,             ONLY: cube_to_pw,&
                                               pw_to_cube,&
                                               pw_to_simple_volumetric
@@ -28,6 +29,10 @@ MODULE cp_realspace_grid_cube
 
    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_realspace_grid_cube'
 
+   INTERFACE cp_pw_to_cube
+      MODULE PROCEDURE cp_pw_to_cube_pw, cp_pw_to_cube_r3d
+   END INTERFACE
+
 CONTAINS
 
 ! **************************************************************************************************
@@ -41,14 +46,43 @@ MODULE cp_realspace_grid_cube
 !> \param silent minimal I/O
 !> \param mpi_io True if cube should be written in parallel using MPI
 ! **************************************************************************************************
-   SUBROUTINE cp_pw_to_cube(pw, unit_nr, title, particles, stride, zero_tails, silent, mpi_io)
+   SUBROUTINE cp_pw_to_cube_pw(pw, unit_nr, title, particles, stride, zero_tails, silent, mpi_io)
       TYPE(pw_type), INTENT(IN)                          :: pw
       INTEGER, INTENT(IN)                                :: unit_nr
       CHARACTER(*), INTENT(IN), OPTIONAL                 :: title
       TYPE(particle_list_type), POINTER                  :: particles
       INTEGER, DIMENSION(:), OPTIONAL, POINTER           :: stride
       LOGICAL, INTENT(IN), OPTIONAL                      :: zero_tails, silent, mpi_io
 
+      TYPE(pw_r3d_type)                                  :: my_pw
+
+      my_pw%in_space = pw%in_space
+      my_pw%pw_grid => pw%pw_grid
+      my_pw%array => pw%cr3d
+
+      CALL cp_pw_to_cube_r3d(my_pw, unit_nr, title, particles, stride, zero_tails, silent, mpi_io)
+
+   END SUBROUTINE cp_pw_to_cube_pw
+
+! **************************************************************************************************
+!> \brief ...
+!> \param pw ...
+!> \param unit_nr ...
+!> \param title ...
+!> \param particles ...
+!> \param stride ...
+!> \param zero_tails ...
+!> \param silent minimal I/O
+!> \param mpi_io True if cube should be written in parallel using MPI
+! **************************************************************************************************
+   SUBROUTINE cp_pw_to_cube_r3d(pw, unit_nr, title, particles, stride, zero_tails, silent, mpi_io)
+      TYPE(pw_r3d_type), INTENT(IN)                      :: pw
+      INTEGER, INTENT(IN)                                :: unit_nr
+      CHARACTER(*), INTENT(IN), OPTIONAL                 :: title
+      TYPE(particle_list_type), POINTER                  :: particles
+      INTEGER, DIMENSION(:), OPTIONAL, POINTER           :: stride
+      LOGICAL, INTENT(IN), OPTIONAL                      :: zero_tails, silent, mpi_io
+
       INTEGER                                            :: i, n
       INTEGER, ALLOCATABLE, DIMENSION(:)                 :: particles_z
       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :)        :: particles_r
@@ -75,7 +109,7 @@ SUBROUTINE cp_pw_to_cube(pw, unit_nr, title, particles, stride, zero_tails, sile
                          silent=silent, mpi_io=mpi_io)
       END IF
 
-   END SUBROUTINE cp_pw_to_cube
+   END SUBROUTINE cp_pw_to_cube_r3d
 
 ! **************************************************************************************************
 !> \brief Prints grid in a simple format: X Y Z value

diff --git a/src/energy_corrections.F b/src/energy_corrections.F
@@ -131,6 +131,7 @@ MODULE energy_corrections
                                               REALDATA3D,&
                                               REALSPACE,&
                                               RECIPROCALSPACE,&
+                                              pw_c1d_type,&
                                               pw_type
    USE qs_atomic_block,                 ONLY: calculate_atomic_block_dm
    USE qs_collocate_density,            ONLY: calculate_rho_elec
@@ -1716,6 +1717,7 @@ SUBROUTINE ec_build_ks_matrix_force(qs_env, ec_env)
       TYPE(mp_para_env_type), POINTER                    :: para_env
       TYPE(neighbor_list_set_p_type), DIMENSION(:), &
          POINTER                                         :: sab_orb
+      TYPE(pw_c1d_type), POINTER                         :: rho_core
       TYPE(pw_env_type), POINTER                         :: pw_env
       TYPE(pw_poisson_type), POINTER                     :: poisson_env
       TYPE(pw_pool_type), POINTER                        :: auxbas_pw_pool
@@ -1725,7 +1727,6 @@ SUBROUTINE ec_build_ks_matrix_force(qs_env, ec_env)
       TYPE(pw_type), DIMENSION(:), POINTER               :: rho_g, rho_r, rhoout_g, rhoout_r, tau_r, &
                                                             tauout_r, v_rspace, v_tau_rspace, &
                                                             v_xc, v_xc_tau
-      TYPE(pw_type), POINTER                             :: rho_core
       TYPE(qs_force_type), DIMENSION(:), POINTER         :: force
       TYPE(qs_ks_env_type), POINTER                      :: ks_env
       TYPE(qs_rho_type), POINTER                         :: rho

diff --git a/src/ewald_methods_tb.F b/src/ewald_methods_tb.F
@@ -233,7 +233,7 @@ SUBROUTINE tb_spme_evaluate(ewald_env, ewald_pw, particle_set, box, &
                DO i = 1, 3
                   DO ig = grid_spme%first_gne0, grid_spme%ngpts_cut_local
                      phib_g%cc(ig) = ffb*dphi_g(i)%cc(ig)*(1.0_dp + ffa*grid_spme%gsq(ig))
-                     phib_g%cc(ig) = phib_g%cc(ig)*green%influence_fn%cc(ig)
+                     phib_g%cc(ig) = phib_g%cc(ig)*green%influence_fn%array(ig)
                   END DO
                   IF (grid_spme%have_g0) phib_g%cc(1) = 0.0_dp
                   DO j = 1, i

diff --git a/src/hfx_pw_methods.F b/src/hfx_pw_methods.F
@@ -50,6 +50,7 @@ MODULE hfx_pw_methods
                                               REALDATA3D,&
                                               REALSPACE,&
                                               RECIPROCALSPACE,&
+                                              pw_c1d_type,&
                                               pw_type
    USE qs_collocate_density,            ONLY: calculate_wavefunction
    USE qs_environment_types,            ONLY: get_qs_env,&
@@ -107,9 +108,10 @@ SUBROUTINE pw_hfx(qs_env, ehfx, hfx_section, poisson_env, auxbas_pw_pool, irep)
       TYPE(dft_control_type), POINTER                    :: dft_control
       TYPE(mo_set_type), DIMENSION(:), POINTER           :: mo_array
       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
+      TYPE(pw_c1d_type)                                  :: greenfn
       TYPE(pw_env_type), POINTER                         :: pw_env
       TYPE(pw_grid_type), POINTER                        :: grid
-      TYPE(pw_type)                                      :: greenfn, pot_g, rho_g, rho_r
+      TYPE(pw_type)                                      :: pot_g, rho_g, rho_r
       TYPE(pw_type), ALLOCATABLE, DIMENSION(:)           :: rho_i, rho_j
       TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
       TYPE(section_vals_type), POINTER                   :: ip_section
@@ -146,9 +148,7 @@ SUBROUTINE pw_hfx(qs_env, ehfx, hfx_section, poisson_env, auxbas_pw_pool, irep)
          ALLOCATE (rho_i(blocksize))
          ALLOCATE (rho_j(blocksize))
 
-         CALL auxbas_pw_pool%create_pw(greenfn, &
-                                       use_data=COMPLEXDATA1D, &
-                                       in_space=RECIPROCALSPACE)
+         CALL auxbas_pw_pool%create_pw(greenfn, in_space=RECIPROCALSPACE)
          ip_section => section_vals_get_subs_vals(hfx_section, "INTERACTION_POTENTIAL")
          CALL section_vals_get(ip_section, explicit=explicit)
          potential_type = do_potential_coulomb
@@ -164,10 +164,10 @@ SUBROUTINE pw_hfx(qs_env, ehfx, hfx_section, poisson_env, auxbas_pw_pool, irep)
                g2 = grid%gsq(ig)
                gg = SQRT(g2)
                g3d = fourpi/g2
-               greenfn%cc(ig) = g3d*(1.0_dp - COS(rcut*gg))
+               greenfn%array(ig) = g3d*(1.0_dp - COS(rcut*gg))
             END DO
             IF (grid%have_g0) &
-               greenfn%cc(1) = 0.5_dp*fourpi*rcut*rcut
+               greenfn%array(1) = 0.5_dp*fourpi*rcut*rcut
          ELSEIF (potential_type == do_potential_short) THEN
             CALL section_vals_val_get(ip_section, "OMEGA", r_val=omega)
             IF (omega > 0.0_dp) omega = 0.25_dp/(omega*omega)
@@ -176,9 +176,9 @@ SUBROUTINE pw_hfx(qs_env, ehfx, hfx_section, poisson_env, auxbas_pw_pool, irep)
                g2 = grid%gsq(ig)
                gg = -omega*g2
                g3d = fourpi/g2
-               greenfn%cc(ig) = g3d*(1.0_dp - EXP(gg))
+               greenfn%array(ig) = g3d*(1.0_dp - EXP(gg))
             END DO
-            IF (grid%have_g0) greenfn%cc(1) = 0.0_dp
+            IF (grid%have_g0) greenfn%array(1) = 0.0_dp
          ELSE
             CPWARN("PW_SCF: Potential type not supported, calculation uses Coulomb potential.")
          END IF

diff --git a/src/library_tests.F b/src/library_tests.F
@@ -89,10 +89,10 @@ MODULE library_tests
    USE pw_methods,                      ONLY: pw_transfer,&
                                               pw_zero
    USE pw_types,                        ONLY: COMPLEXDATA1D,&
-                                              COMPLEXDATA3D,&
                                               REALDATA3D,&
                                               REALSPACE,&
                                               RECIPROCALSPACE,&
+                                              pw_c3d_type,&
                                               pw_type
    USE realspace_grid_types,            ONLY: &
         realspace_grid_desc_type, realspace_grid_input_type, realspace_grid_type, rs_grid_create, &
@@ -830,8 +830,9 @@ SUBROUTINE pw_fft_test(para_env, iw, globenv, pw_transfer_section)
                                                             t_min, tend, tstart
       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: t_end, t_start
       TYPE(cell_type), POINTER                           :: box
+      TYPE(pw_c3d_type)                                  :: cb
       TYPE(pw_grid_type), POINTER                        :: grid
-      TYPE(pw_type)                                      :: ca, cb, cc
+      TYPE(pw_type)                                      :: ca, cc
 
 !..set fft lib
 
@@ -939,7 +940,7 @@ SUBROUTINE pw_fft_test(para_env, iw, globenv, pw_transfer_section)
             no = grid%npts
 
             CALL ca%create(grid, COMPLEXDATA1D, RECIPROCALSPACE)
-            CALL cb%create(grid, COMPLEXDATA3D, REALSPACE)
+            CALL cb%create(grid, REALSPACE)
             CALL cc%create(grid, COMPLEXDATA1D, RECIPROCALSPACE)
 
             ! initialize data

diff --git a/src/mp2_cphf.F b/src/mp2_cphf.F
@@ -91,6 +91,7 @@ MODULE mp2_cphf
                                               REALDATA3D,&
                                               REALSPACE,&
                                               RECIPROCALSPACE,&
+                                              pw_c1d_type,&
                                               pw_type
    USE qs_2nd_kernel_ao,                ONLY: apply_2nd_order_kernel
    USE qs_density_matrices,             ONLY: calculate_whz_matrix
@@ -1331,6 +1332,7 @@ SUBROUTINE update_mp2_forces(qs_env)
       TYPE(neighbor_list_set_p_type), DIMENSION(:), &
          POINTER                                         :: sab_orb, sac_ae, sac_ppl, sap_ppnl
       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
+      TYPE(pw_c1d_type), POINTER                         :: rho_core
       TYPE(pw_env_type), POINTER                         :: pw_env
       TYPE(pw_poisson_type), POINTER                     :: poisson_env
       TYPE(pw_pool_type), POINTER                        :: auxbas_pw_pool
@@ -1340,7 +1342,6 @@ SUBROUTINE update_mp2_forces(qs_env)
       TYPE(pw_type), DIMENSION(:), POINTER               :: rho_g, rho_mp2_g, rho_mp2_r, &
                                                             rho_mp2_r_aux, rho_r, tau_mp2_r, &
                                                             vadmm_rspace, vtau_rspace, vxc_rspace
-      TYPE(pw_type), POINTER                             :: rho_core
       TYPE(qs_dispersion_type), POINTER                  :: dispersion_env
       TYPE(qs_energy_type), POINTER                      :: energy
       TYPE(qs_force_type), DIMENSION(:), POINTER         :: force