From 383c4fa8235d5f7157a23eb4f423444a2b813c55 Mon Sep 17 00:00:00 2001 From: Frederick Stein Date: Fri, 26 Jan 2024 18:07:34 +0100 Subject: [PATCH] Convert all C1D grids --- src/admm_dm_methods.F | 6 +- src/admm_methods.F | 13 +- src/cp_ddapc.F | 20 +- src/cp_ddapc_methods.F | 21 +- src/cp_ddapc_types.F | 5 +- src/cp_ddapc_util.F | 41 +- src/dm_ls_scf_qs.F | 8 +- src/ec_methods.F | 8 +- src/ec_orth_solver.F | 14 +- src/ed_analysis.F | 12 +- src/emd/rt_propagation_output.F | 9 +- src/emd/rt_propagation_utils.F | 8 +- src/energy_corrections.F | 36 +- src/et_coupling_proj.F | 9 +- src/ewald_methods_tb.F | 34 +- src/hfx_pw_methods.F | 9 +- src/iao_analysis.F | 14 +- src/kg_correction.F | 10 +- src/library_tests.F | 18 +- src/localization_tb.F | 8 +- src/lri_environment_methods.F | 9 +- src/minbas_wfn_analysis.F | 9 +- src/molecular_states.F | 6 +- src/mp2_cphf.F | 25 +- src/mp2_eri_gpw.F | 78 +- src/mp2_gpw_method.F | 4 +- src/mp2_integrals.F | 6 +- src/mp2_ri_grad.F | 10 +- src/optimize_embedding_potential.F | 32 +- src/pme.F | 31 +- src/post_scf_bandstructure_utils.F | 9 +- src/pw/mt_util.F | 26 +- src/pw/ps_implicit_methods.F | 4 +- src/pw/pw_copy_all.F | 90 +- src/pw/pw_gpu.F | 21 +- src/pw/pw_methods.F | 2388 +++----------------------- src/pw/pw_poisson_methods.F | 64 +- src/pw/pw_poisson_types.F | 22 +- src/pw/pw_pool_types.F | 33 +- src/pw/pw_spline_utils.F | 60 +- src/pw/pw_types.F | 28 +- src/pw_env/rs_pw_interface.F | 20 +- src/qmmm_gpw_forces.F | 4 +- src/qmmm_image_charge.F | 18 +- src/qs_2nd_kernel_ao.F | 7 +- src/qs_active_space_methods.F | 22 +- src/qs_collocate_density.F | 212 +-- src/qs_dcdr_ao.F | 35 +- src/qs_dispersion_nonloc.F | 24 +- src/qs_electric_field_gradient.F | 20 +- src/qs_elf_methods.F | 8 +- src/qs_energy_window.F | 9 +- src/qs_environment_methods.F | 11 +- src/qs_environment_types.F | 6 +- src/qs_epr_hyp.F | 17 +- src/qs_external_density.F | 13 +- src/qs_fxc.F | 4 +- src/qs_gamma2kp.F | 7 +- src/qs_gspace_mixing.F | 92 +- src/qs_kernel_methods.F | 9 +- src/qs_kpp1_env_methods.F | 25 +- src/qs_ks_methods.F | 14 +- src/qs_ks_reference.F | 11 +- src/qs_ks_types.F | 12 +- src/qs_ks_utils.F | 39 +- src/qs_linres_current.F | 7 +- src/qs_linres_current_utils.F | 9 +- src/qs_linres_epr_nablavks.F | 31 +- src/qs_linres_epr_ownutils.F | 14 +- src/qs_linres_epr_utils.F | 11 +- src/qs_linres_kernel.F | 19 +- src/qs_linres_nmr_epr_common_utils.F | 11 +- src/qs_linres_nmr_shift.F | 23 +- src/qs_loc_methods.F | 8 +- src/qs_loc_states.F | 6 +- src/qs_local_properties.F | 24 +- src/qs_mixing_utils.F | 16 +- src/qs_p_env_methods.F | 6 +- src/qs_pdos.F | 8 +- src/qs_resp.F | 15 +- src/qs_rho0_ggrid.F | 19 +- src/qs_rho0_types.F | 10 +- src/qs_rho_methods.F | 60 +- src/qs_rho_types.F | 30 +- src/qs_sccs.F | 50 +- src/qs_scf_initialization.F | 4 +- src/qs_scf_post_gpw.F | 27 +- src/qs_scf_post_tb.F | 108 +- src/qs_tddfpt2_densities.F | 6 +- src/qs_tddfpt2_fhxc.F | 5 +- src/qs_tddfpt2_fhxc_forces.F | 23 +- src/qs_tddfpt2_forces.F | 26 +- src/qs_tddfpt2_operators.F | 15 +- src/qs_tddfpt2_properties.F | 8 +- src/qs_tddfpt2_types.F | 8 +- src/qs_update_s_mstruct.F | 4 +- src/qs_vxc.F | 39 +- src/qs_wf_history_methods.F | 10 +- src/qs_wf_history_types.F | 5 +- src/response_solver.F | 47 +- src/ri_environment_methods.F | 6 +- src/rpa_gw.F | 18 +- src/rpa_im_time_force_methods.F | 62 +- src/rtp_admm_methods.F | 6 +- src/spme.F | 31 +- src/stm_images.F | 11 +- src/surface_dipole.F | 4 +- src/tip_scan_methods.F | 18 +- src/tip_scan_types.F | 5 +- src/transport.F | 12 +- src/xc/xc.F | 69 +- src/xc/xc_fxc_kernel.F | 15 +- src/xc/xc_rho_set_types.F | 22 +- src/xc/xc_util.F | 281 +-- src/xc_pot_saop.F | 11 +- src/xray_diffraction.F | 26 +- 116 files changed, 1616 insertions(+), 3590 deletions(-) diff --git a/src/admm_dm_methods.F b/src/admm_dm_methods.F index 6d1ed248ab..8c7331efed 100644 --- a/src/admm_dm_methods.F +++ b/src/admm_dm_methods.F @@ -27,7 +27,8 @@ MODULE admm_dm_methods do_admm_blocked_projection USE iterate_matrix, ONLY: invert_Hotelling USE kinds, ONLY: dp - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_collocate_density, ONLY: calculate_rho_elec USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -237,7 +238,8 @@ SUBROUTINE update_rho_aux(qs_env) TYPE(admm_dm_type), POINTER :: admm_dm TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_aux TYPE(dft_control_type), POINTER :: dft_control - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g_aux, rho_r_aux + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g_aux + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r_aux TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho_aux TYPE(task_list_type), POINTER :: task_list_aux_fit diff --git a/src/admm_methods.F b/src/admm_methods.F index d1c27d04c0..df044cb410 100644 --- a/src/admm_methods.F +++ b/src/admm_methods.F @@ -90,7 +90,8 @@ MODULE admm_methods z_zero USE message_passing, ONLY: mp_para_env_type USE parallel_gemm_api, ONLY: parallel_gemm - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_collocate_density, ONLY: calculate_rho_elec USE qs_energy_types, ONLY: qs_energy_type USE qs_environment_types, ONLY: get_qs_env,& @@ -160,7 +161,8 @@ SUBROUTINE admm_mo_calc_rho_aux(qs_env) TYPE(dft_control_type), POINTER :: dft_control TYPE(mo_set_type), DIMENSION(:), POINTER :: mos, mos_aux_fit TYPE(mp_para_env_type), POINTER :: para_env - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g_aux, rho_r_aux + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g_aux + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r_aux TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho, rho_aux_fit TYPE(task_list_type), POINTER :: task_list @@ -320,7 +322,8 @@ SUBROUTINE admm_mo_calc_rho_aux_kp(qs_env) TYPE(mp_para_env_type), POINTER :: para_env TYPE(neighbor_list_set_p_type), DIMENSION(:), & POINTER :: sab_aux_fit, sab_kp - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g_aux, rho_r_aux + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g_aux + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r_aux TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho_aux_fit, rho_orb TYPE(qs_scf_env_type), POINTER :: scf_env @@ -2398,8 +2401,8 @@ SUBROUTINE calc_spin_dep_aux_exch_ener(qs_env, admm_env, ener_k_ispin, ener_x_is TYPE(dft_control_type), POINTER :: dft_control TYPE(local_rho_type), POINTER :: local_rho_buffer TYPE(mp_para_env_type), POINTER :: para_env - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r, v_rspace_dummy, & - v_tau_rspace_dummy + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, v_rspace_dummy, v_tau_rspace_dummy TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho_aux_fit, rho_aux_fit_buffer TYPE(section_vals_type), POINTER :: xc_section_aux diff --git a/src/cp_ddapc.F b/src/cp_ddapc.F index 89b5785d24..783745f837 100644 --- a/src/cp_ddapc.F +++ b/src/cp_ddapc.F @@ -42,10 +42,10 @@ MODULE cp_ddapc pw_transfer,& pw_zero USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_energy_types, ONLY: qs_energy_type USE qs_environment_types, ONLY: get_qs_env,& @@ -84,7 +84,7 @@ SUBROUTINE qs_ks_ddapc(qs_env, auxbas_pw_pool, rho_tot_gspace, v_hartree_gspace, TYPE(qs_environment_type), POINTER :: qs_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), INTENT(IN) :: rho_tot_gspace, v_hartree_gspace + TYPE(pw_c1d_type), INTENT(IN) :: rho_tot_gspace, v_hartree_gspace TYPE(pw_type), POINTER :: v_spin_ddapc_rest_r TYPE(qs_energy_type), POINTER :: energy LOGICAL, INTENT(in) :: calculate_forces @@ -99,7 +99,7 @@ SUBROUTINE qs_ks_ddapc(qs_env, auxbas_pw_pool, rho_tot_gspace, v_hartree_gspace, TYPE(cp_logger_type), POINTER :: logger TYPE(ddapc_restraint_type), POINTER :: ddapc_restraint_control TYPE(dft_control_type), POINTER :: dft_control - TYPE(pw_type) :: v_spin_ddapc_rest_g + TYPE(pw_c1d_type) :: v_spin_ddapc_rest_g TYPE(pw_type), POINTER :: v_hartree_rspace NULLIFY (v_hartree_rspace, dft_control) @@ -138,7 +138,7 @@ SUBROUTINE qs_ks_ddapc(qs_env, auxbas_pw_pool, rho_tot_gspace, v_hartree_gspace, dft_control%qs_control%ddapc_restraint_is_spin = ddapc_restraint_is_spin IF (explicit_potential) THEN CALL auxbas_pw_pool%create_pw(v_spin_ddapc_rest_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_zero(v_spin_ddapc_rest_g) NULLIFY (v_spin_ddapc_rest_r) ALLOCATE (v_spin_ddapc_rest_r) @@ -229,9 +229,9 @@ END SUBROUTINE qs_ks_ddapc SUBROUTINE cp_ddapc_apply_CD(qs_env, rho_tot_gspace, energy, v_hartree_gspace, & calculate_forces, Itype_of_density) TYPE(qs_environment_type), POINTER :: qs_env - TYPE(pw_type), INTENT(IN) :: rho_tot_gspace + TYPE(pw_c1d_type), INTENT(IN) :: rho_tot_gspace REAL(KIND=dp), INTENT(INOUT) :: energy - TYPE(pw_type), INTENT(IN) :: v_hartree_gspace + TYPE(pw_c1d_type), INTENT(IN) :: v_hartree_gspace LOGICAL, INTENT(IN), OPTIONAL :: calculate_forces CHARACTER(LEN=*) :: Itype_of_density @@ -364,7 +364,7 @@ SUBROUTINE cp_ddapc_apply_RS(qs_env, energy_res, v_hartree_gspace, & v_spin_ddapc_rest_g, ddapc_restraint_control, calculate_forces) TYPE(qs_environment_type), POINTER :: qs_env REAL(KIND=dp), INTENT(INOUT), OPTIONAL :: energy_res - TYPE(pw_type), INTENT(IN) :: v_hartree_gspace, v_spin_ddapc_rest_g + TYPE(pw_c1d_type), INTENT(IN) :: v_hartree_gspace, v_spin_ddapc_rest_g TYPE(ddapc_restraint_type), POINTER :: ddapc_restraint_control LOGICAL, INTENT(IN), OPTIONAL :: calculate_forces @@ -467,9 +467,9 @@ END SUBROUTINE cp_ddapc_apply_RS SUBROUTINE cp_ddapc_apply_RF(qs_env, rho_tot_gspace, energy, & v_hartree_gspace, calculate_forces, Itype_of_density) TYPE(qs_environment_type), POINTER :: qs_env - TYPE(pw_type), INTENT(IN) :: rho_tot_gspace + TYPE(pw_c1d_type), INTENT(IN) :: rho_tot_gspace REAL(KIND=dp), INTENT(INOUT) :: energy - TYPE(pw_type), INTENT(IN) :: v_hartree_gspace + TYPE(pw_c1d_type), INTENT(IN) :: v_hartree_gspace LOGICAL, INTENT(IN), OPTIONAL :: calculate_forces CHARACTER(LEN=*) :: Itype_of_density diff --git a/src/cp_ddapc_methods.F b/src/cp_ddapc_methods.F index b88e7399d9..38a0e3478d 100644 --- a/src/cp_ddapc_methods.F +++ b/src/cp_ddapc_methods.F @@ -28,7 +28,8 @@ MODULE cp_ddapc_methods USE message_passing, ONLY: mp_para_env_type USE particle_types, ONLY: particle_type USE pw_spline_utils, ONLY: Eval_Interp_Spl3_pbc - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE spherical_harmonics, ONLY: legendre #include "./base/base_uses.f90" @@ -61,7 +62,7 @@ SUBROUTINE ddapc_eval_gfunc(gfunc, w, gcut, rho_tot_g, radii) REAL(KIND=dp), DIMENSION(:, :), POINTER :: gfunc REAL(kind=dp), DIMENSION(:), POINTER :: w REAL(KIND=dp), INTENT(IN) :: gcut - TYPE(pw_type), INTENT(IN) :: rho_tot_g + TYPE(pw_c1d_type), INTENT(IN) :: rho_tot_g REAL(kind=dp), DIMENSION(:), POINTER :: radii CHARACTER(len=*), PARAMETER :: routineN = 'ddapc_eval_gfunc' @@ -114,7 +115,7 @@ SUBROUTINE build_b_vector(bv, gfunc, w, particle_set, radii, rho_tot_g, gcut) REAL(KIND=dp), DIMENSION(:), POINTER :: w TYPE(particle_type), DIMENSION(:), POINTER :: particle_set REAL(KIND=dp), DIMENSION(:), POINTER :: radii - TYPE(pw_type), INTENT(IN) :: rho_tot_g + TYPE(pw_c1d_type), INTENT(IN) :: rho_tot_g REAL(KIND=dp), INTENT(IN) :: gcut CHARACTER(len=*), PARAMETER :: routineN = 'build_b_vector' @@ -147,7 +148,7 @@ SUBROUTINE build_b_vector(bv, gfunc, w, particle_set, radii, rho_tot_g, gcut) gvec = rho_tot_g%pw_grid%g(:, ig) arg = DOT_PRODUCT(gvec, rvec) phase = CMPLX(COS(arg), -SIN(arg), KIND=dp) - my_bv(ig) = w(ig)*REAL(CONJG(rho_tot_g%cc(ig))*phase, KIND=dp) + my_bv(ig) = w(ig)*REAL(CONJG(rho_tot_g%array(ig))*phase, KIND=dp) END DO DO igauss = 1, SIZE(radii) idim = (iparticle - 1)*SIZE(radii) + igauss @@ -192,7 +193,7 @@ SUBROUTINE build_A_matrix(Am, gfunc, w, particle_set, radii, rho_tot_g, gcut, g_ REAL(KIND=dp), DIMENSION(:), POINTER :: w TYPE(particle_type), DIMENSION(:), POINTER :: particle_set REAL(KIND=dp), DIMENSION(:), POINTER :: radii - TYPE(pw_type), INTENT(IN) :: rho_tot_g + TYPE(pw_c1d_type), INTENT(IN) :: rho_tot_g REAL(KIND=dp), INTENT(IN) :: gcut REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: g_dot_rvec_sin, g_dot_rvec_cos @@ -278,7 +279,7 @@ SUBROUTINE build_der_b_vector(dbv, gfunc, w, particle_set, radii, rho_tot_g, gcu REAL(KIND=dp), DIMENSION(:), POINTER :: w TYPE(particle_type), DIMENSION(:), POINTER :: particle_set REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: radii - TYPE(pw_type), INTENT(IN) :: rho_tot_g + TYPE(pw_c1d_type), INTENT(IN) :: rho_tot_g REAL(KIND=dp), INTENT(IN) :: gcut INTEGER, INTENT(IN) :: iparticle0 @@ -312,7 +313,7 @@ SUBROUTINE build_der_b_vector(dbv, gfunc, w, particle_set, radii, rho_tot_g, gcu gvec = rho_tot_g%pw_grid%g(:, ig) arg = DOT_PRODUCT(gvec, rvec) dphase = -CMPLX(SIN(arg), COS(arg), KIND=dp) - my_dbv(:, ig) = w(ig)*REAL(CONJG(rho_tot_g%cc(ig))*dphase, KIND=dp)*gvec(:) + my_dbv(:, ig) = w(ig)*REAL(CONJG(rho_tot_g%array(ig))*dphase, KIND=dp)*gvec(:) END DO DO igauss = 1, SIZE(radii) idim = (iparticle - 1)*SIZE(radii) + igauss @@ -370,7 +371,7 @@ SUBROUTINE build_der_A_matrix_rows(dAm, gfunc, w, particle_set, radii, & REAL(KIND=dp), DIMENSION(:), POINTER :: w TYPE(particle_type), DIMENSION(:), POINTER :: particle_set REAL(KIND=dp), DIMENSION(:), POINTER :: radii - TYPE(pw_type), INTENT(IN) :: rho_tot_g + TYPE(pw_c1d_type), INTENT(IN) :: rho_tot_g REAL(KIND=dp), INTENT(IN) :: gcut INTEGER, INTENT(IN) :: iparticle0, nparticles REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: g_dot_rvec_sin, g_dot_rvec_cos @@ -488,7 +489,7 @@ END SUBROUTINE cleanup_g_dot_rvec_sin_cos !> \param g_dot_rvec_cos ... ! ************************************************************************************************** SUBROUTINE prep_g_dot_rvec_sin_cos(rho_tot_g, particle_set, gcut, g_dot_rvec_sin, g_dot_rvec_cos) - TYPE(pw_type), INTENT(IN) :: rho_tot_g + TYPE(pw_c1d_type), INTENT(IN) :: rho_tot_g TYPE(particle_type), DIMENSION(:), POINTER :: particle_set REAL(KIND=dp), INTENT(IN) :: gcut REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: g_dot_rvec_sin, g_dot_rvec_cos @@ -546,7 +547,7 @@ SUBROUTINE ddapc_eval_AmI(GAmI, c0, gfunc, w, particle_set, gcut, & REAL(KIND=dp), DIMENSION(:), POINTER :: w TYPE(particle_type), DIMENSION(:), POINTER :: particle_set REAL(KIND=dp), INTENT(IN) :: gcut - TYPE(pw_type), INTENT(IN) :: rho_tot_g + TYPE(pw_c1d_type), INTENT(IN) :: rho_tot_g REAL(KIND=dp), DIMENSION(:), POINTER :: radii INTEGER, INTENT(IN) :: iw REAL(KIND=dp), INTENT(IN) :: Vol diff --git a/src/cp_ddapc_types.F b/src/cp_ddapc_types.F index afeaad65a1..18ccacee97 100644 --- a/src/cp_ddapc_types.F +++ b/src/cp_ddapc_types.F @@ -35,7 +35,8 @@ MODULE cp_ddapc_types USE pw_poisson_types, ONLY: pw_poisson_multipole USE pw_pool_types, ONLY: pw_pool_release,& pw_pool_type - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type #include "./base/base_uses.f90" IMPLICIT NONE @@ -101,7 +102,7 @@ SUBROUTINE cp_ddapc_create(cp_para_env, cp_ddapc_env, cp_ddapc_ewald, & TYPE(particle_type), DIMENSION(:), POINTER :: particle_set REAL(kind=dp), DIMENSION(:), POINTER :: radii TYPE(cell_type), POINTER :: cell, super_cell - TYPE(pw_type), INTENT(IN) :: rho_tot_g + TYPE(pw_c1d_type), INTENT(IN) :: rho_tot_g REAL(KIND=dp), INTENT(IN) :: gcut INTEGER, INTENT(IN) :: iw2 REAL(KIND=dp), INTENT(IN) :: Vol diff --git a/src/cp_ddapc_util.F b/src/cp_ddapc_util.F index b427b7ac99..e16453282e 100644 --- a/src/cp_ddapc_util.F +++ b/src/cp_ddapc_util.F @@ -47,8 +47,7 @@ MODULE cp_ddapc_util pw_copy,& pw_transfer USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - RECIPROCALSPACE,& + USE pw_types, ONLY: RECIPROCALSPACE,& pw_c1d_type,& pw_type USE qs_charges_types, ONLY: qs_charges_type @@ -92,9 +91,9 @@ SUBROUTINE cp_ddapc_init(qs_env) TYPE(dft_control_type), POINTER :: dft_control TYPE(mp_para_env_type), POINTER :: para_env TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: rho_tot_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pool - TYPE(pw_type) :: rho_tot_g TYPE(qs_charges_type), POINTER :: qs_charges TYPE(qs_rho_type), POINTER :: rho TYPE(section_vals_type), POINTER :: density_fit_section @@ -135,8 +134,7 @@ SUBROUTINE cp_ddapc_init(qs_env) WRITE (iw, '(/,A)') " Initializing the DDAPC Environment" END IF CALL pw_env_get(pw_env=pw_env, auxbas_pw_pool=auxbas_pool) - CALL auxbas_pool%create_pw(rho_tot_g, in_space=RECIPROCALSPACE, & - use_data=COMPLEXDATA1D) + CALL auxbas_pool%create_pw(rho_tot_g, in_space=RECIPROCALSPACE) Vol = rho_tot_g%pw_grid%vol ! ! Get Input Parameters @@ -210,7 +208,7 @@ RECURSIVE SUBROUTINE get_ddapc(qs_env, calc_force, density_fit_section, & REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: qout1, qout2, out_radii REAL(KIND=dp), DIMENSION(:, :, :), OPTIONAL, & POINTER :: dq_out - TYPE(pw_type), INTENT(IN), OPTIONAL :: ext_rho_tot_g + TYPE(pw_c1d_type), INTENT(IN), OPTIONAL :: ext_rho_tot_g CHARACTER(LEN=*), OPTIONAL :: Itype_of_density INTEGER, INTENT(IN), OPTIONAL :: iwc @@ -233,12 +231,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_c1d_type) :: rho_tot_g + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_c1d_type), POINTER :: rho0_s_gs, 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 + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r TYPE(qs_charges_type), POINTER :: qs_charges TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_rho_type), POINTER :: rho @@ -277,8 +275,7 @@ RECURSIVE SUBROUTINE get_ddapc(qs_env, calc_force, density_fit_section, & END IF CALL pw_env_get(pw_env=pw_env, & auxbas_pw_pool=auxbas_pool) - CALL auxbas_pool%create_pw(rho_tot_g, in_space=RECIPROCALSPACE, & - use_data=COMPLEXDATA1D) + CALL auxbas_pool%create_pw(rho_tot_g, in_space=RECIPROCALSPACE) IF (PRESENT(ext_rho_tot_g)) THEN ! If provided use the input density in g-space CALL pw_transfer(ext_rho_tot_g, rho_tot_g) @@ -311,7 +308,7 @@ RECURSIVE SUBROUTINE get_ddapc(qs_env, calc_force, density_fit_section, & Vol = rho_r(1)%pw_grid%vol ch_dens = 0.0_dp ! should use pw_integrate - IF (rho_tot_g%pw_grid%have_g0) ch_dens = REAL(rho_tot_g%cc(1), KIND=dp) + IF (rho_tot_g%pw_grid%have_g0) ch_dens = REAL(rho_tot_g%array(1), KIND=dp) CALL logger%para_env%sum(ch_dens) ! ! Get Input Parameters @@ -536,7 +533,7 @@ END SUBROUTINE get_ddapc SUBROUTINE restraint_functional_potential(v_hartree_gspace, & density_fit_section, particle_set, AmI, radii, charges, & ddapc_restraint_control, energy_res) - TYPE(pw_type), INTENT(IN) :: v_hartree_gspace + TYPE(pw_c1d_type), INTENT(IN) :: v_hartree_gspace TYPE(section_vals_type), POINTER :: density_fit_section TYPE(particle_type), DIMENSION(:), POINTER :: particle_set REAL(KIND=dp), DIMENSION(:, :), POINTER :: AmI @@ -571,7 +568,7 @@ SUBROUTINE restraint_functional_potential(v_hartree_gspace, & fac2 = DOT_PRODUCT(cv, MATMUL(AmI, uv)) cv(:) = uv - cv*fac2/fac cv(:) = MATMUL(AmI, cv) - IF (pw_grid%have_g0) v_hartree_gspace%cc(1) = v_hartree_gspace%cc(1) + sfac*fac2/fac + IF (pw_grid%have_g0) v_hartree_gspace%array(1) = v_hartree_gspace%array(1) + sfac*fac2/fac DO ig = pw_grid%first_gne0, pw_grid%ngpts_cut_local g2 = pw_grid%gsq(ig) w = 4.0_dp*pi*(g2 - gcut2)**2.0_dp/(g2*gcut2) @@ -592,7 +589,7 @@ SUBROUTINE restraint_functional_potential(v_hartree_gspace, & END DO END DO g_corr = g_corr*w - v_hartree_gspace%cc(ig) = v_hartree_gspace%cc(ig) + sfac*g_corr/Vol + v_hartree_gspace%array(ig) = v_hartree_gspace%array(ig) + sfac*g_corr/Vol END DO END ASSOCIATE CALL timestop(handle) @@ -613,7 +610,7 @@ END SUBROUTINE restraint_functional_potential ! ************************************************************************************************** SUBROUTINE modify_hartree_pot(v_hartree_gspace, density_fit_section, & particle_set, M, AmI, radii, charges) - TYPE(pw_type), INTENT(IN) :: v_hartree_gspace + TYPE(pw_c1d_type), INTENT(IN) :: v_hartree_gspace TYPE(section_vals_type), POINTER :: density_fit_section TYPE(particle_type), DIMENSION(:), POINTER :: particle_set REAL(KIND=dp), DIMENSION(:, :), POINTER :: M, AmI @@ -641,7 +638,7 @@ SUBROUTINE modify_hartree_pot(v_hartree_gspace, density_fit_section, & fac2 = DOT_PRODUCT(cv, MATMUL(AmI, uv)) cv(:) = uv - cv*fac2/fac cv(:) = MATMUL(AmI, cv) - IF (pw_grid%have_g0) v_hartree_gspace%cc(1) = v_hartree_gspace%cc(1) + sfac*fac2/fac + IF (pw_grid%have_g0) v_hartree_gspace%array(1) = v_hartree_gspace%array(1) + sfac*fac2/fac DO ig = pw_grid%first_gne0, pw_grid%ngpts_cut_local g2 = pw_grid%gsq(ig) w = 4.0_dp*pi*(g2 - gcut2)**2.0_dp/(g2*gcut2) @@ -662,7 +659,7 @@ SUBROUTINE modify_hartree_pot(v_hartree_gspace, density_fit_section, & END DO END DO g_corr = g_corr*w - v_hartree_gspace%cc(ig) = v_hartree_gspace%cc(ig) + sfac*g_corr/Vol + v_hartree_gspace%array(ig) = v_hartree_gspace%array(ig) + sfac*g_corr/Vol END DO END ASSOCIATE CALL timestop(handle) @@ -688,7 +685,7 @@ SUBROUTINE debug_der_b_vector(dbv, particle_set, radii, & REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: dbv TYPE(particle_type), DIMENSION(:), POINTER :: particle_set REAL(KIND=dp), DIMENSION(:), POINTER :: radii - TYPE(pw_type), INTENT(IN) :: rho_tot_g + TYPE(pw_c1d_type), INTENT(IN) :: rho_tot_g REAL(KIND=dp), INTENT(IN) :: gcut INTEGER, INTENT(in) :: iparticle REAL(KIND=dp), INTENT(IN) :: Vol @@ -761,7 +758,7 @@ SUBROUTINE debug_der_A_matrix(dAm, particle_set, radii, & REAL(KIND=dp), DIMENSION(:, :, :), INTENT(IN) :: dAm TYPE(particle_type), DIMENSION(:), POINTER :: particle_set REAL(KIND=dp), DIMENSION(:), POINTER :: radii - TYPE(pw_type), INTENT(IN) :: rho_tot_g + TYPE(pw_c1d_type), INTENT(IN) :: rho_tot_g REAL(KIND=dp), INTENT(IN) :: gcut INTEGER, INTENT(in) :: iparticle REAL(KIND=dp), INTENT(IN) :: Vol @@ -843,7 +840,7 @@ SUBROUTINE debug_charge(dqv, qs_env, density_fit_section, & TYPE(section_vals_type), POINTER :: density_fit_section TYPE(particle_type), DIMENSION(:), POINTER :: particle_set REAL(KIND=dp), DIMENSION(:), POINTER :: radii - TYPE(pw_type), INTENT(IN) :: rho_tot_g + TYPE(pw_c1d_type), INTENT(IN) :: rho_tot_g CHARACTER(LEN=*) :: type_of_density CHARACTER(len=*), PARAMETER :: routineN = 'debug_charge' diff --git a/src/dm_ls_scf_qs.F b/src/dm_ls_scf_qs.F index 6b98a1904a..9f49427700 100644 --- a/src/dm_ls_scf_qs.F +++ b/src/dm_ls_scf_qs.F @@ -43,10 +43,10 @@ MODULE dm_ls_scf_qs USE pw_methods, ONLY: pw_zero USE pw_pool_types, ONLY: pw_pool_p_type,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: 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 @@ -638,10 +638,11 @@ SUBROUTINE write_matrix_to_cube(qs_env, ls_scf_env, matrix_p_ls, unit_nr, title, TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks TYPE(dbcsr_type), TARGET :: matrix_p_qs TYPE(particle_list_type), POINTER :: particles + TYPE(pw_c1d_type) :: wf_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: wf_g, wf_r + TYPE(pw_type) :: wf_r TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_subsys_type), POINTER :: subsys @@ -671,7 +672,6 @@ SUBROUTINE write_matrix_to_cube(qs_env, ls_scf_env, matrix_p_ls, unit_nr, title, in_space=REALSPACE) CALL pw_zero(wf_r) CALL auxbas_pw_pool%create_pw(pw=wf_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_zero(wf_g) CALL calculate_rho_elec(matrix_p=matrix_p_qs, & diff --git a/src/ec_methods.F b/src/ec_methods.F index 384371c2ef..70223faaa8 100644 --- a/src/ec_methods.F +++ b/src/ec_methods.F @@ -31,7 +31,8 @@ MODULE ec_methods USE pw_env_types, ONLY: pw_env_get,& pw_env_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type,& set_qs_env @@ -88,7 +89,10 @@ SUBROUTINE create_kernel(qs_env, vxc, vxc_tau, rho, rho1_r, rho1_g, tau1_r, xc_s TYPE(qs_environment_type), POINTER :: qs_env TYPE(pw_type), DIMENSION(:), POINTER :: vxc, vxc_tau TYPE(qs_rho_type), INTENT(IN), POINTER :: rho - TYPE(pw_type), DIMENSION(:), INTENT(IN), POINTER :: rho1_r, rho1_g, tau1_r + TYPE(pw_type), DIMENSION(:), INTENT(IN), POINTER :: rho1_r + TYPE(pw_c1d_type), DIMENSION(:), INTENT(IN), & + POINTER :: rho1_g + TYPE(pw_type), DIMENSION(:), INTENT(IN), POINTER :: tau1_r TYPE(section_vals_type), INTENT(IN), POINTER :: xc_section LOGICAL, INTENT(IN), OPTIONAL :: compute_virial REAL(KIND=dp), DIMENSION(3, 3), INTENT(INOUT), & diff --git a/src/ec_orth_solver.F b/src/ec_orth_solver.F index c80a600f3d..32ffdbd4d5 100644 --- a/src/ec_orth_solver.F +++ b/src/ec_orth_solver.F @@ -52,10 +52,10 @@ MODULE ec_orth_solver USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_p_type,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -1134,14 +1134,14 @@ SUBROUTINE hessian_op2(qs_env, p_env, matrix_Ax, matrix_p, matrix_s_sqrt_inv, ep TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_G, matrix_s, rho1_ao, rho_ao TYPE(dft_control_type), POINTER :: dft_control TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type) :: rho_tot_gspace, v_hartree_gspace + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho1_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho_tot_gspace, v_hartree_gspace, & - v_hartree_rspace - TYPE(pw_type), DIMENSION(:), POINTER :: rho1_g, rho1_r, rho_r, tau1_r, v_xc, & - v_xc_tau + TYPE(pw_type) :: v_hartree_rspace + TYPE(pw_type), DIMENSION(:), POINTER :: rho1_r, rho_r, tau1_r, v_xc, v_xc_tau TYPE(qs_kpp1_env_type), POINTER :: kpp1_env TYPE(qs_rho_type), POINTER :: rho, rho_aux TYPE(section_vals_type), POINTER :: input, xc_section, xc_section_aux @@ -1181,10 +1181,8 @@ SUBROUTINE hessian_op2(qs_env, p_env, matrix_Ax, matrix_p, matrix_s_sqrt_inv, ep ! Calculate the NSC Hartree potential CALL auxbas_pw_pool%create_pw(pw=v_hartree_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(pw=rho_tot_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(pw=v_hartree_rspace, & use_data=REALDATA3D, & diff --git a/src/ed_analysis.F b/src/ed_analysis.F index cd19a2134d..5167bcc7e9 100644 --- a/src/ed_analysis.F +++ b/src/ed_analysis.F @@ -65,10 +65,10 @@ MODULE ed_analysis USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_rho_core USE qs_core_energies, ONLY: calculate_ecore_alpha,& @@ -916,11 +916,11 @@ SUBROUTINE vh_ewald_correction(qs_env, ealpha, vh_mat, atewd) TYPE(neighbor_list_set_p_type), DIMENSION(:), & POINTER :: sab_orb, sac_ae TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: rho_tot_ewd_g, v_hewd_gspace TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho_tot_ewd_g, rho_tot_ewd_r, & - v_hewd_gspace, v_hewd_rspace + TYPE(pw_type) :: rho_tot_ewd_r, v_hewd_rspace TYPE(pw_type), DIMENSION(:), POINTER :: rho_r TYPE(pw_type), POINTER :: v_hartree_rspace TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set @@ -944,11 +944,11 @@ SUBROUTINE vh_ewald_correction(qs_env, ealpha, vh_mat, atewd) poisson_env=poisson_env) ! CALL auxbas_pw_pool%create_pw(v_hewd_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_hewd_rspace, & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rho_tot_ewd_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(rho_tot_ewd_r, & use_data=REALDATA3D, in_space=REALSPACE) rhotot = 0.0_dp diff --git a/src/emd/rt_propagation_output.F b/src/emd/rt_propagation_output.F index f59abbe154..5fee5e3325 100644 --- a/src/emd/rt_propagation_output.F +++ b/src/emd/rt_propagation_output.F @@ -61,10 +61,10 @@ MODULE rt_propagation_output pw_env_type USE pw_methods, ONLY: pw_zero USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_energy_types, ONLY: qs_energy_type USE qs_environment_types, ONLY: get_qs_env,& @@ -704,9 +704,10 @@ SUBROUTINE rt_current(qs_env, P_im, dft_section, spin, nspin) TYPE(current_env_type) :: current_env TYPE(dbcsr_type), POINTER :: tmp, zero TYPE(particle_list_type), POINTER :: particles + TYPE(pw_c1d_type) :: gs TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: gs, rs + TYPE(pw_type) :: rs TYPE(qs_subsys_type), POINTER :: subsys CALL timeset(routineN, handle) @@ -729,7 +730,7 @@ SUBROUTINE rt_current(qs_env, P_im, dft_section, spin, nspin) current_env%gauge = -1 current_env%gauge_init = .FALSE. CALL auxbas_pw_pool%create_pw(rs, use_data=REALDATA3D, in_space=REALSPACE) - CALL auxbas_pw_pool%create_pw(gs, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(gs, in_space=RECIPROCALSPACE) NULLIFY (stride) ALLOCATE (stride(3)) diff --git a/src/emd/rt_propagation_utils.F b/src/emd/rt_propagation_utils.F index c634a5cc5c..af2acbf10e 100644 --- a/src/emd/rt_propagation_utils.F +++ b/src/emd/rt_propagation_utils.F @@ -63,10 +63,10 @@ MODULE rt_propagation_utils pw_zero USE pw_pool_types, ONLY: pw_pool_p_type,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_wavefunction USE qs_density_matrices, ONLY: calculate_density_matrix @@ -743,10 +743,11 @@ SUBROUTINE write_rtp_mo_cubes(qs_env, rtp) TYPE(mp_para_env_type), POINTER :: para_env TYPE(particle_list_type), POINTER :: particles TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: wf_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: density_r, wf_g, wf_r + TYPE(pw_type) :: density_r, wf_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_subsys_type), POINTER :: subsys TYPE(section_vals_type), POINTER :: dft_section, input @@ -795,7 +796,6 @@ SUBROUTINE write_rtp_mo_cubes(qs_env, rtp) use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(wf_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(density_r, & use_data=REALDATA3D, & diff --git a/src/energy_corrections.F b/src/energy_corrections.F index c03c6ba182..b1dccf56ba 100644 --- a/src/energy_corrections.F +++ b/src/energy_corrections.F @@ -127,8 +127,7 @@ MODULE energy_corrections USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_p_type,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& pw_c1d_type,& @@ -628,12 +627,12 @@ SUBROUTINE ec_dc_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) :: rho_tot_gspace, v_hartree_gspace TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_grid_type), POINTER :: pw_grid TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho_tot_gspace, v_hartree_gspace, & - v_hartree_rspace + TYPE(pw_type) :: v_hartree_rspace TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, v_rspace, v_rspace_in, & v_tau_rspace TYPE(qs_force_type), DIMENSION(:), POINTER :: force @@ -688,9 +687,9 @@ SUBROUTINE ec_dc_build_ks_matrix_force(qs_env, ec_env) ! Calculate the Hartree potential CALL auxbas_pw_pool%create_pw(v_hartree_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(rho_tot_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_hartree_rspace, & use_data=REALDATA3D, in_space=REALSPACE) @@ -1717,16 +1716,17 @@ 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) :: rho_tot_gspace, rhodn_tot_gspace, & + v_hartree_gspace + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g, rhoout_g 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 - TYPE(pw_type) :: dv_hartree_rspace, rho_tot_gspace, & - rhodn_tot_gspace, v_hartree_gspace, & - v_hartree_rspace, vtot_rspace - 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) :: dv_hartree_rspace, v_hartree_rspace, & + vtot_rspace + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, rhoout_r, tau_r, tauout_r, & + v_rspace, v_tau_rspace, v_xc, v_xc_tau TYPE(qs_force_type), DIMENSION(:), POINTER :: force TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho @@ -1779,9 +1779,9 @@ SUBROUTINE ec_build_ks_matrix_force(qs_env, ec_env) ! Calculate the Hartree potential CALL auxbas_pw_pool%create_pw(v_hartree_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(rhodn_tot_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_hartree_rspace, & use_data=REALDATA3D, in_space=REALSPACE) @@ -1797,7 +1797,7 @@ SUBROUTINE ec_build_ks_matrix_force(qs_env, ec_env) CALL auxbas_pw_pool%create_pw(rhoout_r(ispin), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rhoout_g(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO CALL auxbas_pw_pool%create_pw(dv_hartree_rspace, & use_data=REALDATA3D, in_space=REALSPACE) @@ -1824,14 +1824,14 @@ SUBROUTINE ec_build_ks_matrix_force(qs_env, ec_env) NULLIFY (tauout_r) IF (dft_control%use_kinetic_energy_density) THEN BLOCK - TYPE(pw_type) :: tauout_g + TYPE(pw_c1d_type) :: tauout_g ALLOCATE (tauout_r(nspins)) DO ispin = 1, nspins CALL auxbas_pw_pool%create_pw(tauout_r(ispin), & use_data=REALDATA3D, in_space=REALSPACE) END DO CALL auxbas_pw_pool%create_pw(tauout_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) DO ispin = 1, nspins CALL calculate_rho_elec(ks_env=ks_env, matrix_p=ec_env%matrix_p(ispin, 1)%matrix, & @@ -1850,7 +1850,7 @@ SUBROUTINE ec_build_ks_matrix_force(qs_env, ec_env) ! Calculate the Hartree potential CALL auxbas_pw_pool%create_pw(rho_tot_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) ! Get the total input density in g-space [ions + electrons] CALL calc_rho_tot_gspace(rho_tot_gspace, qs_env, rho) diff --git a/src/et_coupling_proj.F b/src/et_coupling_proj.F index 2bf2d08f71..e960d64bfa 100644 --- a/src/et_coupling_proj.F +++ b/src/et_coupling_proj.F @@ -62,10 +62,10 @@ MODULE et_coupling_proj pw_env_type USE pw_pool_types, ONLY: pw_pool_p_type,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_wavefunction USE qs_environment_types, ONLY: get_qs_env,& @@ -1308,10 +1308,11 @@ SUBROUTINE save_mo_cube(qs_env, logger, input, mo, ib, im, is) TYPE(dft_control_type), POINTER :: dft_control TYPE(particle_list_type), POINTER :: particles TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: wf_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: wf_g, wf_r + TYPE(pw_type) :: wf_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_subsys_type), POINTER :: subsys @@ -1349,7 +1350,7 @@ SUBROUTINE save_mo_cube(qs_env, logger, input, mo, ib, im, is) CALL auxbas_pw_pool%create_pw(wf_r, & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(wf_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) ! Calculate the grid values CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, qs_kind_set=qs_kind_set, & diff --git a/src/ewald_methods_tb.F b/src/ewald_methods_tb.F index ee59ccc7d4..338a00ab10 100644 --- a/src/ewald_methods_tb.F +++ b/src/ewald_methods_tb.F @@ -41,10 +41,10 @@ MODULE ewald_methods_tb USE pw_poisson_types, ONLY: greens_fn_type,& pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_neighbor_list_types, ONLY: get_iterator_info,& neighbor_list_iterate,& @@ -115,11 +115,12 @@ SUBROUTINE tb_spme_evaluate(ewald_env, ewald_pw, particle_set, box, & TYPE(greens_fn_type), POINTER :: green TYPE(mp_comm_type) :: group TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type), DIMENSION(3) :: dphi_g + TYPE(pw_c1d_type), POINTER :: phi_g, phib_g, rhob_g TYPE(pw_grid_type), POINTER :: grid_spme TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: pw_pool - TYPE(pw_type), DIMENSION(3) :: dphi_g - TYPE(pw_type), POINTER :: phi_g, phib_g, rhob_g, rhob_r + TYPE(pw_type), POINTER :: rhob_r TYPE(realspace_grid_desc_type), POINTER :: rs_desc TYPE(realspace_grid_type) :: rden, rpot TYPE(realspace_grid_type), ALLOCATABLE, & @@ -175,7 +176,7 @@ SUBROUTINE tb_spme_evaluate(ewald_env, ewald_pw, particle_set, box, & ! transform density to G space and add charge function NULLIFY (rhob_g) ALLOCATE (rhob_g) - CALL pw_pool%create_pw(rhob_g, use_data=COMPLEXDATA1D, & + CALL pw_pool%create_pw(rhob_g, & in_space=RECIPROCALSPACE) CALL pw_transfer(rhob_r, rhob_g) ! update charge function @@ -186,12 +187,12 @@ SUBROUTINE tb_spme_evaluate(ewald_env, ewald_pw, particle_set, box, & ! allocate intermediate arrays DO i = 1, 3 CALL pw_pool%create_pw(dphi_g(i), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO NULLIFY (phi_g) ALLOCATE (phi_g) CALL pw_pool%create_pw(phi_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) IF (use_virial) THEN CALL pw_poisson_solve(poisson_env, rhob_g, vgc, phi_g, dphi_g, h_stress=h_stress) ELSE @@ -227,15 +228,15 @@ SUBROUTINE tb_spme_evaluate(ewald_env, ewald_pw, particle_set, box, & NULLIFY (phib_g) ALLOCATE (phib_g) CALL pw_pool%create_pw(phib_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) ffa = (0.5_dp/alpha)**2 ffb = 1.0_dp/fourpi 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%array(ig) + phib_g%array(ig) = ffb*dphi_g(i)%array(ig)*(1.0_dp + ffa*grid_spme%gsq(ig)) + phib_g%array(ig) = phib_g%array(ig)*green%influence_fn%array(ig) END DO - IF (grid_spme%have_g0) phib_g%cc(1) = 0.0_dp + IF (grid_spme%have_g0) phib_g%array(1) = 0.0_dp DO j = 1, i nd = 0 nd(j) = 1 @@ -460,11 +461,12 @@ SUBROUTINE tb_spme_zforce(ewald_env, ewald_pw, particle_set, box, gmcharge, mcha TYPE(greens_fn_type), POINTER :: green TYPE(mp_comm_type) :: group TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type), DIMENSION(3) :: dphi_g + TYPE(pw_c1d_type), POINTER :: phi_g, rhob_g TYPE(pw_grid_type), POINTER :: grid_spme TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: pw_pool - TYPE(pw_type), DIMENSION(3) :: dphi_g - TYPE(pw_type), POINTER :: phi_g, rhob_g, rhob_r + TYPE(pw_type), POINTER :: rhob_r TYPE(realspace_grid_desc_type), POINTER :: rs_desc TYPE(realspace_grid_type) :: rden, rpot TYPE(realspace_grid_type), DIMENSION(3) :: drpot @@ -519,7 +521,7 @@ SUBROUTINE tb_spme_zforce(ewald_env, ewald_pw, particle_set, box, gmcharge, mcha ! transform density to G space and add charge function NULLIFY (rhob_g) ALLOCATE (rhob_g) - CALL pw_pool%create_pw(rhob_g, use_data=COMPLEXDATA1D, & + CALL pw_pool%create_pw(rhob_g, & in_space=RECIPROCALSPACE) CALL pw_transfer(rhob_r, rhob_g) ! update charge function @@ -530,12 +532,12 @@ SUBROUTINE tb_spme_zforce(ewald_env, ewald_pw, particle_set, box, gmcharge, mcha ! allocate intermediate arrays DO i = 1, 3 CALL pw_pool%create_pw(dphi_g(i), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO NULLIFY (phi_g) ALLOCATE (phi_g) CALL pw_pool%create_pw(phi_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_poisson_solve(poisson_env, rhob_g, vgc, phi_g, dphi_g) CALL rs_grid_create(rpot, rs_desc) diff --git a/src/hfx_pw_methods.F b/src/hfx_pw_methods.F index e9cd63163d..95f36b54e9 100644 --- a/src/hfx_pw_methods.F +++ b/src/hfx_pw_methods.F @@ -46,8 +46,7 @@ MODULE hfx_pw_methods USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& pw_c1d_type,& @@ -108,10 +107,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_c1d_type) :: greenfn, pot_g, rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_grid_type), POINTER :: grid - TYPE(pw_type) :: pot_g, rho_g, rho_r + TYPE(pw_type) :: 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 @@ -139,10 +138,8 @@ SUBROUTINE pw_hfx(qs_env, ehfx, hfx_section, poisson_env, auxbas_pw_pool, irep) use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rho_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(pot_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) ALLOCATE (rho_i(blocksize)) diff --git a/src/iao_analysis.F b/src/iao_analysis.F index ed272be3f8..52cf23d6dc 100644 --- a/src/iao_analysis.F +++ b/src/iao_analysis.F @@ -87,10 +87,10 @@ MODULE iao_analysis USE pw_env_types, ONLY: pw_env_get,& pw_env_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_wavefunction USE qs_environment_types, ONLY: get_qs_env,& @@ -996,9 +996,10 @@ SUBROUTINE print_iao_cubes(qs_env, print_section, iao_coef, basis_set_list) TYPE(dft_control_type), POINTER :: dft_control TYPE(particle_list_type), POINTER :: particles TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: wf_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: wf_g, wf_r + TYPE(pw_type) :: wf_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_subsys_type), POINTER :: subsys @@ -1020,7 +1021,7 @@ SUBROUTINE print_iao_cubes(qs_env, print_section, iao_coef, basis_set_list) CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) CALL auxbas_pw_pool%create_pw(wf_r, use_data=REALDATA3D, in_space=REALSPACE) - CALL auxbas_pw_pool%create_pw(wf_g, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(wf_g, in_space=RECIPROCALSPACE) nspins = SIZE(iao_coef) nstart = MIN(1, n_rep) @@ -1084,9 +1085,10 @@ SUBROUTINE print_ibo_cubes(qs_env, print_section, ibo_coef) TYPE(dft_control_type), POINTER :: dft_control TYPE(particle_list_type), POINTER :: particles TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: wf_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: wf_g, wf_r + TYPE(pw_type) :: wf_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_subsys_type), POINTER :: subsys @@ -1102,7 +1104,7 @@ SUBROUTINE print_ibo_cubes(qs_env, print_section, ibo_coef) CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) CALL auxbas_pw_pool%create_pw(wf_r, use_data=REALDATA3D, in_space=REALSPACE) - CALL auxbas_pw_pool%create_pw(wf_g, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(wf_g, in_space=RECIPROCALSPACE) nspins = SIZE(ibo_coef) nstart = MIN(1, n_rep) diff --git a/src/kg_correction.F b/src/kg_correction.F index 9aeccee478..0583827b7c 100644 --- a/src/kg_correction.F +++ b/src/kg_correction.F @@ -41,7 +41,8 @@ MODULE kg_correction USE pw_methods, ONLY: pw_integral_ab,& pw_scale USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type USE qs_integrate_potential, ONLY: integrate_v_rspace,& @@ -146,10 +147,10 @@ SUBROUTINE kg_ekin_embed(qs_env, kg_env, ks_matrix, ekin_mol, calc_force, do_ker TYPE(cp_logger_type), POINTER :: logger TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: density_matrix TYPE(dft_control_type), POINTER :: dft_control + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho1_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), DIMENSION(:), POINTER :: rho1_g, rho1_r, rho_r, tau1_r, vxc_rho, & - vxc_tau + TYPE(pw_type), DIMENSION(:), POINTER :: rho1_r, rho_r, tau1_r, vxc_rho, vxc_tau TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: old_rho, rho1, rho_struct TYPE(section_vals_type), POINTER :: xc_section @@ -584,9 +585,10 @@ SUBROUTINE kg_ekin_ri_embed(qs_env, kg_env, ks_matrix, ekin_mol, calc_force, & TYPE(lri_environment_type), POINTER :: lri_env, lri_env1 TYPE(lri_kind_type), DIMENSION(:), POINTER :: lri_v_int TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho1_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), DIMENSION(:), POINTER :: rho1_g, rho1_r, tau1_r, vxc_rho, vxc_tau + TYPE(pw_type), DIMENSION(:), POINTER :: rho1_r, tau1_r, vxc_rho, vxc_tau TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho, rho1, rho_struct TYPE(section_vals_type), POINTER :: xc_section diff --git a/src/library_tests.F b/src/library_tests.F index 6d676316f0..7d2a2b223b 100644 --- a/src/library_tests.F +++ b/src/library_tests.F @@ -88,10 +88,10 @@ MODULE library_tests pw_grid_setup USE pw_methods, ONLY: pw_transfer,& pw_zero - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_c3d_type,& pw_type USE realspace_grid_types, ONLY: & @@ -830,9 +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_c1d_type) :: ca, cc TYPE(pw_c3d_type) :: cb TYPE(pw_grid_type), POINTER :: grid - TYPE(pw_type) :: ca, cc !..set fft lib @@ -939,18 +939,18 @@ SUBROUTINE pw_fft_test(para_env, iw, globenv, pw_transfer_section) ! note that the number of grid points might be different from what the user requested (fft-able needed) no = grid%npts - CALL ca%create(grid, COMPLEXDATA1D, RECIPROCALSPACE) + CALL ca%create(grid, RECIPROCALSPACE) CALL cb%create(grid, REALSPACE) - CALL cc%create(grid, COMPLEXDATA1D, RECIPROCALSPACE) + CALL cc%create(grid, RECIPROCALSPACE) ! initialize data CALL pw_zero(ca) CALL pw_zero(cb) CALL pw_zero(cc) - nn = SIZE(ca%cc) + nn = SIZE(ca%array) DO ig = 1, nn gsq = grid%gsq(ig) - ca%cc(ig) = EXP(-gsq) + ca%array(ig) = EXP(-gsq) END DO flops = PRODUCT(no)*30.0_dp*LOG(REAL(MAXVAL(no), KIND=dp)) @@ -971,9 +971,9 @@ SUBROUTINE pw_fft_test(para_env, iw, globenv, pw_transfer_section) perf = 0.0_dp END IF - em = MAXVAL(ABS(ca%cc(:) - cc%cc(:))) + em = MAXVAL(ABS(ca%array(:) - cc%array(:))) CALL para_env%max(em) - et = SUM(ABS(ca%cc(:) - cc%cc(:))) + et = SUM(ABS(ca%array(:) - cc%array(:))) CALL para_env%sum(et) t_min = MINVAL(t_end - t_start) t_max = MAXVAL(t_end - t_start) diff --git a/src/localization_tb.F b/src/localization_tb.F index 056681081d..05f9c725c8 100644 --- a/src/localization_tb.F +++ b/src/localization_tb.F @@ -32,10 +32,10 @@ MODULE localization_tb pw_env_type USE pw_pool_types, ONLY: pw_pool_p_type,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type,& @@ -96,10 +96,11 @@ SUBROUTINE wfn_localization_tb(qs_env, tb_type) TYPE(mo_set_type), DIMENSION(:), POINTER :: mos TYPE(particle_list_type), POINTER :: particles TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: wf_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: wf_g, wf_r + TYPE(pw_type) :: wf_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_loc_env_type), POINTER :: qs_loc_env_homo TYPE(qs_subsys_type), POINTER :: subsys @@ -182,7 +183,6 @@ SUBROUTINE wfn_localization_tb(qs_env, tb_type) use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(wf_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) NULLIFY (marked_states, qs_loc_env_homo) diff --git a/src/lri_environment_methods.F b/src/lri_environment_methods.F index 4524d697d3..ee5532d112 100644 --- a/src/lri_environment_methods.F +++ b/src/lri_environment_methods.F @@ -59,7 +59,8 @@ MODULE lri_environment_methods invmat_symm USE message_passing, ONLY: mp_para_env_type USE particle_types, ONLY: particle_type - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_collocate_density, ONLY: calculate_lri_rho_elec USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -350,7 +351,8 @@ SUBROUTINE lri_kg_rho_update(rho_struct, qs_env, lri_env, lri_density, atomlist) TYPE(dbcsr_type) :: pmat_diag TYPE(dft_control_type), POINTER :: dft_control TYPE(mp_para_env_type), POINTER :: para_env - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r CALL timeset(routineN, handle) @@ -845,7 +847,8 @@ SUBROUTINE distribute_lri_density_on_the_grid(lri_env, lri_density, qs_env, & DIMENSION(:), POINTER :: nl_iterator TYPE(neighbor_list_set_p_type), DIMENSION(:), & POINTER :: soo_list - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r TYPE(qs_rho_type), POINTER :: rho CALL timeset(routineN, handle) diff --git a/src/minbas_wfn_analysis.F b/src/minbas_wfn_analysis.F index 4016472866..6bf63daae0 100644 --- a/src/minbas_wfn_analysis.F +++ b/src/minbas_wfn_analysis.F @@ -65,10 +65,10 @@ MODULE minbas_wfn_analysis USE pw_env_types, ONLY: pw_env_get,& pw_env_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_wavefunction USE qs_environment_types, ONLY: get_qs_env,& @@ -493,9 +493,10 @@ SUBROUTINE post_minbas_cubes(qs_env, print_section, minbas_coeff, ispin) TYPE(dft_control_type), POINTER :: dft_control TYPE(particle_list_type), POINTER :: particles TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: wf_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: wf_g, wf_r + TYPE(pw_type) :: wf_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_subsys_type), POINTER :: subsys TYPE(section_vals_type), POINTER :: minbas_section @@ -521,7 +522,7 @@ SUBROUTINE post_minbas_cubes(qs_env, print_section, minbas_coeff, ispin) CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) CALL auxbas_pw_pool%create_pw(wf_r, use_data=REALDATA3D, in_space=REALSPACE) - CALL auxbas_pw_pool%create_pw(wf_g, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(wf_g, in_space=RECIPROCALSPACE) ! loop over list of atoms CALL section_vals_val_get(minbas_section, "ATOM_LIST", n_rep_val=n_rep) diff --git a/src/molecular_states.F b/src/molecular_states.F index 08e9c53ca5..464ec1bc3a 100644 --- a/src/molecular_states.F +++ b/src/molecular_states.F @@ -47,7 +47,8 @@ MODULE molecular_states USE particle_list_types, ONLY: particle_list_type USE particle_types, ONLY: particle_type USE pw_env_types, ONLY: pw_env_type - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_collocate_density, ONLY: calculate_wavefunction USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -96,7 +97,8 @@ SUBROUTINE construct_molecular_states(molecule_set, mo_localized, & REAL(KIND=dp), DIMENSION(:), POINTER :: mo_eigenvalues TYPE(dbcsr_type), POINTER :: Hks, matrix_S TYPE(qs_environment_type), POINTER :: qs_env - TYPE(pw_type), INTENT(INOUT) :: wf_r, wf_g + TYPE(pw_type), INTENT(INOUT) :: wf_r + TYPE(pw_c1d_type), INTENT(INOUT) :: wf_g TYPE(section_vals_type), POINTER :: loc_print_section TYPE(particle_list_type), POINTER :: particles CHARACTER(LEN=*), INTENT(IN) :: tag diff --git a/src/mp2_cphf.F b/src/mp2_cphf.F index a5be91f283..d2b4541eb0 100644 --- a/src/mp2_cphf.F +++ b/src/mp2_cphf.F @@ -87,8 +87,7 @@ MODULE mp2_cphf USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& pw_c1d_type,& @@ -1332,16 +1331,17 @@ 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) :: pot_g, rho_tot_g, temp_pw_g + TYPE(pw_c1d_type), ALLOCATABLE, DIMENSION(:) :: dvg + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g, rho_mp2_g 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 - TYPE(pw_type) :: pot_g, pot_r, rho_tot_g, temp_pw_g, & - vh_rspace, vhxc_rspace - TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: dvg - 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) :: pot_r, vh_rspace, vhxc_rspace + TYPE(pw_type), DIMENSION(:), POINTER :: rho_mp2_r, rho_mp2_r_aux, rho_r, & + tau_mp2_r, vadmm_rspace, vtau_rspace, & + vxc_rspace TYPE(qs_dispersion_type), POINTER :: dispersion_env TYPE(qs_energy_type), POINTER :: energy TYPE(qs_force_type), DIMENSION(:), POINTER :: force @@ -1623,10 +1623,8 @@ SUBROUTINE update_mp2_forces(qs_env) use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(pot_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(rho_tot_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_zero(rho_tot_g) @@ -1640,13 +1638,13 @@ SUBROUTINE update_mp2_forces(qs_env) ALLOCATE (dvg(3)) DO idir = 1, 3 CALL auxbas_pw_pool%create_pw(dvg(idir), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) END DO + CALL pw_poisson_solve(poisson_env, rho_tot_g, vhartree=pot_g, dvhartree=dvg) + ELSE + CALL pw_poisson_solve(poisson_env, rho_tot_g, vhartree=pot_g) END IF - ! calculate the MP2 potential - CALL pw_poisson_solve(poisson_env, rho_tot_g, vhartree=pot_g, dvhartree=dvg) CALL pw_transfer(pot_g, pot_r) CALL pw_scale(pot_r, pot_r%pw_grid%dvol) CALL pw_axpy(pot_r, vh_rspace) @@ -1669,7 +1667,6 @@ SUBROUTINE update_mp2_forces(qs_env) ! update virial if necessary with the volume term ! first create pw auxiliary stuff CALL auxbas_pw_pool%create_pw(temp_pw_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) ! make a copy of the MP2 density in G space diff --git a/src/mp2_eri_gpw.F b/src/mp2_eri_gpw.F index d251b23bcd..32b13d2e2c 100644 --- a/src/mp2_eri_gpw.F +++ b/src/mp2_eri_gpw.F @@ -45,11 +45,11 @@ MODULE mp2_eri_gpw USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D, & - REALDATA3D, & - REALSPACE, & - RECIPROCALSPACE, & - pw_c1d_type, pw_type + USE pw_types, ONLY: & + REALDATA3D, & + REALSPACE, & + RECIPROCALSPACE, & + pw_c1d_type, pw_type USE qs_collocate_density, ONLY: calculate_rho_elec, & calculate_wavefunction, & collocate_single_gaussian @@ -112,7 +112,8 @@ SUBROUTINE mp2_eri_3c_integrate_gpw(mo_coeff, psi_L, rho_g, atomic_kind_set, qs_ potential_parameter, mat_munu, qs_env, task_list_sub) TYPE(cp_fm_type), INTENT(IN) :: mo_coeff - TYPE(pw_type), INTENT(INOUT) :: psi_L, rho_g + TYPE(pw_type), INTENT(INOUT) :: psi_L + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_g TYPE(atomic_kind_type), DIMENSION(:), INTENT(IN), & POINTER :: atomic_kind_set TYPE(qs_kind_type), DIMENSION(:), INTENT(IN), & @@ -124,7 +125,8 @@ SUBROUTINE mp2_eri_3c_integrate_gpw(mo_coeff, psi_L, rho_g, atomic_kind_set, qs_ TYPE(pw_env_type), INTENT(IN), POINTER :: pw_env_sub REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: external_vector TYPE(pw_poisson_type), INTENT(IN), POINTER :: poisson_env - TYPE(pw_type), INTENT(INOUT) :: rho_r, pot_g + TYPE(pw_type), INTENT(INOUT) :: rho_r + TYPE(pw_c1d_type), INTENT(INOUT) :: pot_g TYPE(libint_potential_type), INTENT(IN) :: potential_parameter TYPE(dbcsr_p_type), INTENT(INOUT) :: mat_munu TYPE(qs_environment_type), INTENT(IN), POINTER :: qs_env @@ -200,7 +202,8 @@ SUBROUTINE mp2_eri_2c_integrate_gpw(qs_env, para_env_sub, my_group_L_start, my_g TYPE(pw_env_type), POINTER :: pw_env_sub TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: pot_g, psi_L, rho_g, rho_r + TYPE(pw_type) :: psi_L, rho_r + TYPE(pw_c1d_type) :: pot_g, rho_g TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(realspace_grid_desc_p_type), DIMENSION(:), & POINTER :: rs_descs @@ -384,7 +387,7 @@ SUBROUTINE integrate_potential_forces_2c(rho_r, LLL, matrix, rho_g, atomic_kind_ TYPE(pw_type), INTENT(INOUT) :: rho_r INTEGER, INTENT(IN) :: LLL TYPE(cp_fm_type), INTENT(IN) :: matrix - TYPE(pw_type), INTENT(INOUT) :: rho_g + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_g TYPE(atomic_kind_type), DIMENSION(:), INTENT(IN), & POINTER :: atomic_kind_set TYPE(qs_kind_type), DIMENSION(:), INTENT(IN), & @@ -394,10 +397,10 @@ SUBROUTINE integrate_potential_forces_2c(rho_r, LLL, matrix, rho_g, atomic_kind_ TYPE(cell_type), INTENT(IN), POINTER :: cell TYPE(pw_env_type), INTENT(IN), POINTER :: pw_env_sub TYPE(pw_poisson_type), INTENT(IN), POINTER :: poisson_env - TYPE(pw_type), INTENT(INOUT) :: pot_g + TYPE(pw_c1d_type), INTENT(INOUT) :: pot_g TYPE(libint_potential_type), INTENT(IN) :: potential_parameter LOGICAL, INTENT(IN) :: use_virial - TYPE(pw_type), INTENT(INOUT) :: rho_g_copy, dvg(3) + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_g_copy, dvg(3) INTEGER, DIMENSION(:), INTENT(IN) :: kind_of, atom_of_kind REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: G_PQ_local TYPE(qs_force_type), DIMENSION(:), INTENT(IN), & @@ -526,16 +529,17 @@ SUBROUTINE integrate_potential_forces_3c_2c(matrix_P_munu, rho_r, rho_g, task_li qs_kind_set, particle_set, cell, LLL, force, dft_control) TYPE(dbcsr_p_type), INTENT(IN) :: matrix_P_munu - TYPE(pw_type), INTENT(INOUT) :: rho_r, rho_g + TYPE(pw_type), INTENT(INOUT) :: rho_r + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_g TYPE(task_list_type), INTENT(IN), POINTER :: task_list_sub TYPE(pw_env_type), INTENT(IN), POINTER :: pw_env_sub TYPE(libint_potential_type), INTENT(IN) :: potential_parameter TYPE(qs_ks_env_type), INTENT(IN), POINTER :: ks_env TYPE(pw_poisson_type), INTENT(IN), POINTER :: poisson_env - TYPE(pw_type), INTENT(INOUT) :: pot_g + TYPE(pw_c1d_type), INTENT(INOUT) :: pot_g LOGICAL, INTENT(IN) :: use_virial - TYPE(pw_type), INTENT(INOUT) :: rho_g_copy - TYPE(pw_type), INTENT(IN) :: dvg(3) + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_g_copy + TYPE(pw_c1d_type), INTENT(IN) :: dvg(3) REAL(KIND=dp), DIMENSION(3, 3), INTENT(INOUT) :: h_stress TYPE(mp_para_env_type), INTENT(IN) :: para_env_sub INTEGER, DIMENSION(:), INTENT(IN) :: kind_of, atom_of_kind @@ -718,9 +722,9 @@ END SUBROUTINE integrate_potential_forces_3c_2c ! ************************************************************************************************** SUBROUTINE virial_gpw_potential(rho_g_copy, pot_g, rho_g, dvg, h_stress, potential_parameter, para_env_sub) - TYPE(pw_type), INTENT(IN) :: rho_g_copy, pot_g - TYPE(pw_type), INTENT(INOUT) :: rho_g - TYPE(pw_type), INTENT(IN) :: dvg(3) + TYPE(pw_c1d_type), INTENT(IN) :: rho_g_copy, pot_g + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_g + TYPE(pw_c1d_type), INTENT(IN) :: dvg(3) REAL(KIND=dp), DIMENSION(3, 3), INTENT(INOUT) :: h_stress TYPE(libint_potential_type), INTENT(IN) :: potential_parameter TYPE(mp_para_env_type), INTENT(IN) :: para_env_sub @@ -760,31 +764,27 @@ END SUBROUTINE virial_gpw_potential !> \param potential_parameter parameters of potential V(g) ! ************************************************************************************************** SUBROUTINE factor_virial_gpw(pw, potential_parameter) - TYPE(pw_type), INTENT(INOUT) :: pw + TYPE(pw_c1d_type), INTENT(INOUT) :: pw TYPE(libint_potential_type), INTENT(IN) :: potential_parameter - TYPE(pw_c1d_type) :: my_pw - - IF (.NOT. (pw%in_space == RECIPROCALSPACE .AND. pw%in_use == COMPLEXDATA1D)) & + IF (.NOT. (pw%in_space == RECIPROCALSPACE)) THEN CPABORT("pw in wrong space or wrong data type") + END IF - my_pw%in_space = pw%in_space - my_pw%pw_grid => pw%pw_grid - my_pw%array => pw%cc SELECT CASE (potential_parameter%potential_type) CASE (do_potential_coulomb) RETURN CASE (do_potential_long) - CALL pw_log_deriv_gauss(my_pw, potential_parameter%omega) + CALL pw_log_deriv_gauss(pw, potential_parameter%omega) CASE (do_potential_short) - CALL pw_log_deriv_compl_gauss(my_pw, potential_parameter%omega) + CALL pw_log_deriv_compl_gauss(pw, potential_parameter%omega) CASE (do_potential_mix_cl) - CALL pw_log_deriv_mix_cl(my_pw, potential_parameter%omega, & + CALL pw_log_deriv_mix_cl(pw, potential_parameter%omega, & potential_parameter%scale_coulomb, potential_parameter%scale_longrange) CASE (do_potential_truncated) - CALL pw_log_deriv_trunc(my_pw, potential_parameter%cutoff_radius) + CALL pw_log_deriv_trunc(pw, potential_parameter%cutoff_radius) CASE (do_potential_id) - CALL pw_zero(my_pw) + CALL pw_zero(pw) CASE DEFAULT CPABORT("Unknown potential type") END SELECT @@ -981,7 +981,8 @@ SUBROUTINE prepare_gpw(qs_env, dft_control, e_cutoff_old, cutoff_old, relative_c TYPE(pw_pool_type), INTENT(IN), POINTER :: auxbas_pw_pool TYPE(pw_poisson_type), INTENT(IN), POINTER :: poisson_env TYPE(task_list_type), POINTER :: task_list_sub - TYPE(pw_type), INTENT(OUT) :: rho_r, rho_g, pot_g, psi_L + TYPE(pw_type), INTENT(OUT) :: rho_r, psi_L + TYPE(pw_c1d_type), INTENT(OUT) :: rho_g, pot_g TYPE(neighbor_list_set_p_type), DIMENSION(:), & INTENT(IN), POINTER :: sab_orb_sub @@ -1036,10 +1037,8 @@ SUBROUTINE prepare_gpw(qs_env, dft_control, e_cutoff_old, cutoff_old, relative_c use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rho_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(pot_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(psi_L, & use_data=REALDATA3D, & @@ -1078,7 +1077,8 @@ SUBROUTINE cleanup_gpw(qs_env, e_cutoff_old, cutoff_old, relative_cutoff_old, pa TYPE(pw_env_type), POINTER :: pw_env_sub TYPE(task_list_type), POINTER :: task_list_sub TYPE(pw_pool_type), INTENT(IN), POINTER :: auxbas_pw_pool - TYPE(pw_type), INTENT(INOUT) :: rho_r, rho_g, pot_g, psi_L + TYPE(pw_type), INTENT(INOUT) :: rho_r, psi_L + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_g, pot_g CHARACTER(LEN=*), PARAMETER :: routineN = 'cleanup_gpw' @@ -1119,11 +1119,11 @@ END SUBROUTINE cleanup_gpw ! ************************************************************************************************** SUBROUTINE calc_potential_gpw(pot_r, rho_g, poisson_env, pot_g, potential_parameter, dvg, no_transfer) TYPE(pw_type), INTENT(INOUT) :: pot_r - TYPE(pw_type), INTENT(IN) :: rho_g + TYPE(pw_c1d_type), INTENT(IN) :: rho_g TYPE(pw_poisson_type), INTENT(IN), POINTER :: poisson_env - TYPE(pw_type), INTENT(INOUT) :: pot_g + TYPE(pw_c1d_type), INTENT(INOUT) :: pot_g TYPE(libint_potential_type), INTENT(IN), OPTIONAL :: potential_parameter - TYPE(pw_type), DIMENSION(3), INTENT(INOUT), & + TYPE(pw_c1d_type), DIMENSION(3), INTENT(INOUT), & OPTIONAL :: dvg LOGICAL, INTENT(IN), OPTIONAL :: no_transfer @@ -1138,13 +1138,13 @@ SUBROUTINE calc_potential_gpw(pot_r, rho_g, poisson_env, pot_g, potential_parame #:for grid in ["rho_g", "pot_g"] my_${grid}$%pw_grid => ${grid}$%pw_grid my_${grid}$%in_space = ${grid}$%in_space - my_${grid}$%array => ${grid}$%cc + my_${grid}$%array => ${grid}$%array #:endfor IF (PRESENT(dvg)) THEN #:for grid in ["dvg(1)", "dvg(2)", "dvg(3)"] my_${grid}$%pw_grid => ${grid}$%pw_grid my_${grid}$%in_space = ${grid}$%in_space - my_${grid}$%array => ${grid}$%cc + my_${grid}$%array => ${grid}$%array #:endfor END IF diff --git a/src/mp2_gpw_method.F b/src/mp2_gpw_method.F index 6d376819ca..4d3a3dabee 100644 --- a/src/mp2_gpw_method.F +++ b/src/mp2_gpw_method.F @@ -49,6 +49,7 @@ MODULE mp2_gpw_method USE pw_pool_types, ONLY: pw_pool_type USE pw_types, ONLY: REALDATA3D,& REALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_wavefunction USE qs_environment_types, ONLY: qs_environment_type @@ -156,10 +157,11 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s TYPE(dft_control_type), POINTER :: dft_control TYPE(group_dist_d1_type) :: gd_exchange TYPE(mp_comm_type) :: comm_exchange + TYPE(pw_c1d_type) :: pot_g, rho_g TYPE(pw_env_type), POINTER :: pw_env_sub TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: pot_g, psi_a, rho_g, rho_r + TYPE(pw_type) :: psi_a, rho_r TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: psi_i TYPE(task_list_type), POINTER :: task_list_sub diff --git a/src/mp2_integrals.F b/src/mp2_integrals.F index 952b072395..123f90edf0 100644 --- a/src/mp2_integrals.F +++ b/src/mp2_integrals.F @@ -79,7 +79,8 @@ MODULE mp2_integrals USE pw_env_types, ONLY: pw_env_type USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type,& set_qs_env @@ -282,10 +283,11 @@ SUBROUTINE mp2_ri_gpw_compute_in(BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, gd DIMENSION(:) :: intermed_mat, intermed_mat_gw TYPE(mp_cart_type) :: mp_comm_t3c_2 TYPE(neighbor_list_3c_type) :: nl_3c + TYPE(pw_c1d_type) :: pot_g, rho_g TYPE(pw_env_type), POINTER :: pw_env_sub TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: pot_g, psi_L, rho_g, rho_r + TYPE(pw_type) :: psi_L, rho_r TYPE(section_vals_type), POINTER :: qs_section TYPE(task_list_type), POINTER :: task_list_sub diff --git a/src/mp2_ri_grad.F b/src/mp2_ri_grad.F index 80429467eb..f3fdd61279 100644 --- a/src/mp2_ri_grad.F +++ b/src/mp2_ri_grad.F @@ -58,8 +58,8 @@ MODULE mp2_ri_grad USE pw_env_types, ONLY: pw_env_type USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - RECIPROCALSPACE,& + USE pw_types, ONLY: RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -157,11 +157,11 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par TYPE(dft_control_type), POINTER :: dft_control TYPE(mp2_eri_force), ALLOCATABLE, DIMENSION(:) :: force_2c, force_2c_RI, force_3c_aux, & force_3c_orb_mu, force_3c_orb_nu + TYPE(pw_c1d_type) :: dvg(3), pot_g, rho_g, rho_g_copy TYPE(pw_env_type), POINTER :: pw_env_sub TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: dvg(3), pot_g, psi_L, rho_g, rho_g_copy, & - rho_r + TYPE(pw_type) :: psi_L, rho_r TYPE(qs_force_type), DIMENSION(:), POINTER :: force, mp2_force TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(task_list_type), POINTER :: task_list_sub @@ -342,11 +342,9 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par ! (hartree potential derivatives) IF (use_virial) THEN CALL auxbas_pw_pool%create_pw(rho_g_copy, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) DO i = 1, 3 CALL auxbas_pw_pool%create_pw(dvg(i), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) END DO END IF diff --git a/src/optimize_embedding_potential.F b/src/optimize_embedding_potential.F index ceed03eb28..58295b42ac 100644 --- a/src/optimize_embedding_potential.F +++ b/src/optimize_embedding_potential.F @@ -68,10 +68,10 @@ MODULE optimize_embedding_potential USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_rho_resp_all,& calculate_wavefunction @@ -963,10 +963,11 @@ SUBROUTINE Coulomb_guess(v_rspace, rhs, mapping_section, qs_env, nforce_eval, if REAL(KIND=dp) :: dvol, normalize_factor REAL(KIND=dp), DIMENSION(:), POINTER :: rhs_subsys TYPE(particle_list_type), POINTER :: particles + TYPE(pw_c1d_type) :: v_resp_gspace TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho_resp, v_resp_gspace, v_resp_rspace + TYPE(pw_type) :: rho_resp, v_resp_rspace TYPE(qs_subsys_type), POINTER :: subsys ! Get available particles @@ -994,7 +995,6 @@ SUBROUTINE Coulomb_guess(v_rspace, rhs, mapping_section, qs_env, nforce_eval, if poisson_env=poisson_env) CALL auxbas_pw_pool%create_pw(v_resp_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_resp_rspace, & @@ -1010,11 +1010,8 @@ SUBROUTINE Coulomb_guess(v_rspace, rhs, mapping_section, qs_env, nforce_eval, if CALL calculate_rho_resp_all(rho_resp, rhs_subsys, natom, eta, qs_env) ! Calculate potential - CALL pw_zero(v_resp_gspace) CALL pw_poisson_solve(poisson_env, rho_resp, & - vhartree=v_resp_gspace) - CALL pw_zero(v_resp_rspace) - CALL pw_transfer(v_resp_gspace, v_resp_rspace) + vhartree=v_resp_rspace) dvol = v_resp_rspace%pw_grid%dvol CALL pw_scale(v_resp_rspace, dvol) normalize_factor = SQRT((eta/pi)**3) @@ -1397,10 +1394,11 @@ SUBROUTINE grid_regularize(potential, pw_env, lambda, reg_term) INTEGER :: i, j, k INTEGER, DIMENSION(3) :: lb, n, ub + TYPE(pw_c1d_type) :: dr2_pot, grid_reg_g, potential_g + TYPE(pw_c1d_type), DIMENSION(3) :: dpot_g TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: dr2_pot, grid_reg, grid_reg_g, & - potential_g, square_norm_dpot - TYPE(pw_type), DIMENSION(3) :: dpot, dpot_g + TYPE(pw_type) :: grid_reg, square_norm_dpot + TYPE(pw_type), DIMENSION(3) :: dpot ! ! First, the contribution to the gradient @@ -1410,11 +1408,9 @@ SUBROUTINE grid_regularize(potential, pw_env, lambda, reg_term) CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) CALL auxbas_pw_pool%create_pw(potential_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(dr2_pot, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(grid_reg, & @@ -1422,7 +1418,6 @@ SUBROUTINE grid_regularize(potential, pw_env, lambda, reg_term) in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(grid_reg_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_zero(grid_reg_g) @@ -1448,7 +1443,6 @@ SUBROUTINE grid_regularize(potential, pw_env, lambda, reg_term) use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(dpot_g(i), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) END DO @@ -1771,9 +1765,10 @@ SUBROUTINE update_embed_pot(embed_pot_coef, dimen_aux, embed_pot, spin_embed_pot TYPE(mo_set_type), DIMENSION(:), POINTER :: mos TYPE(mp_para_env_type), POINTER :: para_env TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: psi_L, rho_g + TYPE(pw_type) :: psi_L TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set CALL timeset(routineN, handle) @@ -1792,7 +1787,6 @@ SUBROUTINE update_embed_pot(embed_pot_coef, dimen_aux, embed_pot, spin_embed_pot ! get some of the grids ready CALL auxbas_pw_pool%create_pw(rho_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(psi_L, & @@ -2901,9 +2895,10 @@ SUBROUTINE Von_Weizsacker(rho_r, v_w, qs_env, vw_cutoff, vw_smooth_cutoff_range) REAL(KIND=dp) :: density_smooth_cut_range, my_rho, & rho_cutoff REAL(kind=dp), DIMENSION(:, :, :), POINTER :: rhoa, rhob + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, tau + TYPE(pw_type), DIMENSION(:), POINTER :: tau TYPE(section_vals_type), POINTER :: input, xc_section TYPE(xc_rho_cflags_type) :: needs TYPE(xc_rho_set_type) :: rho_set @@ -2926,7 +2921,6 @@ SUBROUTINE Von_Weizsacker(rho_r, v_w, qs_env, vw_cutoff, vw_smooth_cutoff_range) ALLOCATE (rho_g(nspins)) DO i_spin = 1, nspins CALL auxbas_pw_pool%create_pw(rho_g(i_spin), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_transfer(rho_r(i_spin), rho_g(i_spin)) END DO diff --git a/src/pme.F b/src/pme.F index b895eb511c..14d3c8e8c3 100644 --- a/src/pme.F +++ b/src/pme.F @@ -44,10 +44,11 @@ MODULE pme USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& + pw_r3d_type,& pw_type USE realspace_grid_types, ONLY: realspace_grid_desc_type,& realspace_grid_type,& @@ -124,12 +125,12 @@ SUBROUTINE pme_evaluate(ewald_env, ewald_pw, box, particle_set, vg_coulomb, & TYPE(dg_rho0_type), POINTER :: dg_rho0 TYPE(dg_type), POINTER :: dg TYPE(mp_comm_type) :: group + TYPE(pw_c1d_type) :: phi_g, rhob_g + TYPE(pw_c1d_type), DIMENSION(3) :: dphi_g TYPE(pw_grid_type), POINTER :: grid_b, grid_s TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: pw_big_pool, pw_small_pool - TYPE(pw_type) :: phi_g, phi_r, rhob_g, rhob_r, rhos1, & - rhos2 - TYPE(pw_type), DIMENSION(3) :: dphi_g + TYPE(pw_type) :: phi_r, rhob_r, rhos1, rhos2 TYPE(realspace_grid_desc_type), POINTER :: rs_desc TYPE(realspace_grid_type), DIMENSION(3) :: drpot TYPE(realspace_grid_type), POINTER :: rden, rpot @@ -250,14 +251,22 @@ SUBROUTINE pme_evaluate(ewald_env, ewald_pw, box, particle_set, vg_coulomb, & ! allocate intermediate arrays DO i = 1, 3 CALL pw_big_pool%create_pw(dphi_g(i), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) END DO CALL pw_big_pool%create_pw(phi_r, & use_data=REALDATA3D, & in_space=REALSPACE) - CALL pw_poisson_solve(poisson_env, rhob_r, vg_coulomb, phi_r, dphi_g, h_stress) + BLOCK + TYPE(pw_r3d_type) :: my_rhob_r, my_phi_r + my_rhob_r%in_space = rhob_r%in_space + my_rhob_r%pw_grid => rhob_r%pw_grid + my_rhob_r%array => rhob_r%cr3d + my_phi_r%in_space = phi_r%in_space + my_phi_r%pw_grid => phi_r%pw_grid + my_phi_r%array => phi_r%cr3d + CALL pw_poisson_solve(poisson_env, my_rhob_r, vg_coulomb, my_phi_r, dphi_g, h_stress) + END BLOCK ! atomic energies IF (atprop%energy .OR. atprop%stress) THEN @@ -297,19 +306,17 @@ SUBROUTINE pme_evaluate(ewald_env, ewald_pw, box, particle_set, vg_coulomb, & END DO IF (atprop%stress) THEN CALL pw_big_pool%create_pw(phi_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_big_pool%create_pw(rhob_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) ffa = (0.5_dp/dg_rho0%zet(1))**2 ffb = 1.0_dp/fourpi DO i = 1, 3 DO ig = grid_b%first_gne0, grid_b%ngpts_cut_local - phi_g%cc(ig) = ffb*dphi_g(i)%cc(ig)*(ffa*grid_b%gsq(ig) + 1.0_dp) - phi_g%cc(ig) = phi_g%cc(ig)*poisson_env%green_fft%influence_fn%array(ig) + phi_g%array(ig) = ffb*dphi_g(i)%array(ig)*(ffa*grid_b%gsq(ig) + 1.0_dp) + phi_g%array(ig) = phi_g%array(ig)*poisson_env%green_fft%influence_fn%array(ig) END DO - IF (grid_b%have_g0) phi_g%cc(1) = 0.0_dp + IF (grid_b%have_g0) phi_g%array(1) = 0.0_dp DO j = 1, i CALL pw_copy(phi_g, rhob_g) nd = 0 diff --git a/src/post_scf_bandstructure_utils.F b/src/post_scf_bandstructure_utils.F index facc67ff6e..ab819507d4 100644 --- a/src/post_scf_bandstructure_utils.F +++ b/src/post_scf_bandstructure_utils.F @@ -82,10 +82,10 @@ MODULE post_scf_bandstructure_utils USE pw_env_types, ONLY: pw_env_get,& pw_env_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_rho_elec USE qs_environment_types, ONLY: get_qs_env,& @@ -2084,9 +2084,10 @@ SUBROUTINE add_to_LDOS_2d(LDOS_2d, qs_env, ikp, bs_env, cfm_mos_ikp, eigenval, & TYPE(cp_fm_type) :: fm_non_spinor, fm_weighted_dm_MIC TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: weighted_dm_MIC TYPE(dft_control_type), POINTER :: dft_control + TYPE(pw_c1d_type) :: rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: LDOS_3d, rho_g + TYPE(pw_type) :: LDOS_3d TYPE(qs_ks_env_type), POINTER :: ks_env CALL timeset(routineN, handle) @@ -2113,7 +2114,7 @@ SUBROUTINE add_to_LDOS_2d(LDOS_2d, qs_env, ikp, bs_env, cfm_mos_ikp, eigenval, & CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) CALL auxbas_pw_pool%create_pw(LDOS_3d, use_data=REALDATA3D, in_space=REALSPACE) - CALL auxbas_pw_pool%create_pw(rho_g, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(rho_g, in_space=RECIPROCALSPACE) i_x_start = LBOUND(LDOS_3d%cr3d, 1) i_x_end = UBOUND(LDOS_3d%cr3d, 1) diff --git a/src/pw/mt_util.F b/src/pw/mt_util.F index 1974f7c66c..8037213cb6 100644 --- a/src/pw/mt_util.F +++ b/src/pw/mt_util.F @@ -20,10 +20,10 @@ MODULE mt_util USE pw_pool_types, ONLY: pw_pool_create,& pw_pool_release,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type #include "../base/base_uses.f90" @@ -53,7 +53,7 @@ MODULE mt_util ! ************************************************************************************************** SUBROUTINE MTin_create_screen_fn(screen_function, pw_pool, method, alpha, & special_dimension, slab_size, super_ref_pw_grid) - TYPE(pw_type), POINTER :: screen_function + TYPE(pw_c1d_type), POINTER :: screen_function TYPE(pw_pool_type), POINTER :: pw_pool INTEGER, INTENT(IN) :: method REAL(KIND=dp), INTENT(in) :: alpha @@ -65,8 +65,9 @@ SUBROUTINE MTin_create_screen_fn(screen_function, pw_pool, method, alpha, & INTEGER :: handle, ig, iz REAL(KIND=dp) :: alpha2, g2, g3d, gxy, gz, zlength + TYPE(pw_c1d_type), POINTER :: Vlocg TYPE(pw_pool_type), POINTER :: pw_pool_aux - TYPE(pw_type), POINTER :: Vloc, Vlocg + TYPE(pw_type), POINTER :: Vloc CALL timeset(routineN, handle) NULLIFY (Vloc, Vlocg, pw_pool_aux) @@ -79,8 +80,7 @@ SUBROUTINE MTin_create_screen_fn(screen_function, pw_pool, method, alpha, & END IF NULLIFY (screen_function) ALLOCATE (screen_function) - CALL pw_pool%create_pw(screen_function, use_data=COMPLEXDATA1D, & - in_space=RECIPROCALSPACE) + CALL pw_pool%create_pw(screen_function, in_space=RECIPROCALSPACE) CALL pw_zero(screen_function) SELECT CASE (method) CASE (MT0D) @@ -88,10 +88,10 @@ SUBROUTINE MTin_create_screen_fn(screen_function, pw_pool, method, alpha, & ALLOCATE (Vloc, Vlocg) IF (ASSOCIATED(pw_pool_aux)) THEN CALL pw_pool_aux%create_pw(Vloc, use_data=REALDATA3D, in_space=REALSPACE) - CALL pw_pool_aux%create_pw(Vlocg, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL pw_pool_aux%create_pw(Vlocg, in_space=RECIPROCALSPACE) ELSE CALL pw_pool%create_pw(Vloc, use_data=REALDATA3D, in_space=REALSPACE) - CALL pw_pool%create_pw(Vlocg, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL pw_pool%create_pw(Vlocg, in_space=RECIPROCALSPACE) END IF CALL mt0din(Vloc, alpha) CALL pw_transfer(Vloc, Vlocg) @@ -111,10 +111,10 @@ SUBROUTINE MTin_create_screen_fn(screen_function, pw_pool, method, alpha, & DO ig = screen_function%pw_grid%first_gne0, screen_function%pw_grid%ngpts_cut_local g2 = screen_function%pw_grid%gsq(ig) g3d = fourpi/g2 - screen_function%cc(ig) = screen_function%cc(ig) - g3d*EXP(-g2/(4.0E0_dp*alpha2)) + screen_function%array(ig) = screen_function%array(ig) - g3d*EXP(-g2/(4.0E0_dp*alpha2)) END DO IF (screen_function%pw_grid%have_g0) & - screen_function%cc(1) = screen_function%cc(1) + fourpi/(4.0E0_dp*alpha2) + screen_function%array(1) = screen_function%array(1) + fourpi/(4.0E0_dp*alpha2) CASE (MT2D) iz = special_dimension ! iz is the direction with NO PBC zlength = slab_size ! zlength is the thickness of the cell @@ -123,9 +123,9 @@ SUBROUTINE MTin_create_screen_fn(screen_function, pw_pool, method, alpha, & g2 = screen_function%pw_grid%gsq(ig) gxy = SQRT(ABS(g2 - gz*gz)) g3d = fourpi/g2 - screen_function%cc(ig) = -g3d*COS(gz*zlength/2.0_dp)*EXP(-gxy*zlength/2.0_dp) + screen_function%array(ig) = -g3d*COS(gz*zlength/2.0_dp)*EXP(-gxy*zlength/2.0_dp) END DO - IF (screen_function%pw_grid%have_g0) screen_function%cc(1) = pi*zlength*zlength/2.0_dp + IF (screen_function%pw_grid%have_g0) screen_function%array(1) = pi*zlength*zlength/2.0_dp CASE (MT1D) iz = special_dimension ! iz is the direction with PBC CALL mt1din(screen_function) @@ -205,7 +205,7 @@ END SUBROUTINE Mt0din !> \author Teodoro Laino (11.2005) ! ************************************************************************************************** SUBROUTINE mt1din(screen_function) - TYPE(pw_type), POINTER :: screen_function + TYPE(pw_c1d_type), POINTER :: screen_function CHARACTER(len=*), PARAMETER :: routineN = 'mt1din' diff --git a/src/pw/ps_implicit_methods.F b/src/pw/ps_implicit_methods.F index e2f1201de0..d3e22567d0 100644 --- a/src/pw/ps_implicit_methods.F +++ b/src/pw/ps_implicit_methods.F @@ -1555,7 +1555,7 @@ SUBROUTINE apply_inv_laplace_operator_dct(pw_pool, green, pw_in, pw_out) CALL pw_transfer(pw_in, pw_in_gs) DO ig = 1, ng - pw_in_gs%array(ig) = prefactor*pw_in_gs%array(ig)*green%dct_influence_fn%cc(ig) + pw_in_gs%array(ig) = prefactor*pw_in_gs%array(ig)*green%dct_influence_fn%array(ig) END DO CALL pw_transfer(pw_in_gs, pw_out) @@ -1663,7 +1663,7 @@ SUBROUTINE apply_laplace_operator_dct(pw_pool, green, pw_in, pw_out) pw_in_gs%array(g0_index) = 0.0_dp END IF DO ig = green%dct_influence_fn%pw_grid%first_gne0, ng - pw_in_gs%array(ig) = prefactor*(pw_in_gs%array(ig)/green%dct_influence_fn%cc(ig)) + pw_in_gs%array(ig) = prefactor*(pw_in_gs%array(ig)/green%dct_influence_fn%array(ig)) END DO CALL pw_transfer(pw_in_gs, pw_out) diff --git a/src/pw/pw_copy_all.F b/src/pw/pw_copy_all.F index f59b443879..68a7464422 100644 --- a/src/pw/pw_copy_all.F +++ b/src/pw/pw_copy_all.F @@ -16,10 +16,8 @@ MODULE pw_copy_all USE kinds, ONLY: dp USE message_passing, ONLY: mp_comm_type USE pw_grid_types, ONLY: pw_grid_type - USE pw_types, ONLY: COMPLEXDATA1D,& - RECIPROCALSPACE,& - pw_c1d_type,& - pw_type + USE pw_types, ONLY: RECIPROCALSPACE,& + pw_c1d_type #include "../base/base_uses.f90" IMPLICIT NONE @@ -28,11 +26,6 @@ MODULE pw_copy_all PUBLIC :: pw_copy_match - INTERFACE pw_copy_match - MODULE PROCEDURE pw_copy_match_pw - MODULE PROCEDURE pw_copy_match_c1d - END INTERFACE - CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'pw_copy_all' LOGICAL, PARAMETER, PRIVATE :: debug_this_module = .FALSE. @@ -46,7 +39,7 @@ MODULE pw_copy_all !> \param pw2 ... !> \author JGH ! ************************************************************************************************** - SUBROUTINE pw_copy_match_c1d(pw1, pw2) + SUBROUTINE pw_copy_match(pw1, pw2) TYPE(pw_c1d_type), INTENT(IN) :: pw1 TYPE(pw_c1d_type), INTENT(INOUT) :: pw2 @@ -112,82 +105,7 @@ SUBROUTINE pw_copy_match_c1d(pw1, pw2) CPABORT("No suitable data field") END IF - END SUBROUTINE pw_copy_match_c1d - -! ************************************************************************************************** -!> \brief copy a pw type variable -!> \param pw1 ... -!> \param pw2 ... -!> \author JGH -! ************************************************************************************************** - SUBROUTINE pw_copy_match_pw(pw1, pw2) - TYPE(pw_type), INTENT(IN) :: pw1 - TYPE(pw_type), INTENT(INOUT) :: pw2 - - COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:) :: cc - INTEGER :: group_size, ig1, ig2, ip, jg2, me, ng1, & - ng2, ngm, penow - INTEGER, ALLOCATABLE, DIMENSION(:) :: ngr - INTEGER, ALLOCATABLE, DIMENSION(:, :) :: g_hat - INTEGER, DIMENSION(3) :: k1, k2 - TYPE(mp_comm_type) :: group - TYPE(pw_grid_type), POINTER :: pg1, pg2 - - IF (pw1%in_use == COMPLEXDATA1D .AND. & - pw2%in_use == COMPLEXDATA1D .AND. & - pw1%in_space == RECIPROCALSPACE) THEN - - ng1 = SIZE(pw1%cc) - ng2 = SIZE(pw2%cc) - - pg1 => pw1%pw_grid - pg2 => pw2%pw_grid - - group = pg1%para%group - group_size = pg1%para%group_size - me = pg1%para%my_pos - ALLOCATE (ngr(group_size)) - ngr = 0 - ngr(me + 1) = pg1%ngpts_cut_local - CALL group%sum(ngr) - ngm = MAXVAL(ngr) - ALLOCATE (cc(ngm)) - cc(1:ng1) = pw1%cc(1:ng1) - cc(ng1 + 1:ngm) = CMPLX(0.0_dp, 0.0_dp, KIND=dp) - ALLOCATE (g_hat(3, ngm)) - g_hat = 0 - g_hat(1:3, 1:ng1) = pg1%g_hat(1:3, 1:ng1) - - DO ip = 1, group_size - penow = me - ip + 1 - IF (penow < 0) penow = penow + group_size - - DO ig1 = 1, ngr(penow + 1) - k1(1:3) = g_hat(1:3, ig1) - jg2 = 0 - DO ig2 = 1, ng2 - k2(1:3) = pg2%g_hat(1:3, ig2) - IF (SUM(ABS(k1 - k2)) == 0) THEN - jg2 = ig2 - EXIT - END IF - END DO - IF (jg2 /= 0) pw2%cc(jg2) = cc(ig1) - END DO - IF (ip /= group_size) THEN - CALL group%shift(cc) - CALL group%shift(g_hat) - END IF - - END DO - - DEALLOCATE (ngr, cc, g_hat) - - ELSE - CPABORT("No suitable data field") - END IF - - END SUBROUTINE pw_copy_match_pw + END SUBROUTINE pw_copy_match END MODULE pw_copy_all diff --git a/src/pw/pw_gpu.F b/src/pw/pw_gpu.F index 4d84353d10..aa059490de 100644 --- a/src/pw/pw_gpu.F +++ b/src/pw/pw_gpu.F @@ -38,6 +38,7 @@ MODULE pw_gpu USE pw_grid_types, ONLY: FULLSPACE USE pw_types, ONLY: REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type #include "../base/base_uses.f90" @@ -103,7 +104,7 @@ END SUBROUTINE pw_gpu_finalize ! ************************************************************************************************** SUBROUTINE pw_gpu_r3dc1d_3d(pw1, pw2, scale) TYPE(pw_type), INTENT(IN) :: pw1 - TYPE(pw_type), INTENT(INOUT) :: pw2 + TYPE(pw_c1d_type), INTENT(INOUT) :: pw2 REAL(KIND=dp), INTENT(IN) :: scale CHARACTER(len=*), PARAMETER :: routineN = 'pw_gpu_r3dc1d_3d' @@ -139,7 +140,7 @@ END SUBROUTINE pw_gpu_cfffg_c ! pointers to data arrays ptr_pwin => pw1%cr3d(l1, l2, l3) - ptr_pwout => pw2%cc(1) + ptr_pwout => pw2%array(1) ! pointer to map array ptr_ghatmap => pw2%pw_grid%g_hatmap(1, 1) @@ -163,7 +164,7 @@ END SUBROUTINE pw_gpu_r3dc1d_3d !> \author Benjamin G Levine ! ************************************************************************************************** SUBROUTINE pw_gpu_c1dr3d_3d(pw1, pw2, scale) - TYPE(pw_type), INTENT(IN) :: pw1 + TYPE(pw_c1d_type), INTENT(IN) :: pw1 TYPE(pw_type), INTENT(INOUT) :: pw2 REAL(KIND=dp), INTENT(IN) :: scale @@ -198,7 +199,7 @@ END SUBROUTINE pw_gpu_sfffc_c npts => pw1%pw_grid%npts ! pointers to data arrays - ptr_pwin => pw1%cc(1) + ptr_pwin => pw1%array(1) ptr_pwout => pw2%cr3d(l1, l2, l3) ! pointer to map array @@ -225,7 +226,7 @@ END SUBROUTINE pw_gpu_c1dr3d_3d ! ************************************************************************************************** SUBROUTINE pw_gpu_r3dc1d_3d_ps(pw1, pw2, scale) TYPE(pw_type), INTENT(IN) :: pw1 - TYPE(pw_type), INTENT(INOUT) :: pw2 + TYPE(pw_c1d_type), INTENT(INOUT) :: pw2 REAL(KIND=dp), INTENT(IN) :: scale CHARACTER(len=*), PARAMETER :: routineN = 'pw_gpu_r3dc1d_3d_ps' @@ -399,7 +400,7 @@ END SUBROUTINE pw_gpu_r3dc1d_3d_ps !> \author Andreas Gloess ! ************************************************************************************************** SUBROUTINE pw_gpu_c1dr3d_3d_ps(pw1, pw2, scale) - TYPE(pw_type), INTENT(IN) :: pw1 + TYPE(pw_c1d_type), INTENT(IN) :: pw1 TYPE(pw_type), INTENT(INOUT) :: pw2 REAL(KIND=dp), INTENT(IN) :: scale @@ -817,7 +818,7 @@ END SUBROUTINE pw_gpu_f SUBROUTINE pw_gpu_fg(pwbuf, pw2, scale) COMPLEX(KIND=dp), DIMENSION(:, :), INTENT(IN), & TARGET :: pwbuf - TYPE(pw_type), INTENT(IN) :: pw2 + TYPE(pw_c1d_type), INTENT(IN) :: pw2 REAL(KIND=dp), INTENT(IN) :: scale CHARACTER(len=*), PARAMETER :: routineN = 'pw_gpu_fg' @@ -850,7 +851,7 @@ END SUBROUTINE pw_gpu_fg_c ! pointers to data arrays ptr_pwin => pwbuf(1, 1) - ptr_pwout => pw2%cc(1) + ptr_pwout => pw2%array(1) ! pointer to map array ptr_ghatmap => pw2%pw_grid%g_hatmap(1, 1) @@ -875,7 +876,7 @@ END SUBROUTINE pw_gpu_fg !> \author Andreas Gloess ! ************************************************************************************************** SUBROUTINE pw_gpu_sf(pw1, pwbuf, scale) - TYPE(pw_type), INTENT(IN) :: pw1 + TYPE(pw_c1d_type), INTENT(IN) :: pw1 COMPLEX(KIND=dp), DIMENSION(:, :), INTENT(INOUT), & TARGET :: pwbuf REAL(KIND=dp), INTENT(IN) :: scale @@ -909,7 +910,7 @@ END SUBROUTINE pw_gpu_sf_c mmax = MAX(mg, 1) ! pointers to data arrays - ptr_pwin => pw1%cc(1) + ptr_pwin => pw1%array(1) ptr_pwout => pwbuf(1, 1) ! pointer to map array diff --git a/src/pw/pw_methods.F b/src/pw/pw_methods.F index 62bfd5d6be..0cafbb17fb 100644 --- a/src/pw/pw_methods.F +++ b/src/pw/pw_methods.F @@ -48,11 +48,11 @@ MODULE pw_methods PW_MODE_DISTRIBUTED, & PW_MODE_LOCAL, & pw_grid_type - USE pw_types, ONLY: COMPLEXDATA1D, & - REALDATA3D, & - REALSPACE, & - RECIPROCALSPACE, & - pw_type, pw_r1d_type, pw_r3d_type, pw_c1d_type, pw_c3d_type + USE pw_types, ONLY: & + REALDATA3D, & + REALSPACE, & + RECIPROCALSPACE, & + pw_type, pw_r1d_type, pw_r3d_type, pw_c1d_type, pw_c3d_type #include "../base/base_uses.f90" #:include 'pw_types.fypp' @@ -77,10 +77,6 @@ MODULE pw_methods INTEGER, PARAMETER, PUBLIC :: do_accurate_sum = 0, & do_standard_sum = 1 - INTERFACE pw_derive - MODULE PROCEDURE pw_derive_pw, pw_derive_c1d - END INTERFACE - INTERFACE pw_zero MODULE PROCEDURE pw_zero_pw #:for kind in pw_kinds @@ -142,9 +138,6 @@ MODULE pw_methods INTERFACE pw_multiply MODULE PROCEDURE pw_multiply_pw - #:for kind in pw_kinds - MODULE PROCEDURE pw_multiply_pw_${kind}$ - #:endfor #:for kind, kind2 in pw_kinds2_sameD MODULE PROCEDURE pw_multiply_${kind}$_${kind2}$ #:endfor @@ -169,7 +162,6 @@ MODULE pw_methods END INTERFACE INTERFACE pw_integral_a2b - MODULE PROCEDURE pw_integral_a2b_pw_pw #:for kind, kind2 in pw_kinds2_sameD #:if kind[1]=="1" MODULE PROCEDURE pw_integral_a2b_${kind}$_${kind2}$ @@ -178,7 +170,6 @@ MODULE pw_methods END INTERFACE INTERFACE pw_gather - MODULE PROCEDURE pw_gather_s_pw, pw_gather_p_pw #:for kind in pw_kinds #:if kind[1]=="1" MODULE PROCEDURE pw_gather_p_${kind}$ @@ -192,7 +183,6 @@ MODULE pw_methods END INTERFACE INTERFACE pw_scatter - MODULE PROCEDURE pw_scatter_s_pw, pw_scatter_p_pw #:for kind in pw_kinds #:if kind[1]=="1" MODULE PROCEDURE pw_scatter_p_${kind}$ @@ -206,16 +196,14 @@ MODULE pw_methods END INTERFACE INTERFACE pw_copy_to_array - MODULE PROCEDURE pw_copy_to_array_r, pw_copy_to_array_r1 - MODULE PROCEDURE pw_copy_to_array_c, pw_copy_to_array_c1 + MODULE PROCEDURE pw_copy_to_array_r, pw_copy_to_array_c #:for kind, kind2 in pw_kinds2_sameD MODULE PROCEDURE pw_copy_to_array_${kind}$_${kind2}$ #:endfor END INTERFACE INTERFACE pw_copy_from_array - MODULE PROCEDURE pw_copy_from_array_r, pw_copy_from_array_r1 - MODULE PROCEDURE pw_copy_from_array_c, pw_copy_from_array_c1 + MODULE PROCEDURE pw_copy_from_array_r, pw_copy_from_array_c #:for kind, kind2 in pw_kinds2_sameD MODULE PROCEDURE pw_copy_from_array_${kind}$_${kind2}$ #:endfor @@ -236,56 +224,6 @@ MODULE pw_methods #:for kind, type in pw_list -! ************************************************************************************************** -!> \brief pw_out = pw_out + alpha * pw1 * pw2 -!> alpha defaults to 1 -!> \param pw_out ... -!> \param pw1 ... -!> \param pw2 ... -!> \param alpha ... -!> \author JGH -! ************************************************************************************************** - SUBROUTINE pw_multiply_pw_${kind}$ (pw_out, pw1, pw2, alpha) - - TYPE(pw_type), INTENT(INOUT) :: pw_out - TYPE(pw_type), INTENT(IN) :: pw1 - TYPE(pw_${kind}$_type), INTENT(IN) :: pw2 - REAL(KIND=dp), INTENT(IN), OPTIONAL :: alpha - - CHARACTER(len=*), PARAMETER :: routineN = 'pw_multiply' - - INTEGER :: handle - REAL(KIND=dp) :: my_alpha - - CALL timeset(routineN, handle) - - my_alpha = 1.0_dp - IF (PRESENT(alpha)) my_alpha = alpha - - IF (.NOT. ASSOCIATED(pw_out%pw_grid, pw1%pw_grid) .OR. .NOT. ASSOCIATED(pw_out%pw_grid, pw2%pw_grid)) & - CPABORT("pw_multiply not implemented for non-identical grids!") - - IF (.FALSE.) THEN - #:if kind=="r1d" - ELSE IF (pw_out%in_use == COMPLEXDATA1D .AND. pw1%in_use == COMPLEXDATA1D) THEN - IF (my_alpha == 1.0_dp) THEN -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2) - pw_out%cc = pw_out%cc + pw1%cc*pw2%array -!$OMP END PARALLEL WORKSHARE - ELSE -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2) - pw_out%cc = pw_out%cc + my_alpha*pw1%cc*pw2%array -!$OMP END PARALLEL WORKSHARE - END IF - #:endif - ELSE - CPABORT("NYI") - END IF - - CALL timestop(handle) - - END SUBROUTINE pw_multiply_pw_${kind}$ - ! ************************************************************************************************** !> \brief pw2 = alpha*pw1 + beta*pw2 !> alpha defaults to 1, beta defaults to 1 @@ -319,21 +257,15 @@ SUBROUTINE pw_axpy_${kind}$_pw(pw1, pw2, alpha, beta, allow_noncompatible_grids) CALL pw_axpy_${kind}$_r3d(pw1, pw2_r3d, alpha, beta, allow_noncompatible_grids) RETURN END IF + #:else + MARK_USED(pw1) + MARK_USED(pw2) + MARK_USED(alpha) + MARK_USED(beta) + MARK_USED(allow_noncompatible_grids) + CPABORT("") #:endif - #:if kind[1]=="1" - TYPE(pw_c1d_type) :: pw2_c1d - - IF (pw2%in_use == COMPLEXDATA1D) THEN - pw2_c1d%in_space = pw2%in_space - pw2_c1d%pw_grid => pw2%pw_grid - pw2_c1d%array => pw2%cc - CALL pw_axpy_${kind}$_c1d(pw1, pw2_c1d, alpha, beta, allow_noncompatible_grids) - RETURN - END IF - #:endif - CPABORT("") - END SUBROUTINE pw_axpy_${kind}$_pw ! ************************************************************************************************** @@ -369,22 +301,15 @@ SUBROUTINE pw_axpy_pw_${kind}$ (pw1, pw2, alpha, beta, allow_noncompatible_grids CALL pw_axpy_r3d_${kind}$ (pw1_r3d, pw2, alpha, beta, allow_noncompatible_grids) RETURN END IF + #:else + MARK_USED(pw1) + MARK_USED(pw2) + MARK_USED(alpha) + MARK_USED(beta) + MARK_USED(allow_noncompatible_grids) + CPABORT("") #:endif - #:if kind[1]=="1" - TYPE(pw_c1d_type) :: pw1_c1d - - IF (pw1%in_use == COMPLEXDATA1D) THEN - pw1_c1d%in_space = pw1%in_space - pw1_c1d%pw_grid => pw1%pw_grid - pw1_c1d%array => pw1%cc - CALL pw_axpy_c1d_${kind}$ (pw1_c1d, pw2, alpha, beta, allow_noncompatible_grids) - RETURN - END IF - #:endif - - CPABORT("") - END SUBROUTINE pw_axpy_pw_${kind}$ ! ************************************************************************************************** @@ -405,7 +330,6 @@ SUBROUTINE pw_transfer_${kind}$_pw(pw1, pw2, debug) LOGICAL, INTENT(IN), OPTIONAL :: debug TYPE(pw_r3d_type) :: pw2_r3d - TYPE(pw_c1d_type) :: pw2_c1d IF (pw2%in_use == REALDATA3D) THEN pw2_r3d%in_space = pw2%in_space @@ -414,13 +338,6 @@ SUBROUTINE pw_transfer_${kind}$_pw(pw1, pw2, debug) CALL pw_transfer_${kind}$_r3d(pw1, pw2_r3d, debug) RETURN END IF - IF (pw2%in_use == COMPLEXDATA1D) THEN - pw2_c1d%in_space = pw2%in_space - pw2_c1d%pw_grid => pw2%pw_grid - pw2_c1d%array => pw2%cc - CALL pw_transfer_${kind}$_c1d(pw1, pw2_c1d, debug) - RETURN - END IF CPABORT("") END SUBROUTINE pw_transfer_${kind}$_pw @@ -443,7 +360,6 @@ SUBROUTINE pw_transfer_pw_${kind}$ (pw1, pw2, debug) LOGICAL, INTENT(IN), OPTIONAL :: debug TYPE(pw_r3d_type) :: pw1_r3d - TYPE(pw_c1d_type) :: pw1_c1d IF (pw1%in_use == REALDATA3D) THEN pw1_r3d%in_space = pw1%in_space @@ -452,13 +368,6 @@ SUBROUTINE pw_transfer_pw_${kind}$ (pw1, pw2, debug) CALL pw_transfer_r3d_${kind}$ (pw1_r3d, pw2, debug) RETURN END IF - IF (pw1%in_use == COMPLEXDATA1D) THEN - pw1_c1d%in_space = pw1%in_space - pw1_c1d%pw_grid => pw1%pw_grid - pw1_c1d%array => pw1%cc - CALL pw_transfer_c1d_${kind}$ (pw1_c1d, pw2, debug) - RETURN - END IF CPABORT("") END SUBROUTINE pw_transfer_pw_${kind}$ @@ -478,19 +387,11 @@ SUBROUTINE pw_copy_${kind}$_pw(pw1, pw2) CALL pw_copy_${kind}$_r3d(pw1, pw2_r3d) RETURN END IF + #:else + MARK_USED(pw1) + MARK_USED(pw2) + CPABORT("") #:endif - #:if kind[1]=="1" - TYPE(pw_c1d_type) :: pw2_c1d - - IF (pw2%in_use == COMPLEXDATA1D) THEN - pw2_c1d%in_space = pw2%in_space - pw2_c1d%pw_grid => pw2%pw_grid - pw2_c1d%array => pw2%cc - CALL pw_copy_${kind}$_c1d(pw1, pw2_c1d) - RETURN - END IF - #:endif - CPABORT("") END SUBROUTINE pw_copy_${kind}$_pw @@ -510,17 +411,9 @@ SUBROUTINE pw_copy_pw_${kind}$ (pw1, pw2) RETURN END IF #:endif - #:if kind[1]=="1" - TYPE(pw_c1d_type) :: pw1_c1d - IF (pw1%in_use == COMPLEXDATA1D) THEN - pw1_c1d%in_space = pw1%in_space - pw1_c1d%pw_grid => pw1%pw_grid - pw1_c1d%array => pw1%cc - CALL pw_copy_c1d_${kind}$ (pw1_c1d, pw2) - RETURN - END IF - #:endif CPABORT("") + MARK_USED(pw1) + MARK_USED(pw2) END SUBROUTINE pw_copy_pw_${kind}$ @@ -848,863 +741,101 @@ SUBROUTINE pw_scatter_p_${kind}$ (pw, c, scale) END SUBROUTINE pw_scatter_p_${kind}$ #:endif -! ************************************************************************************************** -!> \brief Generic function for 3d FFT of a coefficient_type or pw_type -!> \param pw1 ... -!> \param pw2 ... -!> \param debug ... -!> \par History -!> JGH (30-12-2000): New setup of functions and adaptation to parallelism -!> JGH (04-01-2001): Moved routine from pws to this module, only covers -!> pw_types, no more coefficient types -!> \author apsi -!> \note -!> fft_wrap_pw1pw2 -! ************************************************************************************************** - SUBROUTINE fft_wrap_pw1pw2_pw_${kind}$ (pw1, pw2, debug) - - TYPE(pw_type), INTENT(IN) :: pw1 - TYPE(pw_${kind}$_type), INTENT(INOUT) :: pw2 - LOGICAL, INTENT(IN), OPTIONAL :: debug - - CHARACTER(len=*), PARAMETER :: routineN = 'fft_wrap_pw1pw2' - - CHARACTER(LEN=9) :: mode - COMPLEX(KIND=dp), DIMENSION(:, :), CONTIGUOUS, POINTER :: grays - COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER :: c_in, c_out - INTEGER :: dir, handle, handle2, my_pos, nrays, & - out_space, out_unit - #:if kind=="c1d" or kind=="r3d" - INTEGER, DIMENSION(3) :: nloc - #:endif - INTEGER, DIMENSION(:), POINTER :: n - LOGICAL :: test -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - LOGICAL :: use_pw_gpu -#endif - REAL(KIND=dp) :: norm - - CALL timeset(routineN, handle2) - out_unit = cp_logger_get_default_io_unit() - CALL timeset(routineN//"_"//TRIM(ADJUSTL(cp_to_string( & - CEILING(pw1%pw_grid%cutoff/10)*10))), handle) - - NULLIFY (c_in) - NULLIFY (c_out) - - IF (PRESENT(debug)) THEN - test = debug - ELSE - test = .FALSE. - END IF - - !..check if grids are compatible - IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN - IF (pw1%pw_grid%dvol /= pw2%pw_grid%dvol) THEN - CPABORT("PW grids not compatible") - END IF - IF (pw1%pw_grid%para%group /= pw2%pw_grid%para%group) THEN - CPABORT("PW grids have not compatible MPI groups") - END IF - END IF + SUBROUTINE pw_multiply_with_${kind}$_pw(pw1, pw2) + TYPE(pw_${kind}$_type), INTENT(INOUT) :: pw1 + TYPE(pw_type), INTENT(IN) :: pw2 - !..prepare input - IF (pw1%in_space == REALSPACE) THEN - dir = FWFFT - norm = 1.0_dp/pw1%pw_grid%ngpts - out_space = RECIPROCALSPACE - ELSE IF (pw1%in_space == RECIPROCALSPACE) THEN - dir = BWFFT - norm = 1.0_dp - out_space = REALSPACE - ELSE - CPABORT("Error in space tag") - END IF + #:if kind[1]=="3" + TYPE(pw_r3d_type) :: pw2_r3d - n => pw1%pw_grid%npts - - mode = fftselect(pw1%in_use, REALDATA3D, pw1%in_space) - - IF (pw1%pw_grid%para%mode == PW_MODE_LOCAL) THEN - - ! - !..replicated data, use local FFT - ! - - IF (test .AND. out_unit > 0) THEN - WRITE (out_unit, '(A)') " FFT Protocol " - IF (dir == FWFFT) WRITE (out_unit, '(A,T76,A)') " Transform direction ", "FWFFT" - IF (dir == BWFFT) WRITE (out_unit, '(A,T76,A)') " Transform direction ", "BWFFT" - IF (pw1%in_space == REALSPACE) & - WRITE (out_unit, '(A,T72,A)') " in space ", "REALSPACE" - IF (pw1%in_space == RECIPROCALSPACE) & - WRITE (out_unit, '(A,T66,A)') " in space ", "RECIPROCALSPACE" - IF (out_space == REALSPACE) & - WRITE (out_unit, '(A,T72,A)') " out space ", "REALSPACE" - IF (out_space == RECIPROCALSPACE) & - WRITE (out_unit, '(A,T66,A)') " out space ", "RECIPROCALSPACE" - WRITE (out_unit, '(A,T66,E15.6)') " scale factor", norm + IF (pw2%in_use == REALDATA3D) THEN + pw2_r3d%in_space = pw2%in_space + pw2_r3d%pw_grid => pw2%pw_grid + pw2_r3d%array => pw2%cr3d + CALL pw_multiply_with_${kind}$_r3d(pw1, pw2_r3d) + RETURN END IF + #:endif + MARK_USED(pw1) + MARK_USED(pw2) + CPABORT("") - SELECT CASE (mode) - CASE DEFAULT - CPABORT("Illegal combination of in_use and in_space") - #:if kind=="c3d" - CASE ("FW_C3DR3D") - c_in => pw1%cc3d - c_out => pw2%array - CALL fft3d(dir, n, c_in, c_out, scale=norm, debug=test) - CASE ("FW_R3DR3D") - pw2%array = CMPLX(pw1%cr3d, 0.0_dp, KIND=dp) - c_out => pw2%array - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - #:endif - #:if kind=="c1d" - CASE ("FW_C3DR3D") - c_in => pw1%cc3d - ALLOCATE (c_out(n(1), n(2), n(3))) - ! transform - CALL fft3d(dir, n, c_in, c_out, scale=norm, debug=test) - ! gather results - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " PW_GATHER : 3d -> 1d " - CALL pw_gather_s_c1d_c3d(pw2, c_out) - DEALLOCATE (c_out) - CASE ("FW_R3DR3D") -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - CALL pw_gpu_r3dc1d_3d(pw1, pw2, scale=norm) -#elif defined (__PW_FPGA) - ALLOCATE (c_out(n(1), n(2), n(3))) - ! check if bitstream for the fft size is present - ! if not, perform fft3d in CPU - IF (pw_fpga_init_bitstream(n) == 1) THEN - CALL pw_copy_to_array(pw1, c_out) -#if (__PW_FPGA_SP && __PW_FPGA) - CALL pw_fpga_r3dc1d_3d_sp(n, c_out) -#else - CALL pw_fpga_r3dc1d_3d_dp(n, c_out) -#endif - CALL zdscal(n(1)*n(2)*n(3), norm, c_out, 1) - CALL pw_gather_s_${kind}$ (pw2, c_out) - ELSE - CALL pw_copy_to_array(pw1, c_out) - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - CALL pw_gather_s_${kind}$ (pw2, c_out) - END IF - DEALLOCATE (c_out) -#else - ALLOCATE (c_out(n(1), n(2), n(3))) - CALL pw_copy_to_array(pw1, c_out) - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - CALL pw_gather_s_${kind}$_c3d(pw2, c_out) - DEALLOCATE (c_out) -#endif - #:endif - #:if kind=="c3d" - CASE ("BW_C3DR3D") - c_in => pw1%cc3d - c_out => pw2%array - CALL fft3d(dir, n, c_in, c_out, scale=norm, debug=test) - #:endif - #:if kind=="r3d" - CASE ("BW_C3DR3D") - c_in => pw1%cc3d - ALLOCATE (c_out(n(1), n(2), n(3))) - CALL fft3d(dir, n, c_in, c_out, scale=norm, debug=test) - ! use real part only - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " REAL part " - pw2%array = REAL(c_out, KIND=dp) - DEALLOCATE (c_out) - #:endif - #:if kind=="c3d" - CASE ("BW_C1DR3D") - c_out => pw2%array - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " PW_SCATTER : 3d -> 1d " - CALL pw_scatter_s_pw(pw1, c_out) - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - #:endif - #:if kind=="r3d" - CASE ("BW_C1DR3D") -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - CALL pw_gpu_c1dr3d_3d(pw1, pw2, scale=norm) -#elif defined (__PW_FPGA) - ALLOCATE (c_out(n(1), n(2), n(3))) - ! check if bitstream for the fft size is present - ! if not, perform fft3d in CPU - IF (pw_fpga_init_bitstream(n) == 1) THEN - CALL pw_scatter_s_${kind}$_c3d(pw1, c_out) - ! transform using FPGA -#if (__PW_FPGA_SP && __PW_FPGA) - CALL pw_fpga_c1dr3d_3d_sp(n, c_out) -#else - CALL pw_fpga_c1dr3d_3d_dp(n, c_out) -#endif - CALL zdscal(n(1)*n(2)*n(3), norm, c_out, 1) - ! use real part only - CALL pw_copy_from_array(pw2, c_out) - ELSE - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " PW_SCATTER : 3d -> 1d " - CALL pw_scatter_s_${kind}$_c3d(pw1, c_out) - ! transform - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - ! use real part only - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " REAL part " - CALL pw_copy_from_array(pw2, c_out) - END IF - DEALLOCATE (c_out) -#else - ALLOCATE (c_out(n(1), n(2), n(3))) - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " PW_SCATTER : 3d -> 1d " - CALL pw_scatter_s_pw(pw1, c_out) - ! transform - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - ! use real part only - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " REAL part " - CALL pw_copy_from_array(pw2, c_out) - DEALLOCATE (c_out) -#endif - #:endif - END SELECT + END SUBROUTINE pw_multiply_with_${kind}$_pw - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " End of FFT Protocol " + SUBROUTINE pw_multiply_with_pw_${kind}$ (pw1, pw2) + TYPE(pw_type), INTENT(INOUT) :: pw1 + TYPE(pw_${kind}$_type), INTENT(IN) :: pw2 - ELSE + #:if kind[1]=="3" + TYPE(pw_r3d_type) :: pw1_r3d - ! - !..parallel FFT - ! - - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) THEN - WRITE (out_unit, '(A)') " FFT Protocol " - IF (dir == FWFFT) WRITE (out_unit, '(A,T76,A)') " Transform direction ", "FWFFT" - IF (dir == BWFFT) WRITE (out_unit, '(A,T76,A)') " Transform direction ", "BWFFT" - IF (pw1%in_space == REALSPACE) & - WRITE (out_unit, '(A,T72,A)') " in space ", "REALSPACE" - IF (pw1%in_space == RECIPROCALSPACE) & - WRITE (out_unit, '(A,T66,A)') " in space ", "RECIPROCALSPACE" - IF (out_space == REALSPACE) & - WRITE (out_unit, '(A,T72,A)') " out space ", "REALSPACE" - IF (out_space == RECIPROCALSPACE) & - WRITE (out_unit, '(A,T66,A)') " out space ", "RECIPROCALSPACE" - WRITE (out_unit, '(A,T66,E15.6)') " scale factor", norm + IF (pw1%in_use == REALDATA3D) THEN + pw1_r3d%in_space = pw1%in_space + pw1_r3d%pw_grid => pw1%pw_grid + pw1_r3d%array => pw1%cr3d + CALL pw_multiply_with_r3d_${kind}$ (pw1_r3d, pw2) + RETURN END IF + #:endif + MARK_USED(pw1) + MARK_USED(pw2) + CPABORT("") - my_pos = pw1%pw_grid%para%my_pos - nrays = pw1%pw_grid%para%nyzray(my_pos) - grays => pw1%pw_grid%grays - CPASSERT(SIZE(grays, 1) == n(1)) - CPASSERT(SIZE(grays, 2) == nrays) - - SELECT CASE (mode) - CASE DEFAULT - CALL cp_abort(__LOCATION__, & - "Illegal combination of in_use and in_space "// & - "in parallel 3d FFT") - #:if kind=="c1d" - CASE ("FW_C3DR3D") - !..prepare input - c_in => pw1%cc3d - grays = z_zero - !..transform - IF (pw1%pw_grid%para%ray_distribution) THEN - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%group, & - pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%yzp, pw1%pw_grid%para%nyzray, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - ELSE - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - END IF - !..prepare output - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) & - WRITE (out_unit, '(A)') " PW_GATHER : 2d -> 1d " - CALL pw_gather_p_${kind}$ (pw2, grays) - CASE ("FW_R3DR3D") -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - ! (no ray dist. is not efficient in CUDA) - use_pw_gpu = pw1%pw_grid%para%ray_distribution - IF (use_pw_gpu) THEN - CALL pw_gpu_r3dc1d_3d_ps(pw1, pw2, scale=norm) - ELSE -#endif -!.. prepare input - nloc = pw1%pw_grid%npts_local - ALLOCATE (c_in(nloc(1), nloc(2), nloc(3))) - CALL pw_copy_to_array(pw1, c_in) - grays = z_zero - !..transform - IF (pw1%pw_grid%para%ray_distribution) THEN - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%group, & - pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%yzp, pw1%pw_grid%para%nyzray, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - ELSE - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - END IF - !..prepare output - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) & - WRITE (out_unit, '(A)') " PW_GATHER : 2d -> 1d " - CALL pw_gather(pw2, grays) - DEALLOCATE (c_in) - -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - END IF -#endif - #:endif - #:if kind=="c3d" - CASE ("BW_C1DR3D") - !..prepare input - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) & - WRITE (out_unit, '(A)') " PW_SCATTER : 2d -> 1d " - grays = z_zero - CALL pw_scatter_p_pw(pw1, grays) - c_in => pw2%array - !..transform - IF (pw1%pw_grid%para%ray_distribution) THEN - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%group, & - pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%yzp, pw1%pw_grid%para%nyzray, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - ELSE - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - END IF - !..prepare output (nothing to do) - #:endif - #:if kind=="r3d" - CASE ("BW_C1DR3D") -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - ! (no ray dist. is not efficient in CUDA) - use_pw_gpu = pw1%pw_grid%para%ray_distribution - IF (use_pw_gpu) THEN - CALL pw_gpu_c1dr3d_3d_ps(pw1, pw2, scale=norm) - ELSE -#endif -!.. prepare input - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) & - WRITE (out_unit, '(A)') " PW_SCATTER : 2d -> 1d " - grays = z_zero - CALL pw_scatter_p_pw(pw1, grays) - nloc = pw2%pw_grid%npts_local - ALLOCATE (c_in(nloc(1), nloc(2), nloc(3))) - !..transform - IF (pw1%pw_grid%para%ray_distribution) THEN - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%group, & - pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%yzp, pw1%pw_grid%para%nyzray, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - ELSE - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - END IF - !..prepare output - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) & - WRITE (out_unit, '(A)') " Real part " - CALL pw_copy_from_array(pw2, c_in) - DEALLOCATE (c_in) -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - END IF -#endif - #:endif - END SELECT - - END IF - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) THEN - WRITE (out_unit, '(A)') " End of FFT Protocol " - END IF - - CALL timestop(handle) - CALL timestop(handle2) - - END SUBROUTINE fft_wrap_pw1pw2_pw_${kind}$ + END SUBROUTINE pw_multiply_with_pw_${kind}$ + #:endfor + #:for kind, type, kind2, type2 in pw_list2_sameD ! ************************************************************************************************** -!> \brief Generic function for 3d FFT of a coefficient_type or pw_type +!> \brief copy a pw type variable !> \param pw1 ... !> \param pw2 ... -!> \param debug ... !> \par History -!> JGH (30-12-2000): New setup of functions and adaptation to parallelism -!> JGH (04-01-2001): Moved routine from pws to this module, only covers -!> pw_types, no more coefficient types +!> JGH (7-Mar-2001) : check for pw_grid %id_nr, allow copy if +!> in_use == COMPLEXDATA1D and in_space == RECIPROCALSPACE +!> JGH (21-Feb-2003) : Code for generalized reference grids !> \author apsi !> \note -!> fft_wrap_pw1pw2 +!> Currently only copying of respective types allowed, +!> in order to avoid errors ! ************************************************************************************************** - SUBROUTINE fft_wrap_pw1pw2_${kind}$_pw(pw1, pw2, debug) + SUBROUTINE pw_copy_${kind}$_${kind2}$ (pw1, pw2) - TYPE(pw_${kind}$_type), INTENT(IN) :: pw1 - TYPE(pw_type), INTENT(INOUT) :: pw2 - LOGICAL, INTENT(IN), OPTIONAL :: debug + TYPE(pw_${kind}$_type), INTENT(IN) :: pw1 + TYPE(pw_${kind2}$_type), INTENT(INOUT) :: pw2 - CHARACTER(len=*), PARAMETER :: routineN = 'fft_wrap_pw1pw2' + CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy' - CHARACTER(LEN=9) :: mode - COMPLEX(KIND=dp), DIMENSION(:, :), POINTER :: grays - COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER :: c_in, c_out - INTEGER :: dir, handle, handle2, my_pos, nrays, & - out_space, out_unit - #:if kind=="c1d" or kind=="r3d" - INTEGER, DIMENSION(3) :: nloc + INTEGER :: handle + #:if kind[1:]=='1d' + INTEGER :: i, j, ng, ng1, ng2, ns #:endif - INTEGER, DIMENSION(:), POINTER :: n - LOGICAL :: test -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - LOGICAL :: use_pw_gpu -#endif - REAL(KIND=dp) :: norm - - CALL timeset(routineN, handle2) - out_unit = cp_logger_get_default_io_unit() - CALL timeset(routineN//"_"//TRIM(ADJUSTL(cp_to_string( & - CEILING(pw1%pw_grid%cutoff/10)*10))), handle) - NULLIFY (c_in) - NULLIFY (c_out) - - IF (PRESENT(debug)) THEN - test = debug - ELSE - test = .FALSE. - END IF - - !..check if grids are compatible - IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN - IF (pw1%pw_grid%dvol /= pw2%pw_grid%dvol) THEN - CPABORT("PW grids not compatible") - END IF - IF (pw1%pw_grid%para%group /= pw2%pw_grid%para%group) THEN - CPABORT("PW grids have not compatible MPI groups") - END IF - END IF - - !..prepare input - IF (pw1%in_space == REALSPACE) THEN - dir = FWFFT - norm = 1.0_dp/pw1%pw_grid%ngpts - out_space = RECIPROCALSPACE - ELSE IF (pw1%in_space == RECIPROCALSPACE) THEN - dir = BWFFT - norm = 1.0_dp - out_space = REALSPACE - ELSE - CPABORT("Error in space tag") - END IF + CALL timeset(routineN, handle) - n => pw1%pw_grid%npts - - mode = fftselect(REALDATA3D, pw2%in_use, pw1%in_space) - - IF (pw1%pw_grid%para%mode == PW_MODE_LOCAL) THEN - - ! - !..replicated data, use local FFT - ! - - IF (test .AND. out_unit > 0) THEN - WRITE (out_unit, '(A)') " FFT Protocol " - IF (dir == FWFFT) WRITE (out_unit, '(A,T76,A)') " Transform direction ", "FWFFT" - IF (dir == BWFFT) WRITE (out_unit, '(A,T76,A)') " Transform direction ", "BWFFT" - IF (pw1%in_space == REALSPACE) & - WRITE (out_unit, '(A,T72,A)') " in space ", "REALSPACE" - IF (pw1%in_space == RECIPROCALSPACE) & - WRITE (out_unit, '(A,T66,A)') " in space ", "RECIPROCALSPACE" - IF (out_space == REALSPACE) & - WRITE (out_unit, '(A,T72,A)') " out space ", "REALSPACE" - IF (out_space == RECIPROCALSPACE) & - WRITE (out_unit, '(A,T66,A)') " out space ", "RECIPROCALSPACE" - WRITE (out_unit, '(A,T66,E15.6)') " scale factor", norm - END IF + IF (pw1%in_space /= pw2%in_space) & + CPABORT("Both grids must be in the same space!") + IF (pw1%pw_grid%spherical .neqv. pw2%pw_grid%spherical) & + CPABORT("Both grids must be either spherical or non-spherical!") + IF (pw1%pw_grid%spherical .AND. .NOT. pw1%in_space == RECIPROCALSPACE) & + CPABORT("Spherical grids only exist in reciprocal space!") - SELECT CASE (mode) - CASE DEFAULT - CPABORT("Illegal combination of in_use and in_space") - #:if kind=="c3d" - CASE ("FW_R3DC3D") - c_in => pw1%array - c_out => pw2%cc3d - CALL fft3d(dir, n, c_in, c_out, scale=norm, debug=test) - #:endif - #:if kind=="r3d" - CASE ("FW_R3DC3D") - pw2%cc3d = CMPLX(pw1%array, 0.0_dp, KIND=dp) - c_out => pw2%cc3d - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - #:endif - #:if kind=="c3d" - CASE ("FW_R3DC1D") - c_in => pw1%array - ALLOCATE (c_out(n(1), n(2), n(3))) - ! transform - CALL fft3d(dir, n, c_in, c_out, scale=norm, debug=test) - ! gather results - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " PW_GATHER : 3d -> 1d " - CALL pw_gather_s_pw(pw2, c_out) - DEALLOCATE (c_out) - #:endif - #:if kind=="r3d" - CASE ("FW_R3DC1D") -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - CALL pw_gpu_r3dc1d_3d(pw1, pw2, scale=norm) -#elif defined (__PW_FPGA) - ALLOCATE (c_out(n(1), n(2), n(3))) - ! check if bitstream for the fft size is present - ! if not, perform fft3d in CPU - IF (pw_fpga_init_bitstream(n) == 1) THEN - CALL pw_copy_to_array(pw1, c_out) -#if (__PW_FPGA_SP && __PW_FPGA) - CALL pw_fpga_r3dc1d_3d_sp(n, c_out) -#else - CALL pw_fpga_r3dc1d_3d_dp(n, c_out) -#endif - CALL zdscal(n(1)*n(2)*n(3), norm, c_out, 1) - CALL pw_gather_s_${kind}$ (pw2, c_out) + #:if kind[1]=='1' + IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN + IF (pw1%pw_grid%spherical .AND. pw2%pw_grid%spherical) THEN + IF (pw_compatible(pw1%pw_grid, pw2%pw_grid)) THEN + ng1 = SIZE(pw1%array) + ng2 = SIZE(pw2%array) + ng = MIN(ng1, ng2) +!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(ng, pw1, pw2) + pw2%array(1:ng) = ${type2type("pw1%array(1:ng)", kind, kind2)}$ +!$OMP END PARALLEL WORKSHARE + IF (ng2 > ng) THEN +!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(ng, ng2, pw2) + pw2%array(ng + 1:ng2) = CMPLX(0.0_dp, 0.0_dp, KIND=dp) +!$OMP END PARALLEL WORKSHARE + END IF ELSE - CALL pw_copy_to_array(pw1, c_out) - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - CALL pw_gather_s_${kind}$ (pw2, c_out) - END IF - DEALLOCATE (c_out) -#else - ALLOCATE (c_out(n(1), n(2), n(3))) - CALL pw_copy_to_array(pw1, c_out) - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - CALL pw_gather_s_pw(pw2, c_out) - DEALLOCATE (c_out) -#endif - #:endif - #:if kind=="c3d" - CASE ("BW_R3DC3D") - c_in => pw1%array - c_out => pw2%cc3d - CALL fft3d(dir, n, c_in, c_out, scale=norm, debug=test) - CASE ("BW_R3DR3D") - c_in => pw1%array - ALLOCATE (c_out(n(1), n(2), n(3))) - CALL fft3d(dir, n, c_in, c_out, scale=norm, debug=test) - ! use real part only - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " REAL part " - pw2%cr3d = REAL(c_out, KIND=dp) - DEALLOCATE (c_out) - #:endif - #:if kind=="c1d" - CASE ("BW_R3DC3D") - c_out => pw2%cc3d - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " PW_SCATTER : 3d -> 1d " - CALL pw_scatter_s_${kind}$_c3d(pw1, c_out) - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - CASE ("BW_R3DR3D") -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - CALL pw_gpu_c1dr3d_3d(pw1, pw2, scale=norm) -#elif defined (__PW_FPGA) - ALLOCATE (c_out(n(1), n(2), n(3))) - ! check if bitstream for the fft size is present - ! if not, perform fft3d in CPU - IF (pw_fpga_init_bitstream(n) == 1) THEN - CALL pw_scatter_s_${kind}$_c3d(pw1, c_out) - ! transform using FPGA -#if (__PW_FPGA_SP && __PW_FPGA) - CALL pw_fpga_c1dr3d_3d_sp(n, c_out) -#else - CALL pw_fpga_c1dr3d_3d_dp(n, c_out) -#endif - CALL zdscal(n(1)*n(2)*n(3), norm, c_out, 1) - ! use real part only - CALL pw_copy_from_array(pw2, c_out) - ELSE - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " PW_SCATTER : 3d -> 1d " - CALL pw_scatter_s_${kind}$_c3d(pw1, c_out) - ! transform - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - ! use real part only - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " REAL part " - CALL pw_copy_from_array(pw2, c_out) - END IF - DEALLOCATE (c_out) -#else - ALLOCATE (c_out(n(1), n(2), n(3))) - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " PW_SCATTER : 3d -> 1d " - CALL pw_scatter_s_${kind}$_c3d(pw1, c_out) - ! transform - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - ! use real part only - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " REAL part " - CALL pw_copy_from_array(pw2, c_out) - DEALLOCATE (c_out) -#endif - #:endif - END SELECT - - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " End of FFT Protocol " - - ELSE - - ! - !..parallel FFT - ! - - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) THEN - WRITE (out_unit, '(A)') " FFT Protocol " - IF (dir == FWFFT) WRITE (out_unit, '(A,T76,A)') " Transform direction ", "FWFFT" - IF (dir == BWFFT) WRITE (out_unit, '(A,T76,A)') " Transform direction ", "BWFFT" - IF (pw1%in_space == REALSPACE) & - WRITE (out_unit, '(A,T72,A)') " in space ", "REALSPACE" - IF (pw1%in_space == RECIPROCALSPACE) & - WRITE (out_unit, '(A,T66,A)') " in space ", "RECIPROCALSPACE" - IF (out_space == REALSPACE) & - WRITE (out_unit, '(A,T72,A)') " out space ", "REALSPACE" - IF (out_space == RECIPROCALSPACE) & - WRITE (out_unit, '(A,T66,A)') " out space ", "RECIPROCALSPACE" - WRITE (out_unit, '(A,T66,E15.6)') " scale factor", norm - END IF - - my_pos = pw1%pw_grid%para%my_pos - nrays = pw1%pw_grid%para%nyzray(my_pos) - grays => pw1%pw_grid%grays - CPASSERT(SIZE(grays, 1) == n(1)) - CPASSERT(SIZE(grays, 2) == nrays) - - SELECT CASE (mode) - CASE DEFAULT - CALL cp_abort(__LOCATION__, & - "Illegal combination of in_use and in_space "// & - "in parallel 3d FFT") - #:if kind=="c3d" - CASE ("FW_R3DC1D") - !..prepare input - c_in => pw1%array - grays = z_zero - !..transform - IF (pw1%pw_grid%para%ray_distribution) THEN - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%group, & - pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%yzp, pw1%pw_grid%para%nyzray, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - ELSE - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - END IF - !..prepare output - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) & - WRITE (out_unit, '(A)') " PW_GATHER : 2d -> 1d " - CALL pw_gather_p_pw(pw2, grays) - #:endif - #:if kind=="r3d" - CASE ("FW_R3DC1D") -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - ! (no ray dist. is not efficient in CUDA) - use_pw_gpu = pw1%pw_grid%para%ray_distribution - IF (use_pw_gpu) THEN - CALL pw_gpu_r3dc1d_3d_ps(pw1, pw2, scale=norm) - ELSE -#endif -!.. prepare input - nloc = pw1%pw_grid%npts_local - ALLOCATE (c_in(nloc(1), nloc(2), nloc(3))) - CALL pw_copy_to_array(pw1, c_in) - grays = z_zero - !..transform - IF (pw1%pw_grid%para%ray_distribution) THEN - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%group, & - pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%yzp, pw1%pw_grid%para%nyzray, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - ELSE - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - END IF - !..prepare output - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) & - WRITE (out_unit, '(A)') " PW_GATHER : 2d -> 1d " - CALL pw_gather_p_pw(pw2, grays) - DEALLOCATE (c_in) - -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - END IF -#endif - #:endif - #:if kind=="c1d" - CASE ("BW_R3DC3D") - !..prepare input - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) & - WRITE (out_unit, '(A)') " PW_SCATTER : 2d -> 1d " - grays = z_zero - CALL pw_scatter_p_${kind}$ (pw1, grays) - c_in => pw2%cc3d - !..transform - IF (pw1%pw_grid%para%ray_distribution) THEN - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%group, & - pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%yzp, pw1%pw_grid%para%nyzray, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - ELSE - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - END IF - !..prepare output (nothing to do) - #:endif - #:if kind=="c1d" - CASE ("BW_R3DR3D") -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - ! (no ray dist. is not efficient in CUDA) - use_pw_gpu = pw1%pw_grid%para%ray_distribution - IF (use_pw_gpu) THEN - CALL pw_gpu_c1dr3d_3d_ps(pw1, pw2, scale=norm) - ELSE -#endif -!.. prepare input - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) & - WRITE (out_unit, '(A)') " PW_SCATTER : 2d -> 1d " - grays = z_zero - CALL pw_scatter_p_${kind}$ (pw1, grays) - nloc = pw2%pw_grid%npts_local - ALLOCATE (c_in(nloc(1), nloc(2), nloc(3))) - !..transform - IF (pw1%pw_grid%para%ray_distribution) THEN - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%group, & - pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%yzp, pw1%pw_grid%para%nyzray, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - ELSE - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - END IF - !..prepare output - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) & - WRITE (out_unit, '(A)') " Real part " - CALL pw_copy_from_array(pw2, c_in) - DEALLOCATE (c_in) -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - END IF -#endif - #:endif - END SELECT - - END IF - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) THEN - WRITE (out_unit, '(A)') " End of FFT Protocol " - END IF - - CALL timestop(handle) - CALL timestop(handle2) - - END SUBROUTINE fft_wrap_pw1pw2_${kind}$_pw - - SUBROUTINE pw_multiply_with_${kind}$_pw(pw1, pw2) - TYPE(pw_${kind}$_type), INTENT(INOUT) :: pw1 - TYPE(pw_type), INTENT(IN) :: pw2 - - #:if kind[1]=="3" - TYPE(pw_r3d_type) :: pw2_r3d - - IF (pw2%in_use == REALDATA3D) THEN - pw2_r3d%in_space = pw2%in_space - pw2_r3d%pw_grid => pw2%pw_grid - pw2_r3d%array => pw2%cr3d - CALL pw_multiply_with_${kind}$_r3d(pw1, pw2_r3d) - RETURN - END IF - #:endif - - #:if kind[1]=="1" - TYPE(pw_c1d_type) :: pw2_c1d - - IF (pw2%in_use == COMPLEXDATA1D) THEN - pw2_c1d%in_space = pw2%in_space - pw2_c1d%pw_grid => pw2%pw_grid - pw2_c1d%array => pw2%cc - CALL pw_multiply_with_${kind}$_c1d(pw1, pw2_c1d) - RETURN - END IF - #:endif - CPABORT("") - - END SUBROUTINE pw_multiply_with_${kind}$_pw - - SUBROUTINE pw_multiply_with_pw_${kind}$ (pw1, pw2) - TYPE(pw_type), INTENT(INOUT) :: pw1 - TYPE(pw_${kind}$_type), INTENT(IN) :: pw2 - - #:if kind[1]=="3" - TYPE(pw_r3d_type) :: pw1_r3d - - IF (pw1%in_use == REALDATA3D) THEN - pw1_r3d%in_space = pw1%in_space - pw1_r3d%pw_grid => pw1%pw_grid - pw1_r3d%array => pw1%cr3d - CALL pw_multiply_with_r3d_${kind}$ (pw1_r3d, pw2) - RETURN - END IF - #:endif - - #:if kind[1]=="1" - TYPE(pw_c1d_type) :: pw1_c1d - - IF (pw1%in_use == COMPLEXDATA1D) THEN - pw1_c1d%in_space = pw1%in_space - pw1_c1d%pw_grid => pw1%pw_grid - pw1_c1d%array => pw1%cc - CALL pw_multiply_with_c1d_${kind}$ (pw1_c1d, pw2) - RETURN - END IF - #:endif - CPABORT("") - - END SUBROUTINE pw_multiply_with_pw_${kind}$ - #:endfor - - #:for kind, type, kind2, type2 in pw_list2_sameD -! ************************************************************************************************** -!> \brief copy a pw type variable -!> \param pw1 ... -!> \param pw2 ... -!> \par History -!> JGH (7-Mar-2001) : check for pw_grid %id_nr, allow copy if -!> in_use == COMPLEXDATA1D and in_space == RECIPROCALSPACE -!> JGH (21-Feb-2003) : Code for generalized reference grids -!> \author apsi -!> \note -!> Currently only copying of respective types allowed, -!> in order to avoid errors -! ************************************************************************************************** - SUBROUTINE pw_copy_${kind}$_${kind2}$ (pw1, pw2) - - TYPE(pw_${kind}$_type), INTENT(IN) :: pw1 - TYPE(pw_${kind2}$_type), INTENT(INOUT) :: pw2 - - CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy' - - INTEGER :: handle - #:if kind[1:]=='1d' - INTEGER :: i, j, ng, ng1, ng2, ns - #:endif - - CALL timeset(routineN, handle) - - IF (pw1%in_space /= pw2%in_space) & - CPABORT("Both grids must be in the same space!") - IF (pw1%pw_grid%spherical .neqv. pw2%pw_grid%spherical) & - CPABORT("Both grids must be either spherical or non-spherical!") - IF (pw1%pw_grid%spherical .AND. .NOT. pw1%in_space == RECIPROCALSPACE) & - CPABORT("Spherical grids only exist in reciprocal space!") - - #:if kind[1]=='1' - IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN - IF (pw1%pw_grid%spherical .AND. pw2%pw_grid%spherical) THEN - IF (pw_compatible(pw1%pw_grid, pw2%pw_grid)) THEN - ng1 = SIZE(pw1%array) - ng2 = SIZE(pw2%array) - ng = MIN(ng1, ng2) -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(ng, pw1, pw2) - pw2%array(1:ng) = ${type2type("pw1%array(1:ng)", kind, kind2)}$ -!$OMP END PARALLEL WORKSHARE - IF (ng2 > ng) THEN -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(ng, ng2, pw2) - pw2%array(ng + 1:ng2) = CMPLX(0.0_dp, 0.0_dp, KIND=dp) -!$OMP END PARALLEL WORKSHARE - END IF - ELSE - CPABORT("Copies between spherical grids require compatible grids!") + CPABORT("Copies between spherical grids require compatible grids!") END IF ELSE ng1 = SIZE(pw1%array) @@ -2811,11 +1942,7 @@ SUBROUTINE pw_zero_pw(pw) CALL timeset(routineN, handle) - IF (pw%in_use == COMPLEXDATA1D) THEN -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw) - pw%cc(:) = CMPLX(0.0_dp, 0.0_dp, KIND=dp) -!$OMP END PARALLEL WORKSHARE - ELSE IF (pw%in_use == REALDATA3D) THEN + IF (pw%in_use == REALDATA3D) THEN !$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw) pw%cr3d(:, :, :) = 0.0_dp !$OMP END PARALLEL WORKSHARE @@ -2846,7 +1973,6 @@ SUBROUTINE pw_copy_pw_pw(pw1, pw2) TYPE(pw_type), INTENT(INOUT) :: pw2 TYPE(pw_r3d_type) :: pw1_r3d - TYPE(pw_c1d_type) :: pw1_c1d IF (pw1%in_use == REALDATA3D) THEN pw1_r3d%in_space = pw1%in_space @@ -2855,13 +1981,6 @@ SUBROUTINE pw_copy_pw_pw(pw1, pw2) CALL pw_copy(pw1_r3d, pw2) RETURN END IF - IF (pw1%in_use == COMPLEXDATA1D) THEN - pw1_c1d%in_space = pw1%in_space - pw1_c1d%pw_grid => pw1%pw_grid - pw1_c1d%array => pw1%cc - CALL pw_copy(pw1_c1d, pw2) - RETURN - END IF CPABORT("") END SUBROUTINE pw_copy_pw_pw @@ -2892,32 +2011,6 @@ SUBROUTINE pw_copy_to_array_r(pw, array) CALL timestop(handle) END SUBROUTINE pw_copy_to_array_r -! ************************************************************************************************** -!> \brief ... -!> \param pw ... -!> \param array ... -! ************************************************************************************************** - SUBROUTINE pw_copy_to_array_r1(pw, array) - TYPE(pw_type), INTENT(IN) :: pw - REAL(KIND=dp), DIMENSION(:), INTENT(INOUT) :: array - - CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array_r' - - INTEGER :: handle - - CALL timeset(routineN, handle) - - IF (pw%in_use == COMPLEXDATA1D) THEN -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array) - array = REAL(pw%cc, KIND=dp) -!$OMP END PARALLEL WORKSHARE - ELSE - CPABORT("PW grid must be 3D!") - END IF - - CALL timestop(handle) - END SUBROUTINE pw_copy_to_array_r1 - ! ************************************************************************************************** !> \brief ... !> \param pw ... @@ -2945,33 +2038,6 @@ SUBROUTINE pw_copy_to_array_c(pw, array) CALL timestop(handle) END SUBROUTINE pw_copy_to_array_c -! ************************************************************************************************** -!> \brief ... -!> \param pw ... -!> \param array ... -! ************************************************************************************************** - SUBROUTINE pw_copy_to_array_c1(pw, array) - TYPE(pw_type), INTENT(IN) :: pw - COMPLEX(KIND=dp), DIMENSION(:), & - INTENT(INOUT) :: array - - CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array_c' - - INTEGER :: handle - - CALL timeset(routineN, handle) - - IF (pw%in_use == COMPLEXDATA1D) THEN -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array) - array = pw%cc -!$OMP END PARALLEL WORKSHARE - ELSE - CPABORT("PW grid must be 3D!") - END IF - - CALL timestop(handle) - END SUBROUTINE pw_copy_to_array_c1 - ! ************************************************************************************************** !> \brief ... !> \param pw ... @@ -2998,32 +2064,6 @@ SUBROUTINE pw_copy_from_array_r(pw, array) CALL timestop(handle) END SUBROUTINE pw_copy_from_array_r -! ************************************************************************************************** -!> \brief ... -!> \param pw ... -!> \param array ... -! ************************************************************************************************** - SUBROUTINE pw_copy_from_array_r1(pw, array) - TYPE(pw_type), INTENT(IN) :: pw - REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: array - - CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array_r' - - INTEGER :: handle - - CALL timeset(routineN, handle) - - IF (pw%in_use == COMPLEXDATA1D) THEN -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array) - pw%cc = array -!$OMP END PARALLEL WORKSHARE - ELSE - CPABORT("PW grid must be 3D!") - END IF - - CALL timestop(handle) - END SUBROUTINE pw_copy_from_array_r1 - ! ************************************************************************************************** !> \brief ... !> \param pw ... @@ -3050,32 +2090,6 @@ SUBROUTINE pw_copy_from_array_c(pw, array) CALL timestop(handle) END SUBROUTINE pw_copy_from_array_c -! ************************************************************************************************** -!> \brief ... -!> \param pw ... -!> \param array ... -! ************************************************************************************************** - SUBROUTINE pw_copy_from_array_c1(pw, array) - TYPE(pw_type), INTENT(IN) :: pw - COMPLEX(KIND=dp), DIMENSION(:), INTENT(IN) :: array - - CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array_c' - - INTEGER :: handle - - CALL timeset(routineN, handle) - - IF (pw%in_use == COMPLEXDATA1D) THEN -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array) - pw%cc = array -!$OMP END PARALLEL WORKSHARE - ELSE - CPABORT("PW grid must be 3D!") - END IF - - CALL timestop(handle) - END SUBROUTINE pw_copy_from_array_c1 - ! ************************************************************************************************** !> \brief multiplies pw coeffs with a number !> \param pw ... @@ -3095,10 +2109,6 @@ SUBROUTINE pw_scale_pw(pw, a) CALL timeset(routineN, handle) SELECT CASE (pw%in_use) - CASE (COMPLEXDATA1D) -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(A, pw) - pw%cc(:) = a*pw%cc(:) -!$OMP END PARALLEL WORKSHARE CASE (REALDATA3D) !$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(A, pw) pw%cr3d(:, :, :) = a*pw%cr3d(:, :, :) @@ -3123,7 +2133,7 @@ END SUBROUTINE pw_scale_pw !> \author Frederick Stein (12-Apr-2019) !> \note !> Performs a Gaussian damping -!> PW has to be in RECIPROCALSPACE and data in use is COMPLEXDATA1D +!> PW has to be in RECIPROCALSPACE ! ************************************************************************************************** SUBROUTINE pw_gauss_damp(pw, omega) @@ -3160,7 +2170,7 @@ END SUBROUTINE pw_gauss_damp !> \param omega ... !> \note !> Performs a Gaussian damping -!> PW has to be in RECIPROCALSPACE and data in use is COMPLEXDATA1D +!> PW has to be in RECIPROCALSPACE ! ************************************************************************************************** SUBROUTINE pw_log_deriv_gauss(pw, omega) @@ -3205,7 +2215,7 @@ END SUBROUTINE pw_log_deriv_gauss !> \author Frederick Stein (12-Apr-2019) !> \note !> Performs a Gaussian damping -!> PW has to be in RECIPROCALSPACE and data in use is COMPLEXDATA1D +!> PW has to be in RECIPROCALSPACE ! ************************************************************************************************** SUBROUTINE pw_compl_gauss_damp(pw, omega) @@ -3252,7 +2262,7 @@ END SUBROUTINE pw_compl_gauss_damp !> \param pw ... !> \param omega ... !> \note -!> PW has to be in RECIPROCALSPACE and data in use is COMPLEXDATA1D +!> PW has to be in RECIPROCALSPACE ! ************************************************************************************************** SUBROUTINE pw_log_deriv_compl_gauss(pw, omega) @@ -3308,7 +2318,7 @@ END SUBROUTINE pw_log_deriv_compl_gauss !> \author Frederick Stein (16-Dec-2021) !> \note !> Performs a Gaussian damping -!> PW has to be in RECIPROCALSPACE and data in use is COMPLEXDATA1D +!> PW has to be in RECIPROCALSPACE ! ************************************************************************************************** SUBROUTINE pw_gauss_damp_mix(pw, omega, scale_coul, scale_long) @@ -3349,7 +2359,7 @@ END SUBROUTINE pw_gauss_damp_mix !> \param scale_coul ... !> \param scale_long ... !> \note -!> PW has to be in RECIPROCALSPACE and data in use is COMPLEXDATA1D +!> PW has to be in RECIPROCALSPACE ! ************************************************************************************************** SUBROUTINE pw_log_deriv_mix_cl(pw, omega, scale_coul, scale_long) @@ -3398,7 +2408,7 @@ END SUBROUTINE pw_log_deriv_mix_cl !> \author Frederick Stein (07-Jun-2021) !> \note !> Multiplies by complementary cosine -!> PW has to be in RECIPROCALSPACE and data in use is COMPLEXDATA1D +!> PW has to be in RECIPROCALSPACE ! ************************************************************************************************** SUBROUTINE pw_truncated(pw, rcutoff) @@ -3442,7 +2452,7 @@ END SUBROUTINE pw_truncated !> \param pw ... !> \param rcutoff ... !> \note -!> PW has to be in RECIPROCALSPACE and data in use is COMPLEXDATA1D +!> PW has to be in RECIPROCALSPACE ! ************************************************************************************************** SUBROUTINE pw_log_deriv_trunc(pw, rcutoff) @@ -3492,9 +2502,9 @@ END SUBROUTINE pw_log_deriv_trunc !> \author JGH (25-Feb-2001) !> \note !> Calculate the derivative dx^n(1) dy^n(2) dz^n(3) PW -!> PW has to be in RECIPROCALSPACE and data in use is COMPLEXDATA1D +!> PW has to be in RECIPROCALSPACE ! ************************************************************************************************** - SUBROUTINE pw_derive_c1d(pw, n) + SUBROUTINE pw_derive(pw, n) TYPE(pw_c1d_type), INTENT(INOUT) :: pw INTEGER, DIMENSION(3), INTENT(IN) :: n @@ -3555,112 +2565,32 @@ SUBROUTINE pw_derive_c1d(pw, n) CALL timestop(handle) - END SUBROUTINE pw_derive_c1d + END SUBROUTINE pw_derive ! ************************************************************************************************** -!> \brief Calculate the derivative of a plane wave vector +!> \brief Calculate the Laplacian of a plane wave vector !> \param pw ... -!> \param n ... !> \par History -!> JGH (06-10-2002) allow only for inplace derivatives +!> Frederick Stein (01-02-2022) created !> \author JGH (25-Feb-2001) !> \note -!> Calculate the derivative dx^n(1) dy^n(2) dz^n(3) PW -!> PW has to be in RECIPROCALSPACE and data in use is COMPLEXDATA1D +!> Calculate the derivative DELTA PW +!> PW has to be in RECIPROCALSPACE ! ************************************************************************************************** - SUBROUTINE pw_derive_pw(pw, n) + SUBROUTINE pw_laplace(pw) - TYPE(pw_type), INTENT(INOUT) :: pw - INTEGER, DIMENSION(3), INTENT(IN) :: n + TYPE(pw_c1d_type), INTENT(INOUT) :: pw - CHARACTER(len=*), PARAMETER :: routineN = 'pw_derive' + CHARACTER(len=*), PARAMETER :: routineN = 'pw_laplace' - COMPLEX(KIND=dp) :: im - INTEGER :: handle, m + INTEGER :: handle CALL timeset(routineN, handle) - CPASSERT(ALL(n >= 0)) - - m = SUM(n) - im = CMPLX(0.0_dp, 1.0_dp, KIND=dp)**m - - IF (pw%in_space == RECIPROCALSPACE .AND. & - pw%in_use == COMPLEXDATA1D) THEN - - IF (n(1) == 1) THEN -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw) - pw%cc(:) = pw%cc(:)*pw%pw_grid%g(1, :) -!$OMP END PARALLEL WORKSHARE - ELSE IF (n(1) > 1) THEN -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(n, pw) - pw%cc(:) = pw%cc(:)*(pw%pw_grid%g(1, :)**n(1)) -!$OMP END PARALLEL WORKSHARE - END IF - - IF (n(2) == 1) THEN -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw) - pw%cc(:) = pw%cc(:)*pw%pw_grid%g(2, :) -!$OMP END PARALLEL WORKSHARE - ELSE IF (n(2) > 1) THEN -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(n, pw) - pw%cc(:) = pw%cc(:)*(pw%pw_grid%g(2, :)**n(2)) -!$OMP END PARALLEL WORKSHARE - END IF - - IF (n(3) == 1) THEN -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw) - pw%cc(:) = pw%cc(:)*pw%pw_grid%g(3, :) -!$OMP END PARALLEL WORKSHARE - ELSE IF (n(3) > 1) THEN -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(n, pw) - pw%cc(:) = pw%cc(:)*(pw%pw_grid%g(3, :)**n(3)) -!$OMP END PARALLEL WORKSHARE - END IF - - ! im can take the values 1, -1, i, -i - ! skip this if im == 1 - IF (ABS(REAL(im, KIND=dp) - 1.0_dp) > 1.0E-10_dp) THEN -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(im, pw) - pw%cc(:) = im*pw%cc(:) -!$OMP END PARALLEL WORKSHARE - END IF - - ELSE - - CPABORT("No suitable data field") - - END IF - - CALL timestop(handle) - - END SUBROUTINE pw_derive_pw - -! ************************************************************************************************** -!> \brief Calculate the Laplacian of a plane wave vector -!> \param pw ... -!> \par History -!> Frederick Stein (01-02-2022) created -!> \author JGH (25-Feb-2001) -!> \note -!> Calculate the derivative DELTA PW -!> PW has to be in RECIPROCALSPACE and data in use is COMPLEXDATA1D -! ************************************************************************************************** - SUBROUTINE pw_laplace(pw) - - TYPE(pw_type), INTENT(INOUT) :: pw - - CHARACTER(len=*), PARAMETER :: routineN = 'pw_laplace' - - INTEGER :: handle - - CALL timeset(routineN, handle) - - IF (pw%in_space == RECIPROCALSPACE .AND. & - pw%in_use == COMPLEXDATA1D) THEN + IF (pw%in_space == RECIPROCALSPACE) THEN !$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw) - pw%cc(:) = -pw%cc(:)*pw%pw_grid%gsq(:) + pw%array(:) = -pw%array(:)*pw%pw_grid%gsq(:) !$OMP END PARALLEL WORKSHARE ELSE @@ -3683,11 +2613,11 @@ END SUBROUTINE pw_laplace !> none !> \author JGH (05-May-2006) !> \note -!> PW has to be in RECIPROCALSPACE and data in use is COMPLEXDATA1D +!> PW has to be in RECIPROCALSPACE ! ************************************************************************************************** SUBROUTINE pw_dr2(pw, pwdr2, i, j) - TYPE(pw_type), INTENT(INOUT) :: pw, pwdr2 + TYPE(pw_c1d_type), INTENT(INOUT) :: pw, pwdr2 INTEGER, INTENT(IN) :: i, j CHARACTER(len=*), PARAMETER :: routineN = 'pw_dr2' @@ -3699,22 +2629,21 @@ SUBROUTINE pw_dr2(pw, pwdr2, i, j) o3 = 1.0_dp/3.0_dp - IF (pw%in_space == RECIPROCALSPACE .AND. & - pw%in_use == COMPLEXDATA1D) THEN + IF (pw%in_space == RECIPROCALSPACE) THEN - cnt = SIZE(pw%cc) + cnt = SIZE(pw%array) IF (i == j) THEN !$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(ig,gg) SHARED(cnt, i, o3, pw, pwdr2) DO ig = 1, cnt gg = pw%pw_grid%g(i, ig)**2 - o3*pw%pw_grid%gsq(ig) - pwdr2%cc(ig) = gg*pw%cc(ig) + pwdr2%array(ig) = gg*pw%array(ig) END DO !$OMP END PARALLEL DO ELSE !$OMP PARALLEL DO PRIVATE (ig) DEFAULT(NONE) SHARED(cnt, i, j, pw, pwdr2) DO ig = 1, cnt - pwdr2%cc(ig) = pw%cc(ig)*(pw%pw_grid%g(i, ig)*pw%pw_grid%g(j, ig)) + pwdr2%array(ig) = pw%array(ig)*(pw%pw_grid%g(i, ig)*pw%pw_grid%g(j, ig)) END DO !$OMP END PARALLEL DO END IF @@ -3740,12 +2669,12 @@ END SUBROUTINE pw_dr2 !> none !> \author RD (20-Nov-2006) !> \note -!> PW has to be in RECIPROCALSPACE and data in use is COMPLEXDATA1D +!> PW has to be in RECIPROCALSPACE !> Adapted from pw_dr2 ! ************************************************************************************************** SUBROUTINE pw_dr2_gg(pw, pwdr2_gg, i, j) - TYPE(pw_type), INTENT(INOUT) :: pw, pwdr2_gg + TYPE(pw_c1d_type), INTENT(INOUT) :: pw, pwdr2_gg INTEGER, INTENT(IN) :: i, j INTEGER :: cnt, handle, ig @@ -3756,28 +2685,27 @@ SUBROUTINE pw_dr2_gg(pw, pwdr2_gg, i, j) o3 = 1.0_dp/3.0_dp - IF (pw%in_space == RECIPROCALSPACE .AND. & - pw%in_use == COMPLEXDATA1D) THEN + IF (pw%in_space == RECIPROCALSPACE) THEN - cnt = SIZE(pw%cc) + cnt = SIZE(pw%array) IF (i == j) THEN !$OMP PARALLEL DO PRIVATE (ig) DEFAULT(NONE) PRIVATE(gg) SHARED(cnt, i, o3, pw, pwdr2_gg) DO ig = pw%pw_grid%first_gne0, cnt gg = pw%pw_grid%g(i, ig)**2 - o3*pw%pw_grid%gsq(ig) - pwdr2_gg%cc(ig) = gg*pw%cc(ig)/pw%pw_grid%gsq(ig) + pwdr2_gg%array(ig) = gg*pw%array(ig)/pw%pw_grid%gsq(ig) END DO !$OMP END PARALLEL DO ELSE !$OMP PARALLEL DO PRIVATE (ig) DEFAULT(NONE) SHARED(cnt, i, j, pw, pwdr2_gg) DO ig = pw%pw_grid%first_gne0, cnt - pwdr2_gg%cc(ig) = pw%cc(ig)*(pw%pw_grid%g(i, ig)*pw%pw_grid%g(j, ig)) & - /pw%pw_grid%gsq(ig) + pwdr2_gg%array(ig) = pw%array(ig)*(pw%pw_grid%g(i, ig)*pw%pw_grid%g(j, ig)) & + /pw%pw_grid%gsq(ig) END DO !$OMP END PARALLEL DO END IF - IF (pw%pw_grid%have_g0) pwdr2_gg%cc(1) = 0.0_dp + IF (pw%pw_grid%have_g0) pwdr2_gg%array(1) = 0.0_dp ELSE @@ -3799,11 +2727,11 @@ END SUBROUTINE pw_dr2_gg !> none !> \author JGH (09-June-2006) !> \note -!> PW has to be in RECIPROCALSPACE and data in use is COMPLEXDATA1D +!> PW has to be in RECIPROCALSPACE ! ************************************************************************************************** SUBROUTINE pw_smoothing(pw, ecut, sigma) - TYPE(pw_type), INTENT(INOUT) :: pw + TYPE(pw_c1d_type), INTENT(INOUT) :: pw REAL(KIND=dp), INTENT(IN) :: ecut, sigma CHARACTER(len=*), PARAMETER :: routineN = 'pw_smoothing' @@ -3813,16 +2741,15 @@ SUBROUTINE pw_smoothing(pw, ecut, sigma) CALL timeset(routineN, handle) - IF (pw%in_space == RECIPROCALSPACE .AND. & - pw%in_use == COMPLEXDATA1D) THEN + IF (pw%in_space == RECIPROCALSPACE) THEN - cnt = SIZE(pw%cc) + cnt = SIZE(pw%array) !$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(ig, arg, f) SHARED(cnt, ecut, pw, sigma) DO ig = 1, cnt arg = (ecut - pw%pw_grid%gsq(ig))/sigma f = EXP(arg)/(1 + EXP(arg)) - pw%cc(ig) = f*pw%cc(ig) + pw%array(ig) = f*pw%array(ig) END DO !$OMP END PARALLEL DO @@ -3854,7 +2781,6 @@ SUBROUTINE pw_transfer_pw_pw(pw1, pw2, debug) LOGICAL, INTENT(IN), OPTIONAL :: debug TYPE(pw_r3d_type) :: pw1_r3d - TYPE(pw_c1d_type) :: pw1_c1d IF (pw1%in_use == REALDATA3D) THEN pw1_r3d%in_space = pw1%in_space @@ -3863,13 +2789,6 @@ SUBROUTINE pw_transfer_pw_pw(pw1, pw2, debug) CALL pw_transfer(pw1_r3d, pw2, debug) RETURN END IF - IF (pw1%in_use == COMPLEXDATA1D) THEN - pw1_c1d%in_space = pw1%in_space - pw1_c1d%pw_grid => pw1%pw_grid - pw1_c1d%array => pw1%cc - CALL pw_transfer(pw1_c1d, pw2, debug) - RETURN - END IF CPABORT("") END SUBROUTINE pw_transfer_pw_pw @@ -3898,7 +2817,6 @@ SUBROUTINE pw_axpy_pw(pw1, pw2, alpha, beta, allow_noncompatible_grids) LOGICAL, INTENT(IN), OPTIONAL :: allow_noncompatible_grids TYPE(pw_r3d_type) :: pw1_r3d - TYPE(pw_c1d_type) :: pw1_c1d IF (pw1%in_use == REALDATA3D) THEN pw1_r3d%in_space = pw1%in_space @@ -3907,14 +2825,6 @@ SUBROUTINE pw_axpy_pw(pw1, pw2, alpha, beta, allow_noncompatible_grids) CALL pw_axpy_r3d_pw(pw1_r3d, pw2, alpha, beta, allow_noncompatible_grids) RETURN END IF - - IF (pw1%in_use == COMPLEXDATA1D) THEN - pw1_c1d%in_space = pw1%in_space - pw1_c1d%pw_grid => pw1%pw_grid - pw1_c1d%array => pw1%cc - CALL pw_axpy_c1d_pw(pw1_c1d, pw2, alpha, beta, allow_noncompatible_grids) - RETURN - END IF CPABORT("") END SUBROUTINE pw_axpy_pw @@ -3947,20 +2857,8 @@ SUBROUTINE pw_multiply_pw(pw_out, pw1, pw2, alpha) IF (ASSOCIATED(pw_out%pw_grid, pw2%pw_grid) .AND. & ASSOCIATED(pw_out%pw_grid, pw2%pw_grid)) THEN - IF (pw1%in_use == COMPLEXDATA1D .AND. & - pw2%in_use == COMPLEXDATA1D .AND. & - pw_out%in_use == COMPLEXDATA1D) THEN - IF (my_alpha == 1.0_dp) THEN -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2) - pw_out%cc = pw_out%cc + pw1%cc*pw2%cc -!$OMP END PARALLEL WORKSHARE - ELSE -!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2) - pw_out%cc = pw_out%cc + my_alpha*pw1%cc*pw2%cc -!$OMP END PARALLEL WORKSHARE - END IF - ELSE IF (pw1%in_use == REALDATA3D .AND. pw2%in_use == REALDATA3D .AND. & - pw_out%in_use == REALDATA3D) THEN + IF (pw1%in_use == REALDATA3D .AND. pw2%in_use == REALDATA3D .AND. & + pw_out%in_use == REALDATA3D) THEN IF (my_alpha == 1.0_dp) THEN !$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2) pw_out%cr3d = pw_out%cr3d + pw1%cr3d*pw2%cr3d @@ -3983,933 +2881,165 @@ SUBROUTINE pw_multiply_pw(pw_out, pw1, pw2, alpha) END SUBROUTINE pw_multiply_pw ! ************************************************************************************************** -!> \brief Gathers the pw vector from a 3d data field -!> \param pw ... -!> \param c ... -!> \param scale ... +!> \brief writes a small description of the actual grid +!> (change to output the data as cube file, maybe with an +!> optional long_description arg?) +!> \param pw the pw data to output +!> \param unit_nr the unit to output to !> \par History -!> none -!> \author JGH +!> 08.2002 created [fawzi] +!> \author Fawzi Mohamed ! ************************************************************************************************** - SUBROUTINE pw_gather_s_pw(pw, c, scale) - - TYPE(pw_type), INTENT(INOUT) :: pw - COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, INTENT(IN) :: c - REAL(KIND=dp), INTENT(IN), OPTIONAL :: scale - - CHARACTER(len=*), PARAMETER :: routineN = 'pw_gather_s' - - INTEGER :: gpt, handle, l, m, n - - CALL timeset(routineN, handle) + SUBROUTINE pw_write_pw(pw, unit_nr) - IF (pw%in_use /= COMPLEXDATA1D) THEN - CPABORT("Data field has to be COMPLEXDATA1D") - END IF + TYPE(pw_type), INTENT(in) :: pw + INTEGER, INTENT(in) :: unit_nr - IF (pw%in_space /= RECIPROCALSPACE) & - CPABORT("Grid has to be in reciprocal space!") + INTEGER :: iostatus - ASSOCIATE (mapl => pw%pw_grid%mapl%pos, mapm => pw%pw_grid%mapm%pos, mapn => pw%pw_grid%mapn%pos, & - ngpts => SIZE(pw%pw_grid%gsq), ghat => pw%pw_grid%g_hat) + WRITE (unit=unit_nr, fmt="(':{ ')", iostat=iostatus) - IF (PRESENT(scale)) THEN -!$OMP PARALLEL DO PRIVATE(gpt, l, m, n) DEFAULT(NONE) SHARED(c, pw, scale) - DO gpt = 1, ngpts - l = mapl(ghat(1, gpt)) + 1 - m = mapm(ghat(2, gpt)) + 1 - n = mapn(ghat(3, gpt)) + 1 - pw%cc(gpt) = scale*c(l, m, n) - END DO -!$OMP END PARALLEL DO + SELECT CASE (pw%in_use) + CASE (REALDATA3D) + WRITE (unit=unit_nr, fmt="(a)", iostat=iostatus) " in_use=REALDATA3D" + IF (ASSOCIATED(pw%cr3d)) THEN + WRITE (unit=unit_nr, fmt="(' cr3d=')") & + LBOUND(pw%cr3d, 1), UBOUND(pw%cr3d, 1), LBOUND(pw%cr3d, 2), UBOUND(pw%cr3d, 2), & + LBOUND(pw%cr3d, 3), UBOUND(pw%cr3d, 3) ELSE -!$OMP PARALLEL DO PRIVATE(gpt, l, m, n) DEFAULT(NONE) SHARED(c, pw) - DO gpt = 1, ngpts - l = mapl(ghat(1, gpt)) + 1 - m = mapm(ghat(2, gpt)) + 1 - n = mapn(ghat(3, gpt)) + 1 - pw%cc(gpt) = c(l, m, n) - END DO -!$OMP END PARALLEL DO + WRITE (unit=unit_nr, fmt="(' cr3d=*null*')") END IF + CASE default + WRITE (unit=unit_nr, fmt="(' in_use=',i8,',')", iostat=iostatus) & + pw%in_use + END SELECT - END ASSOCIATE + SELECT CASE (pw%in_space) + CASE (REALSPACE) + WRITE (unit=unit_nr, fmt="(a)", iostat=iostatus) " in_space=REALSPACE" + CASE (RECIPROCALSPACE) + WRITE (unit=unit_nr, fmt="(a)", iostat=iostatus) " in_space=RECIPROCALSPACE" + CASE default + WRITE (unit=unit_nr, fmt="(' in_space=',i8,',')", iostat=iostatus) & + pw%in_space + END SELECT - CALL timestop(handle) + WRITE (unit=unit_nr, fmt="(' pw_grid%id_nr=',i8,/,' }')", iostat=iostatus) & + pw%pw_grid%id_nr - END SUBROUTINE pw_gather_s_pw + END SUBROUTINE pw_write_pw ! ************************************************************************************************** !> \brief ... -!> \param pw ... -!> \param c ... -!> \param scale ... +!> \param grida ... +!> \param gridb ... +!> \return ... ! ************************************************************************************************** - SUBROUTINE pw_gather_p_pw(pw, c, scale) - - TYPE(pw_type), INTENT(INOUT) :: pw - COMPLEX(KIND=dp), DIMENSION(:, :), CONTIGUOUS, INTENT(IN) :: c - REAL(KIND=dp), INTENT(IN), OPTIONAL :: scale - - CHARACTER(len=*), PARAMETER :: routineN = 'pw_gather_p' - - INTEGER :: gpt, handle, l, m, mn, n + ELEMENTAL FUNCTION pw_compatible(grida, gridb) RESULT(compat) - CALL timeset(routineN, handle) + TYPE(pw_grid_type), INTENT(IN) :: grida, gridb + LOGICAL :: compat - IF (pw%in_use /= COMPLEXDATA1D) THEN - CPABORT("Data field has to be COMPLEXDATA1D") - END IF + compat = .FALSE. - IF (pw%pw_grid%para%mode /= PW_MODE_DISTRIBUTED) THEN - CPABORT("This grid type is not distributed") + IF (grida%id_nr == gridb%id_nr) THEN + compat = .TRUE. + ELSE IF (grida%reference == gridb%id_nr) THEN + compat = .TRUE. + ELSE IF (gridb%reference == grida%id_nr) THEN + compat = .TRUE. END IF - IF (pw%in_space /= RECIPROCALSPACE) & - CPABORT("Grid mus be in reciprocal space!") - - ASSOCIATE (mapl => pw%pw_grid%mapl%pos, mapm => pw%pw_grid%mapm%pos, mapn => pw%pw_grid%mapn%pos, & - ngpts => SIZE(pw%pw_grid%gsq), ghat => pw%pw_grid%g_hat, yzq => pw%pw_grid%para%yzq) + END FUNCTION pw_compatible - IF (PRESENT(scale)) THEN -!$OMP PARALLEL DO DEFAULT(NONE), & -!$OMP PRIVATE(l, m, mn, n), & -!$OMP SHARED(c, pw, scale) - DO gpt = 1, ngpts - l = mapl(ghat(1, gpt)) + 1 - m = mapm(ghat(2, gpt)) + 1 - n = mapn(ghat(3, gpt)) + 1 - mn = yzq(m, n) - pw%cc(gpt) = scale*c(l, mn) - END DO -!$OMP END PARALLEL DO - ELSE -!$OMP PARALLEL DO DEFAULT(NONE), & -!$OMP PRIVATE(l, m, mn, n), & -!$OMP SHARED(c, pw) - DO gpt = 1, ngpts - l = mapl(ghat(1, gpt)) + 1 - m = mapm(ghat(2, gpt)) + 1 - n = mapn(ghat(3, gpt)) + 1 - mn = yzq(m, n) - pw%cc(gpt) = c(l, mn) - END DO -!$OMP END PARALLEL DO - END IF +! ************************************************************************************************** +!> \brief Calculate integral over unit cell for functions in plane wave basis +!> only returns the real part of it ...... +!> \param pw1 ... +!> \param pw2 ... +!> \param sumtype ... +!> \param just_sum ... +!> \param local_only ... +!> \return ... +!> \par History +!> JGH (14-Mar-2001) : Parallel sum and some tests, HALFSPACE case +!> \author apsi +! ************************************************************************************************** + FUNCTION pw_integral_ab_pw(pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value) - END ASSOCIATE + TYPE(pw_type), INTENT(IN) :: pw1, pw2 + INTEGER, INTENT(IN), OPTIONAL :: sumtype + LOGICAL, INTENT(IN), OPTIONAL :: just_sum, local_only + REAL(KIND=dp) :: integral_value - CALL timestop(handle) + IF (pw1%in_use == REALDATA3D) THEN + BLOCK + TYPE(pw_r3d_type) :: pw1_r3d, pw2_r3d + pw1_r3d%in_space = pw1%in_space + pw1_r3d%pw_grid => pw1%pw_grid + pw1_r3d%array => pw1%cr3d + pw2_r3d%in_space = pw2%in_space + pw2_r3d%pw_grid => pw2%pw_grid + pw2_r3d%array => pw2%cr3d + integral_value = pw_integral_ab(pw1_r3d, pw2_r3d, sumtype, just_sum, local_only) + RETURN + END BLOCK + END IF + CPABORT("") - END SUBROUTINE pw_gather_p_pw + END FUNCTION pw_integral_ab_pw ! ************************************************************************************************** -!> \brief Scatters a pw vector to a 3d data field -!> \param pw ... -!> \param c ... -!> \param scale ... +!> \brief Calculate the structure factor for point r +!> \param sf ... +!> \param r ... !> \par History !> none -!> \author JGH +!> \author JGH (05-May-2006) +!> \note +!> PW has to be in RECIPROCALSPACE ! ************************************************************************************************** - SUBROUTINE pw_scatter_s_pw(pw, c, scale) + SUBROUTINE pw_structure_factor(sf, r) - TYPE(pw_type), INTENT(IN) :: pw - COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, & - INTENT(INOUT) :: c - REAL(KIND=dp), INTENT(IN), OPTIONAL :: scale + TYPE(pw_c1d_type), INTENT(INOUT) :: sf + REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: r - CHARACTER(len=*), PARAMETER :: routineN = 'pw_scatter_s' + CHARACTER(len=*), PARAMETER :: routineN = 'pw_structure_factor' - INTEGER :: gpt, handle, l, m, n + INTEGER :: cnt, handle, ig + REAL(KIND=dp) :: arg CALL timeset(routineN, handle) - IF (pw%in_use /= COMPLEXDATA1D) THEN - CPABORT("Data field has to be COMPLEXDATA1D") - END IF - - IF (pw%in_space /= RECIPROCALSPACE) THEN - CPABORT("Data has to be in RECIPROCALSPACE") - END IF - - ASSOCIATE (mapl => pw%pw_grid%mapl%pos, mapm => pw%pw_grid%mapm%pos, mapn => pw%pw_grid%mapn%pos, & - ghat => pw%pw_grid%g_hat, ngpts => SIZE(pw%pw_grid%gsq)) + IF (sf%in_space == RECIPROCALSPACE) THEN - ! should only zero the unused bits (but the zero is needed) - IF (.NOT. PRESENT(scale)) c = 0.0_dp + cnt = SIZE(sf%array) - IF (PRESENT(scale)) THEN -!$OMP PARALLEL DO PRIVATE(gpt, l, m, n) DEFAULT(NONE) SHARED(c, pw, scale) - DO gpt = 1, ngpts - l = mapl(ghat(1, gpt)) + 1 - m = mapm(ghat(2, gpt)) + 1 - n = mapn(ghat(3, gpt)) + 1 - c(l, m, n) = scale*pw%cc(gpt) - END DO -!$OMP END PARALLEL DO - ELSE -!$OMP PARALLEL DO PRIVATE(gpt, l, m, n) DEFAULT(NONE) SHARED(c, pw) - DO gpt = 1, ngpts - l = mapl(ghat(1, gpt)) + 1 - m = mapm(ghat(2, gpt)) + 1 - n = mapn(ghat(3, gpt)) + 1 - c(l, m, n) = pw%cc(gpt) - END DO +!$OMP PARALLEL DO PRIVATE (ig, arg) DEFAULT(NONE) SHARED(cnt, r, sf) + DO ig = 1, cnt + arg = DOT_PRODUCT(sf%pw_grid%g(:, ig), r) + sf%array(ig) = CMPLX(COS(arg), -SIN(arg), KIND=dp) + END DO !$OMP END PARALLEL DO - END IF - - END ASSOCIATE - - IF (pw%pw_grid%grid_span == HALFSPACE) THEN - ASSOCIATE (mapl => pw%pw_grid%mapl%neg, mapm => pw%pw_grid%mapm%neg, mapn => pw%pw_grid%mapn%neg, & - ghat => pw%pw_grid%g_hat, ngpts => SIZE(pw%pw_grid%gsq)) - - IF (PRESENT(scale)) THEN -!$OMP PARALLEL DO PRIVATE(gpt, l, m, n) DEFAULT(NONE) SHARED(c, pw, scale) - DO gpt = 1, ngpts - l = mapl(ghat(1, gpt)) + 1 - m = mapm(ghat(2, gpt)) + 1 - n = mapn(ghat(3, gpt)) + 1 - c(l, m, n) = scale*CONJG(pw%cc(gpt)) - END DO -!$OMP END PARALLEL DO - ELSE -!$OMP PARALLEL DO PRIVATE(gpt, l, m, n) DEFAULT(NONE) SHARED(c, pw) - DO gpt = 1, ngpts - l = mapl(ghat(1, gpt)) + 1 - m = mapm(ghat(2, gpt)) + 1 - n = mapn(ghat(3, gpt)) + 1 - c(l, m, n) = CONJG(pw%cc(gpt)) - END DO -!$OMP END PARALLEL DO - END IF + ELSE - END ASSOCIATE + CPABORT("No suitable data field") END IF CALL timestop(handle) - END SUBROUTINE pw_scatter_s_pw + END SUBROUTINE pw_structure_factor ! ************************************************************************************************** !> \brief ... -!> \param pw ... -!> \param c ... -!> \param scale ... +!> \param fun ... +!> \param isign ... +!> \param oprt ... +!> \return ... ! ************************************************************************************************** - SUBROUTINE pw_scatter_p_pw(pw, c, scale) - - TYPE(pw_type), INTENT(IN) :: pw - COMPLEX(KIND=dp), DIMENSION(:, :), CONTIGUOUS, INTENT(INOUT) :: c - REAL(KIND=dp), INTENT(IN), OPTIONAL :: scale - - CHARACTER(len=*), PARAMETER :: routineN = 'pw_scatter_p' - - INTEGER :: gpt, handle, l, m, mn, n - - CALL timeset(routineN, handle) - - IF (pw%in_use /= COMPLEXDATA1D) THEN - CPABORT("Data field has to be COMPLEXDATA1D") - END IF - - IF (pw%in_space /= RECIPROCALSPACE) THEN - CPABORT("Data has to be in RECIPROCALSPACE") - END IF - - IF (pw%pw_grid%para%mode /= PW_MODE_DISTRIBUTED) THEN - CPABORT("This grid type is not distributed") - END IF - - ASSOCIATE (mapl => pw%pw_grid%mapl%pos, mapm => pw%pw_grid%mapm%pos, mapn => pw%pw_grid%mapn%pos, & - ghat => pw%pw_grid%g_hat, yzq => pw%pw_grid%para%yzq, ngpts => SIZE(pw%pw_grid%gsq)) - - IF (.NOT. PRESENT(scale)) c = z_zero - - IF (PRESENT(scale)) THEN -!$OMP PARALLEL DO DEFAULT(NONE), & -!$OMP PRIVATE(l, m, mn, n), & -!$OMP SHARED(c, pw, scale) - DO gpt = 1, ngpts - l = mapl(ghat(1, gpt)) + 1 - m = mapm(ghat(2, gpt)) + 1 - n = mapn(ghat(3, gpt)) + 1 - mn = yzq(m, n) - c(l, mn) = scale*pw%cc(gpt) - END DO -!$OMP END PARALLEL DO - ELSE -!$OMP PARALLEL DO DEFAULT(NONE), & -!$OMP PRIVATE(l, m, mn, n), & -!$OMP SHARED(c, pw) - DO gpt = 1, ngpts - l = mapl(ghat(1, gpt)) + 1 - m = mapm(ghat(2, gpt)) + 1 - n = mapn(ghat(3, gpt)) + 1 - mn = yzq(m, n) - c(l, mn) = pw%cc(gpt) - END DO -!$OMP END PARALLEL DO - END IF - - END ASSOCIATE - - IF (pw%pw_grid%grid_span == HALFSPACE) THEN - - ASSOCIATE (mapm => pw%pw_grid%mapm%neg, mapn => pw%pw_grid%mapn%neg, mapl => pw%pw_grid%mapl%neg, & - ghat => pw%pw_grid%g_hat, ngpts => SIZE(pw%pw_grid%gsq), yzq => pw%pw_grid%para%yzq) - - IF (PRESENT(scale)) THEN -!$OMP PARALLEL DO DEFAULT(NONE), & -!$OMP PRIVATE(l, m, mn, n), & -!$OMP SHARED(c, pw, scale) - DO gpt = 1, ngpts - l = mapl(ghat(1, gpt)) + 1 - m = mapm(ghat(2, gpt)) + 1 - n = mapn(ghat(3, gpt)) + 1 - mn = yzq(m, n) - c(l, mn) = scale*CONJG(pw%cc(gpt)) - END DO -!$OMP END PARALLEL DO - ELSE -!$OMP PARALLEL DO DEFAULT(NONE), & -!$OMP PRIVATE(l, m, mn, n) & -!$OMP SHARED(c, pw) - DO gpt = 1, ngpts - l = mapl(ghat(1, gpt)) + 1 - m = mapm(ghat(2, gpt)) + 1 - n = mapn(ghat(3, gpt)) + 1 - mn = yzq(m, n) - c(l, mn) = CONJG(pw%cc(gpt)) - END DO -!$OMP END PARALLEL DO - END IF - END ASSOCIATE - END IF - - CALL timestop(handle) - - END SUBROUTINE pw_scatter_p_pw - -! ************************************************************************************************** -!> \brief Generic function for 3d FFT of a coefficient_type or pw_type -!> \param pw1 ... -!> \param pw2 ... -!> \param debug ... -!> \par History -!> JGH (30-12-2000): New setup of functions and adaptation to parallelism -!> JGH (04-01-2001): Moved routine from pws to this module, only covers -!> pw_types, no more coefficient types -!> \author apsi -!> \note -!> fft_wrap_pw1pw2 -! ************************************************************************************************** - SUBROUTINE fft_wrap_pw1pw2_pw_pw(pw1, pw2, debug) - - TYPE(pw_type), INTENT(IN) :: pw1 - TYPE(pw_type), INTENT(INOUT) :: pw2 - LOGICAL, INTENT(IN), OPTIONAL :: debug - - CHARACTER(len=*), PARAMETER :: routineN = 'fft_wrap_pw1pw2' - - CHARACTER(LEN=9) :: mode - COMPLEX(KIND=dp), DIMENSION(:, :), CONTIGUOUS, POINTER :: grays - COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER :: c_in, c_out - INTEGER :: dir, handle, handle2, my_pos, nrays, & - out_space, out_unit - INTEGER, DIMENSION(3) :: nloc - INTEGER, DIMENSION(:), POINTER :: n - LOGICAL :: test -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - LOGICAL :: use_pw_gpu -#endif - REAL(KIND=dp) :: norm - - CALL timeset(routineN, handle2) - out_unit = cp_logger_get_default_io_unit() - CALL timeset(routineN//"_"//TRIM(ADJUSTL(cp_to_string( & - CEILING(pw1%pw_grid%cutoff/10)*10))), handle) - - NULLIFY (c_in) - NULLIFY (c_out) - - IF (PRESENT(debug)) THEN - test = debug - ELSE - test = .FALSE. - END IF - - !..check if grids are compatible - IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN - IF (pw1%pw_grid%dvol /= pw2%pw_grid%dvol) THEN - CPABORT("PW grids not compatible") - END IF - IF (pw1%pw_grid%para%group /= pw2%pw_grid%para%group) THEN - CPABORT("PW grids have not compatible MPI groups") - END IF - END IF - - !..prepare input - IF (pw1%in_space == REALSPACE) THEN - dir = FWFFT - norm = 1.0_dp/pw1%pw_grid%ngpts - out_space = RECIPROCALSPACE - ELSE IF (pw1%in_space == RECIPROCALSPACE) THEN - dir = BWFFT - norm = 1.0_dp - out_space = REALSPACE - ELSE - CPABORT("Error in space tag") - END IF - - n => pw1%pw_grid%npts - - mode = fftselect(pw1%in_use, pw2%in_use, pw1%in_space) - - IF (pw1%pw_grid%para%mode == PW_MODE_LOCAL) THEN - - ! - !..replicated data, use local FFT - ! - - IF (test .AND. out_unit > 0) THEN - WRITE (out_unit, '(A)') " FFT Protocol " - IF (dir == FWFFT) WRITE (out_unit, '(A,T76,A)') " Transform direction ", "FWFFT" - IF (dir == BWFFT) WRITE (out_unit, '(A,T76,A)') " Transform direction ", "BWFFT" - IF (pw1%in_space == REALSPACE) & - WRITE (out_unit, '(A,T72,A)') " in space ", "REALSPACE" - IF (pw1%in_space == RECIPROCALSPACE) & - WRITE (out_unit, '(A,T66,A)') " in space ", "RECIPROCALSPACE" - IF (out_space == REALSPACE) & - WRITE (out_unit, '(A,T72,A)') " out space ", "REALSPACE" - IF (out_space == RECIPROCALSPACE) & - WRITE (out_unit, '(A,T66,A)') " out space ", "RECIPROCALSPACE" - WRITE (out_unit, '(A,T66,E15.6)') " scale factor", norm - END IF - - SELECT CASE (mode) - CASE DEFAULT - CPABORT("Illegal combination of in_use and in_space") - CASE ("FW_C3DC3D") - c_in => pw1%cc3d - c_out => pw2%cc3d - CALL fft3d(dir, n, c_in, c_out, scale=norm, debug=test) - CASE ("FW_R3DC3D") - pw2%cc3d = CMPLX(pw1%cr3d, 0.0_dp, KIND=dp) - c_out => pw2%cc3d - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - CASE ("FW_C3DC1D") - c_in => pw1%cc3d - ALLOCATE (c_out(n(1), n(2), n(3))) - ! transform - CALL fft3d(dir, n, c_in, c_out, scale=norm, debug=test) - ! gather results - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " PW_GATHER : 3d -> 1d " - CALL pw_gather(pw2, c_out) - DEALLOCATE (c_out) - CASE ("FW_R3DC1D") -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - CALL pw_gpu_r3dc1d_3d(pw1, pw2, scale=norm) -#elif defined (__PW_FPGA) - ALLOCATE (c_out(n(1), n(2), n(3))) - ! check if bitstream for the fft size is present - ! if not, perform fft3d in CPU - IF (pw_fpga_init_bitstream(n) == 1) THEN - CALL pw_copy_to_array(pw1, c_out) -#if (__PW_FPGA_SP && __PW_FPGA) - CALL pw_fpga_r3dc1d_3d_sp(n, c_out) -#else - CALL pw_fpga_r3dc1d_3d_dp(n, c_out) -#endif - CALL zdscal(n(1)*n(2)*n(3), norm, c_out, 1) - CALL pw_gather(pw2, c_out) - ELSE - CALL pw_copy_to_array(pw1, c_out) - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - CALL pw_gather(pw2, c_out) - END IF - DEALLOCATE (c_out) -#else - ALLOCATE (c_out(n(1), n(2), n(3))) - CALL pw_copy_to_array(pw1, c_out) - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - CALL pw_gather(pw2, c_out) - DEALLOCATE (c_out) -#endif - CASE ("BW_C3DC3D") - c_in => pw1%cc3d - c_out => pw2%cc3d - CALL fft3d(dir, n, c_in, c_out, scale=norm, debug=test) - CASE ("BW_C3DR3D") - c_in => pw1%cc3d - ALLOCATE (c_out(n(1), n(2), n(3))) - CALL fft3d(dir, n, c_in, c_out, scale=norm, debug=test) - ! use real part only - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " REAL part " - pw2%cr3d = REAL(c_out, KIND=dp) - DEALLOCATE (c_out) - CASE ("BW_C1DC3D") - c_out => pw2%cc3d - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " PW_SCATTER : 3d -> 1d " - CALL pw_scatter(pw1, c_out) - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - CASE ("BW_C1DR3D") -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - CALL pw_gpu_c1dr3d_3d(pw1, pw2, scale=norm) -#elif defined (__PW_FPGA) - ALLOCATE (c_out(n(1), n(2), n(3))) - ! check if bitstream for the fft size is present - ! if not, perform fft3d in CPU - IF (pw_fpga_init_bitstream(n) == 1) THEN - CALL pw_scatter(pw1, c_out) - ! transform using FPGA -#if (__PW_FPGA_SP && __PW_FPGA) - CALL pw_fpga_c1dr3d_3d_sp(n, c_out) -#else - CALL pw_fpga_c1dr3d_3d_dp(n, c_out) -#endif - CALL zdscal(n(1)*n(2)*n(3), norm, c_out, 1) - ! use real part only - CALL pw_copy_from_array(pw2, c_out) - ELSE - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " PW_SCATTER : 3d -> 1d " - CALL pw_scatter(pw1, c_out) - ! transform - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - ! use real part only - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " REAL part " - CALL pw_copy_from_array(pw2, c_out) - END IF - DEALLOCATE (c_out) -#else - ALLOCATE (c_out(n(1), n(2), n(3))) - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " PW_SCATTER : 3d -> 1d " - CALL pw_scatter(pw1, c_out) - ! transform - CALL fft3d(dir, n, c_out, scale=norm, debug=test) - ! use real part only - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " REAL part " - CALL pw_copy_from_array(pw2, c_out) - DEALLOCATE (c_out) -#endif - END SELECT - - IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " End of FFT Protocol " - - ELSE - - ! - !..parallel FFT - ! - - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) THEN - WRITE (out_unit, '(A)') " FFT Protocol " - IF (dir == FWFFT) WRITE (out_unit, '(A,T76,A)') " Transform direction ", "FWFFT" - IF (dir == BWFFT) WRITE (out_unit, '(A,T76,A)') " Transform direction ", "BWFFT" - IF (pw1%in_space == REALSPACE) & - WRITE (out_unit, '(A,T72,A)') " in space ", "REALSPACE" - IF (pw1%in_space == RECIPROCALSPACE) & - WRITE (out_unit, '(A,T66,A)') " in space ", "RECIPROCALSPACE" - IF (out_space == REALSPACE) & - WRITE (out_unit, '(A,T72,A)') " out space ", "REALSPACE" - IF (out_space == RECIPROCALSPACE) & - WRITE (out_unit, '(A,T66,A)') " out space ", "RECIPROCALSPACE" - WRITE (out_unit, '(A,T66,E15.6)') " scale factor", norm - END IF - - my_pos = pw1%pw_grid%para%my_pos - nrays = pw1%pw_grid%para%nyzray(my_pos) - grays => pw1%pw_grid%grays -! CPASSERT(SIZE(grays, 1) == n(1)) -! CPASSERT(SIZE(grays, 2) == nrays) - - SELECT CASE (mode) - CASE DEFAULT - CALL cp_abort(__LOCATION__, & - "Illegal combination of in_use and in_space "// & - "in parallel 3d FFT") - CASE ("FW_C3DC1D") - !..prepare input - c_in => pw1%cc3d - grays = z_zero - !..transform - IF (pw1%pw_grid%para%ray_distribution) THEN - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%group, & - pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%yzp, pw1%pw_grid%para%nyzray, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - ELSE - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - END IF - !..prepare output - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) & - WRITE (out_unit, '(A)') " PW_GATHER : 2d -> 1d " - CALL pw_gather(pw2, grays) - CASE ("FW_R3DC1D") -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - ! (no ray dist. is not efficient in CUDA) - use_pw_gpu = pw1%pw_grid%para%ray_distribution - IF (use_pw_gpu) THEN - CALL pw_gpu_r3dc1d_3d_ps(pw1, pw2, scale=norm) - ELSE -#endif -!.. prepare input - nloc = pw1%pw_grid%npts_local - ALLOCATE (c_in(nloc(1), nloc(2), nloc(3))) - CALL pw_copy_to_array(pw1, c_in) - grays = z_zero - !..transform - IF (pw1%pw_grid%para%ray_distribution) THEN - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%group, & - pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%yzp, pw1%pw_grid%para%nyzray, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - ELSE - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - END IF - !..prepare output - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) & - WRITE (out_unit, '(A)') " PW_GATHER : 2d -> 1d " - CALL pw_gather(pw2, grays) - DEALLOCATE (c_in) - -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - END IF -#endif - CASE ("BW_C1DC3D") - !..prepare input - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) & - WRITE (out_unit, '(A)') " PW_SCATTER : 2d -> 1d " - grays = z_zero - CALL pw_scatter(pw1, grays) - c_in => pw2%cc3d - !..transform - IF (pw1%pw_grid%para%ray_distribution) THEN - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%group, & - pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%yzp, pw1%pw_grid%para%nyzray, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - ELSE - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - END IF - !..prepare output (nothing to do) - CASE ("BW_C1DR3D") -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - ! (no ray dist. is not efficient in CUDA) - use_pw_gpu = pw1%pw_grid%para%ray_distribution - IF (use_pw_gpu) THEN - CALL pw_gpu_c1dr3d_3d_ps(pw1, pw2, scale=norm) - ELSE -#endif -!.. prepare input - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) & - WRITE (out_unit, '(A)') " PW_SCATTER : 2d -> 1d " - grays = z_zero - CALL pw_scatter(pw1, grays) - nloc = pw2%pw_grid%npts_local - ALLOCATE (c_in(nloc(1), nloc(2), nloc(3))) - !..transform - IF (pw1%pw_grid%para%ray_distribution) THEN - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%group, & - pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%yzp, pw1%pw_grid%para%nyzray, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - ELSE - CALL fft3d(dir, n, c_in, grays, pw1%pw_grid%para%rs_group, & - pw1%pw_grid%para%bo, scale=norm, debug=test) - END IF - !..prepare output - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) & - WRITE (out_unit, '(A)') " Real part " - CALL pw_copy_from_array(pw2, c_in) - DEALLOCATE (c_in) -#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW) - END IF -#endif - END SELECT - - END IF - - IF (test .AND. pw1%pw_grid%para%group_head .AND. out_unit > 0) THEN - WRITE (out_unit, '(A)') " End of FFT Protocol " - END IF - - CALL timestop(handle) - CALL timestop(handle2) - - END SUBROUTINE fft_wrap_pw1pw2_pw_pw - -! ************************************************************************************************** -!> \brief ... -!> \param use1 ... -!> \param use2 ... -!> \param space1 ... -!> \return ... -! ************************************************************************************************** - FUNCTION fftselect(use1, use2, space1) RESULT(mode) - - INTEGER, INTENT(IN) :: use1, use2, space1 - CHARACTER(LEN=9) :: mode - - IF (space1 == REALSPACE) THEN - mode(1:3) = "FW_" - ELSE IF (space1 == RECIPROCALSPACE) THEN - mode(1:3) = "BW_" - ELSE - CPABORT("Error in space tag") - END IF - - SELECT CASE (use1) - CASE (REALDATA3D) - mode(4:6) = "R3D" - CASE (COMPLEXDATA1D) - mode(4:6) = "C1D" - CASE DEFAULT - CPABORT("Error in use1 tag") - END SELECT - - SELECT CASE (use2) - CASE (REALDATA3D) - mode(7:9) = "R3D" - CASE (COMPLEXDATA1D) - mode(7:9) = "C1D" - CASE DEFAULT - CPABORT("Error in use1 tag") - END SELECT - - END FUNCTION fftselect - -! ************************************************************************************************** -!> \brief writes a small description of the actual grid -!> (change to output the data as cube file, maybe with an -!> optional long_description arg?) -!> \param pw the pw data to output -!> \param unit_nr the unit to output to -!> \par History -!> 08.2002 created [fawzi] -!> \author Fawzi Mohamed -! ************************************************************************************************** - SUBROUTINE pw_write_pw(pw, unit_nr) - - TYPE(pw_type), INTENT(in) :: pw - INTEGER, INTENT(in) :: unit_nr - - INTEGER :: iostatus - - WRITE (unit=unit_nr, fmt="(':{ ')", iostat=iostatus) - - SELECT CASE (pw%in_use) - CASE (REALDATA3D) - WRITE (unit=unit_nr, fmt="(a)", iostat=iostatus) " in_use=REALDATA3D" - IF (ASSOCIATED(pw%cr3d)) THEN - WRITE (unit=unit_nr, fmt="(' cr3d=')") & - LBOUND(pw%cr3d, 1), UBOUND(pw%cr3d, 1), LBOUND(pw%cr3d, 2), UBOUND(pw%cr3d, 2), & - LBOUND(pw%cr3d, 3), UBOUND(pw%cr3d, 3) - ELSE - WRITE (unit=unit_nr, fmt="(' cr3d=*null*')") - END IF - CASE (COMPLEXDATA1D) - WRITE (unit=unit_nr, fmt="(a)", iostat=iostatus) " in_use=COMPLEXDATA1D" - IF (ASSOCIATED(pw%cc)) THEN - WRITE (unit=unit_nr, fmt="(' cc=')") & - LBOUND(pw%cc, 1), UBOUND(pw%cc, 1) - ELSE - WRITE (unit=unit_nr, fmt="(' cc=*null*')") - END IF - CASE default - WRITE (unit=unit_nr, fmt="(' in_use=',i8,',')", iostat=iostatus) & - pw%in_use - END SELECT - - SELECT CASE (pw%in_space) - CASE (REALSPACE) - WRITE (unit=unit_nr, fmt="(a)", iostat=iostatus) " in_space=REALSPACE" - CASE (RECIPROCALSPACE) - WRITE (unit=unit_nr, fmt="(a)", iostat=iostatus) " in_space=RECIPROCALSPACE" - CASE default - WRITE (unit=unit_nr, fmt="(' in_space=',i8,',')", iostat=iostatus) & - pw%in_space - END SELECT - - WRITE (unit=unit_nr, fmt="(' pw_grid%id_nr=',i8,/,' }')", iostat=iostatus) & - pw%pw_grid%id_nr - - END SUBROUTINE pw_write_pw - -! ************************************************************************************************** -!> \brief ... -!> \param grida ... -!> \param gridb ... -!> \return ... -! ************************************************************************************************** - ELEMENTAL FUNCTION pw_compatible(grida, gridb) RESULT(compat) - - TYPE(pw_grid_type), INTENT(IN) :: grida, gridb - LOGICAL :: compat - - compat = .FALSE. - - IF (grida%id_nr == gridb%id_nr) THEN - compat = .TRUE. - ELSE IF (grida%reference == gridb%id_nr) THEN - compat = .TRUE. - ELSE IF (gridb%reference == grida%id_nr) THEN - compat = .TRUE. - END IF - - END FUNCTION pw_compatible - -! ************************************************************************************************** -!> \brief Calculate integral over unit cell for functions in plane wave basis -!> only returns the real part of it ...... -!> \param pw1 ... -!> \param pw2 ... -!> \param sumtype ... -!> \param just_sum ... -!> \param local_only ... -!> \return ... -!> \par History -!> JGH (14-Mar-2001) : Parallel sum and some tests, HALFSPACE case -!> \author apsi -! ************************************************************************************************** - FUNCTION pw_integral_ab_pw(pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value) - - TYPE(pw_type), INTENT(IN) :: pw1, pw2 - INTEGER, INTENT(IN), OPTIONAL :: sumtype - LOGICAL, INTENT(IN), OPTIONAL :: just_sum, local_only - REAL(KIND=dp) :: integral_value - - IF (pw1%in_use == REALDATA3D) THEN - BLOCK - TYPE(pw_r3d_type) :: pw1_r3d, pw2_r3d - pw1_r3d%in_space = pw1%in_space - pw1_r3d%pw_grid => pw1%pw_grid - pw1_r3d%array => pw1%cr3d - pw2_r3d%in_space = pw2%in_space - pw2_r3d%pw_grid => pw2%pw_grid - pw2_r3d%array => pw2%cr3d - integral_value = pw_integral_ab(pw1_r3d, pw2_r3d, sumtype, just_sum, local_only) - RETURN - END BLOCK - ELSE - BLOCK - TYPE(pw_c1d_type) :: pw1_c1d, pw2_c1d - pw1_c1d%in_space = pw1%in_space - pw1_c1d%pw_grid => pw1%pw_grid - pw1_c1d%array => pw1%cc - pw2_c1d%in_space = pw2%in_space - pw2_c1d%pw_grid => pw2%pw_grid - pw2_c1d%array => pw2%cc - integral_value = pw_integral_ab(pw1_c1d, pw2_c1d, sumtype, just_sum, local_only) - RETURN - END BLOCK - END IF - CPABORT("") - - END FUNCTION pw_integral_ab_pw - -! ************************************************************************************************** -!> \brief ... -!> \param pw1 ... -!> \param pw2 ... -!> \return ... -! ************************************************************************************************** - FUNCTION pw_integral_a2b_pw_pw(pw1, pw2) RESULT(integral_value) - - TYPE(pw_type), INTENT(IN) :: pw1, pw2 - REAL(KIND=dp) :: integral_value - - CHARACTER(len=*), PARAMETER :: routineN = 'pw_integral_a2b' - - INTEGER :: handle - - CALL timeset(routineN, handle) - - IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN - CPABORT("Grids incompatible") - END IF - - IF (pw1%in_use == COMPLEXDATA1D .AND. & - pw2%in_use == COMPLEXDATA1D) THEN - integral_value = accurate_sum(REAL(CONJG(pw1%cc(:)) & - *pw2%cc(:), KIND=dp)*pw1%pw_grid%gsq(:)) - IF (pw1%pw_grid%grid_span == HALFSPACE) THEN - integral_value = 2.0_dp*integral_value - END IF - ELSE - CPABORT("No possible DATA") - END IF - - IF (pw1%in_space == REALSPACE) THEN - integral_value = integral_value*pw1%pw_grid%dvol - ELSE - integral_value = integral_value*pw1%pw_grid%vol - END IF - - IF (pw1%pw_grid%para%mode == PW_MODE_DISTRIBUTED) & - CALL pw1%pw_grid%para%group%sum(integral_value) - CALL timestop(handle) - - END FUNCTION pw_integral_a2b_pw_pw - -! ************************************************************************************************** -!> \brief Calculate the structure factor for point r -!> \param sf ... -!> \param r ... -!> \par History -!> none -!> \author JGH (05-May-2006) -!> \note -!> PW has to be in RECIPROCALSPACE and data in use is COMPLEXDATA1D -! ************************************************************************************************** - SUBROUTINE pw_structure_factor(sf, r) - - TYPE(pw_type), INTENT(INOUT) :: sf - REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: r - - CHARACTER(len=*), PARAMETER :: routineN = 'pw_structure_factor' - - INTEGER :: cnt, handle, ig - REAL(KIND=dp) :: arg - - CALL timeset(routineN, handle) - - IF (sf%in_space == RECIPROCALSPACE .AND. & - sf%in_use == COMPLEXDATA1D) THEN - - cnt = SIZE(sf%cc) - -!$OMP PARALLEL DO PRIVATE (ig, arg) DEFAULT(NONE) SHARED(cnt, r, sf) - DO ig = 1, cnt - arg = DOT_PRODUCT(sf%pw_grid%g(:, ig), r) - sf%cc(ig) = CMPLX(COS(arg), -SIN(arg), KIND=dp) - END DO -!$OMP END PARALLEL DO - - ELSE - - CPABORT("No suitable data field") - - END IF - - CALL timestop(handle) - - END SUBROUTINE pw_structure_factor - -! ************************************************************************************************** -!> \brief ... -!> \param fun ... -!> \param isign ... -!> \param oprt ... -!> \return ... -! ************************************************************************************************** - FUNCTION pw_integrate_function_pw(fun, isign, oprt) RESULT(total_fun) + FUNCTION pw_integrate_function_pw(fun, isign, oprt) RESULT(total_fun) TYPE(pw_type), INTENT(IN) :: fun INTEGER, INTENT(IN), OPTIONAL :: isign @@ -4925,15 +3055,6 @@ FUNCTION pw_integrate_function_pw(fun, isign, oprt) RESULT(total_fun) total_fun = pw_integrate_function_r3d(fun_r3d, isign, oprt) RETURN END BLOCK - ELSE - BLOCK - TYPE(pw_c1d_type) :: fun_c1d - fun_c1d%in_space = fun%in_space - fun_c1d%pw_grid => fun%pw_grid - fun_c1d%array => fun%cc - total_fun = pw_integrate_function_c1d(fun_c1d, isign, oprt) - RETURN - END BLOCK END IF CPABORT("") @@ -4983,15 +3104,6 @@ SUBROUTINE pw_multiply_with_pw_pw(pw1, pw2) CALL pw_multiply_with_r3d_pw(pw1_r3d, pw2) RETURN END BLOCK - ELSE IF (pw1%in_use == COMPLEXDATA1D) THEN - BLOCK - TYPE(pw_c1d_type) :: pw1_c1d - pw1_c1d%in_space = pw1%in_space - pw1_c1d%pw_grid => pw1%pw_grid - pw1_c1d%array => pw1%cc - CALL pw_multiply_with_c1d_pw(pw1_c1d, pw2) - RETURN - END BLOCK END IF CPABORT("") diff --git a/src/pw/pw_poisson_methods.F b/src/pw/pw_poisson_methods.F index 13fb3864d7..cb1bfb6808 100644 --- a/src/pw/pw_poisson_methods.F +++ b/src/pw/pw_poisson_methods.F @@ -54,11 +54,11 @@ MODULE pw_poisson_methods pw_pool_type, & pw_pools_copy, & pw_pools_dealloc - USE pw_types, ONLY: COMPLEXDATA1D, & - REALDATA3D, & - REALSPACE, & - RECIPROCALSPACE, & - pw_type, pw_c1d_type, pw_r3d_type + USE pw_types, ONLY: & + REALDATA3D, & + REALSPACE, & + RECIPROCALSPACE, & + pw_type, pw_c1d_type, pw_r3d_type #include "../base/base_uses.f90" IMPLICIT NONE @@ -1139,23 +1139,6 @@ SUBROUTINE pw_poisson_solve_pw(poisson_env, density, ehartree, vhartree, & dvhartree, h_stress, rho_core, greenfn) END IF END BLOCK - ELSE - BLOCK - TYPE(pw_c1d_type) :: my_density, my_aux_density - my_density%in_space = density%in_space - my_density%pw_grid => density%pw_grid - my_density%array => density%cc - IF (PRESENT(aux_density)) THEN - my_aux_density%in_space = aux_density%in_space - my_aux_density%pw_grid => aux_density%pw_grid - my_aux_density%array => aux_density%cc - CALL pw_poisson_solve_pw_c1d(poisson_env, my_density, ehartree, vhartree, & - dvhartree, h_stress, rho_core, greenfn, my_aux_density) - ELSE - CALL pw_poisson_solve_pw_c1d(poisson_env, my_density, ehartree, vhartree, & - dvhartree, h_stress, rho_core, greenfn) - END IF - END BLOCK END IF END SUBROUTINE pw_poisson_solve_pw @@ -1185,16 +1168,6 @@ SUBROUTINE pw_poisson_solve_pw_${kindd}$ (poisson_env, density, ehartree, vhartr vhartree=my_vhartree, dvhartree=dvhartree, h_stress=h_stress, & rho_core=rho_core, greenfn=greenfn, aux_density=aux_density) END BLOCK - ELSE - BLOCK - TYPE(pw_c1d_type) :: my_vhartree - my_vhartree%in_space = vhartree%in_space - my_vhartree%pw_grid => vhartree%pw_grid - my_vhartree%array => vhartree%cc - CALL pw_poisson_solve_pw_${kindd}$_c1d(poisson_env, density, ehartree, & - vhartree=my_vhartree, dvhartree=dvhartree, h_stress=h_stress, & - rho_core=rho_core, greenfn=greenfn, aux_density=aux_density) - END BLOCK END IF ELSE IF (PRESENT(dvhartree)) THEN IF (dvhartree(1)%in_use == REALDATA3D) THEN @@ -1209,18 +1182,6 @@ SUBROUTINE pw_poisson_solve_pw_${kindd}$ (poisson_env, density, ehartree, vhartr CALL pw_poisson_solve(poisson_env, density, ehartree, dvhartree=my_dvhartree, h_stress=h_stress, & rho_core=rho_core, greenfn=greenfn, aux_density=aux_density) END BLOCK - ELSE - BLOCK - TYPE(pw_c1d_type) :: my_dvhartree(3) - INTEGER :: i - DO i = 1, 3 - my_dvhartree(i)%in_space = dvhartree(i)%in_space - my_dvhartree(i)%pw_grid => dvhartree(i)%pw_grid - my_dvhartree(i)%array => dvhartree(i)%cc - END DO - CALL pw_poisson_solve(poisson_env, density, ehartree, dvhartree=my_dvhartree, h_stress=h_stress, & - rho_core=rho_core, greenfn=greenfn, aux_density=aux_density) - END BLOCK END IF ELSE CALL pw_poisson_solve(poisson_env, density, ehartree, h_stress=h_stress, & @@ -1419,21 +1380,6 @@ SUBROUTINE pw_poisson_solve_pw_${kindd}$_${kindv}$ (poisson_env, density, ehartr CALL calc_stress_and_gradient_r3d(poisson_env, rhog, ehartree, h_stress=h_stress, dvhartree=my_dvhartree) END IF END BLOCK - ELSE IF (dvhartree(1)%in_use == COMPLEXDATA1D) THEN - BLOCK - TYPE(pw_c1d_type) :: my_dvhartree(3) - INTEGER :: i - DO i = 1, 3 - my_dvhartree(i)%in_space = dvhartree(i)%in_space - my_dvhartree(i)%pw_grid => dvhartree(i)%pw_grid - my_dvhartree(i)%array => dvhartree(i)%cc - END DO - IF (PRESENT(aux_density)) THEN - CALL calc_stress_and_gradient_c1d(poisson_env, rhog, ehartree, rhog_aux, h_stress=h_stress, dvhartree=my_dvhartree) - ELSE - CALL calc_stress_and_gradient_c1d(poisson_env, rhog, ehartree, h_stress=h_stress, dvhartree=my_dvhartree) - END IF - END BLOCK ELSE CPABORT("Grid type not supported!") END IF diff --git a/src/pw/pw_poisson_types.F b/src/pw/pw_poisson_types.F index 3232535718..df473fd9e2 100644 --- a/src/pw/pw_poisson_types.F +++ b/src/pw/pw_poisson_types.F @@ -46,11 +46,9 @@ MODULE pw_poisson_types pw_pool_release,& pw_pool_type,& pw_pools_dealloc - USE pw_types, ONLY: COMPLEXDATA1D,& - RECIPROCALSPACE,& + USE pw_types, ONLY: RECIPROCALSPACE,& pw_c1d_type,& - pw_r1d_type,& - pw_type + pw_r1d_type USE realspace_grid_types, ONLY: realspace_grid_type,& rs_grid_release #include "../base/base_uses.f90" @@ -162,8 +160,8 @@ MODULE pw_poisson_types REAL(KIND=dp) :: sr_alpha = 1.0_dp REAL(KIND=dp) :: sr_rc = 0.0_dp TYPE(pw_c1d_type) :: influence_fn = pw_c1d_type() - TYPE(pw_type), POINTER :: dct_influence_fn => NULL() - TYPE(pw_type), POINTER :: screen_fn => NULL() + TYPE(pw_c1d_type), POINTER :: dct_influence_fn => NULL() + TYPE(pw_c1d_type), POINTER :: screen_fn => NULL() TYPE(pw_r1d_type), POINTER :: p3m_charge => NULL() END TYPE greens_fn_type @@ -192,9 +190,9 @@ SUBROUTINE pw_green_create(green, poisson_params, cell_hmat, pw_pool, & REAL(KIND=dp) :: g2, g3d, gg, gxy, gz, j0g, j1g, k0g, & k1g, rlength, zlength REAL(KIND=dp), DIMENSION(3) :: abc + TYPE(pw_c1d_type), POINTER :: dct_gf TYPE(pw_grid_type), POINTER :: dct_grid TYPE(pw_pool_type), POINTER :: pw_pool_xpndd - TYPE(pw_type), POINTER :: dct_gf !CPASSERT(cell%orthorhombic) DO i = 1, 3 @@ -303,7 +301,7 @@ SUBROUTINE pw_green_create(green, poisson_params, cell_hmat, pw_pool, & NULLIFY (green%dct_influence_fn) ALLOCATE (green%dct_influence_fn) CALL pw_pool_xpndd%create_pw(green%dct_influence_fn, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_pool_release(pw_pool_xpndd) END IF END SELECT @@ -379,10 +377,10 @@ SUBROUTINE pw_green_create(green, poisson_params, cell_hmat, pw_pool, & DO ig = grid%first_gne0, grid%ngpts_cut_local g2 = grid%gsq(ig) g3d = fourpi/g2 - gf%array(ig) = g3d + green%screen_fn%cc(ig) + gf%array(ig) = g3d + green%screen_fn%array(ig) END DO IF (grid%have_g0) & - gf%array(1) = green%screen_fn%cc(1) + gf%array(1) = green%screen_fn%array(1) CASE (PS_IMPLICIT) @@ -398,9 +396,9 @@ SUBROUTINE pw_green_create(green, poisson_params, cell_hmat, pw_pool, & DO ig = dct_grid%first_gne0, dct_grid%ngpts_cut_local g2 = dct_grid%gsq(ig) - dct_gf%cc(ig) = fourpi/g2 + dct_gf%array(ig) = fourpi/g2 END DO - IF (dct_grid%have_g0) dct_gf%cc(1) = 0.0_dp + IF (dct_grid%have_g0) dct_gf%array(1) = 0.0_dp END IF CASE DEFAULT diff --git a/src/pw/pw_pool_types.F b/src/pw/pw_pool_types.F index 2817eff6ee..e6e1497e5e 100644 --- a/src/pw/pw_pool_types.F +++ b/src/pw/pw_pool_types.F @@ -37,14 +37,14 @@ MODULE pw_pool_types USE pw_grids, ONLY: pw_grid_compare, & pw_grid_release, & pw_grid_retain - USE pw_types, ONLY: COMPLEXDATA1D, & - REALDATA3D, & - REALSPACE, & - RECIPROCALSPACE, & + USE pw_types, ONLY: & + REALDATA3D, & + REALSPACE, & + RECIPROCALSPACE, & #:for kind in pw_kinds - pw_${kind}$_type, & + pw_${kind}$_type, & #:endfor - pw_type + pw_type #include "../base/base_uses.f90" IMPLICIT NONE @@ -242,7 +242,7 @@ END FUNCTION try_pop_${kind}$ !> \brief returns a pw, allocating it if none is in the pool !> \param pool the pool from where you get the pw !> \param pw will contain the new pw -!> \param use_data which data it uses: COMPLEXDATA1D, +!> \param use_data which data it uses: !> REALDATA3D !> \param in_space in which space it is: REALSPACE, RECIPROCALSPACE !> \par History @@ -307,7 +307,7 @@ END SUBROUTINE pw_pool_give_back_pw_${kind}$ !> \brief creates a multigrid structure !> \param pools the multigrid pool (i.e. an array of pw_pool) !> \param pws the multigrid of coefficent you want to initialize -!> \param use_data which data it uses: COMPLEXDATA1D, +!> \param use_data which data it uses: !> REALDATA3D !> \param in_space ... !> \par History @@ -356,7 +356,7 @@ END SUBROUTINE pw_pools_give_back_pws_${kind}$ !> \brief returns a pw, allocating it if none is in the pool !> \param pool the pool from where you get the pw !> \param pw will contain the new pw -!> \param use_data which data it uses: COMPLEXDATA1D, +!> \param use_data which data it uses: !> REALDATA3D !> \param in_space in which space it is: REALSPACE, RECIPROCALSPACE !> \par History @@ -385,10 +385,6 @@ SUBROUTINE pw_pool_create_pw_pw(pool, pw, use_data, in_space) r3d_ptr => try_pop_r3d(pool%r3d_array) CALL pw%create(pool%pw_grid, use_data=use_data, & in_space=in_space, r3d_ptr=r3d_ptr) - CASE (COMPLEXDATA1D) - c1d_ptr => try_pop_c1d(pool%c1d_array) - CALL pw%create(pool%pw_grid, use_data=use_data, & - in_space=in_space, c1d_ptr=c1d_ptr) CASE default ! unknown use_data CPABORT("") @@ -427,15 +423,6 @@ SUBROUTINE pw_pool_give_back_pw_pw(pool, pw) CPWARN("hit max_cache") END IF END IF - CASE (COMPLEXDATA1D) - IF (ASSOCIATED(pw%cc)) THEN - IF (cp_sll_1d_c_get_length(pool%c1d_array) < pool%max_cache) THEN - CALL cp_sll_1d_c_insert_el(pool%c1d_array, el=pw%cc) - NULLIFY (pw%cc) - ELSE IF (max_max_cache >= 0) THEN - CPWARN("hit max_cache") - END IF - END IF CASE default ! unknown in_use CPABORT("") @@ -513,7 +500,7 @@ END SUBROUTINE pw_pool_give_back_cr3d !> \brief creates a multigrid structure !> \param pools the multigrid pool (i.e. an array of pw_pool) !> \param pws the multigrid of coefficent you want to initialize -!> \param use_data which data it uses: COMPLEXDATA1D, +!> \param use_data which data it uses: !> REALDATA3D !> \param in_space ... !> \par History diff --git a/src/pw/pw_spline_utils.F b/src/pw/pw_spline_utils.F index 0de6bb9bb2..77f65e0b95 100644 --- a/src/pw/pw_spline_utils.F +++ b/src/pw/pw_spline_utils.F @@ -31,10 +31,10 @@ MODULE pw_spline_utils pw_zero USE pw_pool_types, ONLY: pw_pool_release,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type #include "../base/base_uses.f90" @@ -129,7 +129,7 @@ MODULE pw_spline_utils !> does not work with spherical cutoff ! ************************************************************************************************** SUBROUTINE pw_spline2_interpolate_values_g(spline_g) - TYPE(pw_type), INTENT(IN) :: spline_g + TYPE(pw_c1d_type), INTENT(IN) :: spline_g CHARACTER(len=*), PARAMETER :: routineN = 'pw_spline2_interpolate_values_g' @@ -144,7 +144,6 @@ SUBROUTINE pw_spline2_interpolate_values_g(spline_g) n_tot(1:3) = spline_g%pw_grid%npts(1:3) gbo = spline_g%pw_grid%bounds - CPASSERT(spline_g%in_use == COMPLEXDATA1D) CPASSERT(spline_g%in_space == RECIPROCALSPACE) CPASSERT(.NOT. spline_g%pw_grid%spherical) CPASSERT(spline_g%pw_grid%grid_span == FULLSPACE) @@ -169,7 +168,7 @@ SUBROUTINE pw_spline2_interpolate_values_g(spline_g) END DO !$OMP PARALLEL DO PRIVATE(i,j,k,ii,coeff,c23) DEFAULT(NONE) SHARED(spline_g,cosIVals,cosJVals,cosKVals) - DO ii = 1, SIZE(spline_g%cc) + DO ii = 1, SIZE(spline_g%array) i = spline_g%pw_grid%g_hat(1, ii) j = spline_g%pw_grid%g_hat(2, ii) k = spline_g%pw_grid%g_hat(3, ii) @@ -180,7 +179,7 @@ SUBROUTINE pw_spline2_interpolate_values_g(spline_g) (cosIVals(i) + cosJVals(j) + cosKVals(k))*9.0_dp + & 27.0_dp) - spline_g%cc(ii) = spline_g%cc(ii)*coeff + spline_g%array(ii) = spline_g%array(ii)*coeff END DO DEALLOCATE (cosIVals, cosJVals, cosKVals) @@ -202,7 +201,7 @@ END SUBROUTINE pw_spline2_interpolate_values_g !> needed cos, and avoid the mpi_allreduce ! ************************************************************************************************** SUBROUTINE pw_spline3_interpolate_values_g(spline_g) - TYPE(pw_type), INTENT(IN) :: spline_g + TYPE(pw_c1d_type), INTENT(IN) :: spline_g CHARACTER(len=*), PARAMETER :: routineN = 'pw_spline3_interpolate_values_g' @@ -217,7 +216,6 @@ SUBROUTINE pw_spline3_interpolate_values_g(spline_g) n_tot(1:3) = spline_g%pw_grid%npts(1:3) gbo = spline_g%pw_grid%bounds - CPASSERT(spline_g%in_use == COMPLEXDATA1D) CPASSERT(spline_g%in_space == RECIPROCALSPACE) CPASSERT(.NOT. spline_g%pw_grid%spherical) CPASSERT(spline_g%pw_grid%grid_span == FULLSPACE) @@ -243,7 +241,7 @@ SUBROUTINE pw_spline3_interpolate_values_g(spline_g) END DO !$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,k,ii,coeff,c23) SHARED(spline_g,cosIVals,cosJVals,cosKVals) - DO ii = 1, SIZE(spline_g%cc) + DO ii = 1, SIZE(spline_g%array) i = spline_g%pw_grid%g_hat(1, ii) j = spline_g%pw_grid%g_hat(2, ii) k = spline_g%pw_grid%g_hat(3, ii) @@ -260,7 +258,7 @@ SUBROUTINE pw_spline3_interpolate_values_g(spline_g) (cosIVals(i) + cosJVals(j) + cosKVals(k))*4.0_dp + & 8.0_dp) - spline_g%cc(ii) = spline_g%cc(ii)*coeff + spline_g%array(ii) = spline_g%array(ii)*coeff END DO DEALLOCATE (cosIVals, cosJVals, cosKVals) @@ -370,7 +368,7 @@ END SUBROUTINE pw_spline_scale_deriv !> the distance between gridpoints is assumed to be 1 ! ************************************************************************************************** SUBROUTINE pw_spline3_deriv_g(spline_g, idir) - TYPE(pw_type), INTENT(IN) :: spline_g + TYPE(pw_c1d_type), INTENT(IN) :: spline_g INTEGER, INTENT(in) :: idir CHARACTER(len=*), PARAMETER :: routineN = 'pw_spline3_deriv_g' @@ -389,7 +387,6 @@ SUBROUTINE pw_spline3_deriv_g(spline_g, idir) bo = spline_g%pw_grid%bounds_local gbo = spline_g%pw_grid%bounds - CPASSERT(spline_g%in_use == COMPLEXDATA1D) CPASSERT(spline_g%in_space == RECIPROCALSPACE) CPASSERT(.NOT. spline_g%pw_grid%spherical) CPASSERT(spline_g%pw_grid%grid_span == FULLSPACE) @@ -439,7 +436,7 @@ SUBROUTINE pw_spline3_deriv_g(spline_g, idir) CASE (1) ! x deriv !$OMP PARALLEL DO PRIVATE(ii,k,j,i,coeff,tmp) DEFAULT(NONE) SHARED(spline_g,csIVals,csJVals,csKVals) - DO ii = 1, SIZE(spline_g%cc) + DO ii = 1, SIZE(spline_g%array) i = spline_g%pw_grid%g_hat(1, ii) j = spline_g%pw_grid%g_hat(2, ii) k = spline_g%pw_grid%g_hat(3, ii) @@ -452,13 +449,13 @@ SUBROUTINE pw_spline3_deriv_g(spline_g, idir) (tmp + csIVals(i)*csKVals(k))*2.0_dp + & csIVals(i)*4.0_dp)*inv9 - spline_g%cc(ii) = spline_g%cc(ii)* & - CMPLX(0.0_dp, coeff, dp) + spline_g%array(ii) = spline_g%array(ii)* & + CMPLX(0.0_dp, coeff, dp) END DO CASE (2) ! y deriv !$OMP PARALLEL DO PRIVATE(ii,k,j,i,coeff,tmp) DEFAULT(NONE) SHARED(spline_g,csIVals,csJVals,csKVals) - DO ii = 1, SIZE(spline_g%cc) + DO ii = 1, SIZE(spline_g%array) i = spline_g%pw_grid%g_hat(1, ii) j = spline_g%pw_grid%g_hat(2, ii) k = spline_g%pw_grid%g_hat(3, ii) @@ -468,13 +465,13 @@ SUBROUTINE pw_spline3_deriv_g(spline_g, idir) (tmp + csJVals(j)*csKVals(k))*2.0_dp + & csJVals(j)*4.0_dp)*inv9 - spline_g%cc(ii) = spline_g%cc(ii)* & - CMPLX(0.0_dp, coeff, dp) + spline_g%array(ii) = spline_g%array(ii)* & + CMPLX(0.0_dp, coeff, dp) END DO CASE (3) ! z deriv !$OMP PARALLEL DO PRIVATE(ii,k,j,i,coeff,tmp) DEFAULT(NONE) SHARED(spline_g,csIVals,csJVals,csKVals) - DO ii = 1, SIZE(spline_g%cc) + DO ii = 1, SIZE(spline_g%array) i = spline_g%pw_grid%g_hat(1, ii) j = spline_g%pw_grid%g_hat(2, ii) k = spline_g%pw_grid%g_hat(3, ii) @@ -484,8 +481,8 @@ SUBROUTINE pw_spline3_deriv_g(spline_g, idir) (tmp + csJVals(j)*csKVals(k))*2.0_dp + & csKVals(k)*4.0_dp)*inv9 - spline_g%cc(ii) = spline_g%cc(ii)* & - CMPLX(0.0_dp, coeff, dp) + spline_g%array(ii) = spline_g%array(ii)* & + CMPLX(0.0_dp, coeff, dp) END DO END SELECT @@ -507,7 +504,7 @@ END SUBROUTINE pw_spline3_deriv_g !> the distance between gridpoints is assumed to be 1 ! ************************************************************************************************** SUBROUTINE pw_spline2_deriv_g(spline_g, idir) - TYPE(pw_type), INTENT(IN) :: spline_g + TYPE(pw_c1d_type), INTENT(IN) :: spline_g INTEGER, INTENT(in) :: idir CHARACTER(len=*), PARAMETER :: routineN = 'pw_spline2_deriv_g' @@ -525,7 +522,6 @@ SUBROUTINE pw_spline2_deriv_g(spline_g, idir) n_tot(1:3) = spline_g%pw_grid%npts(1:3) bo = spline_g%pw_grid%bounds - CPASSERT(spline_g%in_use == COMPLEXDATA1D) CPASSERT(spline_g%in_space == RECIPROCALSPACE) CPASSERT(.NOT. spline_g%pw_grid%spherical) CPASSERT(spline_g%pw_grid%grid_span == FULLSPACE) @@ -574,7 +570,7 @@ SUBROUTINE pw_spline2_deriv_g(spline_g, idir) CASE (1) ! x deriv !$OMP PARALLEL DO PRIVATE(ii,k,j,i,coeff,tmp) SHARED(spline_g,csIVals,csJVals,csKVals) DEFAULT(NONE) - DO ii = 1, SIZE(spline_g%cc) + DO ii = 1, SIZE(spline_g%array) i = spline_g%pw_grid%g_hat(1, ii) j = spline_g%pw_grid%g_hat(2, ii) k = spline_g%pw_grid%g_hat(3, ii) @@ -587,13 +583,13 @@ SUBROUTINE pw_spline2_deriv_g(spline_g, idir) (tmp + csIVals(i)*csKVals(k))*3.0_dp + & csIVals(i)*9.0_dp)*inv16 - spline_g%cc(ii) = spline_g%cc(ii)* & - CMPLX(0.0_dp, coeff, dp) + spline_g%array(ii) = spline_g%array(ii)* & + CMPLX(0.0_dp, coeff, dp) END DO CASE (2) ! y deriv !$OMP PARALLEL DO PRIVATE(ii,k,j,i,coeff,tmp) DEFAULT(NONE) SHARED(spline_g,csIVals,csJVals,csKVals) - DO ii = 1, SIZE(spline_g%cc) + DO ii = 1, SIZE(spline_g%array) i = spline_g%pw_grid%g_hat(1, ii) j = spline_g%pw_grid%g_hat(2, ii) k = spline_g%pw_grid%g_hat(3, ii) @@ -603,13 +599,13 @@ SUBROUTINE pw_spline2_deriv_g(spline_g, idir) (tmp + csJVals(j)*csKVals(k))*3.0_dp + & csJVals(j)*9.0_dp)*inv16 - spline_g%cc(ii) = spline_g%cc(ii)* & - CMPLX(0.0_dp, coeff, dp) + spline_g%array(ii) = spline_g%array(ii)* & + CMPLX(0.0_dp, coeff, dp) END DO CASE (3) ! z deriv !$OMP PARALLEL DO PRIVATE(ii,k,j,i,coeff,tmp) DEFAULT(NONE) SHARED(spline_g,csIVals,csJVals,csKVals) - DO ii = 1, SIZE(spline_g%cc) + DO ii = 1, SIZE(spline_g%array) i = spline_g%pw_grid%g_hat(1, ii) j = spline_g%pw_grid%g_hat(2, ii) k = spline_g%pw_grid%g_hat(3, ii) @@ -619,8 +615,8 @@ SUBROUTINE pw_spline2_deriv_g(spline_g, idir) (tmp + csJVals(j)*csKVals(k))*3.0_dp + & csKVals(k)*9.0_dp)*inv16 - spline_g%cc(ii) = spline_g%cc(ii)* & - CMPLX(0.0_dp, coeff, dp) + spline_g%array(ii) = spline_g%array(ii)* & + CMPLX(0.0_dp, coeff, dp) END DO END SELECT diff --git a/src/pw/pw_types.F b/src/pw/pw_types.F index 0e88094b87..7d49a92fee 100644 --- a/src/pw/pw_types.F +++ b/src/pw/pw_types.F @@ -42,7 +42,6 @@ MODULE pw_types ! Flags for the structure member 'in_use' ! NODATA only for internal use, we enforce a certain data type - INTEGER, PARAMETER, PUBLIC :: COMPLEXDATA1D = 302 INTEGER, PARAMETER, PUBLIC :: REALDATA3D = 303 INTEGER, PARAMETER :: NODATA = 305 @@ -53,10 +52,7 @@ MODULE pw_types ! ************************************************************************************************** TYPE pw_type - REAL(KIND=dp), DIMENSION(:), CONTIGUOUS, POINTER :: cr => NULL() REAL(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER :: cr3d => NULL() - COMPLEX(KIND=dp), DIMENSION(:), CONTIGUOUS, POINTER :: cc => NULL() - COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER :: cc3d => NULL() INTEGER :: in_use = NODATA ! Which data is used [r1d/c1d/r3d/c3d] INTEGER :: in_space = NOSPACE ! Real/Reciprocal space @@ -107,8 +103,6 @@ SUBROUTINE pw_release(pw) CLASS(pw_type), INTENT(INOUT) :: pw SELECT CASE (pw%in_use) - CASE (COMPLEXDATA1D) - IF (ASSOCIATED(pw%cc)) DEALLOCATE (pw%cc) CASE (REALDATA3D) IF (ASSOCIATED(pw%cr3d)) DEALLOCATE (pw%cr3d) CASE (NODATA) @@ -133,15 +127,11 @@ END SUBROUTINE pw_release !> 11.2003 created [fawzi] !> \author fawzi ! ************************************************************************************************** - SUBROUTINE pw_create(pw, pw_grid, use_data, in_space, c1d_ptr, r3d_ptr) + SUBROUTINE pw_create(pw, pw_grid, use_data, in_space, r3d_ptr) CLASS(pw_type), INTENT(INOUT) :: pw TYPE(pw_grid_type), INTENT(IN), POINTER :: pw_grid INTEGER, INTENT(in) :: use_data, in_space - #:for kind, type in zip(pw_kinds, pw_types) - #:if kind != "c3d" and kind != "r1d" - ${type}$, CONTIGUOUS, INTENT(IN), OPTIONAL, POINTER :: ${kind}$_ptr - #:endif - #:endfor + REAL(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, INTENT(IN), OPTIONAL, POINTER :: r3d_ptr CHARACTER(len=*), PARAMETER :: routineN = 'pw_create' @@ -162,20 +152,6 @@ SUBROUTINE pw_create(pw, pw_grid, use_data, in_space, c1d_ptr, r3d_ptr) bounds => pw%pw_grid%bounds_local SELECT CASE (use_data) - CASE (COMPLEXDATA1D) - IF (PRESENT(c1d_ptr)) THEN - IF (ASSOCIATED(c1d_ptr)) THEN - IF (ALL(bounds(1, :) <= bounds(2, :))) THEN - CPASSERT(LBOUND(c1d_ptr, 1) == 1) - CPASSERT(UBOUND(c1d_ptr, 1) == pw%pw_grid%ngpts_cut_local) - END IF - pw%cc => c1d_ptr - END IF - END IF - IF (.NOT. ASSOCIATED(pw%cc)) THEN - ALLOCATE (pw%cc(pw%pw_grid%ngpts_cut_local)) - END IF - CASE (REALDATA3D) IF (PRESENT(r3d_ptr)) THEN IF (ASSOCIATED(r3d_ptr)) THEN diff --git a/src/pw_env/rs_pw_interface.F b/src/pw_env/rs_pw_interface.F index 7694f26fcb..3c5cb18e8b 100644 --- a/src/pw_env/rs_pw_interface.F +++ b/src/pw_env/rs_pw_interface.F @@ -29,8 +29,7 @@ MODULE rs_pw_interface USE pw_pool_types, ONLY: pw_pool_p_type,& pw_pools_create_pws,& pw_pools_give_back_pws - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& pw_c1d_type,& @@ -73,19 +72,16 @@ SUBROUTINE density_rs2pw_pw(pw_env, rs_rho, rho, rho_gspace) TYPE(pw_env_type), INTENT(IN) :: pw_env TYPE(realspace_grid_type), DIMENSION(:), & INTENT(IN) :: rs_rho - TYPE(pw_type), INTENT(INOUT) :: rho, rho_gspace + TYPE(pw_type), INTENT(INOUT) :: rho + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_gspace - TYPE(pw_c1d_type) :: my_rho_gspace TYPE(pw_r3d_type) :: my_rho - my_rho_gspace%in_space = rho_gspace%in_space - my_rho_gspace%pw_grid => rho_gspace%pw_grid - my_rho_gspace%array => rho_gspace%cc my_rho%in_space = rho%in_space my_rho%pw_grid => rho%pw_grid my_rho%array => rho%cr3d - CALL density_rs2pw(pw_env, rs_rho, my_rho, my_rho_gspace) + CALL density_rs2pw(pw_env, rs_rho, my_rho, rho_gspace) END SUBROUTINE @@ -113,8 +109,9 @@ SUBROUTINE density_rs2pw_new(pw_env, rs_rho, rho, rho_gspace) INTEGER :: handle, igrid_level, interp_kind TYPE(gridlevel_info_type), POINTER :: gridlevel_info + TYPE(pw_c1d_type), ALLOCATABLE, DIMENSION(:) :: mgrid_gspace TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools - TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: mgrid_gspace, mgrid_rspace + TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: mgrid_rspace TYPE(realspace_grid_desc_p_type), DIMENSION(:), & POINTER :: rs_descs @@ -131,7 +128,6 @@ SUBROUTINE density_rs2pw_new(pw_env, rs_rho, rho, rho_gspace) in_space=REALSPACE) CALL pw_pools_create_pws(pw_pools, mgrid_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) IF (gridlevel_info%ngrid_levels == 1) THEN @@ -227,8 +223,9 @@ SUBROUTINE potential_pw2rs_new(rs_v, v_rspace, pw_env) interp_kind REAL(KIND=dp) :: scale TYPE(gridlevel_info_type), POINTER :: gridlevel_info + TYPE(pw_c1d_type), ALLOCATABLE, DIMENSION(:) :: mgrid_gspace TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools - TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: mgrid_gspace, mgrid_rspace + TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: mgrid_rspace CALL timeset(routineN, handle) @@ -245,7 +242,6 @@ SUBROUTINE potential_pw2rs_new(rs_v, v_rspace, pw_env) SELECT CASE (interp_kind) CASE (pw_interp) CALL pw_pools_create_pws(pw_pools, mgrid_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_transfer(v_rspace, mgrid_gspace(auxbas_grid)) DO igrid_level = 1, gridlevel_info%ngrid_levels diff --git a/src/qmmm_gpw_forces.F b/src/qmmm_gpw_forces.F index a5982de088..ec8e2f67f1 100644 --- a/src/qmmm_gpw_forces.F +++ b/src/qmmm_gpw_forces.F @@ -115,12 +115,12 @@ SUBROUTINE qmmm_forces(qs_env, qmmm_env, mm_particles, calc_force, mm_cell) TYPE(cp_logger_type), POINTER :: logger TYPE(dft_control_type), POINTER :: dft_control TYPE(mp_para_env_type), POINTER :: para_env - TYPE(pw_c1d_type), POINTER :: rho_core + TYPE(pw_c1d_type), POINTER :: rho0_s_gs, rho_core TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pool TYPE(pw_type), DIMENSION(:), POINTER :: rho_r - TYPE(pw_type), POINTER :: rho0_s_gs, rho_tot_r, rho_tot_r2 + TYPE(pw_type), POINTER :: rho_tot_r, rho_tot_r2 TYPE(qs_energy_type), POINTER :: energy TYPE(qs_ks_qmmm_env_type), POINTER :: ks_qmmm_env_loc TYPE(qs_rho_type), POINTER :: rho diff --git a/src/qmmm_image_charge.F b/src/qmmm_image_charge.F index 43ed52ce24..8d31b2a545 100644 --- a/src/qmmm_image_charge.F +++ b/src/qmmm_image_charge.F @@ -51,10 +51,10 @@ MODULE qmmm_image_charge USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qmmm_types_low, ONLY: qmmm_env_qm_type USE qs_collocate_density, ONLY: calculate_rho_metal,& @@ -97,7 +97,8 @@ MODULE qmmm_image_charge SUBROUTINE calculate_image_pot(v_hartree_rspace, rho_hartree_gspace, energy, & qmmm_env, qs_env) - TYPE(pw_type), INTENT(IN) :: v_hartree_rspace, rho_hartree_gspace + TYPE(pw_type), INTENT(IN) :: v_hartree_rspace + TYPE(pw_c1d_type), INTENT(IN) :: rho_hartree_gspace TYPE(qs_energy_type), POINTER :: energy TYPE(qmmm_env_qm_type), POINTER :: qmmm_env TYPE(qs_environment_type), POINTER :: qs_env @@ -704,10 +705,11 @@ SUBROUTINE calculate_image_matrix_gpw(image_matrix, qs_env, qmmm_env) INTEGER :: handle, iatom, iatom_ref, natom REAL(KIND=dp), DIMENSION(:), POINTER :: int_res TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type) :: rho_gb, vb_gspace TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho_gb, vb_gspace, vb_rspace + TYPE(pw_type) :: vb_rspace CALL timeset(routineN, handle) NULLIFY (pw_env, auxbas_pw_pool, poisson_env, para_env, int_res) @@ -722,10 +724,8 @@ SUBROUTINE calculate_image_matrix_gpw(image_matrix, qs_env, qmmm_env) CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, & poisson_env=poisson_env) CALL auxbas_pw_pool%create_pw(rho_gb, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(vb_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(vb_rspace, & use_data=REALDATA3D, & @@ -866,7 +866,7 @@ SUBROUTINE calculate_potential_metal(v_metal_rspace, coeff, rho_hartree_gspace, TYPE(pw_type), INTENT(OUT) :: v_metal_rspace REAL(KIND=dp), DIMENSION(:), POINTER :: coeff - TYPE(pw_type), INTENT(IN), OPTIONAL :: rho_hartree_gspace + TYPE(pw_c1d_type), INTENT(IN), OPTIONAL :: rho_hartree_gspace TYPE(qs_energy_type), OPTIONAL, POINTER :: energy TYPE(qs_environment_type), POINTER :: qs_env @@ -875,10 +875,10 @@ SUBROUTINE calculate_potential_metal(v_metal_rspace, coeff, rho_hartree_gspace, INTEGER :: handle REAL(KIND=dp) :: en_external, en_vmetal_rhohartree, & total_rho_metal + TYPE(pw_c1d_type) :: rho_metal, v_metal_gspace TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho_metal, v_metal_gspace CALL timeset(routineN, handle) @@ -891,11 +891,9 @@ SUBROUTINE calculate_potential_metal(v_metal_rspace, coeff, rho_hartree_gspace, poisson_env=poisson_env) CALL auxbas_pw_pool%create_pw(rho_metal, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_metal_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_metal_rspace, & diff --git a/src/qs_2nd_kernel_ao.F b/src/qs_2nd_kernel_ao.F index d52e832aa9..2a0e10d673 100644 --- a/src/qs_2nd_kernel_ao.F +++ b/src/qs_2nd_kernel_ao.F @@ -40,7 +40,8 @@ MODULE qs_2nd_kernel_ao pw_env_type USE pw_methods, ONLY: pw_scale USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type USE qs_integrate_potential, ONLY: integrate_v_rspace @@ -280,10 +281,10 @@ SUBROUTINE apply_xc_admm_ao(qs_env, p_env, calc_forces, calc_virial, virial) TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_aux TYPE(dft_control_type), POINTER :: dft_control TYPE(linres_control_type), POINTER :: linres_control + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho1_aux_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), DIMENSION(:), POINTER :: rho1_aux_g, rho1_aux_r, tau1_aux_r, & - v_xc, v_xc_tau + TYPE(pw_type), DIMENSION(:), POINTER :: rho1_aux_r, tau1_aux_r, v_xc, v_xc_tau TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho_aux TYPE(section_vals_type), POINTER :: xc_section diff --git a/src/qs_active_space_methods.F b/src/qs_active_space_methods.F index 6856d5e4b1..07b1dfbfcb 100644 --- a/src/qs_active_space_methods.F +++ b/src/qs_active_space_methods.F @@ -96,11 +96,11 @@ MODULE qs_active_space_methods pw_poisson_type USE pw_pool_types, ONLY: & pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D, & - REALDATA3D, & - REALSPACE, & - RECIPROCALSPACE, & - pw_type + USE pw_types, ONLY: & + pw_c1d_type, REALDATA3D, & + REALSPACE, & + RECIPROCALSPACE, & + pw_type USE qcschema, ONLY: qcschema_env_create, & qcschema_env_release, & qcschema_to_hdf5, & @@ -1222,10 +1222,11 @@ SUBROUTINE calculate_eri_gpw(mos, orbitals, eri_env, qs_env, iw) TYPE(neighbor_list_set_p_type), DIMENSION(:), & POINTER :: sab_orb_sub TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: pot_g, rho_g TYPE(pw_env_type), POINTER :: pw_env_sub TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: pot_g, rho_g, rho_r, wfn_r + TYPE(pw_type) :: rho_r, wfn_r TYPE(pw_type), ALLOCATABLE, DIMENSION(:, :), & TARGET :: wfn_a TYPE(pw_type), POINTER :: wfn1, wfn2, wfn3, wfn4 @@ -1406,7 +1407,7 @@ SUBROUTINE calculate_eri_gpw(mos, orbitals, eri_env, qs_env, iw) END IF CALL auxbas_pw_pool%create_pw(wfn_r, use_data=REALDATA3D, in_space=REALSPACE) - CALL auxbas_pw_pool%create_pw(rho_g, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(rho_g, in_space=RECIPROCALSPACE) CALL get_qs_env(qs_env, qs_kind_set=qs_kind_set, cell=cell, & particle_set=particle_set, atomic_kind_set=atomic_kind_set) @@ -1460,7 +1461,7 @@ SUBROUTINE calculate_eri_gpw(mos, orbitals, eri_env, qs_env, iw) ! get some of the grids ready CALL auxbas_pw_pool%create_pw(rho_r, use_data=REALDATA3D, in_space=REALSPACE) - CALL auxbas_pw_pool%create_pw(pot_g, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(pot_g, in_space=RECIPROCALSPACE) ! run the FFT once, to set up buffers and to take into account the memory CALL pw_zero(rho_r) @@ -1873,9 +1874,10 @@ SUBROUTINE print_orbital_cubes(input, qs_env, mos) TYPE(mp_para_env_type), POINTER :: para_env TYPE(particle_list_type), POINTER :: particles TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: wf_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: wf_g, wf_r + TYPE(pw_type) :: wf_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_subsys_type), POINTER :: subsys TYPE(section_vals_type), POINTER :: dft_section, scf_input @@ -1907,7 +1909,7 @@ SUBROUTINE print_orbital_cubes(input, qs_env, mos) ! CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool) CALL auxbas_pw_pool%create_pw(wf_r, use_data=REALDATA3D, in_space=REALSPACE) - CALL auxbas_pw_pool%create_pw(wf_g, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(wf_g, in_space=RECIPROCALSPACE) ! dft_section => section_vals_get_subs_vals(scf_input, "DFT") ! diff --git a/src/qs_collocate_density.F b/src/qs_collocate_density.F index a8f0e4f222..92c959e0d1 100644 --- a/src/qs_collocate_density.F +++ b/src/qs_collocate_density.F @@ -84,11 +84,11 @@ MODULE qs_collocate_density pw_pool_type, & pw_pools_create_pws, & pw_pools_give_back_pws - USE pw_types, ONLY: COMPLEXDATA1D, & - REALDATA3D, & - pw_r3d_type, REALSPACE, & - RECIPROCALSPACE, & - pw_c1d_type, pw_type + USE pw_types, ONLY: & + REALDATA3D, & + pw_r3d_type, REALSPACE, & + RECIPROCALSPACE, & + pw_c1d_type, pw_type USE qs_environment_types, ONLY: get_qs_env, & qs_environment_type USE qs_kind_types, ONLY: get_qs_kind, & @@ -153,6 +153,10 @@ MODULE qs_collocate_density MODULE PROCEDURE collocate_single_gaussian_pw, collocate_single_gaussian_new END INTERFACE + INTERFACE calculate_rho_resp_all + MODULE PROCEDURE calculate_rho_resp_all_pw_type, calculate_rho_resp_all_pw_c1d_type + END INTERFACE + CONTAINS ! ************************************************************************************************** @@ -525,7 +529,8 @@ END SUBROUTINE calculate_ppl_grid SUBROUTINE calculate_lri_rho_elec(lri_rho_g, lri_rho_r, qs_env, & lri_coef, total_rho, basis_type, exact_1c_terms, pmat, atomlist) - TYPE(pw_type), INTENT(INOUT) :: lri_rho_g, lri_rho_r + TYPE(pw_c1d_type), INTENT(INOUT) :: lri_rho_g + TYPE(pw_type), INTENT(INOUT) :: lri_rho_r TYPE(qs_environment_type), POINTER :: qs_env TYPE(lri_kind_type), DIMENSION(:), POINTER :: lri_coef REAL(KIND=dp), INTENT(OUT) :: total_rho @@ -555,7 +560,8 @@ SUBROUTINE calculate_lri_rho_elec(lri_rho_g, lri_rho_r, qs_env, & TYPE(particle_type), DIMENSION(:), POINTER :: particle_set TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools - TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: mgrid_gspace, mgrid_rspace + TYPE(pw_c1d_type), ALLOCATABLE, DIMENSION(:) :: mgrid_gspace + TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: mgrid_rspace TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(realspace_grid_type), DIMENSION(:), POINTER :: rs_rho TYPE(realspace_grid_type), POINTER :: rs_grid @@ -590,7 +596,6 @@ SUBROUTINE calculate_lri_rho_elec(lri_rho_g, lri_rho_r, qs_env, & in_space=REALSPACE) CALL pw_pools_create_pws(pw_pools, mgrid_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) ! *** set up the rs multi-grids *** ! @@ -946,7 +951,7 @@ END SUBROUTINE calculate_rho_core_${kind}$ ! ************************************************************************************************** SUBROUTINE calculate_drho_core(drho_core, qs_env, beta, lambda) - TYPE(pw_type), INTENT(INOUT) :: drho_core + TYPE(pw_c1d_type), INTENT(INOUT) :: drho_core TYPE(qs_environment_type), POINTER :: qs_env INTEGER, INTENT(IN) :: beta, lambda @@ -1079,7 +1084,7 @@ END SUBROUTINE calculate_drho_core ! ************************************************************************************************** SUBROUTINE calculate_rho_single_gaussian(rho_gb, qs_env, iatom_in) - TYPE(pw_type), INTENT(INOUT) :: rho_gb + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_gb TYPE(qs_environment_type), POINTER :: qs_env INTEGER, INTENT(IN) :: iatom_in @@ -1170,7 +1175,7 @@ END SUBROUTINE calculate_rho_single_gaussian ! ************************************************************************************************** SUBROUTINE calculate_rho_metal(rho_metal, coeff, total_rho_metal, qs_env) - TYPE(pw_type), INTENT(INOUT) :: rho_metal + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_metal REAL(KIND=dp), DIMENSION(:), POINTER :: coeff REAL(KIND=dp), INTENT(OUT), OPTIONAL :: total_rho_metal TYPE(qs_environment_type), POINTER :: qs_env @@ -1277,7 +1282,7 @@ END SUBROUTINE calculate_rho_metal ! ************************************************************************************************** SUBROUTINE calculate_rho_resp_single(rho_gb, qs_env, eta, iatom_in) - TYPE(pw_type), INTENT(INOUT) :: rho_gb + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_gb TYPE(qs_environment_type), POINTER :: qs_env REAL(KIND=dp), INTENT(IN) :: eta INTEGER, INTENT(IN) :: iatom_in @@ -1356,6 +1361,7 @@ SUBROUTINE calculate_rho_resp_single(rho_gb, qs_env, eta, iatom_in) END SUBROUTINE calculate_rho_resp_single + #:for kind in ["pw_type", "pw_c1d_type"] ! ************************************************************************************************** !> \brief computes the RESP charge density on a grid based on the RESP charges !> \param rho_resp RESP charge density @@ -1368,97 +1374,98 @@ END SUBROUTINE calculate_rho_resp_single !> 01.2012 created !> \author Dorothea Golze ! ************************************************************************************************** - SUBROUTINE calculate_rho_resp_all(rho_resp, coeff, natom, eta, qs_env) + SUBROUTINE calculate_rho_resp_all_${kind}$ (rho_resp, coeff, natom, eta, qs_env) - TYPE(pw_type), INTENT(INOUT) :: rho_resp - REAL(KIND=dp), DIMENSION(:), POINTER :: coeff - INTEGER, INTENT(IN) :: natom - REAL(KIND=dp), INTENT(IN) :: eta - TYPE(qs_environment_type), POINTER :: qs_env + TYPE(${kind}$), INTENT(INOUT) :: rho_resp + REAL(KIND=dp), DIMENSION(:), POINTER :: coeff + INTEGER, INTENT(IN) :: natom + REAL(KIND=dp), INTENT(IN) :: eta + TYPE(qs_environment_type), POINTER :: qs_env - CHARACTER(len=*), PARAMETER :: routineN = 'calculate_rho_resp_all' + CHARACTER(len=*), PARAMETER :: routineN = 'calculate_rho_resp_all' - INTEGER :: handle, iatom, j, npme, subpatch_pattern - INTEGER, DIMENSION(:), POINTER :: cores - REAL(KIND=dp) :: eps_rho_rspace, radius - REAL(KIND=dp), DIMENSION(3) :: ra - REAL(KIND=dp), DIMENSION(:, :), POINTER :: pab - TYPE(cell_type), POINTER :: cell - TYPE(dft_control_type), POINTER :: dft_control - TYPE(particle_type), DIMENSION(:), POINTER :: particle_set - TYPE(pw_env_type), POINTER :: pw_env - TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rhoc_r - TYPE(realspace_grid_type), POINTER :: rs_rho + INTEGER :: handle, iatom, j, npme, subpatch_pattern + INTEGER, DIMENSION(:), POINTER :: cores + REAL(KIND=dp) :: eps_rho_rspace, radius + REAL(KIND=dp), DIMENSION(3) :: ra + REAL(KIND=dp), DIMENSION(:, :), POINTER :: pab + TYPE(cell_type), POINTER :: cell + TYPE(dft_control_type), POINTER :: dft_control + TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_env_type), POINTER :: pw_env + TYPE(pw_pool_type), POINTER :: auxbas_pw_pool + TYPE(pw_type) :: rhoc_r + TYPE(realspace_grid_type), POINTER :: rs_rho - CALL timeset(routineN, handle) + CALL timeset(routineN, handle) - NULLIFY (cell, cores, dft_control, pab, pw_env, rs_rho, auxbas_pw_pool, & - particle_set) + NULLIFY (cell, cores, dft_control, pab, pw_env, rs_rho, auxbas_pw_pool, & + particle_set) - ALLOCATE (pab(1, 1)) + ALLOCATE (pab(1, 1)) - CALL get_qs_env(qs_env=qs_env, & - cell=cell, & - dft_control=dft_control, & - particle_set=particle_set, & - pw_env=pw_env) - CALL pw_env_get(pw_env, auxbas_rs_grid=rs_rho, & - auxbas_pw_pool=auxbas_pw_pool) - CALL rs_grid_zero(rs_rho) + CALL get_qs_env(qs_env=qs_env, & + cell=cell, & + dft_control=dft_control, & + particle_set=particle_set, & + pw_env=pw_env) + CALL pw_env_get(pw_env, auxbas_rs_grid=rs_rho, & + auxbas_pw_pool=auxbas_pw_pool) + CALL rs_grid_zero(rs_rho) - eps_rho_rspace = dft_control%qs_control%eps_rho_rspace - pab(1, 1) = 1.0_dp + eps_rho_rspace = dft_control%qs_control%eps_rho_rspace + pab(1, 1) = 1.0_dp - CALL reallocate(cores, 1, natom) - npme = 0 - cores = 0 + CALL reallocate(cores, 1, natom) + npme = 0 + cores = 0 - DO iatom = 1, natom - IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed) THEN - IF (MODULO(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos) THEN + DO iatom = 1, natom + IF (rs_rho%desc%parallel .AND. .NOT. rs_rho%desc%distributed) THEN + IF (MODULO(iatom, rs_rho%desc%group_size) == rs_rho%desc%my_pos) THEN + npme = npme + 1 + cores(npme) = iatom + END IF + ELSE npme = npme + 1 cores(npme) = iatom END IF - ELSE - npme = npme + 1 - cores(npme) = iatom - END IF - END DO + END DO - IF (npme .GT. 0) THEN - DO j = 1, npme - iatom = cores(j) - ra(:) = pbc(particle_set(iatom)%r, cell) - subpatch_pattern = 0 - radius = exp_radius_very_extended(la_min=0, la_max=0, & - lb_min=0, lb_max=0, & - ra=ra, rb=ra, rp=ra, & - zetp=eta, eps=eps_rho_rspace, & - pab=pab, o1=0, o2=0, & ! without map_consistent - prefactor=coeff(iatom), cutoff=0.0_dp) + IF (npme .GT. 0) THEN + DO j = 1, npme + iatom = cores(j) + ra(:) = pbc(particle_set(iatom)%r, cell) + subpatch_pattern = 0 + radius = exp_radius_very_extended(la_min=0, la_max=0, & + lb_min=0, lb_max=0, & + ra=ra, rb=ra, rp=ra, & + zetp=eta, eps=eps_rho_rspace, & + pab=pab, o1=0, o2=0, & ! without map_consistent + prefactor=coeff(iatom), cutoff=0.0_dp) - CALL collocate_pgf_product( & - 0, eta, & - 0, 0, 0.0_dp, 0, ra, (/0.0_dp, 0.0_dp, 0.0_dp/), coeff(iatom), pab, 0, 0, rs_rho, & - radius=radius, ga_gb_function=GRID_FUNC_AB, & - use_subpatch=.TRUE., subpatch_pattern=subpatch_pattern) - END DO - END IF + CALL collocate_pgf_product( & + 0, eta, & + 0, 0, 0.0_dp, 0, ra, (/0.0_dp, 0.0_dp, 0.0_dp/), coeff(iatom), pab, 0, 0, rs_rho, & + radius=radius, ga_gb_function=GRID_FUNC_AB, & + use_subpatch=.TRUE., subpatch_pattern=subpatch_pattern) + END DO + END IF - DEALLOCATE (pab, cores) + DEALLOCATE (pab, cores) - CALL auxbas_pw_pool%create_pw(rhoc_r, & - use_data=REALDATA3D, in_space=REALSPACE) + CALL auxbas_pw_pool%create_pw(rhoc_r, & + use_data=REALDATA3D, in_space=REALSPACE) - CALL transfer_rs2pw(rs_rho, rhoc_r) + CALL transfer_rs2pw(rs_rho, rhoc_r) - CALL pw_transfer(rhoc_r, rho_resp) - CALL auxbas_pw_pool%give_back_pw(rhoc_r) + CALL pw_transfer(rhoc_r, rho_resp) + CALL auxbas_pw_pool%give_back_pw(rhoc_r) - CALL timestop(handle) + CALL timestop(handle) - END SUBROUTINE calculate_rho_resp_all + END SUBROUTINE calculate_rho_resp_all_${kind}$ + #:endfor SUBROUTINE calculate_rho_elec_pw(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho, & ks_env, soft_valid, compute_tau, compute_grad, & @@ -1467,7 +1474,8 @@ SUBROUTINE calculate_rho_elec_pw(matrix_p, matrix_p_kp, rho, rho_gspace, total_r TYPE(dbcsr_type), OPTIONAL, TARGET :: matrix_p TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, & POINTER :: matrix_p_kp - TYPE(pw_type), INTENT(INOUT) :: rho, rho_gspace + TYPE(pw_type), INTENT(INOUT) :: rho + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_gspace REAL(KIND=dp), INTENT(OUT), OPTIONAL :: total_rho TYPE(qs_ks_env_type), POINTER :: ks_env LOGICAL, INTENT(IN), OPTIONAL :: soft_valid, compute_tau, compute_grad @@ -1477,16 +1485,12 @@ SUBROUTINE calculate_rho_elec_pw(matrix_p, matrix_p_kp, rho, rho_gspace, total_r TYPE(pw_env_type), OPTIONAL, POINTER :: pw_env_external TYPE(pw_r3d_type) :: my_rho - TYPE(pw_c1d_type) :: my_rho_gspace my_rho%in_space = rho%in_space my_rho%pw_grid => rho%pw_grid my_rho%array => rho%cr3d - my_rho_gspace%in_space = rho_gspace%in_space - my_rho_gspace%pw_grid => rho_gspace%pw_grid - my_rho_gspace%array => rho_gspace%cc - CALL calculate_rho_elec_new(matrix_p, matrix_p_kp, my_rho, my_rho_gspace, total_rho, & + CALL calculate_rho_elec_new(matrix_p, matrix_p_kp, my_rho, rho_gspace, total_rho, & ks_env, soft_valid, compute_tau, compute_grad, & basis_type, der_type, idir, task_list_external, pw_env_external) @@ -1690,7 +1694,8 @@ SUBROUTINE calculate_drho_elec(matrix_p, matrix_p_kp, drho, drho_gspace, qs_env, TYPE(dbcsr_type), OPTIONAL, TARGET :: matrix_p TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, & POINTER :: matrix_p_kp - TYPE(pw_type), DIMENSION(3), INTENT(INOUT) :: drho, drho_gspace + TYPE(pw_type), DIMENSION(3), INTENT(INOUT) :: drho + TYPE(pw_c1d_type), DIMENSION(3), INTENT(INOUT) :: drho_gspace TYPE(qs_environment_type), POINTER :: qs_env LOGICAL, INTENT(IN), OPTIONAL :: soft_valid CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: basis_type @@ -2076,7 +2081,8 @@ SUBROUTINE calculate_drho_elec_dR(matrix_p, matrix_p_kp, drho, drho_gspace, qs_e TYPE(dbcsr_type), OPTIONAL, TARGET :: matrix_p TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, & POINTER :: matrix_p_kp - TYPE(pw_type), INTENT(INOUT) :: drho, drho_gspace + TYPE(pw_type), INTENT(INOUT) :: drho + TYPE(pw_c1d_type), INTENT(INOUT) :: drho_gspace TYPE(qs_environment_type), POINTER :: qs_env LOGICAL, INTENT(IN), OPTIONAL :: soft_valid CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: basis_type @@ -2461,7 +2467,8 @@ SUBROUTINE collocate_single_gaussian_pw(rho, rho_gspace, & atomic_kind_set, qs_kind_set, cell, dft_control, particle_set, & pw_env, required_function, basis_type) - TYPE(pw_type), INTENT(INOUT) :: rho, rho_gspace + TYPE(pw_type), INTENT(INOUT) :: rho + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_gspace TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(cell_type), POINTER :: cell @@ -2472,16 +2479,12 @@ SUBROUTINE collocate_single_gaussian_pw(rho, rho_gspace, & CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: basis_type TYPE(pw_r3d_type) :: my_rho - TYPE(pw_c1d_type) :: my_rho_gspace my_rho%in_space = rho%in_space my_rho%pw_grid => rho%pw_grid my_rho%array => rho%cr3d - my_rho_gspace%in_space = rho_gspace%in_space - my_rho_gspace%pw_grid => rho_gspace%pw_grid - my_rho_gspace%array => rho_gspace%cc - CALL collocate_single_gaussian_new(my_rho, my_rho_gspace, & + CALL collocate_single_gaussian_new(my_rho, rho_gspace, & atomic_kind_set, qs_kind_set, cell, dft_control, particle_set, & pw_env, required_function, basis_type) @@ -2536,7 +2539,8 @@ SUBROUTINE collocate_single_gaussian_new(rho, rho_gspace, & TYPE(gto_basis_set_type), POINTER :: orb_basis_set TYPE(mp_comm_type) :: group TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools - TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: mgrid_gspace, mgrid_rspace + TYPE(pw_c1d_type), ALLOCATABLE, DIMENSION(:) :: mgrid_gspace + TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: mgrid_rspace TYPE(realspace_grid_type), DIMENSION(:), POINTER :: rs_rho IF (PRESENT(basis_type)) THEN @@ -2556,7 +2560,6 @@ SUBROUTINE collocate_single_gaussian_new(rho, rho_gspace, & gridlevel_info=gridlevel_info) CALL pw_pools_create_pws(pw_pools, mgrid_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_pools_create_pws(pw_pools, mgrid_rspace, & use_data=REALDATA3D, & @@ -2679,7 +2682,8 @@ SUBROUTINE calculate_wavefunction_pw(mo_vectors, ivector, rho, rho_gspace, & TYPE(cp_fm_type), INTENT(IN) :: mo_vectors INTEGER, INTENT(IN) :: ivector - TYPE(pw_type), INTENT(INOUT) :: rho, rho_gspace + TYPE(pw_type), INTENT(INOUT) :: rho + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_gspace TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(cell_type), POINTER :: cell @@ -2690,16 +2694,12 @@ SUBROUTINE calculate_wavefunction_pw(mo_vectors, ivector, rho, rho_gspace, & REAL(KIND=dp), DIMENSION(:), OPTIONAL :: external_vector TYPE(pw_r3d_type) :: my_rho - TYPE(pw_c1d_type) :: my_rho_gspace my_rho%in_space = rho%in_space my_rho%pw_grid => rho%pw_grid my_rho%array => rho%cr3d - my_rho_gspace%in_space = rho_gspace%in_space - my_rho_gspace%pw_grid => rho_gspace%pw_grid - my_rho_gspace%array => rho_gspace%cc - CALL calculate_wavefunction_new(mo_vectors, ivector, my_rho, my_rho_gspace, & + CALL calculate_wavefunction_new(mo_vectors, ivector, my_rho, rho_gspace, & atomic_kind_set, qs_kind_set, cell, dft_control, particle_set, & pw_env, basis_type, external_vector) @@ -2764,7 +2764,8 @@ SUBROUTINE calculate_wavefunction_new(mo_vectors, ivector, rho, rho_gspace, & TYPE(gto_basis_set_type), POINTER :: orb_basis_set TYPE(mp_comm_type) :: group TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools - TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: mgrid_gspace, mgrid_rspace + TYPE(pw_c1d_type), ALLOCATABLE, DIMENSION(:) :: mgrid_gspace + TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: mgrid_rspace TYPE(realspace_grid_type), DIMENSION(:), POINTER :: rs_rho IF (PRESENT(basis_type)) THEN @@ -2796,7 +2797,6 @@ SUBROUTINE calculate_wavefunction_new(mo_vectors, ivector, rho, rho_gspace, & gridlevel_info=gridlevel_info) CALL pw_pools_create_pws(pw_pools, mgrid_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_pools_create_pws(pw_pools, mgrid_rspace, & use_data=REALDATA3D, & diff --git a/src/qs_dcdr_ao.F b/src/qs_dcdr_ao.F index 60e443b3af..c4b27ddf3d 100644 --- a/src/qs_dcdr_ao.F +++ b/src/qs_dcdr_ao.F @@ -50,10 +50,10 @@ MODULE qs_dcdr_ao USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_p_type,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_drho_core,& calculate_drho_elec_dR @@ -128,13 +128,14 @@ SUBROUTINE apply_op_constant_term(qs_env, dcdr_env, overlap1) TYPE(cp_fm_type) :: rho_ao_fm, rho_ao_s1, rho_ao_s1_rho_ao, & s1_ao TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho1_ao, rho_ao + TYPE(pw_c1d_type) :: rho1_tot_gspace, v_hartree_gspace + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho1_g, rho1_g_pw TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho1_tot_gspace, v_hartree_gspace, & - v_hartree_rspace - TYPE(pw_type), DIMENSION(:), POINTER :: rho1_g, rho1_g_pw, rho1_r, rho_r, & - tau1_r, v_rspace_new, v_xc, v_xc_tau + TYPE(pw_type) :: v_hartree_rspace + TYPE(pw_type), DIMENSION(:), POINTER :: rho1_r, rho_r, tau1_r, v_rspace_new, & + v_xc, v_xc_tau TYPE(qs_rho_type), POINTER :: perturbed_density, rho TYPE(section_vals_type), POINTER :: input, xc_section TYPE(xc_derivative_set_type) :: deriv_set @@ -241,7 +242,6 @@ SUBROUTINE apply_op_constant_term(qs_env, dcdr_env, overlap1) ALLOCATE (v_rspace_new(dcdr_env%nspins)) CALL auxbas_pw_pool%create_pw(v_hartree_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_hartree_rspace, & use_data=REALDATA3D, & @@ -249,7 +249,6 @@ SUBROUTINE apply_op_constant_term(qs_env, dcdr_env, overlap1) ! Calculate the Hartree potential on the total density CALL auxbas_pw_pool%create_pw(rho1_tot_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL qs_rho_get(perturbed_density, rho_g=rho1_g, rho_r=rho1_r, tau_r=tau1_r) @@ -343,12 +342,12 @@ SUBROUTINE d_core_charge_density_dR(qs_env, dcdr_env) INTEGER :: beta, handle TYPE(cp_logger_type), POINTER :: logger TYPE(dft_control_type), POINTER :: dft_control + TYPE(pw_c1d_type) :: drho_g, v_hartree_gspace TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: drho_g, v_hartree_gspace, & - v_hartree_rspace + TYPE(pw_type) :: v_hartree_rspace TYPE(qs_rho_type), POINTER :: rho CALL timeset(routineN, handle) @@ -366,14 +365,13 @@ SUBROUTINE d_core_charge_density_dR(qs_env, dcdr_env) ! Create the Hartree potential grids in real and reciprocal space. CALL auxbas_pw_pool%create_pw(v_hartree_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_hartree_rspace, & use_data=REALDATA3D, & in_space=REALSPACE) ! Create the grid for the derivative of the core potential CALL auxbas_pw_pool%create_pw(drho_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) DO beta = 1, 3 CALL pw_zero(v_hartree_gspace) @@ -521,14 +519,14 @@ SUBROUTINE d_vhxc_dR(qs_env, dcdr_env) INTEGER :: handle, idir, ispin TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao + TYPE(pw_c1d_type) :: drho_g_total, v_hartree_gspace + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: drho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: drho_g_total, drho_r_total, & - v_hartree_gspace, v_hartree_rspace - TYPE(pw_type), DIMENSION(:), POINTER :: drho_g, drho_r, dtau_r, rho_r, v_xc, & - v_xc_tau + TYPE(pw_type) :: drho_r_total, v_hartree_rspace + TYPE(pw_type), DIMENSION(:), POINTER :: drho_r, dtau_r, rho_r, v_xc, v_xc_tau TYPE(qs_rho_type), POINTER :: rho TYPE(section_vals_type), POINTER :: input, xc_section TYPE(xc_derivative_set_type) :: my_deriv_set @@ -551,7 +549,6 @@ SUBROUTINE d_vhxc_dR(qs_env, dcdr_env) CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, & pw_pools=pw_pools, poisson_env=poisson_env) CALL auxbas_pw_pool%create_pw(v_hartree_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_hartree_rspace, & use_data=REALDATA3D, & @@ -561,10 +558,10 @@ SUBROUTINE d_vhxc_dR(qs_env, dcdr_env) CALL auxbas_pw_pool%create_pw(drho_r(ispin), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(drho_g(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO CALL auxbas_pw_pool%create_pw(drho_g_total, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(drho_r_total, & use_data=REALDATA3D, in_space=REALSPACE) diff --git a/src/qs_dispersion_nonloc.F b/src/qs_dispersion_nonloc.F index 65a9f80572..341e8b1870 100644 --- a/src/qs_dispersion_nonloc.F +++ b/src/qs_dispersion_nonloc.F @@ -37,10 +37,10 @@ MODULE qs_dispersion_nonloc pw_derive,& pw_transfer USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_dispersion_types, ONLY: qs_dispersion_type USE virial_types, ONLY: virial_type @@ -164,7 +164,8 @@ END SUBROUTINE qs_dispersion_nonloc_init ! ************************************************************************************************** SUBROUTINE calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edispersion, & dispersion_env, energy_only, pw_pool, xc_pw_pool, para_env, virial) - TYPE(pw_type), DIMENSION(:), POINTER :: vxc_rho, rho_r, rho_g + TYPE(pw_type), DIMENSION(:), POINTER :: vxc_rho, rho_r + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g REAL(KIND=dp), INTENT(OUT) :: edispersion TYPE(qs_dispersion_type), POINTER :: dispersion_env LOGICAL, INTENT(IN) :: energy_only @@ -183,9 +184,10 @@ SUBROUTINE calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edispersion, & REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: dq0_dgradrho, dq0_drho, hpot, potential, & q0, rho REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: drho, thetas + TYPE(pw_c1d_type) :: tmp_g, vxc_g + TYPE(pw_c1d_type), ALLOCATABLE, DIMENSION(:) :: thetas_g TYPE(pw_grid_type), POINTER :: grid - TYPE(pw_type) :: tmp_g, tmp_r, vxc_g, vxc_r - TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: thetas_g + TYPE(pw_type) :: tmp_r, vxc_r TYPE(pw_type), ALLOCATABLE, DIMENSION(:, :) :: drho_r CALL timeset(routineN, handle) @@ -215,7 +217,7 @@ SUBROUTINE calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edispersion, & const = 1.0_dp/(3.0_dp*SQRT(pi)*b_value**1.5_dp)/(pi**0.75_dp) ! temporary arrays for FFT - CALL pw_pool%create_pw(tmp_g, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL pw_pool%create_pw(tmp_g, in_space=RECIPROCALSPACE) CALL pw_pool%create_pw(tmp_r, use_data=REALDATA3D, in_space=REALSPACE) ! get density derivatives @@ -392,7 +394,7 @@ SUBROUTINE calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edispersion, & END DO END DO !$OMP END PARALLEL DO - CALL pw_pool%create_pw(thetas_g(i), use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL pw_pool%create_pw(thetas_g(i), in_space=RECIPROCALSPACE) CALL pw_transfer(tmp_r, thetas_g(i)) END DO grid => thetas_g(1)%pw_grid @@ -530,7 +532,7 @@ SUBROUTINE calculate_dispersion_nonloc(vxc_rho, rho_r, rho_g, edispersion, & CALL pw_transfer(vxc_r, tmp_g) CALL pw_pool%give_back_pw(vxc_r) CALL xc_pw_pool%create_pw(vxc_r, use_data=REALDATA3D, in_space=REALSPACE) - CALL xc_pw_pool%create_pw(vxc_g, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL xc_pw_pool%create_pw(vxc_g, in_space=RECIPROCALSPACE) CALL pw_transfer(tmp_g, vxc_g) CALL pw_transfer(vxc_g, vxc_r) DO ispin = 1, nspin @@ -574,7 +576,7 @@ END SUBROUTINE calculate_dispersion_nonloc !> OpenMP added: Aug 2016 MTucker ! ************************************************************************************************** SUBROUTINE vdW_energy(thetas_g, dispersion_env, vdW_xc_energy, energy_only, virial) - TYPE(pw_type), DIMENSION(:), INTENT(IN) :: thetas_g + TYPE(pw_c1d_type), DIMENSION(:), INTENT(IN) :: thetas_g TYPE(qs_dispersion_type), POINTER :: dispersion_env REAL(KIND=dp), INTENT(OUT) :: vdW_xc_energy LOGICAL, INTENT(IN) :: energy_only @@ -642,7 +644,7 @@ SUBROUTINE vdW_energy(thetas_g, dispersion_env, vdW_xc_energy, energy_only, viri IF (use_virial) CALL interpolate_dkernel_dk(g, dkernel_of_dk, dispersion_env) END IF DO iq = 1, nqs - theta(iq) = thetas_g(iq)%cc(ig) + theta(iq) = thetas_g(iq)%array(ig) END DO DO q2_i = 1, nqs uu = CMPLX(0.0_dp, 0.0_dp, KIND=dp) @@ -681,7 +683,7 @@ SUBROUTINE vdW_energy(thetas_g, dispersion_env, vdW_xc_energy, energy_only, viri !$OMP DO DO ig = 1, grid%ngpts_cut_local DO iq = 1, nqs - thetas_g(iq)%cc(ig) = u_vdW(ig, iq) + thetas_g(iq)%array(ig) = u_vdW(ig, iq) END DO END DO !$OMP END DO diff --git a/src/qs_electric_field_gradient.F b/src/qs_electric_field_gradient.F index 5ec44807ab..c2742ce9c3 100644 --- a/src/qs_electric_field_gradient.F +++ b/src/qs_electric_field_gradient.F @@ -51,10 +51,10 @@ MODULE qs_electric_field_gradient Eval_Interp_Spl3_pbc, Eval_d_Interp_Spl3_pbc, find_coeffs, pw_spline_do_precond, & pw_spline_precond_create, pw_spline_precond_release, pw_spline_precond_set_kind, & pw_spline_precond_type, spl3_pbc - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -108,13 +108,15 @@ SUBROUTINE qs_efg_calc(qs_env) TYPE(dft_control_type), POINTER :: dft_control TYPE(mp_para_env_type), POINTER :: para_env TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: rho_tot_gspace, structure_factor, & + v_hartree_gspace + TYPE(pw_c1d_type), DIMENSION(6) :: dvr2 TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool TYPE(pw_spline_precond_type) :: precond - TYPE(pw_type) :: dvr2rs, rho_tot_gspace, & - structure_factor, v_hartree_gspace - TYPE(pw_type), DIMENSION(6) :: dvr2, dvspl + TYPE(pw_type) :: dvr2rs + TYPE(pw_type), DIMENSION(6) :: dvspl TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_rho_type), POINTER :: rho TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom_set @@ -212,9 +214,9 @@ SUBROUTINE qs_efg_calc(qs_env) !calculate electrostatic potential CALL auxbas_pw_pool%create_pw(v_hartree_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(rho_tot_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL calc_rho_tot_gspace(rho_tot_gspace, qs_env, rho) CALL pw_poisson_solve(poisson_env, rho_tot_gspace, ehartree, & @@ -228,14 +230,14 @@ SUBROUTINE qs_efg_calc(qs_env) DO j = 1, i ij = (i*(i - 1))/2 + j CALL auxbas_pw_pool%create_pw(dvr2(ij), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_dr2(v_hartree_gspace, dvr2(ij), i, j) END DO END DO IF (.NOT. efg_interpolation) THEN CALL auxbas_pw_pool%create_pw(structure_factor, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) ELSE interp_section => section_vals_get_subs_vals(dft_section, & diff --git a/src/qs_elf_methods.F b/src/qs_elf_methods.F index 4033a58e70..6167db458f 100644 --- a/src/qs_elf_methods.F +++ b/src/qs_elf_methods.F @@ -22,10 +22,10 @@ MODULE qs_elf_methods pw_zero USE pw_pool_types, ONLY: pw_pool_p_type,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_rho_elec USE qs_environment_types, ONLY: get_qs_env,& @@ -73,10 +73,10 @@ SUBROUTINE qs_elf_calc(qs_env, elf_r, rho_cutoff) udvol TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_struct_ao + TYPE(pw_c1d_type) :: tmp_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: tmp_g TYPE(pw_type), DIMENSION(3) :: drho_r TYPE(pw_type), DIMENSION(:), POINTER :: rho_struct_r, tau_struct_r TYPE(pw_type), DIMENSION(:, :), POINTER :: drho_struct_r @@ -114,7 +114,7 @@ SUBROUTINE qs_elf_calc(qs_env, elf_r, rho_cutoff) END IF IF (.NOT. tau_r_valid .OR. .NOT. drho_r_valid) THEN CALL auxbas_pw_pool%create_pw(tmp_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END IF IF (.NOT. drho_r_valid) THEN DO idir = 1, 3 diff --git a/src/qs_energy_window.F b/src/qs_energy_window.F index 65e51898ac..6b8428470c 100644 --- a/src/qs_energy_window.F +++ b/src/qs_energy_window.F @@ -48,10 +48,10 @@ MODULE qs_energy_window pw_env_type USE pw_methods, ONLY: pw_integrate_function USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_rho_elec USE qs_environment_types, ONLY: get_qs_env,& @@ -107,9 +107,10 @@ SUBROUTINE energy_windows(qs_env) tmp TYPE(dbcsr_type), POINTER :: rho_ao_ortho, window TYPE(particle_list_type), POINTER :: particles + TYPE(pw_c1d_type) :: rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho_g, rho_r + TYPE(pw_type) :: rho_r TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho TYPE(qs_subsys_type), POINTER :: subsys @@ -159,7 +160,7 @@ SUBROUTINE energy_windows(qs_env) CALL cp_fm_create(eigenvectors, ao_ao_fmstruct) CALL cp_fm_create(eigenvectors_nonorth, ao_ao_fmstruct) CALL auxbas_pw_pool%create_pw(rho_r, use_data=REALDATA3D, in_space=REALSPACE) - CALL auxbas_pw_pool%create_pw(rho_g, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(rho_g, in_space=RECIPROCALSPACE) !calculate S_minus_half CALL matrix_sqrt_Newton_Schulz(S_half, S_minus_half, matrix_s(1)%matrix, filter_eps, & diff --git a/src/qs_environment_methods.F b/src/qs_environment_methods.F index 10e6b7ef69..a3e8a781d1 100644 --- a/src/qs_environment_methods.F +++ b/src/qs_environment_methods.F @@ -37,8 +37,7 @@ MODULE qs_environment_methods pw_env_release,& pw_env_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& pw_c1d_type,& @@ -204,12 +203,12 @@ SUBROUTINE qs_env_rebuild_pw_env(qs_env) TYPE(dft_control_type), POINTER :: dft_control TYPE(ewald_environment_type), POINTER :: ewald_env TYPE(ewald_pw_type), POINTER :: ewald_pw - TYPE(pw_c1d_type), POINTER :: rho_core + TYPE(pw_c1d_type), POINTER :: rho_core, rho_nlcc_g TYPE(pw_env_type), POINTER :: new_pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool TYPE(pw_type), POINTER :: embed_pot, external_vxc, rho_nlcc, & - rho_nlcc_g, spin_embed_pot, & - v_hartree_rspace, vee, vppl + spin_embed_pot, v_hartree_rspace, vee, & + vppl TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(rho0_mpole_type), POINTER :: rho0_mpole @@ -322,7 +321,7 @@ SUBROUTINE qs_env_rebuild_pw_env(qs_env) ALLOCATE (rho_nlcc_g) END IF CALL pw_env_get(new_pw_env, auxbas_pw_pool=auxbas_pw_pool) - CALL auxbas_pw_pool%create_pw(rho_nlcc_g, COMPLEXDATA1D, RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(rho_nlcc_g, RECIPROCALSPACE) CALL set_ks_env(ks_env, rho_nlcc_g=rho_nlcc_g) END IF diff --git a/src/qs_environment_types.F b/src/qs_environment_types.F index c928f4be83..58e26fdfe4 100644 --- a/src/qs_environment_types.F +++ b/src/qs_environment_types.F @@ -547,7 +547,8 @@ SUBROUTINE get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, ce TYPE(qs_charges_type), OPTIONAL, POINTER :: qs_charges TYPE(pw_type), OPTIONAL, POINTER :: vppl TYPE(pw_c1d_type), OPTIONAL, POINTER :: rho_core - TYPE(pw_type), OPTIONAL, POINTER :: rho_nlcc, rho_nlcc_g + TYPE(pw_type), OPTIONAL, POINTER :: rho_nlcc + TYPE(pw_c1d_type), OPTIONAL, POINTER :: rho_nlcc_g TYPE(qs_ks_env_type), OPTIONAL, POINTER :: ks_env TYPE(qs_ks_qmmm_env_type), OPTIONAL, POINTER :: ks_qmmm_env TYPE(qs_wf_history_type), OPTIONAL, POINTER :: wf_history @@ -572,7 +573,8 @@ SUBROUTINE get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, ce TYPE(rhoz_type), DIMENSION(:), OPTIONAL, POINTER :: rhoz_set TYPE(ecoul_1center_type), DIMENSION(:), OPTIONAL, & POINTER :: ecoul_1c - TYPE(pw_type), OPTIONAL, POINTER :: rho0_s_rs, rho0_s_gs + TYPE(pw_type), OPTIONAL, POINTER :: rho0_s_rs + TYPE(pw_c1d_type), OPTIONAL, POINTER :: rho0_s_gs LOGICAL, OPTIONAL :: do_kpoints, has_unit_metric, & requires_mo_derivs TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, & diff --git a/src/qs_epr_hyp.F b/src/qs_epr_hyp.F index 8d9df472ed..3176821b44 100644 --- a/src/qs_epr_hyp.F +++ b/src/qs_epr_hyp.F @@ -43,9 +43,8 @@ MODULE qs_epr_hyp pw_dr2_gg,& pw_zero USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - RECIPROCALSPACE,& - pw_type + USE pw_types, ONLY: RECIPROCALSPACE,& + pw_c1d_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type USE qs_grid_atom, ONLY: grid_atom_type @@ -97,11 +96,11 @@ SUBROUTINE qs_epr_hyp_calc(qs_env) TYPE(harmonics_atom_type), POINTER :: harmonics TYPE(mp_para_env_type), POINTER :: para_env TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: hypaniso_gspace, rhototspin_elec_gspace + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_grid_type), POINTER :: pw_grid TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: hypaniso_gspace, rhototspin_elec_gspace - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_rho_type), POINTER :: rho TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: rho_rad_h, rho_rad_s @@ -283,7 +282,6 @@ SUBROUTINE qs_epr_hyp_calc(qs_env) auxbas_pw_pool=auxbas_pw_pool) CALL auxbas_pw_pool%create_pw(rhototspin_elec_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_zero(rhototspin_elec_gspace) @@ -296,7 +294,6 @@ SUBROUTINE qs_epr_hyp_calc(qs_env) CALL pw_axpy(rho_g(2), rhototspin_elec_gspace, alpha=-1._dp) ! grid to assemble anisotropic hyperfine terms CALL auxbas_pw_pool%create_pw(hypaniso_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) DO idir1 = 1, 3 @@ -307,10 +304,10 @@ SUBROUTINE qs_epr_hyp_calc(qs_env) DO iatom = 1, natom esum = 0.0_dp ra(:) = pbc(particle_set(iatom)%r, cell) - DO ig = 1, SIZE(hypaniso_gspace%cc) + DO ig = 1, SIZE(hypaniso_gspace%array) arg = DOT_PRODUCT(pw_grid%g(:, ig), ra) - esum = esum + COS(arg)*REAL(hypaniso_gspace%cc(ig), dp) & - - SIN(arg)*AIMAG(hypaniso_gspace%cc(ig)) + esum = esum + COS(arg)*REAL(hypaniso_gspace%array(ig), dp) & + - SIN(arg)*AIMAG(hypaniso_gspace%array(ig)) END DO ! Actually, we need -1.0 * fourpi * hypaniso_gspace esum = esum*fourpi*(-1.0_dp) diff --git a/src/qs_external_density.F b/src/qs_external_density.F index 5e3d287844..16dc647027 100644 --- a/src/qs_external_density.F +++ b/src/qs_external_density.F @@ -23,7 +23,8 @@ MODULE qs_external_density USE pw_env_types, ONLY: pw_env_get,& pw_env_type USE pw_methods, ONLY: pw_integrate_function - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type USE qs_rho_types, ONLY: qs_rho_get,& @@ -69,8 +70,9 @@ SUBROUTINE external_read_density(qs_env) TYPE(cell_type), POINTER :: cell TYPE(dft_control_type), POINTER :: dft_control TYPE(gridlevel_info_type), POINTER :: gridlevel_info + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_ext_g TYPE(pw_env_type), POINTER :: pw_env - TYPE(pw_type), DIMENSION(:), POINTER :: rho_ext_g, rho_ext_r + TYPE(pw_type), DIMENSION(:), POINTER :: rho_ext_r TYPE(qs_rho_type), POINTER :: rho_external TYPE(realspace_grid_desc_p_type), DIMENSION(:), & POINTER :: rs_descs @@ -129,13 +131,6 @@ SUBROUTINE external_read_density(qs_env) lbounds_local = rho_ext_r(1)%pw_grid%bounds_local(1, :) ubounds_local = rho_ext_r(1)%pw_grid%bounds_local(2, :) -! IF ( my_rank .eq. 0 ) THEN -! WRITE(*,*) my_rank,npoints, lbounds, ubounds -! WRITE(*,*) my_rank,npoints_local -! WRITE(*,*) my_rank,lbounds_local -! WRITE(*,*) my_rank,ubounds_local -! END IF - ALLOCATE (buffer(lbounds_local(3):ubounds_local(3))) IF (my_rank == 0) THEN diff --git a/src/qs_fxc.F b/src/qs_fxc.F index 1d6fd1672b..487a62c09b 100644 --- a/src/qs_fxc.F +++ b/src/qs_fxc.F @@ -38,6 +38,7 @@ MODULE qs_fxc USE pw_pool_types, ONLY: pw_pool_type USE pw_types, ONLY: REALDATA3D,& REALSPACE,& + pw_c1d_type,& pw_type USE qs_ks_types, ONLY: get_ks_env,& qs_ks_env_type @@ -97,7 +98,8 @@ SUBROUTINE qs_fxc_analytic(rho0, rho1_r, tau1_r, xc_section, auxbas_pw_pool, is_ INTEGER, DIMENSION(2, 3) :: bo LOGICAL :: lsd REAL(KIND=dp) :: fac - TYPE(pw_type), DIMENSION(:), POINTER :: rho0_g, rho0_r, rho1_g, tau0_r + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho0_g, rho1_g + TYPE(pw_type), DIMENSION(:), POINTER :: rho0_r, tau0_r TYPE(section_vals_type), POINTER :: xc_fun_section TYPE(xc_derivative_set_type) :: deriv_set TYPE(xc_rho_cflags_type) :: needs diff --git a/src/qs_gamma2kp.F b/src/qs_gamma2kp.F index 8144ff05c7..0b58801ac9 100644 --- a/src/qs_gamma2kp.F +++ b/src/qs_gamma2kp.F @@ -26,7 +26,8 @@ MODULE qs_gamma2kp kpoint_type USE message_passing, ONLY: mp_para_env_type USE pw_methods, ONLY: pw_copy - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_energy_init, ONLY: qs_energies_init USE qs_environment, ONLY: qs_init USE qs_environment_types, ONLY: get_qs_env,& @@ -68,8 +69,8 @@ SUBROUTINE create_kp_from_gamma(qs_env, qs_env_kp, with_xc_terms) TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_kp, rho_ao_kp_gamma TYPE(kpoint_type), POINTER :: kpoint TYPE(mp_para_env_type), POINTER :: para_env - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g_gamma, rho_g_kp, rho_r_gamma, & - rho_r_kp + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g_gamma, rho_g_kp + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r_gamma, rho_r_kp TYPE(qs_rho_type), POINTER :: rho, rho_gamma TYPE(qs_scf_env_type), POINTER :: scf_env TYPE(scf_control_type), POINTER :: scf_control diff --git a/src/qs_gspace_mixing.F b/src/qs_gspace_mixing.F index 7e1b4fee45..dc13197b2f 100644 --- a/src/qs_gspace_mixing.F +++ b/src/qs_gspace_mixing.F @@ -21,8 +21,8 @@ MODULE qs_gspace_mixing pw_transfer,& pw_zero USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - RECIPROCALSPACE,& + USE pw_types, ONLY: RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_density_mixing_types, ONLY: broyden_mixing_new_nr,& broyden_mixing_nr,& @@ -79,10 +79,11 @@ SUBROUTINE gspace_mixing(qs_env, mixing_method, mixing_store, rho, para_env, ite REAL(dp) :: alpha REAL(KIND=dp), DIMENSION(:), POINTER :: tot_rho_r TYPE(dft_control_type), POINTER :: dft_control + TYPE(pw_c1d_type) :: rho_tmp + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho_tmp - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom CALL timeset(routineN, handle) @@ -106,7 +107,6 @@ SUBROUTINE gspace_mixing(qs_env, mixing_method, mixing_store, rho, para_env, ite IF (nspin == 2) THEN CALL pw_env_get(pw_env=pw_env, auxbas_pw_pool=auxbas_pw_pool) CALL auxbas_pw_pool%create_pw(rho_tmp, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_zero(rho_tmp) CALL pw_copy(rho_g(1), rho_tmp) @@ -119,7 +119,7 @@ SUBROUTINE gspace_mixing(qs_env, mixing_method, mixing_store, rho, para_env, ite ! skip mixing DO ispin = 1, nspin DO ig = 1, ng - mixing_store%rhoin(ispin)%cc(ig) = rho_g(ispin)%cc(ig) + mixing_store%rhoin(ispin)%cc(ig) = rho_g(ispin)%array(ig) END DO END DO IF (mixing_store%gmix_p .AND. gapw) THEN @@ -212,7 +212,7 @@ SUBROUTINE gmix_potential_only(qs_env, mixing_store, rho) LOGICAL :: gapw REAL(dp) :: alpha, f_mix TYPE(dft_control_type), POINTER :: dft_control - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom CPASSERT(ASSOCIATED(mixing_store%rhoin)) @@ -231,7 +231,7 @@ SUBROUTINE gmix_potential_only(qs_env, mixing_store, rho) alpha = mixing_store%alpha DO ispin = 1, nspin - cc_new => rho_g(ispin)%cc + cc_new => rho_g(ispin)%array DO ig = 1, mixing_store%ig_max ! ng f_mix = mixing_store%alpha*mixing_store%kerker_factor(ig) cc_new(ig) = (1.0_dp - f_mix)*mixing_store%rhoin(ispin)%cc(ig) + f_mix*cc_new(ig) @@ -301,7 +301,7 @@ SUBROUTINE pulay_mixing(qs_env, mixing_store, rho, para_env) REAL(dp), ALLOCATABLE, DIMENSION(:) :: alpha_c, ev REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: a, b, c, c_inv, cpc_h_mix, cpc_s_mix TYPE(dft_control_type), POINTER :: dft_control - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom CPASSERT(ASSOCIATED(mixing_store%res_buffer)) @@ -359,7 +359,7 @@ SUBROUTINE pulay_mixing(qs_env, mixing_store, rho, para_env) res_norm = 0.0_dp DO ig = 1, ng f_mix = mixing_store%kerker_factor(ig) - mixing_store%res_buffer(ib, ispin)%cc(ig) = f_mix*(rho_g(ispin)%cc(ig) - & + mixing_store%res_buffer(ib, ispin)%cc(ig) = f_mix*(rho_g(ispin)%array(ig) - & mixing_store%rhoin_buffer(ib, ispin)%cc(ig)) res_norm = res_norm + & REAL(mixing_store%res_buffer(ib, ispin)%cc(ig), dp)*REAL(mixing_store%res_buffer(ib, ispin)%cc(ig), dp) + & @@ -407,11 +407,11 @@ SUBROUTINE pulay_mixing(qs_env, mixing_store, rho, para_env) IF (nb == 1 .OR. res_norm < 1.E-14_dp) THEN DO ig = 1, ng f_mix = alpha_kerker*mixing_store%kerker_factor(ig) - cc_mix(ig) = rho_g(ispin)%cc(ig) - & + cc_mix(ig) = rho_g(ispin)%array(ig) - & mixing_store%rhoin_buffer(ib, ispin)%cc(ig) - rho_g(ispin)%cc(ig) = f_mix*cc_mix(ig) + & - mixing_store%rhoin_buffer(ib, ispin)%cc(ig) - mixing_store%rhoin_buffer(ibb, ispin)%cc(ig) = rho_g(ispin)%cc(ig) + rho_g(ispin)%array(ig) = f_mix*cc_mix(ig) + & + mixing_store%rhoin_buffer(ib, ispin)%cc(ig) + mixing_store%rhoin_buffer(ibb, ispin)%cc(ig) = rho_g(ispin)%array(ig) END DO IF (mixing_store%gmix_p) THEN IF (gapw) THEN @@ -465,14 +465,14 @@ SUBROUTINE pulay_mixing(qs_env, mixing_store, rho, para_env) IF (alpha_pulay > 0.0_dp) THEN DO ig = 1, ng f_mix = alpha_pulay*mixing_store%kerker_factor(ig) - rho_g(ispin)%cc(ig) = f_mix*rho_g(ispin)%cc(ig) + & - (1.0_dp - f_mix)*cc_mix(ig) - mixing_store%rhoin_buffer(ibb, ispin)%cc(ig) = rho_g(ispin)%cc(ig) + rho_g(ispin)%array(ig) = f_mix*rho_g(ispin)%array(ig) + & + (1.0_dp - f_mix)*cc_mix(ig) + mixing_store%rhoin_buffer(ibb, ispin)%cc(ig) = rho_g(ispin)%array(ig) END DO ELSE DO ig = 1, ng - rho_g(ispin)%cc(ig) = cc_mix(ig) - mixing_store%rhoin_buffer(ibb, ispin)%cc(ig) = rho_g(ispin)%cc(ig) + rho_g(ispin)%array(ig) = cc_mix(ig) + mixing_store%rhoin_buffer(ibb, ispin)%cc(ig) = rho_g(ispin)%array(ig) END DO END IF @@ -580,7 +580,7 @@ SUBROUTINE broyden_mixing(qs_env, mixing_store, rho, para_env) REAL(dp), ALLOCATABLE, DIMENSION(:) :: c, g REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: a, b TYPE(dft_control_type), POINTER :: dft_control - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom CPASSERT(ASSOCIATED(mixing_store%res_buffer)) @@ -641,16 +641,16 @@ SUBROUTINE broyden_mixing(qs_env, mixing_store, rho, para_env) DO ispin = 1, nspin res_rho = CMPLX(0.0_dp, 0.0_dp, KIND=dp) DO ig = 1, ng - res_rho(ig) = rho_g(ispin)%cc(ig) - mixing_store%rhoin(ispin)%cc(ig) + res_rho(ig) = rho_g(ispin)%array(ig) - mixing_store%rhoin(ispin)%cc(ig) END DO IF (only_kerker) THEN DO ig = 1, ng mixing_store%last_res(ispin)%cc(ig) = res_rho(ig) f_mix = alpha*mixing_store%kerker_factor(ig) - rho_g(ispin)%cc(ig) = mixing_store%rhoin(ispin)%cc(ig) + f_mix*res_rho(ig) + rho_g(ispin)%array(ig) = mixing_store%rhoin(ispin)%cc(ig) + f_mix*res_rho(ig) mixing_store%rhoin_old(ispin)%cc(ig) = mixing_store%rhoin(ispin)%cc(ig) - mixing_store%rhoin(ispin)%cc(ig) = rho_g(ispin)%cc(ig) + mixing_store%rhoin(ispin)%cc(ig) = rho_g(ispin)%array(ig) END DO IF (mixing_store%gmix_p) THEN @@ -701,8 +701,8 @@ SUBROUTINE broyden_mixing(qs_env, mixing_store, rho, para_env) AIMAG(mixing_store%res_buffer(ib, ispin)%cc(ig))* & AIMAG(mixing_store%res_buffer(ib, ispin)%cc(ig)) rho_norm = rho_norm + & - REAL(rho_g(ispin)%cc(ig), dp)*REAL(rho_g(ispin)%cc(ig), dp) + & - AIMAG(rho_g(ispin)%cc(ig))*AIMAG(rho_g(ispin)%cc(ig)) + REAL(rho_g(ispin)%array(ig), dp)*REAL(rho_g(ispin)%array(ig), dp) + & + AIMAG(rho_g(ispin)%array(ig))*AIMAG(rho_g(ispin)%array(ig)) END DO DO ig = 1, ng mixing_store%drho_buffer(ib, ispin)%cc(ig) = & @@ -802,10 +802,10 @@ SUBROUTINE broyden_mixing(qs_env, mixing_store, rho, para_env) END DO f_mix = alpha*mixing_store%kerker_factor(ig) - IF (res_norm > 1.E-14_dp) rho_g(ispin)%cc(ig) = mixing_store%rhoin(ispin)%cc(ig) + & - f_mix*res_rho(ig) + cc_mix + IF (res_norm > 1.E-14_dp) rho_g(ispin)%array(ig) = mixing_store%rhoin(ispin)%cc(ig) + & + f_mix*res_rho(ig) + cc_mix mixing_store%rhoin_old(ispin)%cc(ig) = mixing_store%rhoin(ispin)%cc(ig) - mixing_store%rhoin(ispin)%cc(ig) = rho_g(ispin)%cc(ig) + mixing_store%rhoin(ispin)%cc(ig) = rho_g(ispin)%array(ig) END DO IF (mixing_store%gmix_p) THEN @@ -899,7 +899,7 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) REAL(dp), DIMENSION(:, :), POINTER :: fmat, weight TYPE(cp_1d_z_p_type), DIMENSION(:), POINTER :: tmp_z TYPE(cp_1d_z_p_type), DIMENSION(:, :), POINTER :: delta_res, u_vec, z_vec - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g CPASSERT(ASSOCIATED(mixing_store%rhoin_buffer)) @@ -968,7 +968,7 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) ! Residual multiplied by the metrics RP_i(G) = (rho_out(G)-rho_in(G)) * P(G) ! Delta is the norm of the residual, measures how far we are from convergence DO ig = 1, ng - res_rho(ig) = rho_g(ispin)%cc(ig) - mixing_store%rhoin(ispin)%cc(ig) + res_rho(ig) = rho_g(ispin)%array(ig) - mixing_store%rhoin(ispin)%cc(ig) res_rho_p(ig) = res_rho(ig)*p_metric(ig) !*sqt_uvol norm_ig = REAL(res_rho(ig), dp)*REAL(res_rho(ig), dp) + AIMAG(res_rho(ig))*AIMAG(res_rho(ig)) delta = delta + norm_ig @@ -990,9 +990,9 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) ! Simple Kerker damping : linear mixing rho(G) = rho_in(G) - alpha k(G)*(rho_out(G)-rho_in(G)) DO ig = 1, ng f_mix = alpha*mixing_store%kerker_factor(ig) - rho_g(ispin)%cc(ig) = mixing_store%rhoin(ispin)%cc(ig) + f_mix*res_rho(ig) + rho_g(ispin)%array(ig) = mixing_store%rhoin(ispin)%cc(ig) + f_mix*res_rho(ig) mixing_store%rhoin_old(ispin)%cc(ig) = mixing_store%rhoin(ispin)%cc(ig) - mixing_store%rhoin(ispin)%cc(ig) = rho_g(ispin)%cc(ig) + mixing_store%rhoin(ispin)%cc(ig) = rho_g(ispin)%array(ig) mixing_store%last_res(ispin)%cc(ig) = res_rho(ig) END DO ELSE @@ -1133,7 +1133,7 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) END IF ! Overwrite the density i reciprocal space - rho_g(ispin)%cc(:) = CMPLX(0.0_dp, 0.0_dp, KIND=dp) + rho_g(ispin)%array(:) = CMPLX(0.0_dp, 0.0_dp, KIND=dp) DO jb = 1, ib - 1 norm = 0.0_dp DO ig = 1, ng @@ -1146,20 +1146,20 @@ SUBROUTINE broyden_mixing_new(mixing_store, rho, para_env) CALL para_env%sum(norm) ! Subtract |Z_jb)> DO ig = 1, ng - rho_g(ispin)%cc(ig) = rho_g(ispin)%cc(ig) - norm*z_vec(jb, ispin)%cc(ig)*sqt_vol + rho_g(ispin)%array(ig) = rho_g(ispin)%array(ig) - norm*z_vec(jb, ispin)%cc(ig)*sqt_vol END DO END DO DO ig = 1, ng f_mix = alpha*mixing_store%kerker_factor(ig) - rho_g(ispin)%cc(ig) = rho_g(ispin)%cc(ig) + & - mixing_store%rhoin_buffer(ib, ispin)%cc(ig) + f_mix*res_rho(ig) - mixing_store%rhoin_buffer(ibb, ispin)%cc(ig) = rho_g(ispin)%cc(ig) + rho_g(ispin)%array(ig) = rho_g(ispin)%array(ig) + & + mixing_store%rhoin_buffer(ib, ispin)%cc(ig) + f_mix*res_rho(ig) + mixing_store%rhoin_buffer(ibb, ispin)%cc(ig) = rho_g(ispin)%array(ig) END DO mixing_store%rhoin_old(ispin)%cc(ig) = mixing_store%rhoin(ispin)%cc(ig) - mixing_store%rhoin(ispin)%cc(ig) = rho_g(ispin)%cc(ig) + mixing_store%rhoin(ispin)%cc(ig) = rho_g(ispin)%array(ig) mixing_store%last_res(ispin)%cc(:) = res_rho(:) END IF ! ib @@ -1213,7 +1213,7 @@ SUBROUTINE multisecant_mixing(mixing_store, rho, para_env) REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: b_matrix, binv_matrix REAL(dp), DIMENSION(:), POINTER :: g2 REAL(dp), SAVE :: sigma_old = 1.0_dp - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g CPASSERT(ASSOCIATED(mixing_store)) @@ -1255,7 +1255,7 @@ SUBROUTINE multisecant_mixing(mixing_store, rho, para_env) gn => mixing_store%res_buffer(ib, ispin)%cc gn_norm = 0.0_dp DO ig = 1, ng - gn(ig) = (rho_g(ispin)%cc(ig) - mixing_store%rhoin_buffer(ib, ispin)%cc(ig)) + gn(ig) = (rho_g(ispin)%array(ig) - mixing_store%rhoin_buffer(ib, ispin)%cc(ig)) gn_norm = gn_norm + & REAL(gn(ig), dp)*REAL(gn(ig), dp) + AIMAG(gn(ig))*AIMAG(gn(ig)) END DO @@ -1269,9 +1269,9 @@ SUBROUTINE multisecant_mixing(mixing_store, rho, para_env) DO ispin = 1, nspin DO ig = 1, ng f_mix = alpha*mixing_store%kerker_factor(ig) - rho_g(ispin)%cc(ig) = mixing_store%rhoin_buffer(1, ispin)%cc(ig) + & - f_mix*mixing_store%res_buffer(1, ispin)%cc(ig) - mixing_store%rhoin_buffer(ib_next, ispin)%cc(ig) = rho_g(ispin)%cc(ig) + rho_g(ispin)%array(ig) = mixing_store%rhoin_buffer(1, ispin)%cc(ig) + & + f_mix*mixing_store%res_buffer(1, ispin)%cc(ig) + mixing_store%rhoin_buffer(ib_next, ispin)%cc(ig) = rho_g(ispin)%array(ig) END DO END DO CALL timestop(handle) @@ -1504,9 +1504,9 @@ SUBROUTINE multisecant_mixing(mixing_store, rho, para_env) ! update the density DO ig = 1, ng prec = mixing_store%kerker_factor(ig) - rho_g(ispin)%cc(ig) = mixing_store%rhoin_buffer(ib, ispin)%cc(ig) & - - prec*step_size*ugn(ig) + prec*pgn(ig) ! - 0.1_dp * prec* gn(ig) - mixing_store%rhoin_buffer(ib_next, ispin)%cc(ig) = rho_g(ispin)%cc(ig) + rho_g(ispin)%array(ig) = mixing_store%rhoin_buffer(ib, ispin)%cc(ig) & + - prec*step_size*ugn(ig) + prec*pgn(ig) ! - 0.1_dp * prec* gn(ig) + mixing_store%rhoin_buffer(ib_next, ispin)%cc(ig) = rho_g(ispin)%array(ig) END DO END DO ! ispin diff --git a/src/qs_kernel_methods.F b/src/qs_kernel_methods.F index d6518b799c..8c0d2d87f5 100644 --- a/src/qs_kernel_methods.F +++ b/src/qs_kernel_methods.F @@ -22,7 +22,8 @@ MODULE qs_kernel_methods USE pw_methods, ONLY: pw_axpy,& pw_zero USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type USE qs_kernel_types, ONLY: full_kernel_env_type @@ -237,10 +238,12 @@ SUBROUTINE create_fxc_kernel(rho_struct, fxc_rspace, xc_section, is_rks_triplets INTEGER :: handle, ispin, nspins LOGICAL :: rho_g_valid, tau_r_valid REAL(KIND=dp) :: factor + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_c1d_type), POINTER :: rho_nlcc_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r, tau_r - TYPE(pw_type), POINTER :: rho_nlcc, rho_nlcc_g + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, tau_r + TYPE(pw_type), POINTER :: rho_nlcc TYPE(section_vals_type), POINTER :: xc_kernel CALL timeset(routineN, handle) diff --git a/src/qs_kpp1_env_methods.F b/src/qs_kpp1_env_methods.F index 69ca53b7e7..1a793ac6fd 100644 --- a/src/qs_kpp1_env_methods.F +++ b/src/qs_kpp1_env_methods.F @@ -58,10 +58,10 @@ MODULE qs_kpp1_env_methods USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_energy_types, ONLY: allocate_qs_energy,& deallocate_qs_energy,& @@ -218,13 +218,14 @@ SUBROUTINE calc_kpp1(rho1_xc, rho1, xc_section, do_tddft, lsd_singlets, lrigpw, TYPE(lri_environment_type), POINTER :: lri_env TYPE(lri_kind_type), DIMENSION(:), POINTER :: lri_v_int TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type) :: rho1_tot_gspace + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho1_g, rho1_g_pw TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho1_tot_gspace, v_hartree_rspace - TYPE(pw_type), DIMENSION(:), POINTER :: rho1_g, rho1_g_pw, rho1_r, rho1_r_pw, & - tau1_r, tau1_r_pw, v_rspace_new, v_xc, & - v_xc_tau + TYPE(pw_type) :: v_hartree_rspace + TYPE(pw_type), DIMENSION(:), POINTER :: rho1_r, rho1_r_pw, tau1_r, tau1_r_pw, & + v_rspace_new, v_xc, v_xc_tau TYPE(qs_rho_type), POINTER :: rho TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho1_atom_set, rho_atom_set TYPE(section_vals_type), POINTER :: input, scf_section @@ -283,7 +284,6 @@ SUBROUTINE calc_kpp1(rho1_xc, rho1, xc_section, do_tddft, lsd_singlets, lrigpw, ! *** calculate the hartree potential on the total density *** CALL auxbas_pw_pool%create_pw(rho1_tot_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_copy(rho1_g(1), rho1_tot_gspace) @@ -305,10 +305,8 @@ SUBROUTINE calc_kpp1(rho1_xc, rho1, xc_section, do_tddft, lsd_singlets, lrigpw, IF (.NOT. (nspins == 1 .AND. do_excitations .AND. do_triplet)) THEN BLOCK - TYPE(pw_type) :: v_hartree_gspace - CALL auxbas_pw_pool%create_pw(v_hartree_gspace, & - use_data=COMPLEXDATA1D, & - in_space=RECIPROCALSPACE) + TYPE(pw_c1d_type) :: v_hartree_gspace + CALL auxbas_pw_pool%create_pw(v_hartree_gspace, in_space=RECIPROCALSPACE) CALL pw_poisson_solve(poisson_env, rho1_tot_gspace, & energy_hartree, & v_hartree_gspace) @@ -585,7 +583,8 @@ SUBROUTINE kpp1_calc_k_p_p1_fdiff(qs_env, k_p_p1, rho, rho1, & INTEGER :: ispin, nspins REAL(KIND=dp) :: my_diff TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ks_2, matrix_s, rho1_ao, rho_ao - TYPE(pw_type), DIMENSION(:), POINTER :: rho1_g, rho1_r, rho_g, rho_r + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho1_g, rho_g + TYPE(pw_type), DIMENSION(:), POINTER :: rho1_r, rho_r TYPE(qs_energy_type), POINTER :: qs_energy NULLIFY (ks_2, matrix_s, qs_energy, rho_ao, rho1_ao, rho_r, rho1_r, rho_g, rho1_g) @@ -802,7 +801,7 @@ END SUBROUTINE kpp1_did_change SUBROUTINE print_densities(rho1, rho1_tot_gspace, out_unit) TYPE(qs_rho_type), POINTER :: rho1 - TYPE(pw_type), INTENT(IN) :: rho1_tot_gspace + TYPE(pw_c1d_type), INTENT(IN) :: rho1_tot_gspace INTEGER :: out_unit REAL(KIND=dp) :: total_rho_gspace diff --git a/src/qs_ks_methods.F b/src/qs_ks_methods.F index 371d944ea3..3e2092c40e 100644 --- a/src/qs_ks_methods.F +++ b/src/qs_ks_methods.F @@ -84,8 +84,7 @@ MODULE qs_ks_methods USE pw_poisson_types, ONLY: pw_poisson_implicit,& pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& pw_c1d_type,& @@ -204,11 +203,11 @@ SUBROUTINE qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces, just_energy, & TYPE(lri_environment_type), POINTER :: lri_env TYPE(lri_kind_type), DIMENSION(:), POINTER :: lri_v_int TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type) :: rho_tot_gspace, v_hartree_gspace 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 - TYPE(pw_type) :: rho_tot_gspace, v_hartree_gspace TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, v_rspace_embed, v_rspace_new, & v_rspace_new_aux_fit, v_tau_rspace, & v_tau_rspace_aux_fit @@ -348,10 +347,8 @@ SUBROUTINE qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces, just_energy, & ! Calculate the Hartree potential CALL auxbas_pw_pool%create_pw(v_hartree_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(rho_tot_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) scf_section => section_vals_get_subs_vals(input, "DFT%SCF") @@ -923,7 +920,7 @@ END SUBROUTINE qs_ks_build_kohn_sham_matrix !> \param skip_nuclear_density ... ! ************************************************************************************************** SUBROUTINE calc_rho_tot_gspace(rho_tot_gspace, qs_env, rho, skip_nuclear_density) - TYPE(pw_type), INTENT(INOUT) :: rho_tot_gspace + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_tot_gspace TYPE(qs_environment_type), POINTER :: qs_env TYPE(qs_rho_type), POINTER :: rho LOGICAL, INTENT(IN), OPTIONAL :: skip_nuclear_density @@ -931,9 +928,8 @@ SUBROUTINE calc_rho_tot_gspace(rho_tot_gspace, qs_env, rho, skip_nuclear_density INTEGER :: ispin LOGICAL :: my_skip TYPE(dft_control_type), POINTER :: dft_control - TYPE(pw_c1d_type), POINTER :: rho_core - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g - TYPE(pw_type), POINTER :: rho0_s_gs + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_c1d_type), POINTER :: rho0_s_gs, rho_core TYPE(qs_charges_type), POINTER :: qs_charges my_skip = .FALSE. diff --git a/src/qs_ks_reference.F b/src/qs_ks_reference.F index b64e50cf11..a5f3000310 100644 --- a/src/qs_ks_reference.F +++ b/src/qs_ks_reference.F @@ -36,8 +36,7 @@ MODULE qs_ks_reference USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& pw_c1d_type,& @@ -111,13 +110,13 @@ SUBROUTINE ks_ref_potential(qs_env, vh_rspace, vxc_rspace, vtau_rspace, vadmm_rs TYPE(admm_type), POINTER :: admm_env TYPE(dft_control_type), POINTER :: dft_control TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type) :: rho_tot_gspace, v_hartree_gspace TYPE(pw_c1d_type), POINTER :: rho_core TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_grid_type), POINTER :: pw_grid TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho_tot_gspace, v_hartree_gspace, & - v_hartree_rspace + TYPE(pw_type) :: v_hartree_rspace TYPE(pw_type), DIMENSION(:), POINTER :: v_admm_rspace, v_admm_tau_rspace, & v_rspace, v_tau_rspace TYPE(qs_ks_env_type), POINTER :: ks_env @@ -145,11 +144,11 @@ SUBROUTINE ks_ref_potential(qs_env, vh_rspace, vxc_rspace, vtau_rspace, vadmm_rs ! Calculate the Hartree potential CALL auxbas_pw_pool%create_pw(v_hartree_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_hartree_rspace, & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rho_tot_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) ! Get the total density in g-space [ions + electrons] CALL calc_rho_tot_gspace(rho_tot_gspace, qs_env, rho) diff --git a/src/qs_ks_types.F b/src/qs_ks_types.F index cb4c91799f..ac034ec15a 100644 --- a/src/qs_ks_types.F +++ b/src/qs_ks_types.F @@ -162,8 +162,8 @@ MODULE qs_ks_types rho_xc => Null() TYPE(pw_type), POINTER :: vppl => Null(), & - rho_nlcc => Null(), & - rho_nlcc_g => Null() + rho_nlcc => Null() + TYPE(pw_c1d_type), POINTER :: rho_nlcc_g => Null() TYPE(pw_c1d_type), POINTER :: rho_core => NULL() TYPE(pw_type), POINTER :: vee => NULL() @@ -342,7 +342,9 @@ SUBROUTINE get_ks_env(ks_env, v_hartree_rspace, & TYPE(qs_rho_type), OPTIONAL, POINTER :: rho, rho_xc TYPE(pw_type), OPTIONAL, POINTER :: vppl TYPE(pw_c1d_type), OPTIONAL, POINTER :: rho_core - TYPE(pw_type), OPTIONAL, POINTER :: rho_nlcc, rho_nlcc_g, vee + TYPE(pw_type), OPTIONAL, POINTER :: rho_nlcc + TYPE(pw_c1d_type), OPTIONAL, POINTER :: rho_nlcc_g + TYPE(pw_type), OPTIONAL, POINTER :: vee INTEGER, OPTIONAL :: neighbor_list_id TYPE(neighbor_list_set_p_type), DIMENSION(:), OPTIONAL, POINTER :: sab_orb, sab_all, sac_ae, & sac_ppl, sac_lri, sap_ppnl, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, & @@ -576,7 +578,9 @@ SUBROUTINE set_ks_env(ks_env, v_hartree_rspace, & matrix_ks_im_kp TYPE(pw_type), OPTIONAL, POINTER :: vppl TYPE(pw_c1d_type), OPTIONAL, POINTER :: rho_core - TYPE(pw_type), OPTIONAL, POINTER :: rho_nlcc, rho_nlcc_g, vee + TYPE(pw_type), OPTIONAL, POINTER :: rho_nlcc + TYPE(pw_c1d_type), OPTIONAL, POINTER :: rho_nlcc_g + TYPE(pw_type), OPTIONAL, POINTER :: vee INTEGER, OPTIONAL :: neighbor_list_id TYPE(kpoint_type), OPTIONAL, POINTER :: kpoints TYPE(neighbor_list_set_p_type), DIMENSION(:), OPTIONAL, POINTER :: sab_orb, sab_all, sac_ae, & diff --git a/src/qs_ks_utils.F b/src/qs_ks_utils.F index 0982aa7019..503fc945af 100644 --- a/src/qs_ks_utils.F +++ b/src/qs_ks_utils.F @@ -94,10 +94,10 @@ MODULE qs_ks_utils USE pw_poisson_types, ONLY: pw_poisson_implicit,& pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_cdft_types, ONLY: cdft_control_type USE qs_charges_types, ONLY: qs_charges_type @@ -176,10 +176,11 @@ SUBROUTINE low_spin_roks(energy, qs_env, dft_control, do_hfx, just_energy, & TYPE(hfx_type), DIMENSION(:, :), POINTER :: x_data TYPE(mo_set_type), DIMENSION(:), POINTER :: mo_array TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: xc_pw_pool TYPE(pw_type) :: work_v_rspace - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r, tau, vxc, vxc_tau + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, tau, vxc, vxc_tau TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho TYPE(section_vals_type), POINTER :: hfx_section, input, & @@ -318,7 +319,6 @@ SUBROUTINE low_spin_roks(energy, qs_env, dft_control, do_hfx, just_energy, & use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rho_g(ispin), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) END DO CALL auxbas_pw_pool%create_pw(work_v_rspace, & @@ -494,11 +494,14 @@ SUBROUTINE sic_explicit_orbitals(energy, qs_env, dft_control, poisson_env, just_ TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: mo_derivs, rho_ao, tmp_dbcsr TYPE(dbcsr_type), POINTER :: orb_density_matrix, orb_h TYPE(mo_set_type), DIMENSION(:), POINTER :: mo_array + TYPE(pw_c1d_type) :: work_v_gspace + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_c1d_type), TARGET :: orb_rho_g, tmp_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: xc_pw_pool - TYPE(pw_type) :: work_v_gspace, work_v_rspace - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r, tau, vxc, vxc_tau - TYPE(pw_type), TARGET :: orb_rho_g, orb_rho_r, tmp_g, tmp_r + TYPE(pw_type) :: work_v_rspace + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, tau, vxc, vxc_tau + TYPE(pw_type), TARGET :: orb_rho_r, tmp_r TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho TYPE(section_vals_type), POINTER :: input, xc_section @@ -623,13 +626,10 @@ SUBROUTINE sic_explicit_orbitals(energy, qs_env, dft_control, poisson_env, just_ use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(orb_rho_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(tmp_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(work_v_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(work_v_rspace, & use_data=REALDATA3D, & @@ -786,8 +786,8 @@ SUBROUTINE calc_v_sic_rspace(v_sic_rspace, energy, & REAL(kind=dp) :: ener, full_scaling, scaling REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: store_forces TYPE(mo_set_type), DIMENSION(:), POINTER :: mo_array - TYPE(pw_type) :: work_rho, work_v - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_c1d_type) :: work_rho, work_v + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(qs_force_type), DIMENSION(:), POINTER :: force NULLIFY (mo_array, rho_g) @@ -802,10 +802,8 @@ SUBROUTINE calc_v_sic_rspace(v_sic_rspace, energy, & CPASSERT(dft_control%nspins == 2) CALL auxbas_pw_pool%create_pw(work_rho, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(work_v, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL qs_rho_get(rho, rho_g=rho_g) @@ -1702,11 +1700,12 @@ SUBROUTINE calculate_zmp_potential(qs_env, v_rspace_new, rho, exc) REAL(KIND=dp) :: lambda REAL(KIND=dp), DIMENSION(:), POINTER :: tot_rho_ext_r TYPE(dft_control_type), POINTER :: dft_control + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_ext_g, rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool TYPE(pw_type) :: v_xc_rspace - TYPE(pw_type), DIMENSION(:), POINTER :: rho_ext_g, rho_g, rho_r + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(section_vals_type), POINTER :: ext_den_section, input @@ -1746,13 +1745,9 @@ SUBROUTINE calculate_zmp_potential(qs_env, v_rspace_new, rho, exc) ELSE BLOCK REAL(KIND=dp) :: factor - TYPE(pw_type) :: rho_eff_gspace, v_xc_gspace - CALL auxbas_pw_pool%create_pw(pw=rho_eff_gspace, & - use_data=COMPLEXDATA1D, & - in_space=RECIPROCALSPACE) - CALL auxbas_pw_pool%create_pw(pw=v_xc_gspace, & - use_data=COMPLEXDATA1D, & - in_space=RECIPROCALSPACE) + TYPE(pw_c1d_type) :: rho_eff_gspace, v_xc_gspace + CALL auxbas_pw_pool%create_pw(pw=rho_eff_gspace, in_space=RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(pw=v_xc_gspace, in_space=RECIPROCALSPACE) CALL pw_zero(rho_eff_gspace) CALL pw_zero(v_xc_gspace) CALL pw_zero(v_xc_rspace) diff --git a/src/qs_linres_current.F b/src/qs_linres_current.F index e88669b6a1..e34550bebe 100644 --- a/src/qs_linres_current.F +++ b/src/qs_linres_current.F @@ -86,6 +86,7 @@ MODULE qs_linres_current USE pw_pool_types, ONLY: pw_pool_type USE pw_types, ONLY: REALDATA3D,& REALSPACE,& + pw_c1d_type,& pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -213,10 +214,11 @@ SUBROUTINE current_build_current(current_env, qs_env, iB) POINTER :: sab_all TYPE(particle_list_type), POINTER :: particles TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: jrho1_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool TYPE(pw_type) :: wf_r - TYPE(pw_type), DIMENSION(:), POINTER :: jrho1_g, jrho1_r + TYPE(pw_type), DIMENSION(:), POINTER :: jrho1_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_matrix_pools_type), POINTER :: mpools TYPE(qs_subsys_type), POINTER :: subsys @@ -579,7 +581,8 @@ SUBROUTINE calculate_jrho_resp(mat_d0, mat_jp, mat_jp_rii, mat_jp_riii, iB, idir TYPE(dbcsr_type), POINTER :: mat_d0, mat_jp, mat_jp_rii, mat_jp_riii INTEGER, INTENT(IN) :: iB, idir - TYPE(pw_type), INTENT(INOUT) :: current_rs, current_gs + TYPE(pw_type), INTENT(INOUT) :: current_rs + TYPE(pw_c1d_type), INTENT(INOUT) :: current_gs TYPE(qs_environment_type), POINTER :: qs_env TYPE(current_env_type) :: current_env LOGICAL, INTENT(IN), OPTIONAL :: soft_valid, retain_rsgrid diff --git a/src/qs_linres_current_utils.F b/src/qs_linres_current_utils.F index 36cb457a9e..d46aa1ee74 100644 --- a/src/qs_linres_current_utils.F +++ b/src/qs_linres_current_utils.F @@ -76,10 +76,10 @@ MODULE qs_linres_current_utils pw_env_type USE pw_methods, ONLY: pw_zero USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -600,9 +600,10 @@ SUBROUTINE current_env_init(current_env, qs_env) TYPE(mo_set_type), DIMENSION(:), POINTER :: mos TYPE(mp_para_env_type), POINTER :: para_env TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_loc_env_type), POINTER :: qs_loc_env TYPE(qs_matrix_pools_type), POINTER :: mpools @@ -1267,7 +1268,7 @@ SUBROUTINE current_env_init(current_env, qs_env) use_data=REALDATA3D, in_space=REALSPACE) CALL pw_zero(rho_r(ispin)) CALL auxbas_pw_pool%create_pw(rho_g(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_zero(rho_g(ispin)) END DO NULLIFY (current_env%jrho1_set(idir)%rho) diff --git a/src/qs_linres_epr_nablavks.F b/src/qs_linres_epr_nablavks.F index 4f8e81be6d..d36ccaccb8 100644 --- a/src/qs_linres_epr_nablavks.F +++ b/src/qs_linres_epr_nablavks.F @@ -50,10 +50,10 @@ MODULE qs_linres_epr_nablavks USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -141,11 +141,14 @@ SUBROUTINE epr_nablavks(epr_env, qs_env) TYPE(oce_matrix_type), POINTER :: oce TYPE(particle_list_type), POINTER :: particles TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: rho_tot_gspace, v_coulomb_gspace, & + v_coulomb_gtemp, v_hartree_gspace, & + v_hartree_gtemp, v_xc_gtemp TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho_tot_gspace, v_coulomb_gspace, v_coulomb_gtemp, v_coulomb_rtemp, & - v_hartree_gspace, v_hartree_gtemp, v_hartree_rtemp, v_xc_gtemp, v_xc_rtemp, wf_r + TYPE(pw_type) :: v_coulomb_rtemp, v_hartree_rtemp, & + v_xc_rtemp, wf_r TYPE(pw_type), DIMENSION(:), POINTER :: rho1_r, rho2_r, rho_r, v_rspace_new, & v_tau_rspace TYPE(pw_type), POINTER :: pwx, pwy, pwz @@ -281,13 +284,13 @@ SUBROUTINE epr_nablavks(epr_env, qs_env) ! ------------------------------------- CALL auxbas_pw_pool%create_pw(v_hartree_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_hartree_gtemp, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_hartree_rtemp, & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rho_tot_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) IF (gapw) THEN ! need to rebuild the coeff ! @@ -349,9 +352,9 @@ SUBROUTINE epr_nablavks(epr_env, qs_env) ! ! gtemp = gtemp * CMPLX(COS(arg),-SIN(arg),KIND=dp) ! - ! v_hartree_gspace%cc(ig) = v_hartree_gspace%cc(ig) + gtemp + ! v_hartree_gspace%array(ig) = v_hartree_gspace%array(ig) + gtemp ! END DO - ! IF ( v_hartree_gspace%pw_grid%have_g0 ) v_hartree_gspace%cc(1) = 0.0_dp + ! IF ( v_hartree_gspace%pw_grid%have_g0 ) v_hartree_gspace%array(1) = 0.0_dp ! ! END DO @@ -503,9 +506,9 @@ SUBROUTINE epr_nablavks(epr_env, qs_env) IF (gth_gspace) THEN CALL auxbas_pw_pool%create_pw(v_coulomb_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_coulomb_gtemp, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_coulomb_rtemp, & use_data=REALDATA3D, in_space=REALSPACE) @@ -582,9 +585,9 @@ SUBROUTINE epr_nablavks(epr_env, qs_env) arg = DOT_PRODUCT(v_coulomb_gspace%pw_grid%g(:, ig), ratom) gtemp = gtemp*CMPLX(COS(arg), -SIN(arg), KIND=dp) - v_coulomb_gspace%cc(ig) = v_coulomb_gspace%cc(ig) + gtemp + v_coulomb_gspace%array(ig) = v_coulomb_gspace%array(ig) + gtemp END DO - IF (v_coulomb_gspace%pw_grid%have_g0) v_coulomb_gspace%cc(1) = 0.0_dp + IF (v_coulomb_gspace%pw_grid%have_g0) v_coulomb_gspace%array(1) = 0.0_dp END DO @@ -849,7 +852,7 @@ SUBROUTINE epr_nablavks(epr_env, qs_env) ! ------------------------------------- CALL auxbas_pw_pool%create_pw(v_xc_gtemp, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_xc_rtemp, & use_data=REALDATA3D, in_space=REALSPACE) diff --git a/src/qs_linres_epr_ownutils.F b/src/qs_linres_epr_ownutils.F index 85849829a0..1f07226af6 100644 --- a/src/qs_linres_epr_ownutils.F +++ b/src/qs_linres_epr_ownutils.F @@ -47,10 +47,10 @@ MODULE qs_linres_epr_ownutils pw_spline_precond_set_kind,& pw_spline_precond_type,& spl3_pbc - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_core_energies, ONLY: calculate_ptrace USE qs_environment_types, ONLY: get_qs_env,& @@ -778,12 +778,14 @@ SUBROUTINE epr_ind_magnetic_field(epr_env, current_env, qs_env, iB) TYPE(cell_type), POINTER :: cell TYPE(dft_control_type), POINTER :: dft_control TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: pw_gspace_work + TYPE(pw_c1d_type), ALLOCATABLE, DIMENSION(:, :) :: shift_pw_gspace + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: jrho1_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: pw_gspace_work, shift_pw_rspace - TYPE(pw_type), ALLOCATABLE, DIMENSION(:, :) :: shift_pw_gspace - TYPE(pw_type), DIMENSION(:), POINTER :: epr_rho_r, jrho1_g + TYPE(pw_type) :: shift_pw_rspace + TYPE(pw_type), DIMENSION(:), POINTER :: epr_rho_r TYPE(realspace_grid_desc_type), POINTER :: auxbas_rs_desc CALL timeset(routineN, handle) @@ -812,7 +814,6 @@ SUBROUTINE epr_ind_magnetic_field(epr_env, current_env, qs_env, iB) DO ispin = 1, nspins DO idir = 1, 3 CALL auxbas_pw_pool%create_pw(shift_pw_gspace(idir, ispin), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_zero(shift_pw_gspace(idir, ispin)) END DO @@ -821,7 +822,6 @@ SUBROUTINE epr_ind_magnetic_field(epr_env, current_env, qs_env, iB) use_data=REALDATA3D, in_space=REALSPACE) CALL pw_zero(shift_pw_rspace) CALL auxbas_pw_pool%create_pw(pw_gspace_work, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_zero(pw_gspace_work) ! diff --git a/src/qs_linres_epr_utils.F b/src/qs_linres_epr_utils.F index c037ca9b62..565cc4a772 100644 --- a/src/qs_linres_epr_utils.F +++ b/src/qs_linres_epr_utils.F @@ -38,10 +38,10 @@ MODULE qs_linres_epr_utils USE pw_env_types, ONLY: pw_env_get,& pw_env_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -97,9 +97,10 @@ SUBROUTINE epr_env_init(epr_env, qs_env) TYPE(mo_set_type), DIMENSION(:), POINTER :: mos TYPE(nablavks_atom_type), DIMENSION(:), POINTER :: nablavks_atom_set TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_matrix_pools_type), POINTER :: mpools TYPE(scf_control_type), POINTER :: scf_control @@ -188,7 +189,7 @@ SUBROUTINE epr_env_init(epr_env, qs_env) CALL auxbas_pw_pool%create_pw(rho_r(1), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rho_g(1), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL qs_rho_set(epr_env%bind_set(idir, i_B)%rho, rho_r=rho_r, rho_g=rho_g) END DO END DO @@ -204,7 +205,7 @@ SUBROUTINE epr_env_init(epr_env, qs_env) CALL auxbas_pw_pool%create_pw(rho_r(1), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rho_g(1), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL qs_rho_set(epr_env%nablavks_set(idir, ispin)%rho, & rho_r=rho_r, rho_g=rho_g) END DO diff --git a/src/qs_linres_kernel.F b/src/qs_linres_kernel.F index 5661204b52..6e58df20fb 100644 --- a/src/qs_linres_kernel.F +++ b/src/qs_linres_kernel.F @@ -67,10 +67,10 @@ MODULE qs_linres_kernel USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -193,13 +193,14 @@ SUBROUTINE apply_op_2_dft(qs_env, p_env) TYPE(lri_environment_type), POINTER :: lri_env TYPE(lri_kind_type), DIMENSION(:), POINTER :: lri_v_int TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type) :: rho1_tot_gspace, v_hartree_gspace + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho1_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho1_tot_gspace, v_hartree_gspace, & - v_hartree_rspace - TYPE(pw_type), DIMENSION(:), POINTER :: rho1_g, rho1_r, rho_r, tau1_r, & - v_rspace_new, v_xc, v_xc_tau + TYPE(pw_type) :: v_hartree_rspace + TYPE(pw_type), DIMENSION(:), POINTER :: rho1_r, rho_r, tau1_r, v_rspace_new, & + v_xc, v_xc_tau TYPE(qs_kpp1_env_type), POINTER :: kpp1_env TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho, rho0, rho1, rho1_xc, rho1a, & @@ -276,7 +277,6 @@ SUBROUTINE apply_op_2_dft(qs_env, p_env) CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, & poisson_env=poisson_env) CALL auxbas_pw_pool%create_pw(v_hartree_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_hartree_rspace, & use_data=REALDATA3D, & @@ -287,7 +287,6 @@ SUBROUTINE apply_op_2_dft(qs_env, p_env) ! *** calculate the hartree potential on the total density *** CALL auxbas_pw_pool%create_pw(rho1_tot_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL qs_rho_get(rho1, rho_g=rho1_g) @@ -847,10 +846,10 @@ SUBROUTINE apply_xc_admm(qs_env, p_env) TYPE(mp_para_env_type), POINTER :: para_env TYPE(neighbor_list_set_p_type), DIMENSION(:), & POINTER :: sab_aux_fit + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho1_aux_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), DIMENSION(:), POINTER :: rho1_aux_g, rho1_aux_r, tau_pw, v_xc, & - v_xc_tau + TYPE(pw_type), DIMENSION(:), POINTER :: rho1_aux_r, tau_pw, v_xc, v_xc_tau TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho1_atom_set, rho_atom_set TYPE(section_vals_type), POINTER :: xc_fun_section, xc_section TYPE(task_list_type), POINTER :: task_list diff --git a/src/qs_linres_nmr_epr_common_utils.F b/src/qs_linres_nmr_epr_common_utils.F index b2b5c9c279..3174f93789 100644 --- a/src/qs_linres_nmr_epr_common_utils.F +++ b/src/qs_linres_nmr_epr_common_utils.F @@ -21,8 +21,7 @@ MODULE qs_linres_nmr_epr_common_utils USE pw_methods, ONLY: pw_transfer USE pw_pool_types, ONLY: pw_pool_type USE pw_types, ONLY: RECIPROCALSPACE,& - pw_c1d_type,& - pw_type + pw_c1d_type #include "./base/base_uses.f90" IMPLICIT NONE @@ -58,8 +57,8 @@ MODULE qs_linres_nmr_epr_common_utils SUBROUTINE mult_G_ov_G2_grid(pw_pool, rho_gspace, funcG_times_rho, idir, my_chi) TYPE(pw_pool_type), POINTER :: pw_pool - TYPE(pw_type), INTENT(IN) :: rho_gspace - TYPE(pw_type), INTENT(INOUT) :: funcG_times_rho + TYPE(pw_c1d_type), INTENT(IN) :: rho_gspace + TYPE(pw_c1d_type), INTENT(INOUT) :: funcG_times_rho INTEGER, INTENT(IN) :: idir REAL(dp), INTENT(IN) :: my_chi @@ -83,8 +82,8 @@ SUBROUTINE mult_G_ov_G2_grid(pw_pool, rho_gspace, funcG_times_rho, idir, my_chi) CALL pw_transfer(rho_gspace, funcG_times_rho) ng = SIZE(grid%gsq) - funcG_times_rho%cc(1:ng) = funcG_times_rho%cc(1:ng)*influence_fn%array(1:ng) - IF (grid%have_g0) funcG_times_rho%cc(1) = my_chi + funcG_times_rho%array(1:ng) = funcG_times_rho%array(1:ng)*influence_fn%array(1:ng) + IF (grid%have_g0) funcG_times_rho%array(1) = my_chi CALL pw_pool%give_back_pw(influence_fn) diff --git a/src/qs_linres_nmr_shift.F b/src/qs_linres_nmr_shift.F index 372e0147bb..4c20fd7af3 100644 --- a/src/qs_linres_nmr_shift.F +++ b/src/qs_linres_nmr_shift.F @@ -51,10 +51,10 @@ MODULE qs_linres_nmr_shift pw_spline_precond_set_kind,& pw_spline_precond_type,& spl3_pbc - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -116,12 +116,13 @@ SUBROUTINE nmr_shift(nmr_env, current_env, qs_env, iB) TYPE(cell_type), POINTER :: cell TYPE(dft_control_type), POINTER :: dft_control TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: pw_gspace_work + TYPE(pw_c1d_type), ALLOCATABLE, DIMENSION(:, :) :: shift_pw_gspace + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: jrho1_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: pw_gspace_work, shift_pw_rspace - TYPE(pw_type), ALLOCATABLE, DIMENSION(:, :) :: shift_pw_gspace - TYPE(pw_type), DIMENSION(:), POINTER :: jrho1_g + TYPE(pw_type) :: shift_pw_rspace TYPE(realspace_grid_desc_type), POINTER :: auxbas_rs_desc TYPE(section_vals_type), POINTER :: nmr_section @@ -158,7 +159,7 @@ SUBROUTINE nmr_shift(nmr_env, current_env, qs_env, iB) DO ispin = 1, nspins DO idir = 1, 3 CALL auxbas_pw_pool%create_pw(shift_pw_gspace(idir, ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_zero(shift_pw_gspace(idir, ispin)) END DO END DO @@ -167,7 +168,7 @@ SUBROUTINE nmr_shift(nmr_env, current_env, qs_env, iB) CALL set_vecp(iB, iiB, iiiB) ! CALL auxbas_pw_pool%create_pw(pw_gspace_work, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_zero(pw_gspace_work) DO ispin = 1, nspins ! @@ -604,7 +605,7 @@ SUBROUTINE gsum_shift_pwgrid(nmr_env, particle_set, cell, shift_pw_gspace, & TYPE(nmr_env_type) :: nmr_env TYPE(particle_type), DIMENSION(:), POINTER :: particle_set TYPE(cell_type), POINTER :: cell - TYPE(pw_type), INTENT(IN) :: shift_pw_gspace + TYPE(pw_c1d_type), INTENT(IN) :: shift_pw_gspace INTEGER, INTENT(IN) :: i_B, idir CHARACTER(LEN=*), PARAMETER :: routineN = 'gsum_shift_pwgrid' @@ -663,7 +664,7 @@ END SUBROUTINE gsum_shift_pwgrid ! ************************************************************************************************** SUBROUTINE gsumr(r, pw, cplx) REAL(dp), INTENT(IN) :: r(3) - TYPE(pw_type), INTENT(IN) :: pw + TYPE(pw_c1d_type), INTENT(IN) :: pw COMPLEX(dp) :: cplx COMPLEX(dp) :: rg @@ -674,9 +675,9 @@ SUBROUTINE gsumr(r, pw, cplx) cplx = CMPLX(0.0_dp, 0.0_dp, KIND=dp) DO ig = grid%first_gne0, grid%ngpts_cut_local rg = (grid%g(1, ig)*r(1) + grid%g(2, ig)*r(2) + grid%g(3, ig)*r(3))*gaussi - cplx = cplx + pw%cc(ig)*EXP(rg) + cplx = cplx + pw%array(ig)*EXP(rg) END DO - IF (grid%have_g0) cplx = cplx + pw%cc(1) + IF (grid%have_g0) cplx = cplx + pw%array(1) CALL grid%para%group%sum(cplx) END SUBROUTINE gsumr diff --git a/src/qs_loc_methods.F b/src/qs_loc_methods.F index 28f3476842..933c19aab7 100644 --- a/src/qs_loc_methods.F +++ b/src/qs_loc_methods.F @@ -86,10 +86,10 @@ MODULE qs_loc_methods USE pw_env_types, ONLY: pw_env_get,& pw_env_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_wavefunction USE qs_environment_types, ONLY: get_qs_env,& @@ -811,9 +811,10 @@ SUBROUTINE qs_print_cubes(qs_env, mo_coeff, nstates, state_list, centers, & TYPE(dft_control_type), POINTER :: dft_control TYPE(particle_list_type), POINTER :: particles TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: wf_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: wf_g, wf_r + TYPE(pw_type) :: wf_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_subsys_type), POINTER :: subsys @@ -830,7 +831,6 @@ SUBROUTINE qs_print_cubes(qs_env, mo_coeff, nstates, state_list, centers, & use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(wf_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) my_state0 = 0 diff --git a/src/qs_loc_states.F b/src/qs_loc_states.F index fb5912c89b..ab36c23917 100644 --- a/src/qs_loc_states.F +++ b/src/qs_loc_states.F @@ -27,7 +27,8 @@ MODULE qs_loc_states USE molecular_states, ONLY: construct_molecular_states USE molecule_types, ONLY: molecule_type USE particle_list_types, ONLY: particle_list_type - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type,& set_qs_env @@ -72,7 +73,8 @@ SUBROUTINE get_localization_info(qs_env, qs_loc_env, loc_section, mo_local, & TYPE(qs_loc_env_type), POINTER :: qs_loc_env TYPE(section_vals_type), POINTER :: loc_section TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: mo_local - TYPE(pw_type), INTENT(INOUT) :: wf_r, wf_g + TYPE(pw_type), INTENT(INOUT) :: wf_r + TYPE(pw_c1d_type), INTENT(INOUT) :: wf_g TYPE(particle_list_type), POINTER :: particles TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: coeff TYPE(cp_1d_r_p_type), DIMENSION(:), POINTER :: evals diff --git a/src/qs_local_properties.F b/src/qs_local_properties.F index dec0289549..c99bc260ef 100644 --- a/src/qs_local_properties.F +++ b/src/qs_local_properties.F @@ -39,8 +39,7 @@ MODULE qs_local_properties pw_transfer,& pw_zero USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& pw_c1d_type,& @@ -95,14 +94,14 @@ SUBROUTINE qs_local_energy(qs_env, energy_density) TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_ks, matrix_s, matrix_w, rho_ao_kp TYPE(dbcsr_type), POINTER :: matrix TYPE(dft_control_type), POINTER :: dft_control - TYPE(pw_c1d_type), POINTER :: rho_core + TYPE(pw_c1d_type) :: edens_g + TYPE(pw_c1d_type), POINTER :: rho_core, rho_tot_gspace TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: band_density, edens_g, edens_r, & - hartree_density, xc_density + TYPE(pw_type) :: band_density, edens_r, hartree_density, & + xc_density TYPE(pw_type), DIMENSION(:), POINTER :: rho_r - TYPE(pw_type), POINTER :: rho_tot_gspace, rho_tot_rspace, & - v_hartree_rspace + TYPE(pw_type), POINTER :: rho_tot_rspace, v_hartree_rspace TYPE(qs_energy_type), POINTER :: energy TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho, rho_struct @@ -155,7 +154,6 @@ SUBROUTINE qs_local_energy(qs_env, energy_density) use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(edens_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_zero(band_density) DO ispin = 1, nspins @@ -172,7 +170,6 @@ SUBROUTINE qs_local_energy(qs_env, energy_density) ! Hartree energy density correction = -0.5 * V_H(r) * [rho(r) - rho_core(r)] ALLOCATE (rho_tot_gspace, rho_tot_rspace) CALL auxbas_pw_pool%create_pw(rho_tot_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(rho_tot_rspace, & use_data=REALDATA3D, & @@ -271,10 +268,11 @@ SUBROUTINE qs_local_stress(qs_env, stress_tensor, beta) REAL(KIND=dp), DIMENSION(3, 3) :: pv_loc TYPE(cp_logger_type), POINTER :: logger TYPE(dft_control_type), POINTER :: dft_control + TYPE(pw_c1d_type) :: v_hartree_gspace + TYPE(pw_c1d_type), DIMENSION(3) :: efield TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: v_hartree_gspace, xc_density - TYPE(pw_type), DIMENSION(3) :: efield + TYPE(pw_type) :: xc_density TYPE(pw_type), POINTER :: v_hartree_rspace TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho_struct @@ -346,11 +344,11 @@ SUBROUTINE qs_local_stress(qs_env, stress_tensor, beta) ! Electrical field terms CALL get_qs_env(qs_env, v_hartree_rspace=v_hartree_rspace) CALL auxbas_pw_pool%create_pw(v_hartree_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_transfer(v_hartree_rspace, v_hartree_gspace) DO i = 1, 3 CALL auxbas_pw_pool%create_pw(efield(i), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_copy(v_hartree_gspace, efield(i)) END DO CALL pw_derive(efield(1), (/1, 0, 0/)) diff --git a/src/qs_mixing_utils.F b/src/qs_mixing_utils.F index bdbfdebb59..4e2531f979 100644 --- a/src/qs_mixing_utils.F +++ b/src/qs_mixing_utils.F @@ -19,7 +19,7 @@ MODULE qs_mixing_utils USE distribution_1d_types, ONLY: distribution_1d_type USE kinds, ONLY: dp USE message_passing, ONLY: mp_para_env_type - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type USE qs_density_mixing_types, ONLY: broyden_mixing_new_nr,& broyden_mixing_nr,& gspace_mixing_nr,& @@ -433,7 +433,7 @@ SUBROUTINE mixing_init(mixing_method, rho, mixing_store, para_env, rho_atom) REAL(dp), DIMENSION(:), POINTER :: g2 REAL(dp), DIMENSION(:, :), POINTER :: g_vec TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_kp - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g CALL timeset(routineN, handle) @@ -484,7 +484,7 @@ SUBROUTINE mixing_init(mixing_method, rho, mixing_store, para_env, rho_atom) IF (.NOT. ASSOCIATED(mixing_store%rhoin(ispin)%cc)) THEN ALLOCATE (mixing_store%rhoin(ispin)%cc(ng)) END IF - mixing_store%rhoin(ispin)%cc = rho_g(ispin)%cc + mixing_store%rhoin(ispin)%cc = rho_g(ispin)%array IF (ASSOCIATED(mixing_store%rhoin_buffer)) THEN IF (.NOT. ASSOCIATED(mixing_store%rhoin_buffer(1, ispin)%cc)) THEN @@ -493,7 +493,7 @@ SUBROUTINE mixing_init(mixing_method, rho, mixing_store, para_env, rho_atom) END DO END IF mixing_store%rhoin_buffer(1, ispin)%cc(1:ng) = & - rho_g(ispin)%cc(1:ng) + rho_g(ispin)%array(1:ng) END IF IF (ASSOCIATED(mixing_store%res_buffer)) THEN IF (.NOT. ASSOCIATED(mixing_store%res_buffer(1, ispin)%cc)) THEN @@ -505,11 +505,11 @@ SUBROUTINE mixing_init(mixing_method, rho, mixing_store, para_env, rho_atom) END DO IF (nspin == 2) THEN - mixing_store%rhoin(1)%cc = rho_g(1)%cc + rho_g(2)%cc - mixing_store%rhoin(2)%cc = rho_g(1)%cc - rho_g(2)%cc + mixing_store%rhoin(1)%cc = rho_g(1)%array + rho_g(2)%array + mixing_store%rhoin(2)%cc = rho_g(1)%array - rho_g(2)%array IF (ASSOCIATED(mixing_store%rhoin_buffer)) THEN - mixing_store%rhoin_buffer(1, 1)%cc = rho_g(1)%cc + rho_g(2)%cc - mixing_store%rhoin_buffer(1, 2)%cc = rho_g(1)%cc - rho_g(2)%cc + mixing_store%rhoin_buffer(1, 1)%cc = rho_g(1)%array + rho_g(2)%array + mixing_store%rhoin_buffer(1, 2)%cc = rho_g(1)%array - rho_g(2)%array END IF END IF diff --git a/src/qs_p_env_methods.F b/src/qs_p_env_methods.F index 8b2e66b7a1..4e2cbe21c6 100644 --- a/src/qs_p_env_methods.F +++ b/src/qs_p_env_methods.F @@ -69,7 +69,8 @@ MODULE qs_p_env_methods USE parallel_gemm_api, ONLY: parallel_gemm USE preconditioner_types, ONLY: init_preconditioner USE pw_env_types, ONLY: pw_env_type - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_collocate_density, ONLY: calculate_rho_elec USE qs_energy_types, ONLY: qs_energy_type USE qs_environment_types, ONLY: get_qs_env,& @@ -407,7 +408,8 @@ SUBROUTINE p_env_update_rho(p_env, qs_env) TYPE(mp_para_env_type), POINTER :: para_env TYPE(neighbor_list_set_p_type), DIMENSION(:), & POINTER :: sab_aux_fit - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g_aux, rho_r_aux + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g_aux + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r_aux TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(task_list_type), POINTER :: task_list diff --git a/src/qs_pdos.F b/src/qs_pdos.F index 386d564531..414aca8fc0 100644 --- a/src/qs_pdos.F +++ b/src/qs_pdos.F @@ -61,10 +61,10 @@ MODULE qs_pdos pw_env_type USE pw_pool_types, ONLY: pw_pool_p_type,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_wavefunction USE qs_environment_types, ONLY: get_qs_env,& @@ -188,10 +188,11 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl TYPE(gto_basis_set_type), POINTER :: orb_basis_set TYPE(ldos_p_type), DIMENSION(:), POINTER :: ldos_p TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type) :: wf_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: wf_g, wf_r + TYPE(pw_type) :: wf_r TYPE(r_ldos_p_type), DIMENSION(:), POINTER :: r_ldos_p TYPE(section_vals_type), POINTER :: ldos_section @@ -363,7 +364,6 @@ SUBROUTINE calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particl use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(wf_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) ALLOCATE (read_r(4, n_r_ldos)) DO ildos = 1, n_r_ldos diff --git a/src/qs_resp.F b/src/qs_resp.F index 2666d7f0ab..da5c9c5b53 100644 --- a/src/qs_resp.F +++ b/src/qs_resp.F @@ -72,10 +72,10 @@ MODULE qs_resp USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_rho_resp_all,& calculate_rho_resp_single @@ -922,10 +922,11 @@ SUBROUTINE calc_resp_matrix_periodic(qs_env, resp_env, rep_sys, particles, cell, REAL(KIND=dp) :: normalize_factor REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: vpot TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type) :: rho_ga, va_gspace TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho_ga, va_gspace, va_rspace + TYPE(pw_type) :: va_rspace CALL timeset(routineN, handle) @@ -944,10 +945,8 @@ SUBROUTINE calc_resp_matrix_periodic(qs_env, resp_env, rep_sys, particles, cell, CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, & poisson_env=poisson_env) CALL auxbas_pw_pool%create_pw(rho_ga, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(va_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(va_rspace, & use_data=REALDATA3D, & @@ -1689,11 +1688,11 @@ SUBROUTINE print_pot_from_resp_charges(qs_env, resp_env, particles, natom, outpu sum_diff, sum_hartree, udvol TYPE(cp_logger_type), POINTER :: logger TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type) :: rho_resp, v_resp_gspace TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: aux_r, rho_resp, v_resp_gspace, & - v_resp_rspace + TYPE(pw_type) :: aux_r, v_resp_rspace TYPE(pw_type), POINTER :: v_hartree_rspace TYPE(section_vals_type), POINTER :: input, print_key, resp_section @@ -1717,10 +1716,8 @@ SUBROUTINE print_pot_from_resp_charges(qs_env, resp_env, particles, natom, outpu poisson_env=poisson_env) CALL auxbas_pw_pool%create_pw(rho_resp, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_resp_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_resp_rspace, & use_data=REALDATA3D, & diff --git a/src/qs_rho0_ggrid.F b/src/qs_rho0_ggrid.F index 3616cfff90..57caca1d75 100644 --- a/src/qs_rho0_ggrid.F +++ b/src/qs_rho0_ggrid.F @@ -36,10 +36,10 @@ MODULE qs_rho0_ggrid pw_zero USE pw_pool_types, ONLY: pw_pool_p_type,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -110,11 +110,13 @@ SUBROUTINE put_rho0_on_grid(qs_env, rho0, tot_rs_int) TYPE(dft_control_type), POINTER :: dft_control TYPE(mp_para_env_type), POINTER :: para_env TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: coeff_gspace + TYPE(pw_c1d_type), POINTER :: rho0_s_gs TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: pw_pool - TYPE(pw_type) :: coeff_gspace, coeff_rspace, rho0_r_tmp - TYPE(pw_type), POINTER :: rho0_s_gs, rho0_s_rs + TYPE(pw_type) :: coeff_rspace, rho0_r_tmp + TYPE(pw_type), POINTER :: rho0_s_rs TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(realspace_grid_desc_p_type), DIMENSION(:), & POINTER :: descs @@ -158,7 +160,6 @@ SUBROUTINE put_rho0_on_grid(qs_env, rho0, tot_rs_int) CALL pw_pool%create_pw(coeff_rspace, use_data=REALDATA3D, & in_space=REALSPACE) CALL pw_pool%create_pw(coeff_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) END IF CALL rs_grid_zero(rs_grid) @@ -298,7 +299,7 @@ SUBROUTINE rho0_s_grid_create(pw_env, rho0_mpole) ALLOCATE (rho0_mpole%rho0_s_gs) END IF CALL auxbas_pw_pool%create_pw(rho0_mpole%rho0_s_gs, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) ! Find the grid level suitable for rho0_soft rho0_mpole%igrid_zet0_s = gaussian_gridlevel(pw_env%gridlevel_info, 2.0_dp*rho0_mpole%zet0_h) @@ -352,11 +353,11 @@ SUBROUTINE integrate_vhg0_rspace(qs_env, v_rspace, para_env, calculate_forces, l TYPE(gto_basis_set_type), POINTER :: basis_1c_set TYPE(harmonics_atom_type), POINTER :: harmonics TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: coeff_gaux, coeff_gspace TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: pw_aux, pw_pool - TYPE(pw_type) :: coeff_gaux, coeff_gspace, coeff_raux, & - coeff_rspace + TYPE(pw_type) :: coeff_raux, coeff_rspace TYPE(qs_force_type), DIMENSION(:), POINTER :: force TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(realspace_grid_desc_p_type), DIMENSION(:), & @@ -437,7 +438,6 @@ SUBROUTINE integrate_vhg0_rspace(qs_env, v_rspace, para_env, calculate_forces, l pw_pool => pw_pools(igrid)%pool CALL pw_pool%create_pw(coeff_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_pool%create_pw(coeff_rspace, use_data=REALDATA3D, & @@ -446,7 +446,6 @@ SUBROUTINE integrate_vhg0_rspace(qs_env, v_rspace, para_env, calculate_forces, l IF (igrid /= auxbas_grid) THEN pw_aux => pw_pools(auxbas_grid)%pool CALL pw_aux%create_pw(coeff_gaux, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_transfer(v_rspace, coeff_gaux) CALL pw_copy(coeff_gaux, coeff_gspace) diff --git a/src/qs_rho0_types.F b/src/qs_rho0_types.F index 310275e513..2b81931e23 100644 --- a/src/qs_rho0_types.F +++ b/src/qs_rho0_types.F @@ -13,7 +13,8 @@ MODULE qs_rho0_types pi,& rootpi USE memory_utilities, ONLY: reallocate - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_grid_atom, ONLY: grid_atom_type USE qs_rho_atom_types, ONLY: rho_atom_coeff USE whittaker, ONLY: whittaker_c0a,& @@ -58,8 +59,8 @@ MODULE qs_rho0_types REAL(dp), DIMENSION(:), POINTER :: norm_g0l_h INTEGER, DIMENSION(:), POINTER :: lmax0_kind INTEGER :: lmax_0, igrid_zet0_s - TYPE(pw_type), POINTER :: rho0_s_rs, & - rho0_s_gs + TYPE(pw_type), POINTER :: rho0_s_rs + TYPE(pw_c1d_type), POINTER :: rho0_s_gs END TYPE rho0_mpole_type ! ************************************************************************************************** @@ -435,7 +436,8 @@ SUBROUTINE get_rho0_mpole(rho0_mpole, g0_h, vg0_h, iat, ikind, lmax_0, l0_ikind, REAL(dp), INTENT(OUT), OPTIONAL :: zet0_h INTEGER, INTENT(OUT), OPTIONAL :: igrid_zet0_s REAL(dp), INTENT(OUT), OPTIONAL :: rpgf0_h, rpgf0_s, max_rpgf0_s - TYPE(pw_type), OPTIONAL, POINTER :: rho0_s_rs, rho0_s_gs + TYPE(pw_type), OPTIONAL, POINTER :: rho0_s_rs + TYPE(pw_c1d_type), OPTIONAL, POINTER :: rho0_s_gs IF (ASSOCIATED(rho0_mpole)) THEN diff --git a/src/qs_rho_methods.F b/src/qs_rho_methods.F index e4fb836526..2316aa200d 100644 --- a/src/qs_rho_methods.F +++ b/src/qs_rho_methods.F @@ -38,10 +38,10 @@ MODULE qs_rho_methods pw_scale,& pw_zero USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_drho_elec,& calculate_rho_elec @@ -114,10 +114,12 @@ SUBROUTINE qs_rho_rebuild(rho, qs_env, rebuild_ao, rebuild_grids, admm, pw_env_e TYPE(kpoint_type), POINTER :: kpoints TYPE(neighbor_list_set_p_type), DIMENSION(:), & POINTER :: sab_orb + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g, tau_g + TYPE(pw_c1d_type), DIMENSION(:, :), POINTER :: drho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r, tau_g, tau_r - TYPE(pw_type), DIMENSION(:, :), POINTER :: drho_g, drho_r + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, tau_r + TYPE(pw_type), DIMENSION(:, :), POINTER :: drho_r TYPE(pw_type), POINTER :: rho_r_sccs CALL timeset(routineN, handle) @@ -260,7 +262,7 @@ SUBROUTINE qs_rho_rebuild(rho, qs_env, rebuild_ao, rebuild_grids, admm, pw_env_e CALL qs_rho_set(rho, rho_g=rho_g) DO i = 1, nspins CALL auxbas_pw_pool%create_pw(rho_g(i), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO END IF @@ -316,7 +318,7 @@ SUBROUTINE qs_rho_rebuild(rho, qs_env, rebuild_ao, rebuild_grids, admm, pw_env_e DO j = 1, nspins DO i = 1, 3 CALL auxbas_pw_pool%create_pw(drho_g(i, j), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO END DO END IF @@ -352,7 +354,7 @@ SUBROUTINE qs_rho_rebuild(rho, qs_env, rebuild_ao, rebuild_grids, admm, pw_env_e CALL qs_rho_set(rho, tau_g=tau_g) DO i = 1, nspins CALL auxbas_pw_pool%create_pw(tau_g(i), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO END IF END IF ! use_kinetic_energy_density @@ -494,10 +496,11 @@ SUBROUTINE qs_rho_update_rho_low(rho_struct, qs_env, rho_xc_external, & TYPE(neighbor_list_set_p_type), DIMENSION(:), & POINTER :: sab TYPE(oce_matrix_type), POINTER :: oce + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g, rho_xc_g, tau_g, tau_xc_g + TYPE(pw_c1d_type), DIMENSION(:, :), POINTER :: drho_g, drho_xc_g TYPE(pw_env_type), POINTER :: pw_env - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r, rho_xc_g, rho_xc_r, tau_g, & - tau_r, tau_xc_g, tau_xc_r - TYPE(pw_type), DIMENSION(:, :), POINTER :: drho_g, drho_r, drho_xc_g, drho_xc_r + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, rho_xc_r, tau_r, tau_xc_r + TYPE(pw_type), DIMENSION(:, :), POINTER :: drho_r, drho_xc_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho_xc @@ -695,8 +698,9 @@ SUBROUTINE qs_rho_update_tddfpt(rho_struct, qs_env, pw_env_external, task_list_e TYPE(dft_control_type), POINTER :: dft_control TYPE(kpoint_type), POINTER :: kpoints TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(pw_env_type), POINTER :: pw_env - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(task_list_type), POINTER :: task_list @@ -787,11 +791,10 @@ SUBROUTINE qs_rho_copy(rho_input, rho_output, auxbas_pw_pool, mspin) TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_im_in, rho_ao_im_out, rho_ao_in, & rho_ao_out TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_kp_in - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g_in, rho_g_out, rho_r_in, & - rho_r_out, tau_g_in, tau_g_out, & - tau_r_in, tau_r_out - TYPE(pw_type), DIMENSION(:, :), POINTER :: drho_g_in, drho_g_out, drho_r_in, & - drho_r_out + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g_in, rho_g_out, tau_g_in, tau_g_out + TYPE(pw_c1d_type), DIMENSION(:, :), POINTER :: drho_g_in, drho_g_out + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r_in, rho_r_out, tau_r_in, tau_r_out + TYPE(pw_type), DIMENSION(:, :), POINTER :: drho_r_in, drho_r_out TYPE(pw_type), POINTER :: rho_r_sccs_in, rho_r_sccs_out CALL timeset(routineN, handle) @@ -905,7 +908,6 @@ SUBROUTINE qs_rho_copy(rho_input, rho_output, auxbas_pw_pool, mspin) IF (mspin > nspins) THEN DO i = 1, mspin CALL auxbas_pw_pool%create_pw(rho_g_out(i), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_copy(rho_g_in(1), rho_g_out(i)) CALL pw_scale(rho_g_out(i), ospin) @@ -913,7 +915,6 @@ SUBROUTINE qs_rho_copy(rho_input, rho_output, auxbas_pw_pool, mspin) ELSE DO i = 1, nspins CALL auxbas_pw_pool%create_pw(rho_g_out(i), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_copy(rho_g_in(i), rho_g_out(i)) END DO @@ -965,7 +966,6 @@ SUBROUTINE qs_rho_copy(rho_input, rho_output, auxbas_pw_pool, mspin) DO j = 1, mspin DO i = 1, 3 CALL auxbas_pw_pool%create_pw(drho_g_out(i, j), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_copy(drho_g_in(i, 1), drho_g_out(i, j)) CALL pw_scale(drho_g_out(i, j), ospin) @@ -975,7 +975,6 @@ SUBROUTINE qs_rho_copy(rho_input, rho_output, auxbas_pw_pool, mspin) DO j = 1, nspins DO i = 1, 3 CALL auxbas_pw_pool%create_pw(drho_g_out(i, j), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_copy(drho_g_in(i, j), drho_g_out(i, j)) END DO @@ -1014,7 +1013,6 @@ SUBROUTINE qs_rho_copy(rho_input, rho_output, auxbas_pw_pool, mspin) IF (mspin > nspins) THEN DO i = 1, mspin CALL auxbas_pw_pool%create_pw(tau_g_out(i), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_copy(tau_g_in(1), tau_g_out(i)) CALL pw_scale(tau_g_out(i), ospin) @@ -1022,7 +1020,6 @@ SUBROUTINE qs_rho_copy(rho_input, rho_output, auxbas_pw_pool, mspin) ELSE DO i = 1, nspins CALL auxbas_pw_pool%create_pw(tau_g_out(i), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_copy(tau_g_in(i), tau_g_out(i)) END DO @@ -1096,9 +1093,10 @@ SUBROUTINE qs_rho_scale_and_add(rhoa, rhob, alpha, beta) tot_rho_r_b TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_a, rho_ao_b, rho_ao_im_a, & rho_ao_im_b - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g_a, rho_g_b, rho_r_a, rho_r_b, & - tau_g_a, tau_g_b, tau_r_a, tau_r_b - TYPE(pw_type), DIMENSION(:, :), POINTER :: drho_g_a, drho_g_b, drho_r_a, drho_r_b + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g_a, rho_g_b, tau_g_a, tau_g_b + TYPE(pw_c1d_type), DIMENSION(:, :), POINTER :: drho_g_a, drho_g_b + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r_a, rho_r_b, tau_r_a, tau_r_b + TYPE(pw_type), DIMENSION(:, :), POINTER :: drho_r_a, drho_r_b TYPE(pw_type), POINTER :: rho_r_sccs_a, rho_r_sccs_b CALL timeset(routineN, handle) @@ -1270,13 +1268,12 @@ SUBROUTINE duplicate_rho_type(rho_input, rho_output, qs_env) TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_im_in, rho_ao_im_out, rho_ao_in, & rho_ao_out TYPE(dft_control_type), POINTER :: dft_control + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g_in, rho_g_out, tau_g_in, tau_g_out + TYPE(pw_c1d_type), DIMENSION(:, :), POINTER :: drho_g_in, drho_g_out TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g_in, rho_g_out, rho_r_in, & - rho_r_out, tau_g_in, tau_g_out, & - tau_r_in, tau_r_out - TYPE(pw_type), DIMENSION(:, :), POINTER :: drho_g_in, drho_g_out, drho_r_in, & - drho_r_out + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r_in, rho_r_out, tau_r_in, tau_r_out + TYPE(pw_type), DIMENSION(:, :), POINTER :: drho_r_in, drho_r_out TYPE(pw_type), POINTER :: rho_r_sccs_in, rho_r_sccs_out CALL timeset(routineN, handle) @@ -1358,7 +1355,6 @@ SUBROUTINE duplicate_rho_type(rho_input, rho_output, qs_env) CALL qs_rho_set(rho_output, rho_g=rho_g_out) DO i = 1, nspins CALL auxbas_pw_pool%create_pw(rho_g_out(i), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_copy(rho_g_in(i), rho_g_out(i)) END DO @@ -1395,7 +1391,6 @@ SUBROUTINE duplicate_rho_type(rho_input, rho_output, qs_env) DO j = 1, nspins DO i = 1, 3 CALL auxbas_pw_pool%create_pw(drho_g_out(i, j), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_copy(drho_g_in(i, j), drho_g_out(i, j)) END DO @@ -1424,7 +1419,6 @@ SUBROUTINE duplicate_rho_type(rho_input, rho_output, qs_env) CALL qs_rho_set(rho_output, tau_g=tau_g_out) DO i = 1, nspins CALL auxbas_pw_pool%create_pw(tau_g_out(i), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_copy(tau_g_in(i), tau_g_out(i)) END DO diff --git a/src/qs_rho_types.F b/src/qs_rho_types.F index cbeb61a2f3..a02c029285 100644 --- a/src/qs_rho_types.F +++ b/src/qs_rho_types.F @@ -25,7 +25,8 @@ MODULE qs_rho_types set_1d_pointer,& set_2d_pointer USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type #include "./base/base_uses.f90" IMPLICIT NONE @@ -62,11 +63,12 @@ MODULE qs_rho_types PRIVATE TYPE(kpoint_transitional_type) :: rho_ao TYPE(kpoint_transitional_type) :: rho_ao_im - TYPE(pw_type), DIMENSION(:), POINTER :: rho_r => Null(), & - rho_g => Null(), & - tau_r => Null(), & - tau_g => Null() - TYPE(pw_type), DIMENSION(:, :), POINTER :: drho_r => NULL(), drho_g => NULL() + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r => Null() + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g => Null() + TYPE(pw_type), DIMENSION(:), POINTER :: tau_r => Null() + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: tau_g => Null() + TYPE(pw_type), DIMENSION(:, :), POINTER :: drho_r => NULL() + TYPE(pw_c1d_type), DIMENSION(:, :), POINTER :: drho_g => NULL() ! Final rho_iter of last SCCS cycle (r-space) TYPE(pw_type), POINTER :: rho_r_sccs => Null() LOGICAL :: rho_g_valid = .FALSE., & @@ -231,9 +233,11 @@ SUBROUTINE qs_rho_get(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_ao_im_kp, rh POINTER :: rho_ao_kp, rho_ao_im_kp TYPE(pw_type), DIMENSION(:), OPTIONAL, POINTER :: rho_r TYPE(pw_type), DIMENSION(:, :), OPTIONAL, POINTER :: drho_r - TYPE(pw_type), DIMENSION(:), OPTIONAL, POINTER :: rho_g - TYPE(pw_type), DIMENSION(:, :), OPTIONAL, POINTER :: drho_g - TYPE(pw_type), DIMENSION(:), OPTIONAL, POINTER :: tau_r, tau_g + TYPE(pw_c1d_type), DIMENSION(:), OPTIONAL, POINTER :: rho_g + TYPE(pw_c1d_type), DIMENSION(:, :), OPTIONAL, & + POINTER :: drho_g + TYPE(pw_type), DIMENSION(:), OPTIONAL, POINTER :: tau_r + TYPE(pw_c1d_type), DIMENSION(:), OPTIONAL, POINTER :: tau_g LOGICAL, INTENT(out), OPTIONAL :: rho_r_valid, drho_r_valid, rho_g_valid, & drho_g_valid, tau_r_valid, tau_g_valid REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: tot_rho_r, tot_rho_g @@ -303,9 +307,11 @@ SUBROUTINE qs_rho_set(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_ao_im_kp, rh POINTER :: rho_ao_kp, rho_ao_im_kp TYPE(pw_type), DIMENSION(:), OPTIONAL, POINTER :: rho_r TYPE(pw_type), DIMENSION(:, :), OPTIONAL, POINTER :: drho_r - TYPE(pw_type), DIMENSION(:), OPTIONAL, POINTER :: rho_g - TYPE(pw_type), DIMENSION(:, :), OPTIONAL, POINTER :: drho_g - TYPE(pw_type), DIMENSION(:), OPTIONAL, POINTER :: tau_r, tau_g + TYPE(pw_c1d_type), DIMENSION(:), OPTIONAL, POINTER :: rho_g + TYPE(pw_c1d_type), DIMENSION(:, :), OPTIONAL, & + POINTER :: drho_g + TYPE(pw_type), DIMENSION(:), OPTIONAL, POINTER :: tau_r + TYPE(pw_c1d_type), DIMENSION(:), OPTIONAL, POINTER :: tau_g LOGICAL, INTENT(in), OPTIONAL :: rho_r_valid, drho_r_valid, rho_g_valid, & drho_g_valid, tau_r_valid, tau_g_valid REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: tot_rho_r, tot_rho_g diff --git a/src/qs_sccs.F b/src/qs_sccs.F index 289c770e01..1a68840192 100644 --- a/src/qs_sccs.F +++ b/src/qs_sccs.F @@ -75,10 +75,11 @@ MODULE qs_sccs pw_poisson_type USE pw_pool_types, ONLY: pw_pool_p_type,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& + pw_r3d_type,& pw_type USE qs_energy_types, ONLY: qs_energy_type USE qs_environment_types, ONLY: get_qs_env,& @@ -124,7 +125,8 @@ MODULE qs_sccs SUBROUTINE sccs(qs_env, rho_tot_gspace, v_hartree_gspace, v_sccs, h_stress) TYPE(qs_environment_type), POINTER :: qs_env - TYPE(pw_type), INTENT(INOUT) :: rho_tot_gspace, v_hartree_gspace, v_sccs + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_tot_gspace, v_hartree_gspace + TYPE(pw_type), INTENT(INOUT) :: v_sccs REAL(KIND=dp), DIMENSION(3, 3), INTENT(OUT), & OPTIONAL :: h_stress @@ -678,21 +680,30 @@ SUBROUTINE sccs(qs_env, rho_tot_gspace, v_hartree_gspace, v_sccs, h_stress) ! Calculate the total SCCS Hartree energy, potential, and its ! derivatives of the solute and the implicit solvent CALL pw_transfer(rho_tot, rho_tot_gspace) - IF (calculate_stress_tensor) THEN - ! Request also the calculation of the stress tensor contribution - CALL pw_poisson_solve(poisson_env=poisson_env, & - density=rho_tot_gspace, & - ehartree=e_tot, & - vhartree=v_hartree_gspace, & - dvhartree=dphi_tot, & - h_stress=h_stress) - ELSE - CALL pw_poisson_solve(poisson_env=poisson_env, & - density=rho_tot_gspace, & - ehartree=e_tot, & - vhartree=v_hartree_gspace, & - dvhartree=dphi_tot) - END IF + BLOCK + TYPE(pw_r3d_type) :: my_dphi_tot(3) + INTEGER :: i + DO i = 1, 3 + my_dphi_tot(i)%in_space = dphi_tot(i)%in_space + my_dphi_tot(i)%array => dphi_tot(i)%cr3d + my_dphi_tot(i)%pw_grid => dphi_tot(i)%pw_grid + END DO + IF (calculate_stress_tensor) THEN + ! Request also the calculation of the stress tensor contribution + CALL pw_poisson_solve(poisson_env=poisson_env, & + density=rho_tot_gspace, & + ehartree=e_tot, & + vhartree=v_hartree_gspace, & + dvhartree=my_dphi_tot, & + h_stress=h_stress) + ELSE + CALL pw_poisson_solve(poisson_env=poisson_env, & + density=rho_tot_gspace, & + ehartree=e_tot, & + vhartree=v_hartree_gspace, & + dvhartree=my_dphi_tot) + END IF + END BLOCK CALL pw_transfer(v_hartree_gspace, phi_tot) energy%sccs_hartree = 0.5_dp*pw_integral_ab(rho_solute, phi_tot) @@ -994,8 +1005,8 @@ SUBROUTINE derive(f, df, method, pw_env, input) INTEGER :: border_points, handle, i INTEGER, DIMENSION(3) :: lb, n, ub + TYPE(pw_c1d_type), DIMENSION(2) :: work_g1d TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), DIMENSION(2) :: work_g1d TYPE(realspace_grid_desc_type), POINTER :: rs_desc TYPE(realspace_grid_input_type) :: input_settings TYPE(realspace_grid_type), POINTER :: rs_grid @@ -1033,7 +1044,6 @@ SUBROUTINE derive(f, df, method, pw_env, input) ! Get work storage for the 1d grids in g-space (derivative calculation) DO i = 1, SIZE(work_g1d) CALL auxbas_pw_pool%create_pw(work_g1d(i), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) END DO END SELECT diff --git a/src/qs_scf_initialization.F b/src/qs_scf_initialization.F index 2594a395ac..afe56538e2 100644 --- a/src/qs_scf_initialization.F +++ b/src/qs_scf_initialization.F @@ -54,7 +54,7 @@ MODULE qs_scf_initialization USE kinds, ONLY: dp USE kpoint_types, ONLY: kpoint_type USE message_passing, ONLY: mp_para_env_type - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type USE qmmm_image_charge, ONLY: conditional_calc_image_matrix USE qs_block_davidson_types, ONLY: block_davidson_allocate,& block_davidson_env_create @@ -228,7 +228,7 @@ SUBROUTINE qs_scf_ensure_scf_env(qs_env, scf_env) TYPE(qs_environment_type), POINTER :: qs_env TYPE(qs_scf_env_type), POINTER :: scf_env - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(qs_rho_type), POINTER :: rho NULLIFY (rho_g) diff --git a/src/qs_scf_post_gpw.F b/src/qs_scf_post_gpw.F index 0e47f3e08f..badad5a83c 100644 --- a/src/qs_scf_post_gpw.F +++ b/src/qs_scf_post_gpw.F @@ -119,8 +119,7 @@ MODULE qs_scf_post_gpw pw_poisson_type USE pw_pool_types, ONLY: pw_pool_p_type,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& pw_c1d_type,& @@ -275,10 +274,11 @@ SUBROUTINE scf_post_calculation_gpw(qs_env, wf_type, do_mp2) TYPE(mp_para_env_type), POINTER :: para_env TYPE(particle_list_type), POINTER :: particles TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: wf_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: wf_g, wf_r + TYPE(pw_type) :: wf_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_loc_env_type), POINTER :: qs_loc_env_homo, qs_loc_env_lumo, & qs_loc_env_mixed @@ -457,7 +457,6 @@ SUBROUTINE scf_post_calculation_gpw(qs_env, wf_type, do_mp2) use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(wf_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) END IF @@ -1030,7 +1029,8 @@ SUBROUTINE qs_scf_post_occ_cubes(input, dft_section, dft_control, logger, qs_env TYPE(cp_logger_type), POINTER :: logger TYPE(qs_environment_type), POINTER :: qs_env TYPE(cp_fm_type), INTENT(IN) :: mo_coeff - TYPE(pw_type), INTENT(INOUT) :: wf_g, wf_r + TYPE(pw_c1d_type), INTENT(INOUT) :: wf_g + TYPE(pw_type), INTENT(INOUT) :: wf_r TYPE(particle_list_type), POINTER :: particles INTEGER, INTENT(IN) :: homo, ispin @@ -1134,7 +1134,8 @@ SUBROUTINE qs_scf_post_unocc_cubes(input, dft_section, dft_control, logger, qs_e TYPE(cp_logger_type), POINTER :: logger TYPE(qs_environment_type), POINTER :: qs_env TYPE(cp_fm_type), INTENT(IN) :: unoccupied_orbs - TYPE(pw_type), INTENT(INOUT) :: wf_g, wf_r + TYPE(pw_c1d_type), INTENT(INOUT) :: wf_g + TYPE(pw_type), INTENT(INOUT) :: wf_r TYPE(particle_list_type), POINTER :: particles INTEGER, INTENT(IN) :: nlumos, homo, ispin INTEGER, INTENT(IN), OPTIONAL :: lumo @@ -1921,14 +1922,14 @@ SUBROUTINE write_mo_free_results(qs_env) TYPE(mp_para_env_type), POINTER :: para_env TYPE(particle_list_type), POINTER :: particles TYPE(particle_type), DIMENSION(:), POINTER :: particle_set - TYPE(pw_c1d_type), POINTER :: rho_core + TYPE(pw_c1d_type) :: aux_g, rho_elec_gspace + TYPE(pw_c1d_type), POINTER :: rho0_s_gs, rho_core TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: aux_g, aux_r, rho_elec_gspace, & - rho_elec_rspace, wf_r + TYPE(pw_type) :: aux_r, rho_elec_rspace, wf_r TYPE(pw_type), DIMENSION(:), POINTER :: rho_r - TYPE(pw_type), POINTER :: mb_rho, rho0_s_gs, v_hartree_rspace, vee + TYPE(pw_type), POINTER :: mb_rho, v_hartree_rspace, vee TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_kind_type), POINTER :: qs_kind TYPE(qs_rho_type), POINTER :: rho @@ -2146,7 +2147,6 @@ SUBROUTINE write_mo_free_results(qs_env) in_space=REALSPACE) CALL pw_zero(rho_elec_rspace) CALL auxbas_pw_pool%create_pw(pw=rho_elec_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_zero(rho_elec_gspace) CALL get_pw_grid_info(pw_grid=rho_elec_gspace%pw_grid, & @@ -2410,7 +2410,6 @@ SUBROUTINE write_mo_free_results(qs_env) use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(aux_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) append_cube = section_get_lval(input, "DFT%PRINT%EFIELD_CUBE%APPEND") @@ -3384,11 +3383,11 @@ SUBROUTINE update_hartree_with_mp2(rho, qs_env) TYPE(qs_environment_type), POINTER :: qs_env LOGICAL :: use_virial + TYPE(pw_c1d_type) :: rho_tot_gspace, v_hartree_gspace 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 - TYPE(pw_type) :: rho_tot_gspace, v_hartree_gspace TYPE(pw_type), POINTER :: v_hartree_rspace TYPE(qs_energy_type), POINTER :: energy TYPE(virial_type), POINTER :: virial @@ -3405,10 +3404,8 @@ SUBROUTINE update_hartree_with_mp2(rho, qs_env) CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, & poisson_env=poisson_env) CALL auxbas_pw_pool%create_pw(v_hartree_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(rho_tot_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL calc_rho_tot_gspace(rho_tot_gspace, qs_env, rho) diff --git a/src/qs_scf_post_tb.F b/src/qs_scf_post_tb.F index 80856ae2d5..c1551da320 100644 --- a/src/qs_scf_post_tb.F +++ b/src/qs_scf_post_tb.F @@ -93,8 +93,7 @@ MODULE qs_scf_post_tb pw_poisson_parameter_type USE pw_pool_types, ONLY: pw_pool_p_type,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& pw_c1d_type,& @@ -1051,10 +1050,11 @@ SUBROUTINE print_e_density(qs_env, cube_section) TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_kp TYPE(dft_control_type), POINTER :: dft_control TYPE(particle_list_type), POINTER :: particles + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho TYPE(qs_subsys_type), POINTER :: subsys @@ -1198,12 +1198,13 @@ SUBROUTINE print_density_cubes(qs_env, cube_section, total_density, v_hartree, e TYPE(dft_control_type), POINTER :: dft_control TYPE(particle_list_type), POINTER :: particles TYPE(pw_c1d_type) :: rho_core + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_parameter_type) :: poisson_params TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho_tot_rspace, vhartree - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r + TYPE(pw_type) :: rho_tot_rspace + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho TYPE(qs_subsys_type), POINTER :: subsys @@ -1293,9 +1294,9 @@ SUBROUTINE print_density_cubes(qs_env, cube_section, total_density, v_hartree, e END IF IF (my_v_hartree .OR. my_efield) THEN BLOCK - TYPE(pw_type) :: rho_tot_gspace + TYPE(pw_c1d_type) :: rho_tot_gspace CALL auxbas_pw_pool%create_pw(pw=rho_tot_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_transfer(rho_tot_rspace, rho_tot_gspace) poisson_params%solver = pw_poisson_analytic poisson_params%periodic = cell%perd @@ -1305,46 +1306,16 @@ SUBROUTINE print_density_cubes(qs_env, cube_section, total_density, v_hartree, e TYPE(pw_grid_type), POINTER :: pwdummy NULLIFY (pwdummy) CALL pw_green_create(green_fft, poisson_params, cell%hmat, auxbas_pw_pool, pwdummy, pwdummy) - rho_tot_gspace%cc(:) = rho_tot_gspace%cc(:)*green_fft%influence_fn%array(:) + rho_tot_gspace%array(:) = rho_tot_gspace%array(:)*green_fft%influence_fn%array(:) CALL pw_green_release(green_fft, auxbas_pw_pool) END BLOCK IF (my_v_hartree) THEN - CALL auxbas_pw_pool%create_pw(pw=vhartree, & - use_data=REALDATA3D, in_space=REALSPACE) - CALL pw_transfer(rho_tot_gspace, vhartree) - filename = "V_HARTREE" - mpi_io = .TRUE. - unit_nr = cp_print_key_unit_nr(logger, cube_section, '', & - extension=".cube", middle_name=TRIM(filename), file_position=my_pos_cube, & - log_filename=.FALSE., mpi_io=mpi_io, fout=mpi_filename) - IF (iounit > 0) THEN - IF (.NOT. mpi_io) THEN - INQUIRE (UNIT=unit_nr, NAME=filename) - ELSE - filename = mpi_filename - END IF - WRITE (UNIT=iounit, FMT="(T2,A,/,T2,A79)") & - "The Hartree potential is written in cube file format to the file:", ADJUSTR(TRIM(filename)) - END IF - CALL cp_pw_to_cube(vhartree, unit_nr, "Hartree Potential", & - particles=particles, & - stride=section_get_ivals(cube_section, "STRIDE"), mpi_io=mpi_io) - CALL cp_print_key_finished_output(unit_nr, logger, cube_section, '', mpi_io=mpi_io) - CALL auxbas_pw_pool%give_back_pw(vhartree) - END IF - IF (my_efield) THEN - CALL auxbas_pw_pool%create_pw(pw=vhartree, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) - udvol = 1.0_dp/rho_tot_rspace%pw_grid%dvol - DO id = 1, 3 + BLOCK + TYPE(pw_type) :: vhartree + CALL auxbas_pw_pool%create_pw(pw=vhartree, & + use_data=REALDATA3D, in_space=REALSPACE) CALL pw_transfer(rho_tot_gspace, vhartree) - nd = 0 - nd(id) = 1 - CALL pw_derive(vhartree, nd) - CALL pw_transfer(vhartree, rho_tot_rspace) - CALL pw_scale(rho_tot_rspace, udvol) - - filename = "EFIELD_"//cdir(id) + filename = "V_HARTREE" mpi_io = .TRUE. unit_nr = cp_print_key_unit_nr(logger, cube_section, '', & extension=".cube", middle_name=TRIM(filename), file_position=my_pos_cube, & @@ -1356,14 +1327,50 @@ SUBROUTINE print_density_cubes(qs_env, cube_section, total_density, v_hartree, e filename = mpi_filename END IF WRITE (UNIT=iounit, FMT="(T2,A,/,T2,A79)") & - "The Efield is written in cube file format to the file:", ADJUSTR(TRIM(filename)) + "The Hartree potential is written in cube file format to the file:", ADJUSTR(TRIM(filename)) END IF - CALL cp_pw_to_cube(rho_tot_rspace, unit_nr, "EFIELD "//cdir(id), & + CALL cp_pw_to_cube(vhartree, unit_nr, "Hartree Potential", & particles=particles, & stride=section_get_ivals(cube_section, "STRIDE"), mpi_io=mpi_io) CALL cp_print_key_finished_output(unit_nr, logger, cube_section, '', mpi_io=mpi_io) - END DO - CALL auxbas_pw_pool%give_back_pw(vhartree) + CALL auxbas_pw_pool%give_back_pw(vhartree) + END BLOCK + END IF + IF (my_efield) THEN + BLOCK + TYPE(pw_c1d_type) :: vhartree + CALL auxbas_pw_pool%create_pw(pw=vhartree, & + in_space=RECIPROCALSPACE) + udvol = 1.0_dp/rho_tot_rspace%pw_grid%dvol + DO id = 1, 3 + CALL pw_transfer(rho_tot_gspace, vhartree) + nd = 0 + nd(id) = 1 + CALL pw_derive(vhartree, nd) + CALL pw_transfer(vhartree, rho_tot_rspace) + CALL pw_scale(rho_tot_rspace, udvol) + + filename = "EFIELD_"//cdir(id) + mpi_io = .TRUE. + unit_nr = cp_print_key_unit_nr(logger, cube_section, '', & + extension=".cube", middle_name=TRIM(filename), file_position=my_pos_cube, & + log_filename=.FALSE., mpi_io=mpi_io, fout=mpi_filename) + IF (iounit > 0) THEN + IF (.NOT. mpi_io) THEN + INQUIRE (UNIT=unit_nr, NAME=filename) + ELSE + filename = mpi_filename + END IF + WRITE (UNIT=iounit, FMT="(T2,A,/,T2,A79)") & + "The Efield is written in cube file format to the file:", ADJUSTR(TRIM(filename)) + END IF + CALL cp_pw_to_cube(rho_tot_rspace, unit_nr, "EFIELD "//cdir(id), & + particles=particles, & + stride=section_get_ivals(cube_section, "STRIDE"), mpi_io=mpi_io) + CALL cp_print_key_finished_output(unit_nr, logger, cube_section, '', mpi_io=mpi_io) + END DO + CALL auxbas_pw_pool%give_back_pw(vhartree) + END BLOCK END IF CALL auxbas_pw_pool%give_back_pw(rho_tot_gspace) END BLOCK @@ -1395,11 +1402,12 @@ SUBROUTINE print_elf(qs_env, elf_section) TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_kp TYPE(dft_control_type), POINTER :: dft_control TYPE(particle_list_type), POINTER :: particles + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: elf_r - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho TYPE(qs_subsys_type), POINTER :: subsys @@ -1500,10 +1508,11 @@ SUBROUTINE print_mo_cubes(qs_env, cube_section) TYPE(mo_set_type), DIMENSION(:), POINTER :: mos TYPE(particle_list_type), POINTER :: particles TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: wf_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: wf_g, wf_r + TYPE(pw_type) :: wf_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_subsys_type), POINTER :: subsys TYPE(scf_control_type), POINTER :: scf_control @@ -1555,7 +1564,6 @@ SUBROUTINE print_mo_cubes(qs_env, cube_section) use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(wf_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL get_qs_env(qs_env, subsys=subsys) diff --git a/src/qs_tddfpt2_densities.F b/src/qs_tddfpt2_densities.F index 21ffbfe625..83995b7c39 100644 --- a/src/qs_tddfpt2_densities.F +++ b/src/qs_tddfpt2_densities.F @@ -20,7 +20,8 @@ MODULE qs_tddfpt2_densities USE parallel_gemm_api, ONLY: parallel_gemm USE pw_env_types, ONLY: pw_env_get USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_collocate_density, ONLY: calculate_rho_elec USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -171,7 +172,8 @@ SUBROUTINE tddfpt_construct_aux_fit_density(rho_orb_struct, rho_aux_fit_struct, TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_aux_fit, rho_ao_orb TYPE(neighbor_list_set_p_type), DIMENSION(:), & POINTER :: sab_aux_fit - TYPE(pw_type), DIMENSION(:), POINTER :: rho_aux_fit_g, rho_aux_fit_r + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_aux_fit_g + TYPE(pw_type), DIMENSION(:), POINTER :: rho_aux_fit_r TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(task_list_type), POINTER :: task_list diff --git a/src/qs_tddfpt2_fhxc.F b/src/qs_tddfpt2_fhxc.F index 09c80e0851..093c595b64 100644 --- a/src/qs_tddfpt2_fhxc.F +++ b/src/qs_tddfpt2_fhxc.F @@ -33,6 +33,7 @@ MODULE qs_tddfpt2_fhxc USE pw_pool_types, ONLY: pw_pool_type USE pw_types, ONLY: REALDATA3D,& REALSPACE,& + pw_c1d_type,& pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -120,10 +121,10 @@ SUBROUTINE fhxc_kernel(Aop_evects, evects, is_rks_triplets, & TYPE(dft_control_type), POINTER :: dft_control TYPE(lri_kind_type), DIMENSION(:), POINTER :: lri_v_int TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_ia_g, rho_ia_g_aux_fit TYPE(pw_pool_type), POINTER :: auxbas_pw_pool TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: V_rspace_sub - TYPE(pw_type), DIMENSION(:), POINTER :: rho_ia_g, rho_ia_g_aux_fit, rho_ia_r, & - rho_ia_r_aux_fit + TYPE(pw_type), DIMENSION(:), POINTER :: rho_ia_r, rho_ia_r_aux_fit TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho1_atom_set, rho_atom_set TYPE(task_list_type), POINTER :: task_list diff --git a/src/qs_tddfpt2_fhxc_forces.F b/src/qs_tddfpt2_fhxc_forces.F index da51991fb7..b8733db2a6 100644 --- a/src/qs_tddfpt2_fhxc_forces.F +++ b/src/qs_tddfpt2_fhxc_forces.F @@ -87,10 +87,10 @@ MODULE qs_tddfpt2_fhxc_forces USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_rho_elec USE qs_environment_types, ONLY: get_qs_env,& @@ -203,15 +203,14 @@ SUBROUTINE fhxc_force(qs_env, ex_env, gs_mos, full_kernel, debug_forces) POINTER :: sab, sab_aux_fit, sab_orb, sap_oce TYPE(oce_matrix_type), POINTER :: oce TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: rhox_tot_gspace, xv_hartree_gspace + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g_aux, rhox_g, rhox_g_aux, rhoxx_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rhox_tot_gspace, xv_hartree_gspace, & - xv_hartree_rspace + TYPE(pw_type) :: xv_hartree_rspace TYPE(pw_type), DIMENSION(:), POINTER :: fxc_rho, fxc_tau, gxc_rho, gxc_tau, & - rho_g_aux, rho_r_aux, rhox_g, & - rhox_g_aux, rhox_r, rhox_r_aux, & - rhoxx_g, rhoxx_r + rho_r_aux, rhox_r, rhox_r_aux, rhoxx_r TYPE(qs_force_type), DIMENSION(:), POINTER :: force TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_ks_env_type), POINTER :: ks_env @@ -398,10 +397,10 @@ SUBROUTINE fhxc_force(qs_env, ex_env, gs_mos, full_kernel, debug_forces) CALL auxbas_pw_pool%create_pw(rhox_r(ispin), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rhox_g(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO CALL auxbas_pw_pool%create_pw(rhox_tot_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_zero(rhox_tot_gspace) DO ispin = 1, nspins @@ -419,7 +418,7 @@ SUBROUTINE fhxc_force(qs_env, ex_env, gs_mos, full_kernel, debug_forces) CALL auxbas_pw_pool%create_pw(rhoxx_r(ispin), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rhoxx_g(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO DO ispin = 1, nspins IF (nspins == 2) CALL dbcsr_scale(matrix_px1(ispin)%matrix, 2.0_dp) @@ -436,7 +435,7 @@ SUBROUTINE fhxc_force(qs_env, ex_env, gs_mos, full_kernel, debug_forces) CALL auxbas_pw_pool%create_pw(xv_hartree_rspace, & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(xv_hartree_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) ! calculate associated hartree potential IF (gapw) THEN CALL pw_axpy(local_rho_set%rho0_mpole%rho0_s_gs, rhox_tot_gspace) @@ -685,7 +684,7 @@ SUBROUTINE fhxc_force(qs_env, ex_env, gs_mos, full_kernel, debug_forces) CALL auxbas_pw_pool%create_pw(rhox_r_aux(ispin), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rhox_g_aux(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO DO ispin = 1, nspins CALL calculate_rho_elec(ks_env=ks_env, matrix_p=matrix_px1_admm(ispin)%matrix, & diff --git a/src/qs_tddfpt2_forces.F b/src/qs_tddfpt2_forces.F index 4c5e57ae0a..4ac54053e9 100644 --- a/src/qs_tddfpt2_forces.F +++ b/src/qs_tddfpt2_forces.F @@ -70,10 +70,10 @@ MODULE qs_tddfpt2_forces USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_rho_elec USE qs_density_matrices, ONLY: calculate_wx_matrix,& @@ -675,15 +675,15 @@ SUBROUTINE tddfpt_resvec2(qs_env, matrix_pe, matrix_pe_admm, gs_mos, matrix_hz, TYPE(neighbor_list_set_p_type), DIMENSION(:), & POINTER :: sab, sab_aux_fit TYPE(oce_matrix_type), POINTER :: oce + TYPE(pw_c1d_type) :: rho_tot_gspace, v_hartree_gspace + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g, rho_g_aux, rhoz_g_aux, trho_g, & + trho_xc_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho_tot_gspace, v_hartree_gspace, & - v_hartree_rspace - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_g_aux, rho_r, rho_r_aux, & - rhoz_g_aux, rhoz_r_aux, tau_r, trho_g, & - trho_r, trho_xc_g, trho_xc_r, v_xc, & - v_xc_tau + TYPE(pw_type) :: v_hartree_rspace + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, rho_r_aux, rhoz_r_aux, tau_r, & + trho_r, trho_xc_r, v_xc, v_xc_tau TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho, rho_aux_fit, rho_xc, rhoz_aux, trho @@ -707,9 +707,9 @@ SUBROUTINE tddfpt_resvec2(qs_env, matrix_pe, matrix_pe_admm, gs_mos, matrix_hz, poisson_env=poisson_env) CALL auxbas_pw_pool%create_pw(v_hartree_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(rho_tot_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_hartree_rspace, & use_data=REALDATA3D, in_space=REALSPACE) @@ -718,7 +718,7 @@ SUBROUTINE tddfpt_resvec2(qs_env, matrix_pe, matrix_pe_admm, gs_mos, matrix_hz, CALL auxbas_pw_pool%create_pw(trho_r(ispin), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(trho_g(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO IF (gapw_xc) THEN ALLOCATE (trho_xc_r(nspins), trho_xc_g(nspins)) @@ -726,7 +726,7 @@ SUBROUTINE tddfpt_resvec2(qs_env, matrix_pe, matrix_pe_admm, gs_mos, matrix_hz, CALL auxbas_pw_pool%create_pw(trho_xc_r(ispin), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(trho_xc_g(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO END IF @@ -952,7 +952,7 @@ SUBROUTINE tddfpt_resvec2(qs_env, matrix_pe, matrix_pe_admm, gs_mos, matrix_hz, CALL auxbas_pw_pool%create_pw(rhoz_r_aux(ispin), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rhoz_g_aux(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO DO ispin = 1, nspins CALL calculate_rho_elec(ks_env=ks_env, matrix_p=mpe(ispin, 1)%matrix, & diff --git a/src/qs_tddfpt2_operators.F b/src/qs_tddfpt2_operators.F index 3bb0dd466c..3c7fbdd5a5 100644 --- a/src/qs_tddfpt2_operators.F +++ b/src/qs_tddfpt2_operators.F @@ -37,7 +37,8 @@ MODULE qs_tddfpt2_operators USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type USE qs_kernel_types, ONLY: full_kernel_env_type @@ -159,13 +160,14 @@ END SUBROUTINE tddfpt_apply_energy_diff SUBROUTINE tddfpt_apply_coulomb(A_ia_rspace, rho_ia_g, local_rho_set, hartree_local, & qs_env, sub_env, gapw, work_v_gspace, work_v_rspace) TYPE(pw_type), DIMENSION(:), INTENT(INOUT) :: A_ia_rspace - TYPE(pw_type), INTENT(INOUT) :: rho_ia_g + TYPE(pw_c1d_type), INTENT(INOUT) :: rho_ia_g TYPE(local_rho_type), POINTER :: local_rho_set TYPE(hartree_local_type), POINTER :: hartree_local TYPE(qs_environment_type), POINTER :: qs_env TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env LOGICAL, INTENT(IN) :: gapw - TYPE(pw_type), INTENT(INOUT) :: work_v_gspace, work_v_rspace + TYPE(pw_c1d_type), INTENT(INOUT) :: work_v_gspace + TYPE(pw_type), INTENT(INOUT) :: work_v_rspace CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_apply_coulomb' @@ -332,9 +334,9 @@ SUBROUTINE tddfpt_apply_xc_analytic(kernel_env, rho_ia_struct, is_rks_triplets, CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_apply_xc_analytic' INTEGER :: handle, ispin + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_ia_g, rho_ia_g2 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), DIMENSION(:), POINTER :: rho_ia_g, rho_ia_g2, rho_ia_r, & - rho_ia_r2, tau_ia_r, tau_ia_r2 + TYPE(pw_type), DIMENSION(:), POINTER :: rho_ia_r, rho_ia_r2, tau_ia_r, tau_ia_r2 CALL timeset(routineN, handle) @@ -418,8 +420,9 @@ SUBROUTINE tddfpt_apply_xc_fd(kernel_env, rho_ia_struct, is_rks_triplets, nspins INTEGER :: handle, ispin LOGICAL :: lsd, singlet, triplet + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho1_g TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), DIMENSION(:), POINTER :: rho1_g, rho1_r, tau1_r + TYPE(pw_type), DIMENSION(:), POINTER :: rho1_r, tau1_r TYPE(xc_rho_set_type), POINTER :: rho_set CALL timeset(routineN, handle) diff --git a/src/qs_tddfpt2_properties.F b/src/qs_tddfpt2_properties.F index d45fdabf6c..c387c1534e 100644 --- a/src/qs_tddfpt2_properties.F +++ b/src/qs_tddfpt2_properties.F @@ -79,10 +79,10 @@ MODULE qs_tddfpt2_properties USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_p_type,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_wavefunction USE qs_environment_types, ONLY: get_qs_env,& @@ -1263,10 +1263,11 @@ SUBROUTINE print_nto_cubes(qs_env, mos, istate, stride, append_cube, print_secti TYPE(dft_control_type), POINTER :: dft_control TYPE(particle_list_type), POINTER :: particles TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: wf_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: wf_g, wf_r + TYPE(pw_type) :: wf_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_subsys_type), POINTER :: subsys @@ -1278,7 +1279,6 @@ SUBROUTINE print_nto_cubes(qs_env, mos, istate, stride, append_cube, print_secti use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(wf_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL get_qs_env(qs_env, subsys=subsys) diff --git a/src/qs_tddfpt2_types.F b/src/qs_tddfpt2_types.F index b1cce2e098..e5206810a8 100644 --- a/src/qs_tddfpt2_types.F +++ b/src/qs_tddfpt2_types.F @@ -42,10 +42,10 @@ MODULE qs_tddfpt2_types USE parallel_gemm_api, ONLY: parallel_gemm USE pw_env_types, ONLY: pw_env_get USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -159,7 +159,7 @@ MODULE qs_tddfpt2_types !> group-specific copy of a Coulomb/xc-potential on a real-space grid TYPE(pw_type), DIMENSION(:), POINTER :: A_ia_rspace_sub !> group-specific copy of a reciprocal-space grid - TYPE(pw_type), DIMENSION(:), POINTER :: wpw_gspace_sub + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: wpw_gspace_sub !> group-specific copy of a real-space grid TYPE(pw_type), DIMENSION(:), POINTER :: wpw_rspace_sub !> group-specific copy of a real-space grid for the kinetic energy density @@ -416,7 +416,7 @@ SUBROUTINE tddfpt_create_work_matrices(work_matrices, gs_mos, nstates, do_hfx, d use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(work_matrices%wpw_gspace_sub(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(work_matrices%wpw_rspace_sub(ispin), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(work_matrices%wpw_tau_rspace_sub(ispin), & diff --git a/src/qs_update_s_mstruct.F b/src/qs_update_s_mstruct.F index ccf2ba86a5..397203802f 100644 --- a/src/qs_update_s_mstruct.F +++ b/src/qs_update_s_mstruct.F @@ -69,8 +69,8 @@ SUBROUTINE qs_env_update_s_mstruct(qs_env) INTEGER :: handle LOGICAL :: do_ppl TYPE(dft_control_type), POINTER :: dft_control - TYPE(pw_c1d_type), POINTER :: rho_core - TYPE(pw_type), POINTER :: rho_nlcc, rho_nlcc_g, vppl + TYPE(pw_c1d_type), POINTER :: rho_core, rho_nlcc_g + TYPE(pw_type), POINTER :: rho_nlcc, vppl CALL timeset(routineN, handle) diff --git a/src/qs_vxc.F b/src/qs_vxc.F index b149d5a540..a79c610809 100644 --- a/src/qs_vxc.F +++ b/src/qs_vxc.F @@ -38,10 +38,10 @@ MODULE qs_vxc pw_transfer,& pw_zero USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_dispersion_nonloc, ONLY: calculate_dispersion_nonloc USE qs_dispersion_types, ONLY: qs_dispersion_type @@ -123,14 +123,13 @@ SUBROUTINE qs_vxc_create(ks_env, rho_struct, xc_section, vxc_rho, vxc_tau, exc, TYPE(cell_type), POINTER :: cell TYPE(dft_control_type), POINTER :: dft_control TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g, rho_m_gspace, rho_struct_g + TYPE(pw_c1d_type), POINTER :: rho_nlcc_g, tmp_g, tmp_g2 TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool, vdw_pw_pool, xc_pw_pool - TYPE(pw_type), DIMENSION(:), POINTER :: my_vxc_rho, my_vxc_tau, rho_g, & - rho_m_gspace, rho_m_rspace, rho_r, & - rho_struct_g, rho_struct_r, tau, & - tau_struct_r - TYPE(pw_type), POINTER :: rho_nlcc, rho_nlcc_g, tmp_g, tmp_g2, & - tmp_pw + TYPE(pw_type), DIMENSION(:), POINTER :: my_vxc_rho, my_vxc_tau, rho_m_rspace, & + rho_r, rho_struct_r, tau, tau_struct_r + TYPE(pw_type), POINTER :: rho_nlcc, tmp_pw TYPE(virial_type), POINTER :: virial CALL timeset(routineN, handle) @@ -247,13 +246,11 @@ SUBROUTINE qs_vxc_create(ks_env, rho_struct, xc_section, vxc_rho, vxc_tau, exc, ALLOCATE (rho_r(mspin)) ALLOCATE (rho_g(mspin)) DO ispin = 1, mspin - CALL xc_pw_pool%create_pw(rho_g(ispin), & - in_space=RECIPROCALSPACE, use_data=COMPLEXDATA1D) + CALL xc_pw_pool%create_pw(rho_g(ispin), in_space=RECIPROCALSPACE) CALL pw_transfer(rho_struct_g(ispin), rho_g(ispin)) END DO DO ispin = 1, mspin - CALL xc_pw_pool%create_pw(rho_r(ispin), & - in_space=REALSPACE, use_data=REALDATA3D) + CALL xc_pw_pool%create_pw(rho_r(ispin), REALDATA3D, in_space=REALSPACE) CALL pw_transfer(rho_g(ispin), rho_r(ispin)) END DO IF (tau_r_valid) THEN @@ -369,7 +366,6 @@ SUBROUTINE qs_vxc_create(ks_env, rho_struct, xc_section, vxc_rho, vxc_tau, exc, IF (dft_control%sic_method_id .EQ. sic_mauri_spz .AND. .NOT. sic_scaling_b_zero) THEN ALLOCATE (rho_m_rspace(2), rho_m_gspace(2)) CALL xc_pw_pool%create_pw(rho_m_gspace(1), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL xc_pw_pool%create_pw(rho_m_rspace(1), & use_data=REALDATA3D, & @@ -380,7 +376,6 @@ SUBROUTINE qs_vxc_create(ks_env, rho_struct, xc_section, vxc_rho, vxc_tau, exc, CALL pw_axpy(rho_struct_g(2), rho_m_gspace(1), alpha=-1._dp) ! bit sad, these will be just zero... CALL xc_pw_pool%create_pw(rho_m_gspace(2), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL xc_pw_pool%create_pw(rho_m_rspace(2), & use_data=REALDATA3D, & @@ -432,7 +427,6 @@ SUBROUTINE qs_vxc_create(ks_env, rho_struct, xc_section, vxc_rho, vxc_tau, exc, ALLOCATE (rho_m_rspace(2), rho_m_gspace(2)) DO ispin = 1, 2 CALL xc_pw_pool%create_pw(rho_m_gspace(ispin), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL xc_pw_pool%create_pw(rho_m_rspace(ispin), & use_data=REALDATA3D, & @@ -533,11 +527,10 @@ SUBROUTINE qs_vxc_create(ks_env, rho_struct, xc_section, vxc_rho, vxc_tau, exc, ! IF (uf_grid .AND. (ASSOCIATED(vxc_rho) .OR. ASSOCIATED(vxc_tau))) THEN BLOCK - TYPE(pw_type) :: tmp_pw, tmp_g, tmp_g2 - CALL xc_pw_pool%create_pw(tmp_g, & - in_space=RECIPROCALSPACE, use_data=COMPLEXDATA1D) - CALL auxbas_pw_pool%create_pw(tmp_g2, & - in_space=RECIPROCALSPACE, use_data=COMPLEXDATA1D) + TYPE(pw_type) :: tmp_pw + TYPE(pw_c1d_type) :: tmp_g, tmp_g2 + CALL xc_pw_pool%create_pw(tmp_g, in_space=RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(tmp_g2, in_space=RECIPROCALSPACE) IF (ASSOCIATED(vxc_rho)) THEN DO ispin = 1, SIZE(vxc_rho) CALL auxbas_pw_pool%create_pw(tmp_pw, & @@ -608,11 +601,13 @@ SUBROUTINE qs_xc_density(ks_env, rho_struct, xc_section, dispersion_env, & TYPE(cell_type), POINTER :: cell TYPE(dft_control_type), POINTER :: dft_control TYPE(mp_para_env_type), POINTER :: para_env + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_c1d_type), POINTER :: rho_nlcc_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool, vdw_pw_pool, xc_pw_pool TYPE(pw_type) :: exc_r - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r, tau_r, vxc_rho, vxc_tau - TYPE(pw_type), POINTER :: rho_nlcc, rho_nlcc_g + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, tau_r, vxc_rho, vxc_tau + TYPE(pw_type), POINTER :: rho_nlcc CALL timeset(routineN, handle) diff --git a/src/qs_wf_history_methods.F b/src/qs_wf_history_methods.F index c7daf24a8a..8c4de56cf8 100644 --- a/src/qs_wf_history_methods.F +++ b/src/qs_wf_history_methods.F @@ -62,10 +62,10 @@ MODULE qs_wf_history_methods pw_env_type USE pw_methods, ONLY: pw_copy USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_density_matrices, ONLY: calculate_density_matrix USE qs_environment_types, ONLY: get_qs_env,& @@ -148,9 +148,10 @@ SUBROUTINE wfs_update(snapshot, wf_history, qs_env, dt) TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_kp TYPE(dft_control_type), POINTER :: dft_control TYPE(mo_set_type), DIMENSION(:), POINTER :: mos + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r TYPE(qs_rho_type), POINTER :: rho CALL timeset(routineN, handle) @@ -214,8 +215,7 @@ SUBROUTINE wfs_update(snapshot, wf_history, qs_env, dt) IF (.NOT. ASSOCIATED(snapshot%rho_g)) THEN ALLOCATE (snapshot%rho_g(nspins)) DO ispin = 1, nspins - CALL auxbas_pw_pool%create_pw(snapshot%rho_g(ispin), & - in_space=RECIPROCALSPACE, use_data=COMPLEXDATA1D) + CALL auxbas_pw_pool%create_pw(snapshot%rho_g(ispin), RECIPROCALSPACE) END DO END IF DO ispin = 1, nspins diff --git a/src/qs_wf_history_types.F b/src/qs_wf_history_types.F index 1c0f353c21..219dd673de 100644 --- a/src/qs_wf_history_types.F +++ b/src/qs_wf_history_types.F @@ -21,7 +21,8 @@ MODULE qs_wf_history_types dbcsr_p_type,& dbcsr_type USE kinds, ONLY: dp - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_rho_types, ONLY: qs_rho_release,& qs_rho_type #include "./base/base_uses.f90" @@ -57,7 +58,7 @@ MODULE qs_wf_history_types TYPE qs_wf_snapshot_type TYPE(cp_fm_type), DIMENSION(:), POINTER :: wf TYPE(pw_type), DIMENSION(:), POINTER :: rho_r - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_kp TYPE(dbcsr_type), POINTER :: overlap diff --git a/src/response_solver.F b/src/response_solver.F index a013c4bd95..a9c027f941 100644 --- a/src/response_solver.F +++ b/src/response_solver.F @@ -94,8 +94,7 @@ MODULE response_solver USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& pw_c1d_type,& @@ -866,16 +865,19 @@ SUBROUTINE response_force(qs_env, vh_rspace, vxc_rspace, vtau_rspace, vadmm_rspa sap_ppnl TYPE(oce_matrix_type), POINTER :: oce TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: rho_tot_gspace, rho_tot_gspace_gs, rho_tot_gspace_t, rhoz_tot_gspace, & + v_hartree_gspace_gs, v_hartree_gspace_t, zv_hartree_gspace + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g_aux, rho_g_gs, rho_g_t, rhoz_g, & + rhoz_g_aux, rhoz_g_xc 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 - TYPE(pw_type) :: rho_tot_gspace, rho_tot_gspace_gs, rho_tot_gspace_t, rhoz_tot_gspace, & - v_hartree_gspace_gs, v_hartree_gspace_t, v_hartree_rspace_gs, v_hartree_rspace_t, & - vhxc_rspace, zv_hartree_gspace, zv_hartree_rspace - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g_aux, rho_g_gs, rho_g_t, rho_r_aux, rho_r_gs, & - rho_r_t, rhoz_g, rhoz_g_aux, rhoz_g_xc, rhoz_r, rhoz_r_aux, rhoz_r_xc, tau_r_aux, tauz_r, & - tauz_r_xc, v_xc, v_xc_tau + TYPE(pw_type) :: v_hartree_rspace_gs, v_hartree_rspace_t, & + vhxc_rspace, zv_hartree_rspace + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r_aux, rho_r_gs, rho_r_t, rhoz_r, & + rhoz_r_aux, rhoz_r_xc, tau_r_aux, & + tauz_r, tauz_r_xc, v_xc, v_xc_tau TYPE(qs_force_type), DIMENSION(:), POINTER :: force TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_ks_env_type), POINTER :: ks_env @@ -1196,10 +1198,10 @@ SUBROUTINE response_force(qs_env, vh_rspace, vxc_rspace, vtau_rspace, vadmm_rspa CALL auxbas_pw_pool%create_pw(rho_r_gs(ispin), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rho_g_gs(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO CALL auxbas_pw_pool%create_pw(rho_tot_gspace_gs, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) ! compute soft GS density total_rho_gs = 0.0_dp CALL pw_zero(rho_tot_gspace_gs) @@ -1221,7 +1223,7 @@ SUBROUTINE response_force(qs_env, vh_rspace, vxc_rspace, vtau_rspace, vadmm_rspa END IF ! compute GS potential CALL auxbas_pw_pool%create_pw(v_hartree_gspace_gs, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_hartree_rspace_gs, & use_data=REALDATA3D, in_space=REALSPACE) NULLIFY (hartree_local_gs) @@ -1447,14 +1449,14 @@ SUBROUTINE response_force(qs_env, vh_rspace, vxc_rspace, vtau_rspace, vadmm_rspa CALL auxbas_pw_pool%create_pw(rhoz_r(ispin), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rhoz_g(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO CALL auxbas_pw_pool%create_pw(rhoz_tot_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(zv_hartree_rspace, & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(zv_hartree_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_zero(rhoz_tot_gspace) DO ispin = 1, nspins @@ -1470,7 +1472,7 @@ SUBROUTINE response_force(qs_env, vh_rspace, vxc_rspace, vtau_rspace, vadmm_rspa CALL auxbas_pw_pool%create_pw(rhoz_r_xc(ispin), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rhoz_g_xc(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO DO ispin = 1, nspins CALL calculate_rho_elec(ks_env=ks_env, matrix_p=mpa(ispin)%matrix, & @@ -1482,10 +1484,9 @@ SUBROUTINE response_force(qs_env, vh_rspace, vxc_rspace, vtau_rspace, vadmm_rspa IF (ASSOCIATED(vtau_rspace)) THEN CPASSERT(.NOT. (gapw .OR. gapw_xc)) BLOCK - TYPE(pw_type) :: work_g + TYPE(pw_c1d_type) :: work_g ALLOCATE (tauz_r(nspins)) - CALL auxbas_pw_pool%create_pw(work_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(work_g, in_space=RECIPROCALSPACE) DO ispin = 1, nspins CALL auxbas_pw_pool%create_pw(tauz_r(ispin), & use_data=REALDATA3D, in_space=REALSPACE) @@ -1511,7 +1512,7 @@ SUBROUTINE response_force(qs_env, vh_rspace, vxc_rspace, vtau_rspace, vadmm_rspa CALL get_qs_env(qs_env, rho=rho) CALL auxbas_pw_pool%create_pw(rho_tot_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) ! Get the total input density in g-space [ions + electrons] CALL calc_rho_tot_gspace(rho_tot_gspace, qs_env, rho) @@ -1668,10 +1669,10 @@ SUBROUTINE response_force(qs_env, vh_rspace, vxc_rspace, vtau_rspace, vadmm_rspa CALL auxbas_pw_pool%create_pw(rho_r_t(ispin), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rho_g_t(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO CALL auxbas_pw_pool%create_pw(rho_tot_gspace_t, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) total_rho_t = 0.0_dp CALL pw_zero(rho_tot_gspace_t) DO ispin = 1, nspins @@ -1687,7 +1688,7 @@ SUBROUTINE response_force(qs_env, vh_rspace, vxc_rspace, vtau_rspace, vadmm_rspa CALL pw_axpy(local_rho_set_t%rho0_mpole%rho0_s_gs, rho_tot_gspace_t) ! compute response Coulomb potential CALL auxbas_pw_pool%create_pw(v_hartree_gspace_t, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(v_hartree_rspace_t, & use_data=REALDATA3D, in_space=REALSPACE) NULLIFY (hartree_local_t) @@ -2073,7 +2074,7 @@ SUBROUTINE response_force(qs_env, vh_rspace, vxc_rspace, vtau_rspace, vadmm_rspa CALL auxbas_pw_pool%create_pw(rhoz_r_aux(ispin), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rhoz_g_aux(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO DO ispin = 1, nspins CALL calculate_rho_elec(ks_env=ks_env, matrix_p=mpz(ispin, 1)%matrix, & diff --git a/src/ri_environment_methods.F b/src/ri_environment_methods.F index c07d021c62..4f0d991446 100644 --- a/src/ri_environment_methods.F +++ b/src/ri_environment_methods.F @@ -39,7 +39,8 @@ MODULE ri_environment_methods lri_kind_type USE message_passing, ONLY: mp_comm_type,& mp_para_env_type - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_collocate_density, ONLY: calculate_lri_rho_elec USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type,& @@ -372,7 +373,8 @@ SUBROUTINE calculate_ri_densities(lri_env, qs_env, pmatrix, & REAL(KIND=dp), DIMENSION(:, :), POINTER :: avec TYPE(lri_density_type), POINTER :: lri_density TYPE(lri_kind_type), DIMENSION(:), POINTER :: lri_coef - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r CALL timeset(routineN, handle) diff --git a/src/rpa_gw.F b/src/rpa_gw.F index 59ec54953d..fc02f53a31 100644 --- a/src/rpa_gw.F +++ b/src/rpa_gw.F @@ -111,10 +111,10 @@ MODULE rpa_gw pw_scale,& pw_zero USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_band_structure, ONLY: calculate_kp_orbitals USE qs_collocate_density, ONLY: calculate_rho_elec @@ -2205,9 +2205,9 @@ SUBROUTINE print_local_bandgap(qs_env, Eigenval, gw_corr_lev_occ, gw_corr_lev_vi CHARACTER(LEN=*), PARAMETER :: routineN = 'print_local_bandgap' INTEGER :: handle, i_E + TYPE(pw_c1d_type) :: rho_g_dummy TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: E_CBM_rspace, E_gap_rspace, & - E_VBM_rspace, rho_g_dummy + TYPE(pw_type) :: E_CBM_rspace, E_gap_rspace, E_VBM_rspace TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: LDOS CALL timeset(routineN, handle) @@ -2246,8 +2246,8 @@ END SUBROUTINE print_local_bandgap ! ************************************************************************************************** SUBROUTINE calculate_E_gap_rspace(E_gap_rspace, E_VBM_rspace, E_CBM_rspace, rho_g_dummy, & LDOS, qs_env, Eigenval, gw_corr_lev_occ, gw_corr_lev_virt, homo, dft_gw_char) - TYPE(pw_type) :: E_gap_rspace, E_VBM_rspace, & - E_CBM_rspace, rho_g_dummy + TYPE(pw_type) :: E_gap_rspace, E_VBM_rspace, E_CBM_rspace + TYPE(pw_c1d_type) :: rho_g_dummy TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: LDOS TYPE(qs_environment_type), POINTER :: qs_env REAL(KIND=dp), DIMENSION(:, :, :), INTENT(IN) :: Eigenval @@ -2503,8 +2503,8 @@ END SUBROUTINE print_file !> \param qs_env ... ! ************************************************************************************************** SUBROUTINE create_real_space_grids(E_gap_rspace, E_VBM_rspace, E_CBM_rspace, rho_g_dummy, LDOS, auxbas_pw_pool, qs_env) - TYPE(pw_type) :: E_gap_rspace, E_VBM_rspace, & - E_CBM_rspace, rho_g_dummy + TYPE(pw_type) :: E_gap_rspace, E_VBM_rspace, E_CBM_rspace + TYPE(pw_c1d_type) :: rho_g_dummy TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: LDOS TYPE(pw_pool_type), POINTER :: auxbas_pw_pool TYPE(qs_environment_type), POINTER :: qs_env @@ -2524,7 +2524,7 @@ SUBROUTINE create_real_space_grids(E_gap_rspace, E_VBM_rspace, E_CBM_rspace, rho CALL auxbas_pw_pool%create_pw(E_gap_rspace, use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(E_VBM_rspace, use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(E_CBM_rspace, use_data=REALDATA3D, in_space=REALSPACE) - CALL auxbas_pw_pool%create_pw(rho_g_dummy, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(rho_g_dummy, in_space=RECIPROCALSPACE) n_E = INT(mp2_env%ri_g0w0%energy_window_print_loc_bandgap/ & mp2_env%ri_g0w0%energy_spacing_print_loc_bandgap) diff --git a/src/rpa_im_time_force_methods.F b/src/rpa_im_time_force_methods.F index 691a543fc1..679a364ac2 100644 --- a/src/rpa_im_time_force_methods.F +++ b/src/rpa_im_time_force_methods.F @@ -112,10 +112,10 @@ MODULE rpa_im_time_force_methods USE pw_poisson_methods, ONLY: pw_poisson_solve USE pw_poisson_types, ONLY: pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_rho_elec,& calculate_wavefunction @@ -2421,17 +2421,18 @@ SUBROUTINE prepare_for_response(force_data, qs_env) matrix_s_aux, work_admm TYPE(dbcsr_type) :: dbcsr_work TYPE(dft_control_type), POINTER :: dft_control + TYPE(pw_c1d_type) :: rhoz_tot_gspace, zv_hartree_gspace + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rhoz_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rhoz_tot_gspace, zv_hartree_gspace, & - zv_hartree_rspace - TYPE(pw_type), DIMENSION(:), POINTER :: rhoz_g, rhoz_r, tauz_r, v_xc, v_xc_tau + TYPE(pw_type) :: zv_hartree_rspace + TYPE(pw_type), DIMENSION(:), POINTER :: rhoz_r, tauz_r, v_xc, v_xc_tau TYPE(qs_rho_type), POINTER :: rho, rho_aux_fit TYPE(section_vals_type), POINTER :: hfx_section, xc_section TYPE(task_list_type), POINTER :: task_list_aux_fit - NULLIFY (pw_env, rhoz_g, rhoz_r, tauz_r, v_xc, v_xc_tau, & + NULLIFY (pw_env, rhoz_r, rhoz_g, tauz_r, v_xc, v_xc_tau, & poisson_env, auxbas_pw_pool, dft_control, admm_env, xc_section, rho, rho_aux_fit, & task_list_aux_fit, ker_tau_admm, work_admm, dbcsr_p_work, matrix_s, hfx_section) @@ -2455,14 +2456,14 @@ SUBROUTINE prepare_for_response(force_data, qs_env) CALL auxbas_pw_pool%create_pw(rhoz_r(ispin), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rhoz_g(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO CALL auxbas_pw_pool%create_pw(rhoz_tot_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(zv_hartree_rspace, & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(zv_hartree_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_zero(rhoz_tot_gspace) DO ispin = 1, nspins @@ -2480,10 +2481,9 @@ SUBROUTINE prepare_for_response(force_data, qs_env) CALL qs_rho_get(rho, tau_r_valid=do_tau) IF (do_tau) THEN BLOCK - TYPE(pw_type) :: tauz_g + TYPE(pw_c1d_type) :: tauz_g ALLOCATE (tauz_r(nspins)) - CALL auxbas_pw_pool%create_pw(tauz_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(tauz_g, in_space=RECIPROCALSPACE) DO ispin = 1, nspins CALL auxbas_pw_pool%create_pw(tauz_r(ispin), & use_data=REALDATA3D, in_space=REALSPACE) @@ -2579,9 +2579,8 @@ SUBROUTINE prepare_for_response(force_data, qs_env) IF (do_tau_admm) THEN BLOCK - TYPE(pw_type) :: tauz_g - CALL auxbas_pw_pool%create_pw(tauz_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + TYPE(pw_c1d_type) :: tauz_g + CALL auxbas_pw_pool%create_pw(tauz_g, in_space=RECIPROCALSPACE) DO ispin = 1, nspins CALL pw_zero(tauz_r(ispin)) CALL calculate_rho_elec(ks_env=qs_env%ks_env, matrix_p=ker_tau_admm(ispin)%matrix, & @@ -2723,11 +2722,11 @@ SUBROUTINE get_2c_gpw_forces(G_PQ, force, h_stress, use_virial, mp2_env, qs_env) TYPE(neighbor_list_set_p_type), DIMENSION(:), & POINTER :: sab_orb TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: dvg(3), pot_g, rho_g, rho_g_copy TYPE(pw_env_type), POINTER :: pw_env_ext TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: dvg(3), pot_g, psi_L, rho_g, rho_g_copy, & - rho_r + TYPE(pw_type) :: psi_L, rho_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(realspace_grid_type), DIMENSION(:), POINTER :: rs_v TYPE(task_list_type), POINTER :: task_list_ext @@ -2810,11 +2809,9 @@ SUBROUTINE get_2c_gpw_forces(G_PQ, force, h_stress, use_virial, mp2_env, qs_env) IF (use_virial) THEN CALL auxbas_pw_pool%create_pw(rho_g_copy, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) DO i_xyz = 1, 3 CALL auxbas_pw_pool%create_pw(dvg(i_xyz), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) END DO END IF @@ -3168,13 +3165,14 @@ SUBROUTINE update_im_time_forces(p_env, matrix_hz, matrix_p_F, matrix_p_F_admm, 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) :: rho_tot_gspace, rhoz_tot_gspace, & + zv_hartree_gspace + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rhoz_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rho_tot_gspace, rhoz_tot_gspace, & - vh_rspace, vhxc_rspace, & - zv_hartree_gspace, zv_hartree_rspace - TYPE(pw_type), DIMENSION(:), POINTER :: rhoz_g, rhoz_r, tauz_r, v_xc, v_xc_tau, & + TYPE(pw_type) :: vh_rspace, vhxc_rspace, zv_hartree_rspace + TYPE(pw_type), DIMENSION(:), POINTER :: rhoz_r, tauz_r, v_xc, v_xc_tau, & vadmm_rspace, vtau_rspace, vxc_rspace TYPE(qs_force_type), DIMENSION(:), POINTER :: force TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set @@ -3495,14 +3493,14 @@ SUBROUTINE update_im_time_forces(p_env, matrix_hz, matrix_p_F, matrix_p_F_admm, CALL auxbas_pw_pool%create_pw(rhoz_r(ispin), & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(rhoz_g(ispin), & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END DO CALL auxbas_pw_pool%create_pw(rhoz_tot_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL auxbas_pw_pool%create_pw(zv_hartree_rspace, & use_data=REALDATA3D, in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(zv_hartree_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_zero(rhoz_tot_gspace) DO ispin = 1, nspins @@ -3515,7 +3513,7 @@ SUBROUTINE update_im_time_forces(p_env, matrix_hz, matrix_p_F, matrix_p_F_admm, CALL get_qs_env(qs_env, rho=rho) CALL auxbas_pw_pool%create_pw(rho_tot_gspace, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL calc_rho_tot_gspace(rho_tot_gspace, qs_env, rho) @@ -3544,9 +3542,8 @@ SUBROUTINE update_im_time_forces(p_env, matrix_hz, matrix_p_F, matrix_p_F_admm, IF (do_tau) THEN BLOCK - TYPE(pw_type) :: tauz_g - CALL auxbas_pw_pool%create_pw(tauz_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + TYPE(pw_c1d_type) :: tauz_g + CALL auxbas_pw_pool%create_pw(tauz_g, in_space=RECIPROCALSPACE) ALLOCATE (tauz_r(nspins)) DO ispin = 1, nspins CALL auxbas_pw_pool%create_pw(tauz_r(ispin), & @@ -3660,9 +3657,8 @@ SUBROUTINE update_im_time_forces(p_env, matrix_hz, matrix_p_F, matrix_p_F_admm, IF (do_tau_admm) THEN BLOCK - TYPE(pw_type) :: tauz_g - CALL auxbas_pw_pool%create_pw(tauz_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + TYPE(pw_c1d_type) :: tauz_g + CALL auxbas_pw_pool%create_pw(tauz_g, in_space=RECIPROCALSPACE) DO ispin = 1, nspins CALL pw_zero(tauz_r(ispin)) CALL calculate_rho_elec(ks_env=qs_env%ks_env, matrix_p=current_density(ispin)%matrix, & diff --git a/src/rtp_admm_methods.F b/src/rtp_admm_methods.F index d10e84cf5f..095c714b25 100644 --- a/src/rtp_admm_methods.F +++ b/src/rtp_admm_methods.F @@ -41,7 +41,8 @@ MODULE rtp_admm_methods zero USE message_passing, ONLY: mp_para_env_type USE parallel_gemm_api, ONLY: parallel_gemm - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type USE qs_collocate_density, ONLY: calculate_rho_elec USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type,& @@ -96,7 +97,8 @@ SUBROUTINE rtp_admm_calc_rho_aux(qs_env) TYPE(dft_control_type), POINTER :: dft_control TYPE(mo_set_type), DIMENSION(:), POINTER :: mos, mos_aux_fit TYPE(mp_para_env_type), POINTER :: para_env - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g_aux, rho_r_aux + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g_aux + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r_aux TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho, rho_aux_fit TYPE(rt_prop_type), POINTER :: rtp diff --git a/src/spme.F b/src/spme.F index 36a854857d..00db3a19d0 100644 --- a/src/spme.F +++ b/src/spme.F @@ -43,10 +43,10 @@ MODULE spme USE pw_poisson_types, ONLY: greens_fn_type,& pw_poisson_type USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE realspace_grid_types, ONLY: realspace_grid_desc_type,& realspace_grid_type,& @@ -125,11 +125,12 @@ SUBROUTINE spme_evaluate(ewald_env, ewald_pw, box, particle_set, & REAL(KIND=dp), DIMENSION(3, 3) :: f_stress, h_stress TYPE(greens_fn_type), POINTER :: green TYPE(mp_comm_type) :: group + TYPE(pw_c1d_type), DIMENSION(3) :: dphi_g + TYPE(pw_c1d_type), POINTER :: phi_g, rhob_g TYPE(pw_grid_type), POINTER :: grid_spme TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: pw_pool - TYPE(pw_type), DIMENSION(3) :: dphi_g - TYPE(pw_type), POINTER :: phi_g, rhob_g, rhob_r + TYPE(pw_type), POINTER :: rhob_r TYPE(realspace_grid_desc_type), POINTER :: rs_desc TYPE(realspace_grid_type), DIMENSION(3) :: drpot TYPE(realspace_grid_type), POINTER :: rden, rpot @@ -227,7 +228,6 @@ SUBROUTINE spme_evaluate(ewald_env, ewald_pw, box, particle_set, & NULLIFY (rhob_g) ALLOCATE (rhob_g) CALL pw_pool%create_pw(rhob_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_transfer(rhob_r, rhob_g) ! update charge function @@ -237,13 +237,11 @@ SUBROUTINE spme_evaluate(ewald_env, ewald_pw, box, particle_set, & ! allocate intermediate arrays DO i = 1, 3 CALL pw_pool%create_pw(dphi_g(i), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) END DO NULLIFY (phi_g) ALLOCATE (phi_g) CALL pw_pool%create_pw(phi_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_poisson_solve(poisson_env, rhob_g, vg_coulomb, phi_g, dphi_g, & h_stress) @@ -309,10 +307,10 @@ SUBROUTINE spme_evaluate(ewald_env, ewald_pw, box, particle_set, & ffb = 1.0_dp/fourpi DO i = 1, 3 DO ig = grid_spme%first_gne0, grid_spme%ngpts_cut_local - phi_g%cc(ig) = ffb*dphi_g(i)%cc(ig)*(ffa*grid_spme%gsq(ig) + 1.0_dp) - phi_g%cc(ig) = phi_g%cc(ig)*poisson_env%green_fft%influence_fn%array(ig) + phi_g%array(ig) = ffb*dphi_g(i)%array(ig)*(ffa*grid_spme%gsq(ig) + 1.0_dp) + phi_g%array(ig) = phi_g%array(ig)*poisson_env%green_fft%influence_fn%array(ig) END DO - IF (grid_spme%have_g0) phi_g%cc(1) = 0.0_dp + IF (grid_spme%have_g0) phi_g%array(1) = 0.0_dp DO j = 1, i nd = 0 nd(j) = 1 @@ -493,10 +491,11 @@ SUBROUTINE spme_potential(ewald_env, ewald_pw, box, particle_set_a, charges_a, & REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: rhos TYPE(greens_fn_type), POINTER :: green TYPE(mp_comm_type) :: group + TYPE(pw_c1d_type), POINTER :: phi_g, rhob_g TYPE(pw_grid_type), POINTER :: grid_spme TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: pw_pool - TYPE(pw_type), POINTER :: phi_g, rhob_g, rhob_r + TYPE(pw_type), POINTER :: rhob_r TYPE(realspace_grid_desc_type), POINTER :: rs_desc TYPE(realspace_grid_type), POINTER :: rden, rpot @@ -552,7 +551,6 @@ SUBROUTINE spme_potential(ewald_env, ewald_pw, box, particle_set_a, charges_a, & NULLIFY (rhob_g) ALLOCATE (rhob_g) CALL pw_pool%create_pw(rhob_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_transfer(rhob_r, rhob_g) ! update charge function @@ -563,7 +561,6 @@ SUBROUTINE spme_potential(ewald_env, ewald_pw, box, particle_set_a, charges_a, & NULLIFY (phi_g) ALLOCATE (phi_g) CALL pw_pool%create_pw(phi_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_poisson_solve(poisson_env, density=rhob_g, vhartree=phi_g) !---------- END OF ELECTROSTATIC CALCULATION -------- @@ -640,11 +637,12 @@ SUBROUTINE spme_forces(ewald_env, ewald_pw, box, particle_set_a, charges_a, & REAL(KIND=dp), DIMENSION(3) :: fat TYPE(greens_fn_type), POINTER :: green TYPE(mp_comm_type) :: group + TYPE(pw_c1d_type), DIMENSION(3) :: dphi_g + TYPE(pw_c1d_type), POINTER :: phi_g, rhob_g TYPE(pw_grid_type), POINTER :: grid_spme TYPE(pw_poisson_type), POINTER :: poisson_env TYPE(pw_pool_type), POINTER :: pw_pool - TYPE(pw_type), DIMENSION(3) :: dphi_g - TYPE(pw_type), POINTER :: phi_g, rhob_g, rhob_r + TYPE(pw_type), POINTER :: rhob_r TYPE(realspace_grid_desc_type), POINTER :: rs_desc TYPE(realspace_grid_type), DIMENSION(3) :: drpot TYPE(realspace_grid_type), POINTER :: rden @@ -701,7 +699,6 @@ SUBROUTINE spme_forces(ewald_env, ewald_pw, box, particle_set_a, charges_a, & NULLIFY (rhob_g) ALLOCATE (rhob_g) CALL pw_pool%create_pw(rhob_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_transfer(rhob_r, rhob_g) ! update charge function @@ -711,13 +708,11 @@ SUBROUTINE spme_forces(ewald_env, ewald_pw, box, particle_set_a, charges_a, & ! allocate intermediate arrays DO i = 1, 3 CALL pw_pool%create_pw(dphi_g(i), & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) END DO NULLIFY (phi_g) ALLOCATE (phi_g) CALL pw_pool%create_pw(phi_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_poisson_solve(poisson_env, density=rhob_g, vhartree=phi_g, & dvhartree=dphi_g) diff --git a/src/stm_images.F b/src/stm_images.F index ff1f4e49da..f418c07eaf 100644 --- a/src/stm_images.F +++ b/src/stm_images.F @@ -45,10 +45,10 @@ MODULE stm_images pw_env_type USE pw_pool_types, ONLY: pw_pool_p_type,& pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_rho_elec USE qs_environment_types, ONLY: get_qs_env,& @@ -114,10 +114,11 @@ SUBROUTINE th_stm_image(qs_env, stm_section, particles, unoccupied_orbs, & TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao TYPE(dbcsr_type), POINTER :: stm_density_ao TYPE(mo_set_type), DIMENSION(:), POINTER :: mos + TYPE(pw_c1d_type) :: wf_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: wf_g, wf_r + TYPE(pw_type) :: wf_r TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho @@ -161,7 +162,6 @@ SUBROUTINE th_stm_image(qs_env, stm_section, particles, unoccupied_orbs, & use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(wf_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) nspin = SIZE(mos, 1) @@ -260,7 +260,8 @@ SUBROUTINE stm_cubes(ks_env, stm_section, stm_density_ao, wf_r, wf_g, mo_arrays, TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(section_vals_type), POINTER :: stm_section TYPE(dbcsr_type), POINTER :: stm_density_ao - TYPE(pw_type), INTENT(INOUT) :: wf_r, wf_g + TYPE(pw_type), INTENT(INOUT) :: wf_r + TYPE(pw_c1d_type), INTENT(INOUT) :: wf_g TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: mo_arrays TYPE(cp_1d_r_p_type), DIMENSION(:), INTENT(IN) :: evals, occupation REAL(KIND=dp) :: efermi diff --git a/src/surface_dipole.F b/src/surface_dipole.F index 134c79f7b7..6079a2149e 100644 --- a/src/surface_dipole.F +++ b/src/surface_dipole.F @@ -74,13 +74,13 @@ SUBROUTINE calc_dipsurf_potential(qs_env, energy) REAL(dp), ALLOCATABLE, DIMENSION(:) :: rhoavsurf TYPE(cell_type), POINTER :: cell TYPE(dft_control_type), POINTER :: dft_control - TYPE(pw_c1d_type), POINTER :: rho_core + TYPE(pw_c1d_type), POINTER :: rho0_s_gs, rho_core TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools TYPE(pw_pool_type), POINTER :: auxbas_pw_pool TYPE(pw_type) :: vdip_r, wf_r TYPE(pw_type), DIMENSION(:), POINTER :: rho_r - TYPE(pw_type), POINTER :: rho0_s_gs, v_hartree_rspace + TYPE(pw_type), POINTER :: v_hartree_rspace TYPE(qs_rho_type), POINTER :: rho TYPE(qs_subsys_type), POINTER :: subsys diff --git a/src/tip_scan_methods.F b/src/tip_scan_methods.F index fcbb643f91..8e80b289c8 100644 --- a/src/tip_scan_methods.F +++ b/src/tip_scan_methods.F @@ -26,14 +26,15 @@ MODULE tip_scan_methods pw_grid_release,& pw_grid_setup USE pw_methods, ONLY: pw_axpy,& + pw_multiply_with,& pw_structure_factor,& pw_transfer,& pw_zero USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -84,9 +85,9 @@ SUBROUTINE tip_scanning(qs_env, input_section) TYPE(dft_control_type), POINTER :: dft_control TYPE(mo_set_type), ALLOCATABLE, DIMENSION(:) :: mos_ref TYPE(mo_set_type), DIMENSION(:), POINTER :: mos + TYPE(pw_c1d_type) :: sf, vref TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: sf, vref TYPE(pw_type), POINTER :: vee, vtip TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(scanning_type) :: scan_env @@ -128,9 +129,9 @@ SUBROUTINE tip_scanning(qs_env, input_section) ALLOCATE (vtip) CALL auxbas_pw_pool%create_pw(vtip, REALDATA3D, REALSPACE) CALL pw_zero(vtip) - CALL auxbas_pw_pool%create_pw(vref, COMPLEXDATA1D, RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(vref, RECIPROCALSPACE) CALL pw_zero(vref) - CALL auxbas_pw_pool%create_pw(sf, COMPLEXDATA1D, RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(sf, RECIPROCALSPACE) ! get the reference tip potential and store it in reciprocal space (vref) CALL pw_transfer(scan_env%tip_pw_g, vref) @@ -225,7 +226,8 @@ END SUBROUTINE tip_scanning ! ************************************************************************************************** SUBROUTINE shift_tip_potential(vref, sf, vtip, rpos) - TYPE(pw_type), INTENT(INOUT) :: vref, sf, vtip + TYPE(pw_c1d_type), INTENT(INOUT) :: vref, sf + TYPE(pw_type), INTENT(INOUT) :: vtip REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: rpos CHARACTER(LEN=*), PARAMETER :: routineN = 'shift_tip_potential' @@ -235,7 +237,7 @@ SUBROUTINE shift_tip_potential(vref, sf, vtip, rpos) CALL timeset(routineN, handle) CALL pw_structure_factor(sf, rpos) - sf%cc = vref%cc*sf%cc + CALL pw_multiply_with(sf, vref) CALL pw_transfer(sf, vtip) CALL timestop(handle) @@ -296,7 +298,7 @@ SUBROUTINE read_tip_file(qs_env, scan_env) scaling = 0.1_dp !deb CALL cp_cube_to_pw(scan_env%tip_pw_r, scan_env%tip_cube_file, scaling, silent=.TRUE.) - CALL scan_env%tip_pw_g%create(pw_grid, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL scan_env%tip_pw_g%create(pw_grid, in_space=RECIPROCALSPACE) CALL pw_transfer(scan_env%tip_pw_r, scan_env%tip_pw_g) CALL pw_grid_release(pw_grid) diff --git a/src/tip_scan_types.F b/src/tip_scan_types.F index cd281c95e7..cfaffc6371 100644 --- a/src/tip_scan_types.F +++ b/src/tip_scan_types.F @@ -10,7 +10,8 @@ MODULE tip_scan_types section_vals_val_get USE kinds, ONLY: default_string_length,& dp - USE pw_types, ONLY: pw_type + USE pw_types, ONLY: pw_c1d_type,& + pw_type #include "./base/base_uses.f90" IMPLICIT NONE @@ -29,7 +30,7 @@ MODULE tip_scan_types ALLOCATABLE :: tip_pos CHARACTER(LEN=default_string_length) :: tip_cube_file TYPE(pw_type), POINTER :: tip_pw_r - TYPE(pw_type), POINTER :: tip_pw_g + TYPE(pw_c1d_type), POINTER :: tip_pw_g END TYPE scanning_type ! ************************************************************************************************** diff --git a/src/transport.F b/src/transport.F index 95c912dc6f..20fe6a38a5 100644 --- a/src/transport.F +++ b/src/transport.F @@ -62,10 +62,10 @@ MODULE transport pw_env_type USE pw_methods, ONLY: pw_zero USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type,& @@ -654,10 +654,12 @@ SUBROUTINE transport_current(input, qs_env) TYPE(dbcsr_type), POINTER :: zero TYPE(dft_control_type), POINTER :: dft_control TYPE(particle_list_type), POINTER :: particles + TYPE(pw_c1d_type) :: gs + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: gs, rs - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r + TYPE(pw_type) :: rs + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r TYPE(qs_rho_type), POINTER :: rho TYPE(qs_subsys_type), POINTER :: subsys TYPE(section_vals_type), POINTER :: dft_section @@ -695,7 +697,7 @@ SUBROUTINE transport_current(input, qs_env) current_env%gauge_init = .FALSE. CALL auxbas_pw_pool%create_pw(rs, use_data=REALDATA3D, in_space=REALSPACE) - CALL auxbas_pw_pool%create_pw(gs, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL auxbas_pw_pool%create_pw(gs, in_space=RECIPROCALSPACE) NULLIFY (zero) ALLOCATE (zero) diff --git a/src/xc/xc.F b/src/xc/xc.F index 67d361de8a..72432b7440 100644 --- a/src/xc/xc.F +++ b/src/xc/xc.F @@ -43,12 +43,12 @@ MODULE xc pw_zero, pw_integrate_function USE pw_pool_types, ONLY: & pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D, & - REALDATA3D, & - REALSPACE, & - RECIPROCALSPACE, & - pw_p_type, & - pw_type + USE pw_types, ONLY: & + REALDATA3D, & + REALSPACE, & + RECIPROCALSPACE, & + pw_p_type, & + pw_c1d_type, pw_type USE xc_derivative_desc, ONLY: & deriv_rho, deriv_rhoa, deriv_rhob, & deriv_norm_drhoa, deriv_norm_drhob, deriv_norm_drho, deriv_tau_a, deriv_tau_b, deriv_tau, & @@ -153,7 +153,8 @@ FUNCTION xc_uses_norm_drho(xc_fun_section, lsd) RESULT(res) SUBROUTINE xc_vxc_pw_create1(vxc_rho, vxc_tau, rho_r, rho_g, tau, exc, xc_section, & pw_pool, compute_virial, virial_xc, exc_r) TYPE(pw_type), DIMENSION(:), POINTER :: vxc_rho, vxc_tau - TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, rho_g, tau + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, tau + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g REAL(KIND=dp), INTENT(out) :: exc TYPE(section_vals_type), POINTER :: xc_section TYPE(pw_pool_type), POINTER :: pw_pool @@ -216,7 +217,8 @@ END SUBROUTINE xc_vxc_pw_create1 SUBROUTINE xc_vxc_pw_create_test_lsd(vxc_rho, vxc_tau, rho_r, rho_g, tau, & exc, xc_section, pw_pool) TYPE(pw_type), DIMENSION(:), POINTER :: vxc_rho, vxc_tau - TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, rho_g, tau + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, tau + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g REAL(KIND=dp), INTENT(out) :: exc TYPE(section_vals_type), POINTER :: xc_section TYPE(pw_pool_type), POINTER :: pw_pool @@ -232,7 +234,8 @@ SUBROUTINE xc_vxc_pw_create_test_lsd(vxc_rho, vxc_tau, rho_r, rho_g, tau, & REAL(kind=dp), DIMENSION(:, :, :), POINTER :: pot, pot2, pot3 TYPE(cp_sll_xc_deriv_type), POINTER :: deriv_iter TYPE(pw_type), DIMENSION(:), POINTER :: vxc_rho2, vxc_tau2 - TYPE(pw_type), DIMENSION(:), POINTER :: rho2_g, rho2_r, tau2 + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho2_g + TYPE(pw_type), DIMENSION(:), POINTER :: rho2_r, tau2 TYPE(xc_derivative_set_type) :: dSet1, dSet2 TYPE(xc_derivative_type), POINTER :: deriv, deriv2, deriv3 TYPE(xc_rho_set_type) :: rho_set1, rho_set2 @@ -553,7 +556,8 @@ END SUBROUTINE xc_vxc_pw_create_test_lsd SUBROUTINE xc_vxc_pw_create_debug(vxc_rho, vxc_tau, rho_r, rho_g, tau, exc, & xc_section, pw_pool) TYPE(pw_type), DIMENSION(:), POINTER :: vxc_rho, vxc_tau - TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, rho_g, tau + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, tau + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g REAL(KIND=dp), INTENT(out) :: exc TYPE(section_vals_type), POINTER :: xc_section TYPE(pw_pool_type), POINTER :: pw_pool @@ -845,7 +849,8 @@ SUBROUTINE xc_rho_set_and_dset_create(rho_set, deriv_set, deriv_order, & TYPE(xc_rho_set_type) :: rho_set TYPE(xc_derivative_set_type) :: deriv_set INTEGER, INTENT(in) :: deriv_order - TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, rho_g, tau + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, tau + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(section_vals_type), POINTER :: xc_section TYPE(pw_pool_type), POINTER :: pw_pool LOGICAL, INTENT(in) :: calc_potential @@ -1134,7 +1139,8 @@ SUBROUTINE xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section pw_pool, compute_virial, virial_xc, exc_r) TYPE(pw_type), DIMENSION(:), POINTER :: vxc_rho, vxc_tau REAL(KIND=dp), INTENT(out) :: exc - TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, rho_g, tau + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, tau + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(section_vals_type), POINTER :: xc_section TYPE(pw_pool_type), POINTER :: pw_pool LOGICAL :: compute_virial @@ -1158,7 +1164,8 @@ SUBROUTINE xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section TYPE(cp_sll_xc_deriv_type), POINTER :: pos TYPE(pw_grid_type), POINTER :: pw_grid TYPE(pw_type), DIMENSION(3) :: pw_to_deriv, pw_to_deriv_rho - TYPE(pw_type) :: tmp_g, v_drho_r, virial_pw, vxc_g + TYPE(pw_c1d_type) :: tmp_g, vxc_g + TYPE(pw_type) :: v_drho_r, virial_pw TYPE(xc_derivative_set_type) :: deriv_set TYPE(xc_derivative_type), POINTER :: deriv_att TYPE(xc_rho_set_type) :: rho_set @@ -1262,10 +1269,10 @@ SUBROUTINE xc_vxc_pw_create(vxc_rho, vxc_tau, exc, rho_r, rho_g, tau, xc_section IF ((has_gradient .AND. xc_requires_tmp_g(xc_deriv_method_id)) .OR. pw_grid%spherical) THEN CALL pw_pool%create_pw(vxc_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) IF (.NOT. pw_grid%spherical) THEN CALL pw_pool%create_pw(tmp_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END IF END IF @@ -1453,7 +1460,8 @@ END SUBROUTINE xc_vxc_pw_create ! ************************************************************************************************** FUNCTION xc_exc_calc(rho_r, rho_g, tau, xc_section, pw_pool) & RESULT(exc) - TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, rho_g, tau + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, tau + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(section_vals_type), POINTER :: xc_section TYPE(pw_pool_type), POINTER :: pw_pool REAL(kind=dp) :: exc @@ -1530,7 +1538,8 @@ SUBROUTINE xc_calc_2nd_deriv(v_xc, v_xc_tau, deriv_set, rho_set, rho1_r, rho1_g, TYPE(pw_type), DIMENSION(:), POINTER :: v_xc, v_xc_tau TYPE(xc_derivative_set_type) :: deriv_set TYPE(xc_rho_set_type) :: rho_set - TYPE(pw_type), DIMENSION(:), POINTER :: rho1_r, rho1_g, tau1_r + TYPE(pw_type), DIMENSION(:), POINTER :: rho1_r, tau1_r + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho1_g TYPE(pw_pool_type), INTENT(IN), POINTER :: pw_pool TYPE(section_vals_type), INTENT(IN), POINTER :: xc_section LOGICAL, INTENT(IN) :: gapw @@ -1664,7 +1673,8 @@ SUBROUTINE xc_calc_2nd_deriv_numerical(v_xc, v_tau, rho_set, rho1_r, rho1_g, tau TYPE(pw_type), DIMENSION(:), INTENT(IN), POINTER :: v_xc, v_tau TYPE(xc_rho_set_type), INTENT(IN) :: rho_set - TYPE(pw_type), DIMENSION(:), INTENT(IN), POINTER :: rho1_r, rho1_g, tau1_r + TYPE(pw_type), DIMENSION(:), INTENT(IN), POINTER :: rho1_r, tau1_r + TYPE(pw_c1d_type), DIMENSION(:), INTENT(IN), POINTER :: rho1_g TYPE(pw_pool_type), INTENT(IN), POINTER :: pw_pool TYPE(section_vals_type), INTENT(IN), POINTER :: xc_section LOGICAL, INTENT(IN) :: do_triplet @@ -1695,7 +1705,8 @@ SUBROUTINE xc_calc_2nd_deriv_numerical(v_xc, v_tau, rho_set, rho1_r, rho1_g, tau TYPE(cp_3d_r_cp_type), DIMENSION(3) :: drho, drho1, drho1a, drho1b, drhoa, drhob TYPE(pw_type) :: v_drho, v_drhoa, v_drhob TYPE(pw_type), DIMENSION(:), POINTER :: vxc_rho, vxc_tau - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r, tau_r + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, tau_r TYPE(pw_type) :: virial_pw, v_laplace, v_laplacea, v_laplaceb TYPE(section_vals_type), POINTER :: xc_fun_section TYPE(xc_derivative_set_type) :: deriv_set1 @@ -2304,7 +2315,8 @@ SUBROUTINE calc_resp_potential_numer_ab(rho_r, rho_g, rho1_r, rhoa, rhob, vxc_rh REAL(KIND=dp), INTENT(IN) :: step REAL(KIND=dp), DIMENSION(:, :, :), POINTER, INTENT(IN) :: rhoa, rhob, tau_a, tau_b TYPE(pw_type), DIMENSION(:), POINTER, INTENT(IN) :: rho_r - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, tau_r + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_type), DIMENSION(:), POINTER :: tau_r CHARACTER(len=*), PARAMETER :: routineN = 'calc_resp_potential_numer_ab' @@ -2669,7 +2681,8 @@ SUBROUTINE xc_calc_2nd_deriv_analytical(v_xc, v_xc_tau, deriv_set, rho_set, rho1 TYPE(cp_3d_r_cp_type), DIMENSION(3) :: drho, drho1, drho1a, drho1b, drhoa, drhob TYPE(pw_type), DIMENSION(:), ALLOCATABLE :: v_drhoa, v_drhob, v_drho, v_laplace TYPE(pw_type), DIMENSION(:, :), ALLOCATABLE :: v_drho_r - TYPE(pw_type) :: tmp_g, virial_pw, vxc_g + TYPE(pw_type) :: virial_pw + TYPE(pw_c1d_type) :: tmp_g, vxc_g TYPE(xc_derivative_type), POINTER :: deriv_att CALL timeset(routineN, handle) @@ -2721,9 +2734,9 @@ SUBROUTINE xc_calc_2nd_deriv_analytical(v_xc, v_xc_tau, deriv_set, rho_set, rho1 IF (xc_requires_tmp_g(xc_deriv_method_id) .AND. .NOT. my_gapw) THEN IF (ASSOCIATED(pw_pool)) THEN CALL pw_pool%create_pw(tmp_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_pool%create_pw(vxc_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) ELSE ! remember to refix for gapw CPABORT("XC_DERIV method is not implemented in GAPW") @@ -3172,7 +3185,8 @@ SUBROUTINE virial_laplace(rho_r, pw_pool, virial_xc, deriv_data) CHARACTER(len=*), PARAMETER :: routineN = 'virial_laplace' INTEGER :: handle, idir, jdir - TYPE(pw_type), POINTER :: virial_pw, tmp_g, rho_g + TYPE(pw_type), POINTER :: virial_pw + TYPE(pw_c1d_type), POINTER :: tmp_g, rho_g INTEGER, DIMENSION(3) :: my_deriv CALL timeset(routineN, handle) @@ -3183,9 +3197,9 @@ SUBROUTINE virial_laplace(rho_r, pw_pool, virial_xc, deriv_data) use_data=REALDATA3D, & in_space=REALSPACE) CALL pw_pool%create_pw(tmp_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_pool%create_pw(rho_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_zero(virial_pw) CALL pw_transfer(rho_r, rho_g) DO idir = 1, 3 @@ -3238,7 +3252,8 @@ SUBROUTINE xc_prep_2nd_deriv(deriv_set, & INTEGER :: handle, nspins LOGICAL :: lsd - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, tau + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_type), DIMENSION(:), POINTER :: tau CALL timeset(routineN, handle) diff --git a/src/xc/xc_fxc_kernel.F b/src/xc/xc_fxc_kernel.F index 432ebe2b6a..c39b183da6 100644 --- a/src/xc/xc_fxc_kernel.F +++ b/src/xc/xc_fxc_kernel.F @@ -18,10 +18,10 @@ MODULE xc_fxc_kernel pw_scale,& pw_zero USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE xc_b97_fxc, ONLY: b97_fcc_eval,& b97_fxc_eval @@ -57,7 +57,9 @@ MODULE xc_fxc_kernel !> \author JGH ! ************************************************************************************************** SUBROUTINE calc_fxc_kernel(fxc_rspace, rho_r, rho_g, tau_r, xc_kernel, triplet, pw_pool) - TYPE(pw_type), DIMENSION(:) :: fxc_rspace, rho_r, rho_g, tau_r + TYPE(pw_type), DIMENSION(:) :: fxc_rspace, rho_r + TYPE(pw_c1d_type), DIMENSION(:) :: rho_g + TYPE(pw_type), DIMENSION(:) :: tau_r TYPE(section_vals_type), POINTER :: xc_kernel LOGICAL, INTENT(IN) :: triplet TYPE(pw_pool_type), POINTER :: pw_pool @@ -72,8 +74,9 @@ SUBROUTINE calc_fxc_kernel(fxc_rspace, rho_r, rho_g, tau_r, xc_kernel, triplet, REAL(KIND=dp) :: scalec, scalex REAL(KIND=dp), DIMENSION(3) :: ccaa, ccab, cxaa, g_ab REAL(KIND=dp), DIMENSION(:), POINTER :: rvals + TYPE(pw_c1d_type) :: rhog, tmpg TYPE(pw_type) :: fxa, fxb, norm_drhoa, norm_drhob, rhoa, & - rhob, rhog, tmpg + rhob TYPE(pw_type), DIMENSION(3) :: drhoa TYPE(xc_rho_cflags_type) :: needs @@ -116,8 +119,8 @@ SUBROUTINE calc_fxc_kernel(fxc_rspace, rho_r, rho_g, tau_r, xc_kernel, triplet, END DO CALL pw_pool%create_pw(norm_drhoa, use_data=REALDATA3D, in_space=REALSPACE) CALL pw_pool%create_pw(norm_drhob, use_data=REALDATA3D, in_space=REALSPACE) - CALL pw_pool%create_pw(rhog, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) - CALL pw_pool%create_pw(tmpg, use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + CALL pw_pool%create_pw(rhog, in_space=RECIPROCALSPACE) + CALL pw_pool%create_pw(tmpg, in_space=RECIPROCALSPACE) IF (lsd) THEN CALL pw_copy(rho_g(1), rhog) ELSE IF (triplet) THEN diff --git a/src/xc/xc_rho_set_types.F b/src/xc/xc_rho_set_types.F index 48f2a88cfc..7a77ef4012 100644 --- a/src/xc/xc_rho_set_types.F +++ b/src/xc/xc_rho_set_types.F @@ -20,12 +20,12 @@ MODULE xc_rho_set_types USE pw_pool_types, ONLY: & pw_pool_type USE pw_spline_utils, ONLY: pw_spline_scale_deriv - USE pw_types, ONLY: COMPLEXDATA1D, & - REALDATA3D, & - REALSPACE, & - RECIPROCALSPACE, & - pw_p_type, & - pw_type + USE pw_types, ONLY: & + pw_c1d_type, REALDATA3D, & + REALSPACE, & + RECIPROCALSPACE, & + pw_p_type, & + pw_type USE xc_input_constants, ONLY: xc_deriv_pw, & xc_deriv_spline2, & xc_deriv_spline3, & @@ -604,7 +604,7 @@ SUBROUTINE xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, & xc_deriv_method_id, xc_rho_smooth_id, pw_pool) TYPE(xc_rho_set_type), INTENT(INOUT) :: rho_set TYPE(pw_type), DIMENSION(:), INTENT(IN) :: rho_r - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(pw_type), DIMENSION(:), POINTER, INTENT(IN) :: tau TYPE(xc_rho_cflags_type), INTENT(in) :: needs INTEGER, INTENT(IN) :: xc_deriv_method_id, xc_rho_smooth_id @@ -618,7 +618,7 @@ SUBROUTINE xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, & REAL(kind=dp) :: rho_cutoff TYPE(pw_type), DIMENSION(2) :: laplace_rho_r TYPE(pw_type), DIMENSION(3, 2) :: drho_r - TYPE(pw_type) :: my_rho_g, tmp_g + TYPE(pw_c1d_type) :: my_rho_g, tmp_g TYPE(pw_type), DIMENSION(2) :: my_rho_r IF (ANY(rho_set%local_bounds /= pw_pool%pw_grid%bounds_local)) & @@ -668,7 +668,7 @@ SUBROUTINE xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, & IF (needs_rho_g) THEN CALL pw_pool%create_pw(tmp_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) END IF DO ispin = 1, nspins CALL pw_pool%create_pw(my_rho_r(ispin), & @@ -699,13 +699,13 @@ SUBROUTINE xc_rho_set_update(rho_set, rho_r, rho_g, tau, needs, & IF (.NOT. ASSOCIATED(my_rho_g%pw_grid)) THEN my_rho_g_local = .TRUE. CALL pw_pool%create_pw(my_rho_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) CALL pw_transfer(my_rho_r(ispin), my_rho_g) END IF IF (.NOT. my_rho_g_local .AND. (xc_deriv_method_id == xc_deriv_spline2 .OR. & xc_deriv_method_id == xc_deriv_spline3)) THEN CALL pw_pool%create_pw(my_rho_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) + in_space=RECIPROCALSPACE) my_rho_g_local = .TRUE. CALL pw_copy(rho_g(ispin), my_rho_g) END IF diff --git a/src/xc/xc_util.F b/src/xc/xc_util.F index f999d8dddc..ec5fb751f8 100644 --- a/src/xc/xc_util.F +++ b/src/xc/xc_util.F @@ -12,25 +12,25 @@ !> \author Frederick Stein ! ************************************************************************************************** MODULE xc_util - USE pw_methods, ONLY: pw_axpy,& - pw_copy,& - pw_derive,& - pw_laplace,& - pw_transfer,& - pw_zero - USE pw_pool_types, ONLY: pw_pool_type - USE pw_spline_utils, ONLY: & - nn10_coeffs, nn10_deriv_coeffs, nn50_coeffs, nn50_deriv_coeffs, pw_nn_deriv_r, & - pw_nn_smear_r, pw_spline2_deriv_g, pw_spline2_interpolate_values_g, pw_spline3_deriv_g, & - pw_spline3_interpolate_values_g, pw_spline_scale_deriv, spline2_coeffs, & - spline2_deriv_coeffs, spline3_coeffs, spline3_deriv_coeffs - USE pw_types, ONLY: COMPLEXDATA1D,& - RECIPROCALSPACE,& - pw_type - USE xc_input_constants, ONLY: & - xc_deriv_nn10_smooth, xc_deriv_nn50_smooth, xc_deriv_pw, xc_deriv_spline2, & - xc_deriv_spline2_smooth, xc_deriv_spline3, xc_deriv_spline3_smooth, xc_rho_nn10, & - xc_rho_nn50, xc_rho_no_smooth, xc_rho_spline2_smooth, xc_rho_spline3_smooth + USE pw_methods, ONLY: pw_axpy, & + pw_copy, & + pw_derive, & + pw_laplace, & + pw_transfer, & + pw_zero + USE pw_pool_types, ONLY: pw_pool_type + USE pw_spline_utils, ONLY: & + nn10_coeffs, nn10_deriv_coeffs, nn50_coeffs, nn50_deriv_coeffs, pw_nn_deriv_r, & + pw_nn_smear_r, pw_spline2_deriv_g, pw_spline2_interpolate_values_g, pw_spline3_deriv_g, & + pw_spline3_interpolate_values_g, pw_spline_scale_deriv, spline2_coeffs, & + spline2_deriv_coeffs, spline3_coeffs, spline3_deriv_coeffs + USE pw_types, ONLY: RECIPROCALSPACE, & + REALDATA3D, REALSPACE, pw_c1d_type, & + pw_type + USE xc_input_constants, ONLY: & + xc_deriv_nn10_smooth, xc_deriv_nn50_smooth, xc_deriv_pw, xc_deriv_spline2, & + xc_deriv_spline2_smooth, xc_deriv_spline3, xc_deriv_spline3_smooth, xc_rho_nn10, & + xc_rho_nn50, xc_rho_no_smooth, xc_rho_spline2_smooth, xc_rho_spline3_smooth #include "../base/base_uses.f90" IMPLICIT NONE @@ -40,6 +40,14 @@ MODULE xc_util PUBLIC :: xc_pw_smooth, xc_pw_laplace, xc_pw_divergence, xc_pw_derive, xc_requires_tmp_g, xc_pw_gradient CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xc_util' + INTERFACE xc_pw_derive + MODULE PROCEDURE xc_pw_derive_pw_type, xc_pw_derive_pw_c1d_type + END INTERFACE + + INTERFACE xc_pw_laplace + MODULE PROCEDURE xc_pw_laplace_pw_type, xc_pw_laplace_pw_c1d_type + END INTERFACE + CONTAINS ! ************************************************************************************************** @@ -114,7 +122,7 @@ END SUBROUTINE xc_pw_smooth ! ************************************************************************************************** SUBROUTINE xc_pw_gradient(pw_r, pw_g, tmp_g, gradient, xc_deriv_method_id) TYPE(pw_type), INTENT(IN) :: pw_r - TYPE(pw_type), INTENT(INOUT) :: pw_g, tmp_g + TYPE(pw_c1d_type), INTENT(INOUT) :: pw_g, tmp_g TYPE(pw_type), DIMENSION(3), INTENT(INOUT) :: gradient INTEGER, INTENT(IN) :: xc_deriv_method_id @@ -127,6 +135,7 @@ SUBROUTINE xc_pw_gradient(pw_r, pw_g, tmp_g, gradient, xc_deriv_method_id) END SUBROUTINE xc_pw_gradient + #:for kind in ["pw_type", "pw_c1d_type"] ! ************************************************************************************************** !> \brief Calculates the Laplacian of pw !> \param pw on input: pw of which the Laplacian shall be calculated, on output if pw_out is absent: Laplacian of input @@ -135,52 +144,52 @@ END SUBROUTINE xc_pw_gradient !> \param pw_out if present, save the Laplacian of pw here !> \param tmp_g scratch grid in reciprocal space, used instead of the internal grid if given explicitly to save memory ! ************************************************************************************************** - SUBROUTINE xc_pw_laplace(pw, pw_pool, deriv_method_id, pw_out, tmp_g) - TYPE(pw_type), INTENT(INOUT) :: pw - TYPE(pw_pool_type), INTENT(IN), POINTER :: pw_pool - INTEGER, INTENT(IN) :: deriv_method_id - TYPE(pw_type), INTENT(INOUT), OPTIONAL :: pw_out - TYPE(pw_type), INTENT(IN), OPTIONAL :: tmp_g + SUBROUTINE xc_pw_laplace_${kind}$ (pw, pw_pool, deriv_method_id, pw_out, tmp_g) + TYPE(${kind}$), INTENT(INOUT) :: pw + TYPE(pw_pool_type), INTENT(IN), POINTER :: pw_pool + INTEGER, INTENT(IN) :: deriv_method_id + TYPE(pw_type), INTENT(INOUT), OPTIONAL :: pw_out + TYPE(pw_c1d_type), INTENT(IN), OPTIONAL :: tmp_g - CHARACTER(len=*), PARAMETER :: routineN = 'xc_pw_laplace' + CHARACTER(len=*), PARAMETER :: routineN = 'xc_pw_laplace' - INTEGER :: handle - LOGICAL :: owns_tmp_g - TYPE(pw_type) :: my_tmp_g + INTEGER :: handle + LOGICAL :: owns_tmp_g + TYPE(pw_c1d_type) :: my_tmp_g - CALL timeset(routineN, handle) + CALL timeset(routineN, handle) - SELECT CASE (deriv_method_id) - CASE (xc_deriv_pw) + SELECT CASE (deriv_method_id) + CASE (xc_deriv_pw) - IF (PRESENT(tmp_g)) my_tmp_g = tmp_g + IF (PRESENT(tmp_g)) my_tmp_g = tmp_g - owns_tmp_g = .FALSE. - IF (.NOT. ASSOCIATED(my_tmp_g%pw_grid)) THEN - CALL pw_pool%create_pw(my_tmp_g, & - use_data=COMPLEXDATA1D, in_space=RECIPROCALSPACE) - owns_tmp_g = .TRUE. - END IF - CALL pw_zero(my_tmp_g) - CALL pw_transfer(pw, my_tmp_g) + owns_tmp_g = .FALSE. + IF (.NOT. ASSOCIATED(my_tmp_g%pw_grid)) THEN + CALL pw_pool%create_pw(my_tmp_g, in_space=RECIPROCALSPACE) + owns_tmp_g = .TRUE. + END IF + CALL pw_zero(my_tmp_g) + CALL pw_transfer(pw, my_tmp_g) - CALL pw_laplace(my_tmp_g) + CALL pw_laplace(my_tmp_g) - IF (PRESENT(pw_out)) THEN - CALL pw_transfer(my_tmp_g, pw_out) - ELSE - CALL pw_transfer(my_tmp_g, pw) - END IF - IF (owns_tmp_g) THEN - CALL pw_pool%give_back_pw(my_tmp_g) - END IF - CASE default - CPABORT("Unsupported derivative method") - END SELECT + IF (PRESENT(pw_out)) THEN + CALL pw_transfer(my_tmp_g, pw_out) + ELSE + CALL pw_transfer(my_tmp_g, pw) + END IF + IF (owns_tmp_g) THEN + CALL pw_pool%give_back_pw(my_tmp_g) + END IF + CASE default + CPABORT("Unsupported derivative method") + END SELECT - CALL timestop(handle) + CALL timestop(handle) - END SUBROUTINE xc_pw_laplace + END SUBROUTINE xc_pw_laplace_${kind}$ + #:endfor ! ************************************************************************************************** !> \brief Calculates the divergence of pw_to_deriv @@ -193,7 +202,8 @@ END SUBROUTINE xc_pw_laplace SUBROUTINE xc_pw_divergence(xc_deriv_method_id, pw_to_deriv, tmp_g, vxc_g, vxc_r) INTEGER, INTENT(IN) :: xc_deriv_method_id TYPE(pw_type), DIMENSION(3), INTENT(INOUT) :: pw_to_deriv - TYPE(pw_type), INTENT(INOUT) :: tmp_g, vxc_g, vxc_r + TYPE(pw_c1d_type), INTENT(INOUT) :: tmp_g, vxc_g + TYPE(pw_type), INTENT(INOUT) :: vxc_r CHARACTER(len=*), PARAMETER :: routineN = 'xc_pw_divergence' @@ -222,6 +232,7 @@ SUBROUTINE xc_pw_divergence(xc_deriv_method_id, pw_to_deriv, tmp_g, vxc_g, vxc_r END SUBROUTINE xc_pw_divergence + #:for kind in ["pw_type", "pw_c1d_type"] ! ************************************************************************************************** !> \brief Calculates the derivative of a function on a planewave grid in a given direction !> \param pw function to derive @@ -232,75 +243,105 @@ END SUBROUTINE xc_pw_divergence !> \param copy_to_vxcr ... !> \param pw_g ... ! ************************************************************************************************** - SUBROUTINE xc_pw_derive(pw, tmp_g, vxc_r, idir, xc_deriv_method_id, copy_to_vxcr, pw_g) - TYPE(pw_type), INTENT(IN) :: pw - TYPE(pw_type), INTENT(INOUT) :: tmp_g, vxc_r - INTEGER, INTENT(IN) :: idir, xc_deriv_method_id - LOGICAL, INTENT(IN), OPTIONAL :: copy_to_vxcr - TYPE(pw_type), INTENT(IN), OPTIONAL :: pw_g - - CHARACTER(len=*), PARAMETER :: routineN = 'xc_pw_derive' - INTEGER, DIMENSION(3, 3), PARAMETER :: nd = RESHAPE((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/)) - - INTEGER :: handle - LOGICAL :: my_copy_to_vxcr - - CALL timeset(routineN, handle) - - my_copy_to_vxcr = .TRUE. - IF (PRESENT(copy_to_vxcr)) my_copy_to_vxcr = copy_to_vxcr - - IF (xc_requires_tmp_g(xc_deriv_method_id)) THEN - - IF (PRESENT(pw_g)) THEN - IF (ASSOCIATED(pw_g%pw_grid)) THEN - CALL pw_copy(pw_g, tmp_g) + SUBROUTINE xc_pw_derive_${kind}$ (pw, tmp_g, vxc_r, idir, xc_deriv_method_id, copy_to_vxcr, pw_g) + TYPE(${kind}$), INTENT(IN) :: pw + TYPE(pw_c1d_type), INTENT(INOUT) :: tmp_g + TYPE(pw_type), INTENT(INOUT) :: vxc_r + INTEGER, INTENT(IN) :: idir, xc_deriv_method_id + LOGICAL, INTENT(IN), OPTIONAL :: copy_to_vxcr + TYPE(pw_c1d_type), INTENT(IN), OPTIONAL :: pw_g + + CHARACTER(len=*), PARAMETER :: routineN = 'xc_pw_derive' + INTEGER, DIMENSION(3, 3), PARAMETER :: nd = RESHAPE((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/)) + + INTEGER :: handle + LOGICAL :: my_copy_to_vxcr + #:if kind=="pw_c1d_type" + TYPE(pw_type) :: tmp_r + #:endif + + CALL timeset(routineN, handle) + + my_copy_to_vxcr = .TRUE. + IF (PRESENT(copy_to_vxcr)) my_copy_to_vxcr = copy_to_vxcr + + IF (xc_requires_tmp_g(xc_deriv_method_id)) THEN + + IF (PRESENT(pw_g)) THEN + IF (ASSOCIATED(pw_g%pw_grid)) THEN + CALL pw_copy(pw_g, tmp_g) + ELSE + CALL pw_transfer(pw, tmp_g) + END IF ELSE CALL pw_transfer(pw, tmp_g) END IF + + SELECT CASE (xc_deriv_method_id) + CASE (xc_deriv_pw) + CALL pw_derive(tmp_g, nd(:, idir)) + CASE (xc_deriv_spline2) + CALL pw_spline2_interpolate_values_g(tmp_g) + CALL pw_spline2_deriv_g(tmp_g, idir=idir) + CASE (xc_deriv_spline3) + CALL pw_spline3_interpolate_values_g(tmp_g) + CALL pw_spline3_deriv_g(tmp_g, idir=idir) + CASE default + CPABORT("Unsupported deriv method") + END SELECT + + IF (my_copy_to_vxcr) CALL pw_transfer(tmp_g, vxc_r) ELSE - CALL pw_transfer(pw, tmp_g) + #:if kind=="pw_type" + SELECT CASE (xc_deriv_method_id) + CASE (xc_deriv_spline2_smooth) + CALL pw_nn_deriv_r(pw_in=pw, & + pw_out=vxc_r, coeffs=spline2_deriv_coeffs, & + idir=idir) + CASE (xc_deriv_spline3_smooth) + CALL pw_nn_deriv_r(pw_in=pw, & + pw_out=vxc_r, coeffs=spline3_deriv_coeffs, & + idir=idir) + CASE (xc_deriv_nn10_smooth) + CALL pw_nn_deriv_r(pw_in=pw, & + pw_out=vxc_r, coeffs=nn10_deriv_coeffs, & + idir=idir) + CASE (xc_deriv_nn50_smooth) + CALL pw_nn_deriv_r(pw_in=pw, & + pw_out=vxc_r, coeffs=nn50_deriv_coeffs, & + idir=idir) + CASE default + CPABORT("Unsupported derivative method") + END SELECT + #:else + CALL tmp_r%create(pw%pw_grid, REALDATA3D, REALSPACE) + SELECT CASE (xc_deriv_method_id) + CASE (xc_deriv_spline2_smooth) + CALL pw_nn_deriv_r(pw_in=tmp_r, & + pw_out=vxc_r, coeffs=spline2_deriv_coeffs, & + idir=idir) + CASE (xc_deriv_spline3_smooth) + CALL pw_nn_deriv_r(pw_in=tmp_r, & + pw_out=vxc_r, coeffs=spline3_deriv_coeffs, & + idir=idir) + CASE (xc_deriv_nn10_smooth) + CALL pw_nn_deriv_r(pw_in=tmp_r, & + pw_out=vxc_r, coeffs=nn10_deriv_coeffs, & + idir=idir) + CASE (xc_deriv_nn50_smooth) + CALL pw_nn_deriv_r(pw_in=tmp_r, & + pw_out=vxc_r, coeffs=nn50_deriv_coeffs, & + idir=idir) + CASE default + CPABORT("Unsupported derivative method") + END SELECT + CALL tmp_r%release() + #:endif END IF - SELECT CASE (xc_deriv_method_id) - CASE (xc_deriv_pw) - CALL pw_derive(tmp_g, nd(:, idir)) - CASE (xc_deriv_spline2) - CALL pw_spline2_interpolate_values_g(tmp_g) - CALL pw_spline2_deriv_g(tmp_g, idir=idir) - CASE (xc_deriv_spline3) - CALL pw_spline3_interpolate_values_g(tmp_g) - CALL pw_spline3_deriv_g(tmp_g, idir=idir) - CASE default - CPABORT("Unsupported deriv method") - END SELECT - - IF (my_copy_to_vxcr) CALL pw_transfer(tmp_g, vxc_r) - ELSE - SELECT CASE (xc_deriv_method_id) - CASE (xc_deriv_spline2_smooth) - CALL pw_nn_deriv_r(pw_in=pw, & - pw_out=vxc_r, coeffs=spline2_deriv_coeffs, & - idir=idir) - CASE (xc_deriv_spline3_smooth) - CALL pw_nn_deriv_r(pw_in=pw, & - pw_out=vxc_r, coeffs=spline3_deriv_coeffs, & - idir=idir) - CASE (xc_deriv_nn10_smooth) - CALL pw_nn_deriv_r(pw_in=pw, & - pw_out=vxc_r, coeffs=nn10_deriv_coeffs, & - idir=idir) - CASE (xc_deriv_nn50_smooth) - CALL pw_nn_deriv_r(pw_in=pw, & - pw_out=vxc_r, coeffs=nn50_deriv_coeffs, & - idir=idir) - CASE default - CPABORT("Unsupported derivative method") - END SELECT - END IF - - CALL timestop(handle) + CALL timestop(handle) - END SUBROUTINE xc_pw_derive + END SUBROUTINE xc_pw_derive_${kind}$ + #:endfor END MODULE xc_util diff --git a/src/xc_pot_saop.F b/src/xc_pot_saop.F index b119d22476..d79802131a 100644 --- a/src/xc_pot_saop.F +++ b/src/xc_pot_saop.F @@ -48,10 +48,10 @@ MODULE xc_pot_saop pw_scale,& pw_zero USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - REALDATA3D,& + USE pw_types, ONLY: REALDATA3D,& REALSPACE,& RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_collocate_density, ONLY: calculate_rho_elec USE qs_environment_types, ONLY: get_qs_env,& @@ -147,11 +147,13 @@ SUBROUTINE add_saop_pot(ks_matrix, qs_env, oe_corr) TYPE(cp_fm_type), POINTER :: mo_coeff TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: orbital_density_matrix, rho_struct_ao TYPE(mo_set_type), DIMENSION(:), POINTER :: molecular_orbitals + TYPE(pw_c1d_type) :: orbital_g + TYPE(pw_c1d_type), DIMENSION(:), POINTER :: rho_g TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: orbital, orbital_g + TYPE(pw_type) :: orbital TYPE(pw_type), ALLOCATABLE, DIMENSION(:) :: vxc_GLLB, vxc_SAOP - TYPE(pw_type), DIMENSION(:), POINTER :: rho_g, rho_r, rho_struct_r, tau, vxc_LB, & + TYPE(pw_type), DIMENSION(:), POINTER :: rho_r, rho_struct_r, tau, vxc_LB, & vxc_tau, vxc_tmp TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho_struct @@ -308,7 +310,6 @@ SUBROUTINE add_saop_pot(ks_matrix, qs_env, oe_corr) use_data=REALDATA3D, & in_space=REALSPACE) CALL auxbas_pw_pool%create_pw(orbital_g, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) DO ispin = 1, nspins diff --git a/src/xray_diffraction.F b/src/xray_diffraction.F index 3bf6c84654..b79b2f878b 100644 --- a/src/xray_diffraction.F +++ b/src/xray_diffraction.F @@ -47,8 +47,8 @@ MODULE xray_diffraction pw_transfer,& pw_zero USE pw_pool_types, ONLY: pw_pool_type - USE pw_types, ONLY: COMPLEXDATA1D,& - RECIPROCALSPACE,& + USE pw_types, ONLY: RECIPROCALSPACE,& + pw_c1d_type,& pw_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -106,9 +106,9 @@ SUBROUTINE xray_diffraction_spectrum(qs_env, unit_number, q_max) TYPE(dft_control_type), POINTER :: dft_control TYPE(mp_para_env_type), POINTER :: para_env TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_c1d_type) :: rhotot_elec_gspace TYPE(pw_env_type), POINTER :: pw_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type) :: rhotot_elec_gspace TYPE(qs_rho_type), POINTER :: rho TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom_set @@ -162,7 +162,6 @@ SUBROUTINE xray_diffraction_spectrum(qs_env, unit_number, q_max) ! Plane waves grid to assemble the total electronic density CALL auxbas_pw_pool%create_pw(pw=rhotot_elec_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_zero(rhotot_elec_gspace) @@ -240,7 +239,7 @@ SUBROUTINE xray_diffraction_spectrum(qs_env, unit_number, q_max) f2sum(ishell) = 0.0_dp f4sum(ishell) = 0.0_dp DO ig_shell = 1, ng_shell(ishell) - f = ABS(rhotot_elec_gspace%cc(ig + ig_shell)) + f = ABS(rhotot_elec_gspace%array(ig + ig_shell)) fmin(ishell) = MIN(fmin(ishell), f) fmax(ishell) = MAX(fmax(ishell), f) fsum(ishell) = fsum(ishell) + f @@ -490,7 +489,7 @@ SUBROUTINE calculate_rhotot_elec_gspace(qs_env, auxbas_pw_pool, & TYPE(qs_environment_type), POINTER :: qs_env TYPE(pw_pool_type), POINTER :: auxbas_pw_pool - TYPE(pw_type), INTENT(INOUT) :: rhotot_elec_gspace + TYPE(pw_c1d_type), INTENT(INOUT) :: rhotot_elec_gspace REAL(KIND=dp), INTENT(IN) :: q_max REAL(KIND=dp), INTENT(OUT) :: rho_hard, rho_soft REAL(KIND=dp), INTENT(IN), OPTIONAL :: fsign @@ -512,7 +511,7 @@ SUBROUTINE calculate_rhotot_elec_gspace(qs_env, auxbas_pw_pool, & TYPE(dft_control_type), POINTER :: dft_control TYPE(gto_basis_set_type), POINTER :: basis_1c_set TYPE(particle_type), DIMENSION(:), POINTER :: particle_set - TYPE(pw_type) :: rho_elec_gspace + TYPE(pw_C1d_type) :: rho_elec_gspace TYPE(pw_type), DIMENSION(:), POINTER :: rho_r TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_rho_type), POINTER :: rho @@ -562,7 +561,6 @@ SUBROUTINE calculate_rhotot_elec_gspace(qs_env, auxbas_pw_pool, & ! Load the soft contribution of the electronic density CALL auxbas_pw_pool%create_pw(pw=rho_elec_gspace, & - use_data=COMPLEXDATA1D, & in_space=RECIPROCALSPACE) CALL pw_zero(rhotot_elec_gspace) @@ -784,7 +782,7 @@ SUBROUTINE collocate_pgf_product_gspace(la_max, zeta, la_min, & REAL(dp), DIMENSION(:, :), POINTER :: pab INTEGER, INTENT(IN) :: na, nb REAL(dp), INTENT(IN) :: eps_rho_gspace, gsq_max - TYPE(pw_type), INTENT(IN) :: pw + TYPE(pw_c1d_type), INTENT(IN) :: pw CHARACTER(LEN=*), PARAMETER :: routineN = 'collocate_pgf_product_gspace' @@ -832,8 +830,8 @@ SUBROUTINE collocate_pgf_product_gspace(la_max, zeta, la_min, & CALL reallocate(rag, lb_cube_min, ub_cube_max) CALL reallocate(rbg, lb_cube_min, ub_cube_max) - lb_grid = LBOUND(pw%cc, 1) - ub_grid = UBOUND(pw%cc, 1) + lb_grid = LBOUND(pw%array, 1) + ub_grid = UBOUND(pw%array, 1) DO i = 1, 3 @@ -943,9 +941,9 @@ SUBROUTINE collocate_pgf_product_gspace(la_max, zeta, la_min, & ig = pw%pw_grid%g_hat(1, i) jg = pw%pw_grid%g_hat(2, i) kg = pw%pw_grid%g_hat(3, i) - pw%cc(i) = pw%cc(i) + pij*cubeaxis(ig, 1, ax, bx)* & - cubeaxis(jg, 2, ay, by)* & - cubeaxis(kg, 3, az, bz) + pw%array(i) = pw%array(i) + pij*cubeaxis(ig, 1, ax, bx)* & + cubeaxis(jg, 2, ay, by)* & + cubeaxis(kg, 3, az, bz) END DO END DO