pw_methods.F

Go to the documentation of this file.

!--------------------------------------------------------------------------------------------------!
!   CP2K: A general program to perform molecular dynamics simulations                              !
!   Copyright 2000-2025 CP2K developers group <https://cp2k.org>                                   !
!                                                                                                  !
!   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
!--------------------------------------------------------------------------------------------------!
 
! **************************************************************************************************
!> \note
!>      If parallel mode is distributed certain combination of
!>      "in_use" and "in_space" can not be used.
!>      For performance reasons it would be better to have the loops
!>      over g-vectors in the gather/scatter routines in new subprograms
!>      with the actual arrays (also the addressing) in the parameter list
!> \par History
!>      JGH (29-Dec-2000) : Changes for parallel use
!>      JGH (13-Mar-2001) : added timing calls
!>      JGH (26-Feb-2003) : OpenMP enabled
!>      JGH (17-Nov-2007) : Removed mass arrays
!>      JGH (01-Dec-2007) : Removed and renamed routines
!>      JGH (04-Jul-2019) : added pw_multiply routine
!>      03.2008 [tlaino] : Splitting pw_types into pw_types and pw_methods
!> \author apsi
! **************************************************************************************************
MODULE pw_methods
 
 
   USE cp_log_handling, ONLY: cp_logger_get_default_io_unit, &
                              cp_to_string
   USE fft_tools, ONLY: bwfft, &
                        fwfft, &
                        fft3d
   USE kahan_sum, ONLY: accurate_dot_product, &
                        accurate_sum
   USE kinds, ONLY: dp
   USE machine, ONLY: m_memory
   USE mathconstants, ONLY: gaussi, &
                            z_zero
   USE pw_copy_all, ONLY: pw_copy_match
   USE pw_fpga, ONLY: pw_fpga_c1dr3d_3d_dp, &
                      pw_fpga_c1dr3d_3d_sp, &
                      pw_fpga_init_bitstream, &
                      pw_fpga_r3dc1d_3d_dp, &
                      pw_fpga_r3dc1d_3d_sp
   USE pw_gpu, ONLY: pw_gpu_c1dr3d_3d, &
                     pw_gpu_c1dr3d_3d_ps, &
                     pw_gpu_r3dc1d_3d, &
                     pw_gpu_r3dc1d_3d_ps
   USE pw_grid_types, ONLY: halfspace, &
                            pw_mode_distributed, &
                            pw_mode_local, &
                            pw_grid_type
         USE pw_types, ONLY: pw_r1d_rs_type
         USE pw_types, ONLY: pw_r3d_rs_type
         USE pw_types, ONLY: pw_c1d_rs_type
         USE pw_types, ONLY: pw_c3d_rs_type
         USE pw_types, ONLY: pw_r1d_gs_type
         USE pw_types, ONLY: pw_r3d_gs_type
         USE pw_types, ONLY: pw_c1d_gs_type
         USE pw_types, ONLY: pw_c3d_gs_type
#include "../base/base_uses.f90"
 
   IMPLICIT NONE
 
   PRIVATE
 
   PUBLIC :: pw_zero, pw_structure_factor, pw_smoothing
   PUBLIC :: pw_copy, pw_axpy, pw_transfer, pw_scale
   PUBLIC :: pw_gauss_damp, pw_compl_gauss_damp, pw_derive, pw_laplace, pw_dr2, pw_write, pw_multiply
   PUBLIC :: pw_log_deriv_gauss, pw_log_deriv_compl_gauss, pw_log_deriv_mix_cl, pw_log_deriv_trunc
   PUBLIC :: pw_gauss_damp_mix, pw_multiply_with
   PUBLIC :: pw_integral_ab, pw_integral_a2b
   PUBLIC :: pw_dr2_gg, pw_integrate_function
   PUBLIC :: pw_set, pw_truncated
   PUBLIC :: pw_scatter, pw_gather
   PUBLIC :: pw_copy_to_array, pw_copy_from_array
 
   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'pw_methods'
   LOGICAL, PARAMETER, PRIVATE :: debug_this_module = .false.
   INTEGER, PARAMETER, PUBLIC  ::  do_accurate_sum = 0, &
                                  do_standard_sum = 1
 
   INTERFACE pw_zero
            MODULE PROCEDURE pw_zero_r1d_rs
            MODULE PROCEDURE pw_zero_r3d_rs
            MODULE PROCEDURE pw_zero_c1d_rs
            MODULE PROCEDURE pw_zero_c3d_rs
            MODULE PROCEDURE pw_zero_r1d_gs
            MODULE PROCEDURE pw_zero_r3d_gs
            MODULE PROCEDURE pw_zero_c1d_gs
            MODULE PROCEDURE pw_zero_c3d_gs
   END INTERFACE
 
   INTERFACE pw_scale
            MODULE PROCEDURE pw_scale_r1d_rs
            MODULE PROCEDURE pw_scale_r3d_rs
            MODULE PROCEDURE pw_scale_c1d_rs
            MODULE PROCEDURE pw_scale_c3d_rs
            MODULE PROCEDURE pw_scale_r1d_gs
            MODULE PROCEDURE pw_scale_r3d_gs
            MODULE PROCEDURE pw_scale_c1d_gs
            MODULE PROCEDURE pw_scale_c3d_gs
   END INTERFACE
 
   INTERFACE pw_write
            MODULE PROCEDURE pw_write_r1d_rs
            MODULE PROCEDURE pw_write_r3d_rs
            MODULE PROCEDURE pw_write_c1d_rs
            MODULE PROCEDURE pw_write_c3d_rs
            MODULE PROCEDURE pw_write_r1d_gs
            MODULE PROCEDURE pw_write_r3d_gs
            MODULE PROCEDURE pw_write_c1d_gs
            MODULE PROCEDURE pw_write_c3d_gs
   END INTERFACE
 
   INTERFACE pw_integrate_function
            MODULE PROCEDURE pw_integrate_function_r1d_rs
            MODULE PROCEDURE pw_integrate_function_r3d_rs
            MODULE PROCEDURE pw_integrate_function_c1d_rs
            MODULE PROCEDURE pw_integrate_function_c3d_rs
            MODULE PROCEDURE pw_integrate_function_r1d_gs
            MODULE PROCEDURE pw_integrate_function_r3d_gs
            MODULE PROCEDURE pw_integrate_function_c1d_gs
            MODULE PROCEDURE pw_integrate_function_c3d_gs
   END INTERFACE
 
   INTERFACE pw_set
            MODULE PROCEDURE pw_set_value_r1d_rs
            MODULE PROCEDURE pw_zero_r1d_rs
            MODULE PROCEDURE pw_set_value_r3d_rs
            MODULE PROCEDURE pw_zero_r3d_rs
            MODULE PROCEDURE pw_set_value_c1d_rs
            MODULE PROCEDURE pw_zero_c1d_rs
            MODULE PROCEDURE pw_set_value_c3d_rs
            MODULE PROCEDURE pw_zero_c3d_rs
            MODULE PROCEDURE pw_set_value_r1d_gs
            MODULE PROCEDURE pw_zero_r1d_gs
            MODULE PROCEDURE pw_set_value_r3d_gs
            MODULE PROCEDURE pw_zero_r3d_gs
            MODULE PROCEDURE pw_set_value_c1d_gs
            MODULE PROCEDURE pw_zero_c1d_gs
            MODULE PROCEDURE pw_set_value_c3d_gs
            MODULE PROCEDURE pw_zero_c3d_gs
   END INTERFACE
 
   INTERFACE pw_copy
            MODULE PROCEDURE pw_copy_r1d_r1d_rs
            MODULE PROCEDURE pw_copy_r1d_c1d_rs
            MODULE PROCEDURE pw_copy_r3d_r3d_rs
            MODULE PROCEDURE pw_copy_r3d_c3d_rs
            MODULE PROCEDURE pw_copy_c1d_r1d_rs
            MODULE PROCEDURE pw_copy_c1d_c1d_rs
            MODULE PROCEDURE pw_copy_c3d_r3d_rs
            MODULE PROCEDURE pw_copy_c3d_c3d_rs
            MODULE PROCEDURE pw_copy_r1d_r1d_gs
            MODULE PROCEDURE pw_copy_r1d_c1d_gs
            MODULE PROCEDURE pw_copy_r3d_r3d_gs
            MODULE PROCEDURE pw_copy_r3d_c3d_gs
            MODULE PROCEDURE pw_copy_c1d_r1d_gs
            MODULE PROCEDURE pw_copy_c1d_c1d_gs
            MODULE PROCEDURE pw_copy_c3d_r3d_gs
            MODULE PROCEDURE pw_copy_c3d_c3d_gs
   END INTERFACE
 
   INTERFACE pw_axpy
            MODULE PROCEDURE pw_axpy_r1d_r1d_rs
            MODULE PROCEDURE pw_axpy_r1d_c1d_rs
            MODULE PROCEDURE pw_axpy_r3d_r3d_rs
            MODULE PROCEDURE pw_axpy_r3d_c3d_rs
            MODULE PROCEDURE pw_axpy_c1d_r1d_rs
            MODULE PROCEDURE pw_axpy_c1d_c1d_rs
            MODULE PROCEDURE pw_axpy_c3d_r3d_rs
            MODULE PROCEDURE pw_axpy_c3d_c3d_rs
            MODULE PROCEDURE pw_axpy_r1d_r1d_gs
            MODULE PROCEDURE pw_axpy_r1d_c1d_gs
            MODULE PROCEDURE pw_axpy_r3d_r3d_gs
            MODULE PROCEDURE pw_axpy_r3d_c3d_gs
            MODULE PROCEDURE pw_axpy_c1d_r1d_gs
            MODULE PROCEDURE pw_axpy_c1d_c1d_gs
            MODULE PROCEDURE pw_axpy_c3d_r3d_gs
            MODULE PROCEDURE pw_axpy_c3d_c3d_gs
   END INTERFACE
 
   INTERFACE pw_multiply
            MODULE PROCEDURE pw_multiply_r1d_r1d_rs
            MODULE PROCEDURE pw_multiply_r1d_c1d_rs
            MODULE PROCEDURE pw_multiply_r3d_r3d_rs
            MODULE PROCEDURE pw_multiply_r3d_c3d_rs
            MODULE PROCEDURE pw_multiply_c1d_r1d_rs
            MODULE PROCEDURE pw_multiply_c1d_c1d_rs
            MODULE PROCEDURE pw_multiply_c3d_r3d_rs
            MODULE PROCEDURE pw_multiply_c3d_c3d_rs
            MODULE PROCEDURE pw_multiply_r1d_r1d_gs
            MODULE PROCEDURE pw_multiply_r1d_c1d_gs
            MODULE PROCEDURE pw_multiply_r3d_r3d_gs
            MODULE PROCEDURE pw_multiply_r3d_c3d_gs
            MODULE PROCEDURE pw_multiply_c1d_r1d_gs
            MODULE PROCEDURE pw_multiply_c1d_c1d_gs
            MODULE PROCEDURE pw_multiply_c3d_r3d_gs
            MODULE PROCEDURE pw_multiply_c3d_c3d_gs
   END INTERFACE
 
   INTERFACE pw_multiply_with
            MODULE PROCEDURE pw_multiply_with_r1d_r1d_rs
            MODULE PROCEDURE pw_multiply_with_r1d_c1d_rs
            MODULE PROCEDURE pw_multiply_with_r3d_r3d_rs
            MODULE PROCEDURE pw_multiply_with_r3d_c3d_rs
            MODULE PROCEDURE pw_multiply_with_c1d_r1d_rs
            MODULE PROCEDURE pw_multiply_with_c1d_c1d_rs
            MODULE PROCEDURE pw_multiply_with_c3d_r3d_rs
            MODULE PROCEDURE pw_multiply_with_c3d_c3d_rs
            MODULE PROCEDURE pw_multiply_with_r1d_r1d_gs
            MODULE PROCEDURE pw_multiply_with_r1d_c1d_gs
            MODULE PROCEDURE pw_multiply_with_r3d_r3d_gs
            MODULE PROCEDURE pw_multiply_with_r3d_c3d_gs
            MODULE PROCEDURE pw_multiply_with_c1d_r1d_gs
            MODULE PROCEDURE pw_multiply_with_c1d_c1d_gs
            MODULE PROCEDURE pw_multiply_with_c3d_r3d_gs
            MODULE PROCEDURE pw_multiply_with_c3d_c3d_gs
   END INTERFACE
 
   INTERFACE pw_integral_ab
            MODULE PROCEDURE pw_integral_ab_r1d_r1d_rs
            MODULE PROCEDURE pw_integral_ab_r1d_c1d_rs
            MODULE PROCEDURE pw_integral_ab_r3d_r3d_rs
            MODULE PROCEDURE pw_integral_ab_r3d_c3d_rs
            MODULE PROCEDURE pw_integral_ab_c1d_r1d_rs
            MODULE PROCEDURE pw_integral_ab_c1d_c1d_rs
            MODULE PROCEDURE pw_integral_ab_c3d_r3d_rs
            MODULE PROCEDURE pw_integral_ab_c3d_c3d_rs
            MODULE PROCEDURE pw_integral_ab_r1d_r1d_gs
            MODULE PROCEDURE pw_integral_ab_r1d_c1d_gs
            MODULE PROCEDURE pw_integral_ab_r3d_r3d_gs
            MODULE PROCEDURE pw_integral_ab_r3d_c3d_gs
            MODULE PROCEDURE pw_integral_ab_c1d_r1d_gs
            MODULE PROCEDURE pw_integral_ab_c1d_c1d_gs
            MODULE PROCEDURE pw_integral_ab_c3d_r3d_gs
            MODULE PROCEDURE pw_integral_ab_c3d_c3d_gs
   END INTERFACE
 
   INTERFACE pw_integral_a2b
            MODULE PROCEDURE pw_integral_a2b_r1d_r1d
            MODULE PROCEDURE pw_integral_a2b_r1d_c1d
            MODULE PROCEDURE pw_integral_a2b_c1d_r1d
            MODULE PROCEDURE pw_integral_a2b_c1d_c1d
   END INTERFACE
 
   INTERFACE pw_gather
            MODULE PROCEDURE pw_gather_p_r1d
            MODULE PROCEDURE pw_gather_p_c1d
            MODULE PROCEDURE pw_gather_s_r1d_r3d
            MODULE PROCEDURE pw_gather_s_r1d_c3d
            MODULE PROCEDURE pw_gather_s_c1d_r3d
            MODULE PROCEDURE pw_gather_s_c1d_c3d
   END INTERFACE
 
   INTERFACE pw_scatter
            MODULE PROCEDURE pw_scatter_p_r1d
            MODULE PROCEDURE pw_scatter_p_c1d
            MODULE PROCEDURE pw_scatter_s_r1d_r3d
            MODULE PROCEDURE pw_scatter_s_r1d_c3d
            MODULE PROCEDURE pw_scatter_s_c1d_r3d
            MODULE PROCEDURE pw_scatter_s_c1d_c3d
   END INTERFACE
 
   INTERFACE pw_copy_to_array
            MODULE PROCEDURE pw_copy_to_array_r1d_r1d_rs
            MODULE PROCEDURE pw_copy_to_array_r1d_c1d_rs
            MODULE PROCEDURE pw_copy_to_array_r3d_r3d_rs
            MODULE PROCEDURE pw_copy_to_array_r3d_c3d_rs
            MODULE PROCEDURE pw_copy_to_array_c1d_r1d_rs
            MODULE PROCEDURE pw_copy_to_array_c1d_c1d_rs
            MODULE PROCEDURE pw_copy_to_array_c3d_r3d_rs
            MODULE PROCEDURE pw_copy_to_array_c3d_c3d_rs
            MODULE PROCEDURE pw_copy_to_array_r1d_r1d_gs
            MODULE PROCEDURE pw_copy_to_array_r1d_c1d_gs
            MODULE PROCEDURE pw_copy_to_array_r3d_r3d_gs
            MODULE PROCEDURE pw_copy_to_array_r3d_c3d_gs
            MODULE PROCEDURE pw_copy_to_array_c1d_r1d_gs
            MODULE PROCEDURE pw_copy_to_array_c1d_c1d_gs
            MODULE PROCEDURE pw_copy_to_array_c3d_r3d_gs
            MODULE PROCEDURE pw_copy_to_array_c3d_c3d_gs
   END INTERFACE
 
   INTERFACE pw_copy_from_array
            MODULE PROCEDURE pw_copy_from_array_r1d_r1d_rs
            MODULE PROCEDURE pw_copy_from_array_r1d_c1d_rs
            MODULE PROCEDURE pw_copy_from_array_r3d_r3d_rs
            MODULE PROCEDURE pw_copy_from_array_r3d_c3d_rs
            MODULE PROCEDURE pw_copy_from_array_c1d_r1d_rs
            MODULE PROCEDURE pw_copy_from_array_c1d_c1d_rs
            MODULE PROCEDURE pw_copy_from_array_c3d_r3d_rs
            MODULE PROCEDURE pw_copy_from_array_c3d_c3d_rs
            MODULE PROCEDURE pw_copy_from_array_r1d_r1d_gs
            MODULE PROCEDURE pw_copy_from_array_r1d_c1d_gs
            MODULE PROCEDURE pw_copy_from_array_r3d_r3d_gs
            MODULE PROCEDURE pw_copy_from_array_r3d_c3d_gs
            MODULE PROCEDURE pw_copy_from_array_c1d_r1d_gs
            MODULE PROCEDURE pw_copy_from_array_c1d_c1d_gs
            MODULE PROCEDURE pw_copy_from_array_c3d_r3d_gs
            MODULE PROCEDURE pw_copy_from_array_c3d_c3d_gs
   END INTERFACE
 
   INTERFACE pw_transfer
               MODULE PROCEDURE pw_copy_r1d_r1d_rs
               MODULE PROCEDURE pw_copy_r1d_r1d_gs
            MODULE PROCEDURE pw_gather_s_r1d_r3d_2
            MODULE PROCEDURE pw_scatter_s_r1d_r3d_2
               MODULE PROCEDURE pw_copy_r1d_c1d_rs
               MODULE PROCEDURE pw_copy_r1d_c1d_gs
            MODULE PROCEDURE pw_gather_s_r1d_c3d_2
            MODULE PROCEDURE pw_scatter_s_r1d_c3d_2
               MODULE PROCEDURE pw_copy_r3d_r3d_rs
               MODULE PROCEDURE pw_copy_r3d_r3d_gs
            MODULE PROCEDURE fft_wrap_pw1pw2_r3d_c1d_rs_gs
               MODULE PROCEDURE pw_copy_r3d_c3d_rs
               MODULE PROCEDURE pw_copy_r3d_c3d_gs
            MODULE PROCEDURE fft_wrap_pw1pw2_r3d_c3d_rs_gs
               MODULE PROCEDURE pw_copy_c1d_r1d_rs
               MODULE PROCEDURE pw_copy_c1d_r1d_gs
            MODULE PROCEDURE pw_gather_s_c1d_r3d_2
            MODULE PROCEDURE pw_scatter_s_c1d_r3d_2
            MODULE PROCEDURE fft_wrap_pw1pw2_c1d_r3d_gs_rs
               MODULE PROCEDURE pw_copy_c1d_c1d_rs
               MODULE PROCEDURE pw_copy_c1d_c1d_gs
            MODULE PROCEDURE pw_gather_s_c1d_c3d_2
            MODULE PROCEDURE pw_scatter_s_c1d_c3d_2
            MODULE PROCEDURE fft_wrap_pw1pw2_c1d_c3d_gs_rs
               MODULE PROCEDURE pw_copy_c3d_r3d_rs
               MODULE PROCEDURE pw_copy_c3d_r3d_gs
            MODULE PROCEDURE fft_wrap_pw1pw2_c3d_r3d_gs_rs
            MODULE PROCEDURE fft_wrap_pw1pw2_c3d_c1d_rs_gs
               MODULE PROCEDURE pw_copy_c3d_c3d_rs
               MODULE PROCEDURE pw_copy_c3d_c3d_gs
            MODULE PROCEDURE fft_wrap_pw1pw2_c3d_c3d_rs_gs
            MODULE PROCEDURE fft_wrap_pw1pw2_c3d_c3d_gs_rs
   END INTERFACE
 
CONTAINS
! **************************************************************************************************
!> \brief Set values of a pw type to zero
!> \param pw ...
!> \par History
!>      none
!> \author apsi
! **************************************************************************************************
         SUBROUTINE pw_zero_r1d_rs (pw)
 
            TYPE(pw_r1d_rs_type), INTENT(INOUT)                       :: pw
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_zero'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
#if !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw)
            pw%array =       0.0_dp
!$OMP END PARALLEL WORKSHARE
#else
            pw%array =       0.0_dp
#endif
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_zero_r1d_rs
 
! **************************************************************************************************
!> \brief multiplies pw coeffs with a number
!> \param pw ...
!> \param a ...
!> \par History
!>      11.2004 created [Joost VandeVondele]
! **************************************************************************************************
         SUBROUTINE pw_scale_r1d_rs (pw, a)
 
            TYPE(pw_r1d_rs_type), INTENT(INOUT)                       :: pw
            REAL(KIND=dp), INTENT(IN)                          :: a
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_scale'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(A, pw)
            pw%array = a*pw%array
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_scale_r1d_rs
 
! **************************************************************************************************
!> \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_r1d_rs (pw, unit_nr)
 
            TYPE(pw_r1d_rs_type), INTENT(in)                          :: pw
            INTEGER, INTENT(in)                                :: unit_nr
 
            INTEGER                                            :: iostatus
 
            WRITE (unit=unit_nr, fmt="('<pw>:{ ')", iostat=iostatus)
 
            WRITE (unit=unit_nr, fmt="(a)", iostat=iostatus) " in_use=r1d"
            IF (ASSOCIATED(pw%array)) THEN
                  WRITE (unit=unit_nr, fmt="(' array=<r(',i8,':',i8,')>')") &
                     lbound(pw%array, 1), ubound(pw%array, 1)
            ELSE
               WRITE (unit=unit_nr, fmt="(' array=*null*')")
            END IF
 
         END SUBROUTINE pw_write_r1d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param fun ...
!> \param isign ...
!> \param oprt ...
!> \return ...
! **************************************************************************************************
         FUNCTION pw_integrate_function_r1d_rs (fun, isign, oprt) RESULT(total_fun)
 
            TYPE(pw_r1d_rs_type), INTENT(IN)                          :: fun
            INTEGER, INTENT(IN), OPTIONAL                      :: isign
            CHARACTER(len=*), INTENT(IN), OPTIONAL             :: oprt
            REAL(kind=dp)                                      :: total_fun
 
            INTEGER                                            :: iop
 
            iop = 0
 
            IF (PRESENT(oprt)) THEN
               SELECT CASE (oprt)
               CASE ("ABS", "abs")
                  iop = 1
               CASE DEFAULT
                  cpabort("Unknown operator")
               END SELECT
            END IF
 
            total_fun = 0.0_dp
 
               ! do reduction using maximum accuracy
               IF (iop == 1) THEN
                  total_fun = fun%pw_grid%dvol*accurate_sum(abs(fun%array))
               ELSE
                  total_fun = fun%pw_grid%dvol*accurate_sum(      fun%array)
               END IF
 
            IF (fun%pw_grid%para%mode /= pw_mode_local) THEN
               CALL fun%pw_grid%para%group%sum(total_fun)
            END IF
 
            IF (PRESENT(isign)) THEN
               total_fun = total_fun*sign(1._dp, real(isign, dp))
            END IF
 
         END FUNCTION pw_integrate_function_r1d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param value ...
! **************************************************************************************************
         SUBROUTINE pw_set_value_r1d_rs (pw, value)
            TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), INTENT(IN)                          :: value
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_set_value'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw,value)
            pw%array =       value
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_set_value_r1d_rs
! **************************************************************************************************
!> \brief Set values of a pw type to zero
!> \param pw ...
!> \par History
!>      none
!> \author apsi
! **************************************************************************************************
         SUBROUTINE pw_zero_r1d_gs (pw)
 
            TYPE(pw_r1d_gs_type), INTENT(INOUT)                       :: pw
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_zero'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
#if !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw)
            pw%array =       0.0_dp
!$OMP END PARALLEL WORKSHARE
#else
            pw%array =       0.0_dp
#endif
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_zero_r1d_gs
 
! **************************************************************************************************
!> \brief multiplies pw coeffs with a number
!> \param pw ...
!> \param a ...
!> \par History
!>      11.2004 created [Joost VandeVondele]
! **************************************************************************************************
         SUBROUTINE pw_scale_r1d_gs (pw, a)
 
            TYPE(pw_r1d_gs_type), INTENT(INOUT)                       :: pw
            REAL(KIND=dp), INTENT(IN)                          :: a
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_scale'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(A, pw)
            pw%array = a*pw%array
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_scale_r1d_gs
 
! **************************************************************************************************
!> \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_r1d_gs (pw, unit_nr)
 
            TYPE(pw_r1d_gs_type), INTENT(in)                          :: pw
            INTEGER, INTENT(in)                                :: unit_nr
 
            INTEGER                                            :: iostatus
 
            WRITE (unit=unit_nr, fmt="('<pw>:{ ')", iostat=iostatus)
 
            WRITE (unit=unit_nr, fmt="(a)", iostat=iostatus) " in_use=r1d"
            IF (ASSOCIATED(pw%array)) THEN
                  WRITE (unit=unit_nr, fmt="(' array=<r(',i8,':',i8,')>')") &
                     lbound(pw%array, 1), ubound(pw%array, 1)
            ELSE
               WRITE (unit=unit_nr, fmt="(' array=*null*')")
            END IF
 
         END SUBROUTINE pw_write_r1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param fun ...
!> \param isign ...
!> \param oprt ...
!> \return ...
! **************************************************************************************************
         FUNCTION pw_integrate_function_r1d_gs (fun, isign, oprt) RESULT(total_fun)
 
            TYPE(pw_r1d_gs_type), INTENT(IN)                          :: fun
            INTEGER, INTENT(IN), OPTIONAL                      :: isign
            CHARACTER(len=*), INTENT(IN), OPTIONAL             :: oprt
            REAL(kind=dp)                                      :: total_fun
 
            INTEGER                                            :: iop
 
            iop = 0
 
            IF (PRESENT(oprt)) THEN
               SELECT CASE (oprt)
               CASE ("ABS", "abs")
                  iop = 1
               CASE DEFAULT
                  cpabort("Unknown operator")
               END SELECT
            END IF
 
            total_fun = 0.0_dp
 
               IF (iop == 1) &
                  cpabort("Operator ABS not implemented")
                  IF (fun%pw_grid%have_g0) total_fun = fun%pw_grid%vol*      fun%array(1)
 
            IF (fun%pw_grid%para%mode /= pw_mode_local) THEN
               CALL fun%pw_grid%para%group%sum(total_fun)
            END IF
 
            IF (PRESENT(isign)) THEN
               total_fun = total_fun*sign(1._dp, real(isign, dp))
            END IF
 
         END FUNCTION pw_integrate_function_r1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param value ...
! **************************************************************************************************
         SUBROUTINE pw_set_value_r1d_gs (pw, value)
            TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), INTENT(IN)                          :: value
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_set_value'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw,value)
            pw%array =       value
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_set_value_r1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param c ...
!> \param scale ...
! **************************************************************************************************
         SUBROUTINE pw_gather_p_r1d (pw, c, scale)
 
            TYPE(pw_r1d_gs_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
 
            CALL timeset(routinen, handle)
 
            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, &
                       ngpts => SIZE(pw%pw_grid%gsq), ghat => pw%pw_grid%g_hat, 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)
                     pw%array(gpt) = scale*      real(c(l, mn), kind=dp)
                  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%array(gpt) =       real(c(l, mn), kind=dp)
                  END DO
!$OMP END PARALLEL DO
               END IF
 
            END associate
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_gather_p_r1d
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param c ...
!> \param scale ...
! **************************************************************************************************
         SUBROUTINE pw_scatter_p_r1d (pw, c, scale)
            TYPE(pw_r1d_gs_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%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) =       cmplx(scale*pw%array(gpt), 0.0_dp, kind=dp)
                  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) =       cmplx(pw%array(gpt), 0.0_dp, kind=dp)
                  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*(      cmplx(pw%array(gpt), 0.0_dp, kind=dp))
                     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) = (      cmplx(pw%array(gpt), 0.0_dp, kind=dp))
                     END DO
!$OMP END PARALLEL DO
                  END IF
               END associate
            END IF
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_scatter_p_r1d
! **************************************************************************************************
!> \brief Set values of a pw type to zero
!> \param pw ...
!> \par History
!>      none
!> \author apsi
! **************************************************************************************************
         SUBROUTINE pw_zero_r3d_rs (pw)
 
            TYPE(pw_r3d_rs_type), INTENT(INOUT)                       :: pw
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_zero'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
#if !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw)
            pw%array =       0.0_dp
!$OMP END PARALLEL WORKSHARE
#else
            pw%array =       0.0_dp
#endif
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_zero_r3d_rs
 
! **************************************************************************************************
!> \brief multiplies pw coeffs with a number
!> \param pw ...
!> \param a ...
!> \par History
!>      11.2004 created [Joost VandeVondele]
! **************************************************************************************************
         SUBROUTINE pw_scale_r3d_rs (pw, a)
 
            TYPE(pw_r3d_rs_type), INTENT(INOUT)                       :: pw
            REAL(KIND=dp), INTENT(IN)                          :: a
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_scale'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(A, pw)
            pw%array = a*pw%array
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_scale_r3d_rs
 
! **************************************************************************************************
!> \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_r3d_rs (pw, unit_nr)
 
            TYPE(pw_r3d_rs_type), INTENT(in)                          :: pw
            INTEGER, INTENT(in)                                :: unit_nr
 
            INTEGER                                            :: iostatus
 
            WRITE (unit=unit_nr, fmt="('<pw>:{ ')", iostat=iostatus)
 
            WRITE (unit=unit_nr, fmt="(a)", iostat=iostatus) " in_use=r3d"
            IF (ASSOCIATED(pw%array)) THEN
                  WRITE (unit=unit_nr, fmt="(' array=<r(',i8,':',i8,',',i8,':',i8,',',i8,':',i8,')>')") &
                     lbound(pw%array, 1), ubound(pw%array, 1), lbound(pw%array, 2), ubound(pw%array, 2), &
                     lbound(pw%array, 3), ubound(pw%array, 3)
            ELSE
               WRITE (unit=unit_nr, fmt="(' array=*null*')")
            END IF
 
         END SUBROUTINE pw_write_r3d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param fun ...
!> \param isign ...
!> \param oprt ...
!> \return ...
! **************************************************************************************************
         FUNCTION pw_integrate_function_r3d_rs (fun, isign, oprt) RESULT(total_fun)
 
            TYPE(pw_r3d_rs_type), INTENT(IN)                          :: fun
            INTEGER, INTENT(IN), OPTIONAL                      :: isign
            CHARACTER(len=*), INTENT(IN), OPTIONAL             :: oprt
            REAL(kind=dp)                                      :: total_fun
 
            INTEGER                                            :: iop
 
            iop = 0
 
            IF (PRESENT(oprt)) THEN
               SELECT CASE (oprt)
               CASE ("ABS", "abs")
                  iop = 1
               CASE DEFAULT
                  cpabort("Unknown operator")
               END SELECT
            END IF
 
            total_fun = 0.0_dp
 
               ! do reduction using maximum accuracy
               IF (iop == 1) THEN
                  total_fun = fun%pw_grid%dvol*accurate_sum(abs(fun%array))
               ELSE
                  total_fun = fun%pw_grid%dvol*accurate_sum(      fun%array)
               END IF
 
            IF (fun%pw_grid%para%mode /= pw_mode_local) THEN
               CALL fun%pw_grid%para%group%sum(total_fun)
            END IF
 
            IF (PRESENT(isign)) THEN
               total_fun = total_fun*sign(1._dp, real(isign, dp))
            END IF
 
         END FUNCTION pw_integrate_function_r3d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param value ...
! **************************************************************************************************
         SUBROUTINE pw_set_value_r3d_rs (pw, value)
            TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), INTENT(IN)                          :: value
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_set_value'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw,value)
            pw%array =       value
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_set_value_r3d_rs
! **************************************************************************************************
!> \brief Set values of a pw type to zero
!> \param pw ...
!> \par History
!>      none
!> \author apsi
! **************************************************************************************************
         SUBROUTINE pw_zero_r3d_gs (pw)
 
            TYPE(pw_r3d_gs_type), INTENT(INOUT)                       :: pw
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_zero'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
#if !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw)
            pw%array =       0.0_dp
!$OMP END PARALLEL WORKSHARE
#else
            pw%array =       0.0_dp
#endif
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_zero_r3d_gs
 
! **************************************************************************************************
!> \brief multiplies pw coeffs with a number
!> \param pw ...
!> \param a ...
!> \par History
!>      11.2004 created [Joost VandeVondele]
! **************************************************************************************************
         SUBROUTINE pw_scale_r3d_gs (pw, a)
 
            TYPE(pw_r3d_gs_type), INTENT(INOUT)                       :: pw
            REAL(KIND=dp), INTENT(IN)                          :: a
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_scale'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(A, pw)
            pw%array = a*pw%array
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_scale_r3d_gs
 
! **************************************************************************************************
!> \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_r3d_gs (pw, unit_nr)
 
            TYPE(pw_r3d_gs_type), INTENT(in)                          :: pw
            INTEGER, INTENT(in)                                :: unit_nr
 
            INTEGER                                            :: iostatus
 
            WRITE (unit=unit_nr, fmt="('<pw>:{ ')", iostat=iostatus)
 
            WRITE (unit=unit_nr, fmt="(a)", iostat=iostatus) " in_use=r3d"
            IF (ASSOCIATED(pw%array)) THEN
                  WRITE (unit=unit_nr, fmt="(' array=<r(',i8,':',i8,',',i8,':',i8,',',i8,':',i8,')>')") &
                     lbound(pw%array, 1), ubound(pw%array, 1), lbound(pw%array, 2), ubound(pw%array, 2), &
                     lbound(pw%array, 3), ubound(pw%array, 3)
            ELSE
               WRITE (unit=unit_nr, fmt="(' array=*null*')")
            END IF
 
         END SUBROUTINE pw_write_r3d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param fun ...
!> \param isign ...
!> \param oprt ...
!> \return ...
! **************************************************************************************************
         FUNCTION pw_integrate_function_r3d_gs (fun, isign, oprt) RESULT(total_fun)
 
            TYPE(pw_r3d_gs_type), INTENT(IN)                          :: fun
            INTEGER, INTENT(IN), OPTIONAL                      :: isign
            CHARACTER(len=*), INTENT(IN), OPTIONAL             :: oprt
            REAL(kind=dp)                                      :: total_fun
 
            INTEGER                                            :: iop
 
            iop = 0
 
            IF (PRESENT(oprt)) THEN
               SELECT CASE (oprt)
               CASE ("ABS", "abs")
                  iop = 1
               CASE DEFAULT
                  cpabort("Unknown operator")
               END SELECT
            END IF
 
            total_fun = 0.0_dp
 
               IF (iop == 1) &
                  cpabort("Operator ABS not implemented")
                  cpabort("Reciprocal space integration for 3D grids not implemented!")
 
            IF (fun%pw_grid%para%mode /= pw_mode_local) THEN
               CALL fun%pw_grid%para%group%sum(total_fun)
            END IF
 
            IF (PRESENT(isign)) THEN
               total_fun = total_fun*sign(1._dp, real(isign, dp))
            END IF
 
         END FUNCTION pw_integrate_function_r3d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param value ...
! **************************************************************************************************
         SUBROUTINE pw_set_value_r3d_gs (pw, value)
            TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), INTENT(IN)                          :: value
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_set_value'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw,value)
            pw%array =       value
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_set_value_r3d_gs
 
! **************************************************************************************************
!> \brief Set values of a pw type to zero
!> \param pw ...
!> \par History
!>      none
!> \author apsi
! **************************************************************************************************
         SUBROUTINE pw_zero_c1d_rs (pw)
 
            TYPE(pw_c1d_rs_type), INTENT(INOUT)                       :: pw
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_zero'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
#if !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw)
            pw%array =       cmplx(0.0_dp, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
#else
            pw%array =       cmplx(0.0_dp, 0.0_dp, kind=dp)
#endif
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_zero_c1d_rs
 
! **************************************************************************************************
!> \brief multiplies pw coeffs with a number
!> \param pw ...
!> \param a ...
!> \par History
!>      11.2004 created [Joost VandeVondele]
! **************************************************************************************************
         SUBROUTINE pw_scale_c1d_rs (pw, a)
 
            TYPE(pw_c1d_rs_type), INTENT(INOUT)                       :: pw
            REAL(KIND=dp), INTENT(IN)                          :: a
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_scale'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(A, pw)
            pw%array = a*pw%array
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_scale_c1d_rs
 
! **************************************************************************************************
!> \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_c1d_rs (pw, unit_nr)
 
            TYPE(pw_c1d_rs_type), INTENT(in)                          :: pw
            INTEGER, INTENT(in)                                :: unit_nr
 
            INTEGER                                            :: iostatus
 
            WRITE (unit=unit_nr, fmt="('<pw>:{ ')", iostat=iostatus)
 
            WRITE (unit=unit_nr, fmt="(a)", iostat=iostatus) " in_use=c1d"
            IF (ASSOCIATED(pw%array)) THEN
                  WRITE (unit=unit_nr, fmt="(' array=<c(',i8,':',i8,')>')") &
                     lbound(pw%array, 1), ubound(pw%array, 1)
            ELSE
               WRITE (unit=unit_nr, fmt="(' array=*null*')")
            END IF
 
         END SUBROUTINE pw_write_c1d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param fun ...
!> \param isign ...
!> \param oprt ...
!> \return ...
! **************************************************************************************************
         FUNCTION pw_integrate_function_c1d_rs (fun, isign, oprt) RESULT(total_fun)
 
            TYPE(pw_c1d_rs_type), INTENT(IN)                          :: fun
            INTEGER, INTENT(IN), OPTIONAL                      :: isign
            CHARACTER(len=*), INTENT(IN), OPTIONAL             :: oprt
            REAL(kind=dp)                                      :: total_fun
 
            INTEGER                                            :: iop
 
            iop = 0
 
            IF (PRESENT(oprt)) THEN
               SELECT CASE (oprt)
               CASE ("ABS", "abs")
                  iop = 1
               CASE DEFAULT
                  cpabort("Unknown operator")
               END SELECT
            END IF
 
            total_fun = 0.0_dp
 
               ! do reduction using maximum accuracy
               IF (iop == 1) THEN
                  total_fun = fun%pw_grid%dvol*accurate_sum(abs(fun%array))
               ELSE
                  total_fun = fun%pw_grid%dvol*accurate_sum(      real(fun%array, kind=dp))
               END IF
 
            IF (fun%pw_grid%para%mode /= pw_mode_local) THEN
               CALL fun%pw_grid%para%group%sum(total_fun)
            END IF
 
            IF (PRESENT(isign)) THEN
               total_fun = total_fun*sign(1._dp, real(isign, dp))
            END IF
 
         END FUNCTION pw_integrate_function_c1d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param value ...
! **************************************************************************************************
         SUBROUTINE pw_set_value_c1d_rs (pw, value)
            TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), INTENT(IN)                          :: value
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_set_value'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw,value)
            pw%array =       cmplx(value, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_set_value_c1d_rs
! **************************************************************************************************
!> \brief Set values of a pw type to zero
!> \param pw ...
!> \par History
!>      none
!> \author apsi
! **************************************************************************************************
         SUBROUTINE pw_zero_c1d_gs (pw)
 
            TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_zero'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
#if !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw)
            pw%array =       cmplx(0.0_dp, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
#else
            pw%array =       cmplx(0.0_dp, 0.0_dp, kind=dp)
#endif
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_zero_c1d_gs
 
! **************************************************************************************************
!> \brief multiplies pw coeffs with a number
!> \param pw ...
!> \param a ...
!> \par History
!>      11.2004 created [Joost VandeVondele]
! **************************************************************************************************
         SUBROUTINE pw_scale_c1d_gs (pw, a)
 
            TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw
            REAL(KIND=dp), INTENT(IN)                          :: a
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_scale'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(A, pw)
            pw%array = a*pw%array
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_scale_c1d_gs
 
! **************************************************************************************************
!> \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_c1d_gs (pw, unit_nr)
 
            TYPE(pw_c1d_gs_type), INTENT(in)                          :: pw
            INTEGER, INTENT(in)                                :: unit_nr
 
            INTEGER                                            :: iostatus
 
            WRITE (unit=unit_nr, fmt="('<pw>:{ ')", iostat=iostatus)
 
            WRITE (unit=unit_nr, fmt="(a)", iostat=iostatus) " in_use=c1d"
            IF (ASSOCIATED(pw%array)) THEN
                  WRITE (unit=unit_nr, fmt="(' array=<c(',i8,':',i8,')>')") &
                     lbound(pw%array, 1), ubound(pw%array, 1)
            ELSE
               WRITE (unit=unit_nr, fmt="(' array=*null*')")
            END IF
 
         END SUBROUTINE pw_write_c1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param fun ...
!> \param isign ...
!> \param oprt ...
!> \return ...
! **************************************************************************************************
         FUNCTION pw_integrate_function_c1d_gs (fun, isign, oprt) RESULT(total_fun)
 
            TYPE(pw_c1d_gs_type), INTENT(IN)                          :: fun
            INTEGER, INTENT(IN), OPTIONAL                      :: isign
            CHARACTER(len=*), INTENT(IN), OPTIONAL             :: oprt
            REAL(kind=dp)                                      :: total_fun
 
            INTEGER                                            :: iop
 
            iop = 0
 
            IF (PRESENT(oprt)) THEN
               SELECT CASE (oprt)
               CASE ("ABS", "abs")
                  iop = 1
               CASE DEFAULT
                  cpabort("Unknown operator")
               END SELECT
            END IF
 
            total_fun = 0.0_dp
 
               IF (iop == 1) &
                  cpabort("Operator ABS not implemented")
                  IF (fun%pw_grid%have_g0) total_fun = fun%pw_grid%vol*      real(fun%array(1), kind=dp)
 
            IF (fun%pw_grid%para%mode /= pw_mode_local) THEN
               CALL fun%pw_grid%para%group%sum(total_fun)
            END IF
 
            IF (PRESENT(isign)) THEN
               total_fun = total_fun*sign(1._dp, real(isign, dp))
            END IF
 
         END FUNCTION pw_integrate_function_c1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param value ...
! **************************************************************************************************
         SUBROUTINE pw_set_value_c1d_gs (pw, value)
            TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), INTENT(IN)                          :: value
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_set_value'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw,value)
            pw%array =       cmplx(value, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_set_value_c1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param c ...
!> \param scale ...
! **************************************************************************************************
         SUBROUTINE pw_gather_p_c1d (pw, c, scale)
 
            TYPE(pw_c1d_gs_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
 
            CALL timeset(routinen, handle)
 
            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, &
                       ngpts => SIZE(pw%pw_grid%gsq), ghat => pw%pw_grid%g_hat, 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)
                     pw%array(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%array(gpt) =       c(l, mn)
                  END DO
!$OMP END PARALLEL DO
               END IF
 
            END associate
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_gather_p_c1d
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param c ...
!> \param scale ...
! **************************************************************************************************
         SUBROUTINE pw_scatter_p_c1d (pw, c, scale)
            TYPE(pw_c1d_gs_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%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%array(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%array(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%array(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%array(gpt))
                     END DO
!$OMP END PARALLEL DO
                  END IF
               END associate
            END IF
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_scatter_p_c1d
! **************************************************************************************************
!> \brief Set values of a pw type to zero
!> \param pw ...
!> \par History
!>      none
!> \author apsi
! **************************************************************************************************
         SUBROUTINE pw_zero_c3d_rs (pw)
 
            TYPE(pw_c3d_rs_type), INTENT(INOUT)                       :: pw
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_zero'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
#if !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw)
            pw%array =       cmplx(0.0_dp, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
#else
            pw%array =       cmplx(0.0_dp, 0.0_dp, kind=dp)
#endif
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_zero_c3d_rs
 
! **************************************************************************************************
!> \brief multiplies pw coeffs with a number
!> \param pw ...
!> \param a ...
!> \par History
!>      11.2004 created [Joost VandeVondele]
! **************************************************************************************************
         SUBROUTINE pw_scale_c3d_rs (pw, a)
 
            TYPE(pw_c3d_rs_type), INTENT(INOUT)                       :: pw
            REAL(KIND=dp), INTENT(IN)                          :: a
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_scale'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(A, pw)
            pw%array = a*pw%array
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_scale_c3d_rs
 
! **************************************************************************************************
!> \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_c3d_rs (pw, unit_nr)
 
            TYPE(pw_c3d_rs_type), INTENT(in)                          :: pw
            INTEGER, INTENT(in)                                :: unit_nr
 
            INTEGER                                            :: iostatus
 
            WRITE (unit=unit_nr, fmt="('<pw>:{ ')", iostat=iostatus)
 
            WRITE (unit=unit_nr, fmt="(a)", iostat=iostatus) " in_use=c3d"
            IF (ASSOCIATED(pw%array)) THEN
                  WRITE (unit=unit_nr, fmt="(' array=<c(',i8,':',i8,',',i8,':',i8,',',i8,':',i8,')>')") &
                     lbound(pw%array, 1), ubound(pw%array, 1), lbound(pw%array, 2), ubound(pw%array, 2), &
                     lbound(pw%array, 3), ubound(pw%array, 3)
            ELSE
               WRITE (unit=unit_nr, fmt="(' array=*null*')")
            END IF
 
         END SUBROUTINE pw_write_c3d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param fun ...
!> \param isign ...
!> \param oprt ...
!> \return ...
! **************************************************************************************************
         FUNCTION pw_integrate_function_c3d_rs (fun, isign, oprt) RESULT(total_fun)
 
            TYPE(pw_c3d_rs_type), INTENT(IN)                          :: fun
            INTEGER, INTENT(IN), OPTIONAL                      :: isign
            CHARACTER(len=*), INTENT(IN), OPTIONAL             :: oprt
            REAL(kind=dp)                                      :: total_fun
 
            INTEGER                                            :: iop
 
            iop = 0
 
            IF (PRESENT(oprt)) THEN
               SELECT CASE (oprt)
               CASE ("ABS", "abs")
                  iop = 1
               CASE DEFAULT
                  cpabort("Unknown operator")
               END SELECT
            END IF
 
            total_fun = 0.0_dp
 
               ! do reduction using maximum accuracy
               IF (iop == 1) THEN
                  total_fun = fun%pw_grid%dvol*accurate_sum(abs(fun%array))
               ELSE
                  total_fun = fun%pw_grid%dvol*accurate_sum(      real(fun%array, kind=dp))
               END IF
 
            IF (fun%pw_grid%para%mode /= pw_mode_local) THEN
               CALL fun%pw_grid%para%group%sum(total_fun)
            END IF
 
            IF (PRESENT(isign)) THEN
               total_fun = total_fun*sign(1._dp, real(isign, dp))
            END IF
 
         END FUNCTION pw_integrate_function_c3d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param value ...
! **************************************************************************************************
         SUBROUTINE pw_set_value_c3d_rs (pw, value)
            TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), INTENT(IN)                          :: value
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_set_value'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw,value)
            pw%array =       cmplx(value, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_set_value_c3d_rs
! **************************************************************************************************
!> \brief Set values of a pw type to zero
!> \param pw ...
!> \par History
!>      none
!> \author apsi
! **************************************************************************************************
         SUBROUTINE pw_zero_c3d_gs (pw)
 
            TYPE(pw_c3d_gs_type), INTENT(INOUT)                       :: pw
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_zero'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
#if !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw)
            pw%array =       cmplx(0.0_dp, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
#else
            pw%array =       cmplx(0.0_dp, 0.0_dp, kind=dp)
#endif
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_zero_c3d_gs
 
! **************************************************************************************************
!> \brief multiplies pw coeffs with a number
!> \param pw ...
!> \param a ...
!> \par History
!>      11.2004 created [Joost VandeVondele]
! **************************************************************************************************
         SUBROUTINE pw_scale_c3d_gs (pw, a)
 
            TYPE(pw_c3d_gs_type), INTENT(INOUT)                       :: pw
            REAL(KIND=dp), INTENT(IN)                          :: a
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_scale'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(A, pw)
            pw%array = a*pw%array
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_scale_c3d_gs
 
! **************************************************************************************************
!> \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_c3d_gs (pw, unit_nr)
 
            TYPE(pw_c3d_gs_type), INTENT(in)                          :: pw
            INTEGER, INTENT(in)                                :: unit_nr
 
            INTEGER                                            :: iostatus
 
            WRITE (unit=unit_nr, fmt="('<pw>:{ ')", iostat=iostatus)
 
            WRITE (unit=unit_nr, fmt="(a)", iostat=iostatus) " in_use=c3d"
            IF (ASSOCIATED(pw%array)) THEN
                  WRITE (unit=unit_nr, fmt="(' array=<c(',i8,':',i8,',',i8,':',i8,',',i8,':',i8,')>')") &
                     lbound(pw%array, 1), ubound(pw%array, 1), lbound(pw%array, 2), ubound(pw%array, 2), &
                     lbound(pw%array, 3), ubound(pw%array, 3)
            ELSE
               WRITE (unit=unit_nr, fmt="(' array=*null*')")
            END IF
 
         END SUBROUTINE pw_write_c3d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param fun ...
!> \param isign ...
!> \param oprt ...
!> \return ...
! **************************************************************************************************
         FUNCTION pw_integrate_function_c3d_gs (fun, isign, oprt) RESULT(total_fun)
 
            TYPE(pw_c3d_gs_type), INTENT(IN)                          :: fun
            INTEGER, INTENT(IN), OPTIONAL                      :: isign
            CHARACTER(len=*), INTENT(IN), OPTIONAL             :: oprt
            REAL(kind=dp)                                      :: total_fun
 
            INTEGER                                            :: iop
 
            iop = 0
 
            IF (PRESENT(oprt)) THEN
               SELECT CASE (oprt)
               CASE ("ABS", "abs")
                  iop = 1
               CASE DEFAULT
                  cpabort("Unknown operator")
               END SELECT
            END IF
 
            total_fun = 0.0_dp
 
               IF (iop == 1) &
                  cpabort("Operator ABS not implemented")
                  cpabort("Reciprocal space integration for 3D grids not implemented!")
 
            IF (fun%pw_grid%para%mode /= pw_mode_local) THEN
               CALL fun%pw_grid%para%group%sum(total_fun)
            END IF
 
            IF (PRESENT(isign)) THEN
               total_fun = total_fun*sign(1._dp, real(isign, dp))
            END IF
 
         END FUNCTION pw_integrate_function_c3d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param value ...
! **************************************************************************************************
         SUBROUTINE pw_set_value_c3d_gs (pw, value)
            TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), INTENT(IN)                          :: value
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_set_value'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw,value)
            pw%array =       cmplx(value, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_set_value_c3d_gs
 
 
! **************************************************************************************************
!> \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_r1d_r1d_rs (pw1, pw2)
 
            TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw1
            TYPE(pw_r1d_rs_type), INTENT(INOUT)                       :: pw2
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_copy'
 
            INTEGER                                            :: handle
               INTEGER :: i, j, ng, ng1, ng2, ns
 
            CALL timeset(routinen, handle)
 
            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) &
                  cpabort("Spherical grids only exist in reciprocal space!")
 
               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) =       pw1%array(1:ng)
!$OMP END PARALLEL WORKSHARE
                        IF (ng2 > ng) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(ng, ng2, pw2)
                           pw2%array(ng + 1:ng2) =       0.0_dp
!$OMP END PARALLEL WORKSHARE
                        END IF
                     ELSE
                        cpabort("Copies between spherical grids require compatible grids!")
                     END IF
                  ELSE
                     ng1 = SIZE(pw1%array)
                     ng2 = SIZE(pw2%array)
                     ns = 2*max(ng1, ng2)
 
                     IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                        IF (ng1 >= ng2) THEN
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP             PRIVATE(i,j) &
!$OMP             SHARED(ng2, pw1, pw2)
                           DO i = 1, ng2
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) =       pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        ELSE
                           CALL pw_zero(pw2)
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP             PRIVATE(i,j) &
!$OMP             SHARED(ng1, pw1, pw2)
                           DO i = 1, ng1
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) =       pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE IF ((pw2%pw_grid%id_nr == pw1%pw_grid%reference)) THEN
                        IF (ng1 >= ng2) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng2, pw1, pw2)
                           DO i = 1, ng2
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) =       pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        ELSE
                           CALL pw_zero(pw2)
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng1, pw1, pw2)
                           DO i = 1, ng1
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) =       pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                           cpabort("Copy not implemented!")
                     END IF
 
                  END IF
 
               ELSE
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw1, pw2)
                  pw2%array =       pw1%array
!$OMP END PARALLEL WORKSHARE
               END IF
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_copy_r1d_r1d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_to_array_r1d_r1d_rs (pw, array)
            TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), DIMENSION(:), INTENT(INOUT)   :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
               array(:) =       pw%array(:)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_to_array_r1d_r1d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_from_array_r1d_r1d_rs (pw, array)
            TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), DIMENSION(:), INTENT(IN)      :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
            pw%array =       array
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_from_array_r1d_r1d_rs
 
! **************************************************************************************************
!> \brief pw2 = alpha*pw1 + beta*pw2
!>      alpha defaults to 1, beta defaults to 1
!> \param pw1 ...
!> \param pw2 ...
!> \param alpha ...
!> \param beta ...
!> \param allow_noncompatible_grids ...
!> \par History
!>      JGH (21-Feb-2003) : added reference grid functionality
!>      JGH (01-Dec-2007) : rename and remove complex alpha
!> \author apsi
!> \note
!>      Currently only summing up of respective types allowed,
!>      in order to avoid errors
! **************************************************************************************************
         SUBROUTINE pw_axpy_r1d_r1d_rs (pw1, pw2, alpha, beta, allow_noncompatible_grids)
 
            TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw1
            TYPE(pw_r1d_rs_type), INTENT(INOUT)                       :: pw2
            REAL(KIND=dp), INTENT(in), OPTIONAL                :: alpha, beta
            LOGICAL, INTENT(IN), OPTIONAL                      :: allow_noncompatible_grids
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_axpy'
 
            INTEGER                                            :: handle
            LOGICAL                                            :: my_allow_noncompatible_grids
            REAL(KIND=dp)                                      :: my_alpha, my_beta
               INTEGER                                            :: i, j, ng, ng1, ng2
 
            CALL timeset(routinen, handle)
 
            my_alpha = 1.0_dp
            IF (PRESENT(alpha)) my_alpha = alpha
 
            my_beta = 1.0_dp
            IF (PRESENT(beta)) my_beta = beta
 
            my_allow_noncompatible_grids = .false.
            IF (PRESENT(allow_noncompatible_grids)) my_allow_noncompatible_grids = allow_noncompatible_grids
 
            IF (my_beta /= 1.0_dp) THEN
               IF (my_beta == 0.0_dp) THEN
                  CALL pw_zero(pw2)
               ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw2,my_beta)
                  pw2%array = pw2%array*my_beta
!$OMP END PARALLEL WORKSHARE
               END IF
            END IF
 
               IF (ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
 
                  IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw1, pw2)
                     pw2%array = pw2%array +       pw1%array
!$OMP END PARALLEL WORKSHARE
                  ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha)
                     pw2%array = pw2%array + my_alpha*      pw1%array
!$OMP END PARALLEL WORKSHARE
                  END IF
 
               ELSE IF (pw_compatible(pw1%pw_grid, pw2%pw_grid) .OR. my_allow_noncompatible_grids) THEN
 
                  ng1 = SIZE(pw1%array)
                  ng2 = SIZE(pw2%array)
                  ng = min(ng1, ng2)
 
                  IF (pw1%pw_grid%spherical) THEN
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                        DO i = 1, ng
                           pw2%array(i) = pw2%array(i) +       pw1%array(i)
                        END DO
!$OMP END PARALLEL DO
                     ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha,ng)
                        DO i = 1, ng
                           pw2%array(i) = pw2%array(i) + my_alpha*      pw1%array(i)
                        END DO
!$OMP END PARALLEL DO
                     END IF
                  ELSE IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                     IF (ng1 >= ng2) THEN
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) +       pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) + my_alpha*      pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) +       pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) + my_alpha*      pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END IF
                  ELSE IF ((pw2%pw_grid%id_nr == pw1%pw_grid%reference)) THEN
                     IF (ng1 >= ng2) THEN
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) +       pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) + my_alpha*      pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) +       pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) + my_alpha*      pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END IF
                  ELSE
                     cpabort("Grids not compatible")
                  END IF
 
                  ELSE
 
                     cpabort("Grids not compatible")
 
                  END IF
 
                  CALL timestop(handle)
 
                  END SUBROUTINE pw_axpy_r1d_r1d_rs
 
! **************************************************************************************************
!> \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_r1d_r1d_rs (pw_out, pw1, pw2, alpha)
 
                     TYPE(pw_r1d_rs_type), INTENT(INOUT)                       :: pw_out
                     TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_r1d_rs_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 !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
                     END IF
#else
                     IF (my_alpha == 1.0_dp) THEN
                        pw_out%array = pw_out%array + pw1%array*      pw2%array
                     ELSE
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      pw2%array
                     END IF
#endif
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_r1d_r1d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
! **************************************************************************************************
                  SUBROUTINE pw_multiply_with_r1d_r1d_rs (pw1, pw2)
                     TYPE(pw_r1d_rs_type), INTENT(INOUT)                       :: pw1
                     TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw2
 
                     CHARACTER(LEN=*), PARAMETER                        :: routineN = 'pw_multiply_with'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) &
                        cpabort("Incompatible grids!")
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                     pw1%array = pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_with_r1d_r1d_rs
 
! **************************************************************************************************
!> \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_r1d_r1d_rs (pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value)
 
                     TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw2
                     INTEGER, INTENT(IN), OPTIONAL                      :: sumtype
                     LOGICAL, INTENT(IN), OPTIONAL                      :: just_sum, local_only
                     REAL(kind=dp)                                      :: integral_value
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_integral_ab_r1d_r1d_rs'
 
                     INTEGER                                            :: handle, loc_sumtype
                     LOGICAL                                            :: my_just_sum, my_local_only
 
                     CALL timeset(routinen, handle)
 
                     loc_sumtype = do_accurate_sum
                     IF (PRESENT(sumtype)) loc_sumtype = sumtype
 
                     my_local_only = .false.
                     IF (PRESENT(local_only)) my_local_only = local_only
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                        cpabort("Grids incompatible")
                     END IF
 
                     my_just_sum = .false.
                     IF (PRESENT(just_sum)) my_just_sum = just_sum
 
                     ! do standard sum
                     IF (loc_sumtype == do_standard_sum) THEN
 
                        ! Do standard sum
 
                           integral_value = dot_product(pw1%array, pw2%array)
 
                     ELSE
 
                        ! Do accurate sum
                           integral_value = accurate_dot_product(pw1%array, pw2%array)
 
                     END IF
 
                     IF (.NOT. my_just_sum) THEN
                           integral_value = integral_value*pw1%pw_grid%dvol
                     END IF
 
                        IF (pw1%pw_grid%grid_span == halfspace) THEN
                           integral_value = 2.0_dp*integral_value
                           IF (pw1%pw_grid%have_g0) integral_value = integral_value - &
                              pw1%array(1)*pw2%array(1)
                           END IF
 
                        IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == pw_mode_distributed) &
                           CALL pw1%pw_grid%para%group%sum(integral_value)
 
                        CALL timestop(handle)
 
                     END FUNCTION pw_integral_ab_r1d_r1d_rs
! **************************************************************************************************
!> \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_r1d_r1d_gs (pw1, pw2)
 
            TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw1
            TYPE(pw_r1d_gs_type), INTENT(INOUT)                       :: pw2
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_copy'
 
            INTEGER                                            :: handle
               INTEGER :: i, j, ng, ng1, ng2, ns
 
            CALL timeset(routinen, handle)
 
            IF (pw1%pw_grid%spherical .neqv. pw2%pw_grid%spherical) &
               cpabort("Both grids must be either spherical or non-spherical!")
 
               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) =       pw1%array(1:ng)
!$OMP END PARALLEL WORKSHARE
                        IF (ng2 > ng) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(ng, ng2, pw2)
                           pw2%array(ng + 1:ng2) =       0.0_dp
!$OMP END PARALLEL WORKSHARE
                        END IF
                     ELSE
                        cpabort("Copies between spherical grids require compatible grids!")
                     END IF
                  ELSE
                     ng1 = SIZE(pw1%array)
                     ng2 = SIZE(pw2%array)
                     ns = 2*max(ng1, ng2)
 
                     IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                        IF (ng1 >= ng2) THEN
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP             PRIVATE(i,j) &
!$OMP             SHARED(ng2, pw1, pw2)
                           DO i = 1, ng2
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) =       pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        ELSE
                           CALL pw_zero(pw2)
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP             PRIVATE(i,j) &
!$OMP             SHARED(ng1, pw1, pw2)
                           DO i = 1, ng1
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) =       pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE IF ((pw2%pw_grid%id_nr == pw1%pw_grid%reference)) THEN
                        IF (ng1 >= ng2) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng2, pw1, pw2)
                           DO i = 1, ng2
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) =       pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        ELSE
                           CALL pw_zero(pw2)
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng1, pw1, pw2)
                           DO i = 1, ng1
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) =       pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                           cpabort("Copy not implemented!")
                     END IF
 
                  END IF
 
               ELSE
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw1, pw2)
                  pw2%array =       pw1%array
!$OMP END PARALLEL WORKSHARE
               END IF
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_copy_r1d_r1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_to_array_r1d_r1d_gs (pw, array)
            TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), DIMENSION(:), INTENT(INOUT)   :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
               array(:) =       pw%array(:)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_to_array_r1d_r1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_from_array_r1d_r1d_gs (pw, array)
            TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), DIMENSION(:), INTENT(IN)      :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
            pw%array =       array
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_from_array_r1d_r1d_gs
 
! **************************************************************************************************
!> \brief pw2 = alpha*pw1 + beta*pw2
!>      alpha defaults to 1, beta defaults to 1
!> \param pw1 ...
!> \param pw2 ...
!> \param alpha ...
!> \param beta ...
!> \param allow_noncompatible_grids ...
!> \par History
!>      JGH (21-Feb-2003) : added reference grid functionality
!>      JGH (01-Dec-2007) : rename and remove complex alpha
!> \author apsi
!> \note
!>      Currently only summing up of respective types allowed,
!>      in order to avoid errors
! **************************************************************************************************
         SUBROUTINE pw_axpy_r1d_r1d_gs (pw1, pw2, alpha, beta, allow_noncompatible_grids)
 
            TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw1
            TYPE(pw_r1d_gs_type), INTENT(INOUT)                       :: pw2
            REAL(KIND=dp), INTENT(in), OPTIONAL                :: alpha, beta
            LOGICAL, INTENT(IN), OPTIONAL                      :: allow_noncompatible_grids
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_axpy'
 
            INTEGER                                            :: handle
            LOGICAL                                            :: my_allow_noncompatible_grids
            REAL(KIND=dp)                                      :: my_alpha, my_beta
               INTEGER                                            :: i, j, ng, ng1, ng2
 
            CALL timeset(routinen, handle)
 
            my_alpha = 1.0_dp
            IF (PRESENT(alpha)) my_alpha = alpha
 
            my_beta = 1.0_dp
            IF (PRESENT(beta)) my_beta = beta
 
            my_allow_noncompatible_grids = .false.
            IF (PRESENT(allow_noncompatible_grids)) my_allow_noncompatible_grids = allow_noncompatible_grids
 
            IF (my_beta /= 1.0_dp) THEN
               IF (my_beta == 0.0_dp) THEN
                  CALL pw_zero(pw2)
               ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw2,my_beta)
                  pw2%array = pw2%array*my_beta
!$OMP END PARALLEL WORKSHARE
               END IF
            END IF
 
               IF (ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
 
                  IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw1, pw2)
                     pw2%array = pw2%array +       pw1%array
!$OMP END PARALLEL WORKSHARE
                  ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha)
                     pw2%array = pw2%array + my_alpha*      pw1%array
!$OMP END PARALLEL WORKSHARE
                  END IF
 
               ELSE IF (pw_compatible(pw1%pw_grid, pw2%pw_grid) .OR. my_allow_noncompatible_grids) THEN
 
                  ng1 = SIZE(pw1%array)
                  ng2 = SIZE(pw2%array)
                  ng = min(ng1, ng2)
 
                  IF (pw1%pw_grid%spherical) THEN
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                        DO i = 1, ng
                           pw2%array(i) = pw2%array(i) +       pw1%array(i)
                        END DO
!$OMP END PARALLEL DO
                     ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha,ng)
                        DO i = 1, ng
                           pw2%array(i) = pw2%array(i) + my_alpha*      pw1%array(i)
                        END DO
!$OMP END PARALLEL DO
                     END IF
                  ELSE IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                     IF (ng1 >= ng2) THEN
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) +       pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) + my_alpha*      pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) +       pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) + my_alpha*      pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END IF
                  ELSE IF ((pw2%pw_grid%id_nr == pw1%pw_grid%reference)) THEN
                     IF (ng1 >= ng2) THEN
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) +       pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) + my_alpha*      pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) +       pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) + my_alpha*      pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END IF
                  ELSE
                     cpabort("Grids not compatible")
                  END IF
 
                  ELSE
 
                     cpabort("Grids not compatible")
 
                  END IF
 
                  CALL timestop(handle)
 
                  END SUBROUTINE pw_axpy_r1d_r1d_gs
 
! **************************************************************************************************
!> \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_r1d_r1d_gs (pw_out, pw1, pw2, alpha)
 
                     TYPE(pw_r1d_gs_type), INTENT(INOUT)                       :: pw_out
                     TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_r1d_gs_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 !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
                     END IF
#else
                     IF (my_alpha == 1.0_dp) THEN
                        pw_out%array = pw_out%array + pw1%array*      pw2%array
                     ELSE
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      pw2%array
                     END IF
#endif
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_r1d_r1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
! **************************************************************************************************
                  SUBROUTINE pw_multiply_with_r1d_r1d_gs (pw1, pw2)
                     TYPE(pw_r1d_gs_type), INTENT(INOUT)                       :: pw1
                     TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw2
 
                     CHARACTER(LEN=*), PARAMETER                        :: routineN = 'pw_multiply_with'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) &
                        cpabort("Incompatible grids!")
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                     pw1%array = pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_with_r1d_r1d_gs
 
! **************************************************************************************************
!> \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_r1d_r1d_gs (pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value)
 
                     TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw2
                     INTEGER, INTENT(IN), OPTIONAL                      :: sumtype
                     LOGICAL, INTENT(IN), OPTIONAL                      :: just_sum, local_only
                     REAL(kind=dp)                                      :: integral_value
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_integral_ab_r1d_r1d_gs'
 
                     INTEGER                                            :: handle, loc_sumtype
                     LOGICAL                                            :: my_just_sum, my_local_only
 
                     CALL timeset(routinen, handle)
 
                     loc_sumtype = do_accurate_sum
                     IF (PRESENT(sumtype)) loc_sumtype = sumtype
 
                     my_local_only = .false.
                     IF (PRESENT(local_only)) my_local_only = local_only
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                        cpabort("Grids incompatible")
                     END IF
 
                     my_just_sum = .false.
                     IF (PRESENT(just_sum)) my_just_sum = just_sum
 
                     ! do standard sum
                     IF (loc_sumtype == do_standard_sum) THEN
 
                        ! Do standard sum
 
                           integral_value = dot_product(pw1%array, pw2%array)
 
                     ELSE
 
                        ! Do accurate sum
                           integral_value = accurate_dot_product(pw1%array, pw2%array)
 
                     END IF
 
                     IF (.NOT. my_just_sum) THEN
                           integral_value = integral_value*pw1%pw_grid%vol
                     END IF
 
                        IF (pw1%pw_grid%grid_span == halfspace) THEN
                           integral_value = 2.0_dp*integral_value
                           IF (pw1%pw_grid%have_g0) integral_value = integral_value - &
                              pw1%array(1)*pw2%array(1)
                           END IF
 
                        IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == pw_mode_distributed) &
                           CALL pw1%pw_grid%para%group%sum(integral_value)
 
                        CALL timestop(handle)
 
                     END FUNCTION pw_integral_ab_r1d_r1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
!> \return ...
! **************************************************************************************************
                        FUNCTION pw_integral_a2b_r1d_r1d (pw1, pw2) RESULT(integral_value)
 
                           TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw1
                           TYPE(pw_r1d_gs_type), INTENT(IN) :: 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
 
                              integral_value = accurate_sum(pw1%array*pw2%array*pw1%pw_grid%gsq)
                           IF (pw1%pw_grid%grid_span == halfspace) THEN
                              integral_value = 2.0_dp*integral_value
                           END IF
 
                           integral_value = integral_value*pw1%pw_grid%vol
 
                           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_r1d_r1d
! **************************************************************************************************
!> \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_r1d_c1d_rs (pw1, pw2)
 
            TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw1
            TYPE(pw_c1d_rs_type), INTENT(INOUT)                       :: pw2
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_copy'
 
            INTEGER                                            :: handle
               INTEGER :: i, j, ng, ng1, ng2, ns
 
            CALL timeset(routinen, handle)
 
            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) &
                  cpabort("Spherical grids only exist in reciprocal space!")
 
               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) =       cmplx(pw1%array(1:ng), 0.0_dp, kind=dp)
!$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!")
                     END IF
                  ELSE
                     ng1 = SIZE(pw1%array)
                     ng2 = SIZE(pw2%array)
                     ns = 2*max(ng1, ng2)
 
                     IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                        IF (ng1 >= ng2) THEN
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP             PRIVATE(i,j) &
!$OMP             SHARED(ng2, pw1, pw2)
                           DO i = 1, ng2
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) =       cmplx(pw1%array(j), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE
                           CALL pw_zero(pw2)
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP             PRIVATE(i,j) &
!$OMP             SHARED(ng1, pw1, pw2)
                           DO i = 1, ng1
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) =       cmplx(pw1%array(i), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE IF ((pw2%pw_grid%id_nr == pw1%pw_grid%reference)) THEN
                        IF (ng1 >= ng2) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng2, pw1, pw2)
                           DO i = 1, ng2
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) =       cmplx(pw1%array(j), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE
                           CALL pw_zero(pw2)
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng1, pw1, pw2)
                           DO i = 1, ng1
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) =       cmplx(pw1%array(i), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                           cpabort("Copy not implemented!")
                     END IF
 
                  END IF
 
               ELSE
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw1, pw2)
                  pw2%array =       cmplx(pw1%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
               END IF
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_copy_r1d_c1d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_to_array_r1d_c1d_rs (pw, array)
            TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw
            COMPLEX(KIND=dp), DIMENSION(:), INTENT(INOUT)   :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
               array(:) =       cmplx(pw%array(:), 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_to_array_r1d_c1d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_from_array_r1d_c1d_rs (pw, array)
            TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw
            COMPLEX(KIND=dp), DIMENSION(:), INTENT(IN)      :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
            pw%array =       real(array, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_from_array_r1d_c1d_rs
 
! **************************************************************************************************
!> \brief pw2 = alpha*pw1 + beta*pw2
!>      alpha defaults to 1, beta defaults to 1
!> \param pw1 ...
!> \param pw2 ...
!> \param alpha ...
!> \param beta ...
!> \param allow_noncompatible_grids ...
!> \par History
!>      JGH (21-Feb-2003) : added reference grid functionality
!>      JGH (01-Dec-2007) : rename and remove complex alpha
!> \author apsi
!> \note
!>      Currently only summing up of respective types allowed,
!>      in order to avoid errors
! **************************************************************************************************
         SUBROUTINE pw_axpy_r1d_c1d_rs (pw1, pw2, alpha, beta, allow_noncompatible_grids)
 
            TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw1
            TYPE(pw_c1d_rs_type), INTENT(INOUT)                       :: pw2
            REAL(KIND=dp), INTENT(in), OPTIONAL                :: alpha, beta
            LOGICAL, INTENT(IN), OPTIONAL                      :: allow_noncompatible_grids
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_axpy'
 
            INTEGER                                            :: handle
            LOGICAL                                            :: my_allow_noncompatible_grids
            REAL(KIND=dp)                                      :: my_alpha, my_beta
               INTEGER                                            :: i, j, ng, ng1, ng2
 
            CALL timeset(routinen, handle)
 
            my_alpha = 1.0_dp
            IF (PRESENT(alpha)) my_alpha = alpha
 
            my_beta = 1.0_dp
            IF (PRESENT(beta)) my_beta = beta
 
            my_allow_noncompatible_grids = .false.
            IF (PRESENT(allow_noncompatible_grids)) my_allow_noncompatible_grids = allow_noncompatible_grids
 
            IF (my_beta /= 1.0_dp) THEN
               IF (my_beta == 0.0_dp) THEN
                  CALL pw_zero(pw2)
               ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw2,my_beta)
                  pw2%array = pw2%array*my_beta
!$OMP END PARALLEL WORKSHARE
               END IF
            END IF
 
               IF (ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
 
                  IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw1, pw2)
                     pw2%array = pw2%array +       cmplx(pw1%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                  ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha)
                     pw2%array = pw2%array + my_alpha*      cmplx(pw1%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                  END IF
 
               ELSE IF (pw_compatible(pw1%pw_grid, pw2%pw_grid) .OR. my_allow_noncompatible_grids) THEN
 
                  ng1 = SIZE(pw1%array)
                  ng2 = SIZE(pw2%array)
                  ng = min(ng1, ng2)
 
                  IF (pw1%pw_grid%spherical) THEN
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                        DO i = 1, ng
                           pw2%array(i) = pw2%array(i) +       cmplx(pw1%array(i), 0.0_dp, kind=dp)
                        END DO
!$OMP END PARALLEL DO
                     ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha,ng)
                        DO i = 1, ng
                           pw2%array(i) = pw2%array(i) + my_alpha*      cmplx(pw1%array(i), 0.0_dp, kind=dp)
                        END DO
!$OMP END PARALLEL DO
                     END IF
                  ELSE IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                     IF (ng1 >= ng2) THEN
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) +       cmplx(pw1%array(j), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) + my_alpha*      cmplx(pw1%array(j), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) +       cmplx(pw1%array(i), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) + my_alpha*      cmplx(pw1%array(i), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END IF
                  ELSE IF ((pw2%pw_grid%id_nr == pw1%pw_grid%reference)) THEN
                     IF (ng1 >= ng2) THEN
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) +       cmplx(pw1%array(j), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) + my_alpha*      cmplx(pw1%array(j), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) +       cmplx(pw1%array(i), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) + my_alpha*      cmplx(pw1%array(i), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END IF
                  ELSE
                     cpabort("Grids not compatible")
                  END IF
 
                  ELSE
 
                     cpabort("Grids not compatible")
 
                  END IF
 
                  CALL timestop(handle)
 
                  END SUBROUTINE pw_axpy_r1d_c1d_rs
 
! **************************************************************************************************
!> \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_r1d_c1d_rs (pw_out, pw1, pw2, alpha)
 
                     TYPE(pw_r1d_rs_type), INTENT(INOUT)                       :: pw_out
                     TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_c1d_rs_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 !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + pw1%array*      real(pw2%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      real(pw2%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     END IF
#else
                     IF (my_alpha == 1.0_dp) THEN
                        pw_out%array = pw_out%array + pw1%array*      real(pw2%array, kind=dp)
                     ELSE
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      real(pw2%array, kind=dp)
                     END IF
#endif
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_r1d_c1d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
! **************************************************************************************************
                  SUBROUTINE pw_multiply_with_r1d_c1d_rs (pw1, pw2)
                     TYPE(pw_r1d_rs_type), INTENT(INOUT)                       :: pw1
                     TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw2
 
                     CHARACTER(LEN=*), PARAMETER                        :: routineN = 'pw_multiply_with'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) &
                        cpabort("Incompatible grids!")
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                     pw1%array = pw1%array*      real(pw2%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_with_r1d_c1d_rs
 
! **************************************************************************************************
!> \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_r1d_c1d_rs (pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value)
 
                     TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw2
                     INTEGER, INTENT(IN), OPTIONAL                      :: sumtype
                     LOGICAL, INTENT(IN), OPTIONAL                      :: just_sum, local_only
                     REAL(kind=dp)                                      :: integral_value
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_integral_ab_r1d_c1d_rs'
 
                     INTEGER                                            :: handle, loc_sumtype
                     LOGICAL                                            :: my_just_sum, my_local_only
 
                     CALL timeset(routinen, handle)
 
                     loc_sumtype = do_accurate_sum
                     IF (PRESENT(sumtype)) loc_sumtype = sumtype
 
                     my_local_only = .false.
                     IF (PRESENT(local_only)) my_local_only = local_only
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                        cpabort("Grids incompatible")
                     END IF
 
                     my_just_sum = .false.
                     IF (PRESENT(just_sum)) my_just_sum = just_sum
 
                     ! do standard sum
                     IF (loc_sumtype == do_standard_sum) THEN
 
                        ! Do standard sum
 
                           integral_value = sum(pw1%array*real(pw2%array, kind=dp)) !? complex bit
 
                     ELSE
 
                        ! Do accurate sum
                           integral_value = accurate_sum(pw1%array*real(pw2%array, kind=dp)) !? complex bit
 
                     END IF
 
                     IF (.NOT. my_just_sum) THEN
                           integral_value = integral_value*pw1%pw_grid%dvol
                     END IF
 
                        IF (pw1%pw_grid%grid_span == halfspace) THEN
                           integral_value = 2.0_dp*integral_value
                           IF (pw1%pw_grid%have_g0) integral_value = integral_value - &
                              pw1%array(1)*real(pw2%array(1), kind=dp)
                           END IF
 
                        IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == pw_mode_distributed) &
                           CALL pw1%pw_grid%para%group%sum(integral_value)
 
                        CALL timestop(handle)
 
                     END FUNCTION pw_integral_ab_r1d_c1d_rs
! **************************************************************************************************
!> \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_r1d_c1d_gs (pw1, pw2)
 
            TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw1
            TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw2
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_copy'
 
            INTEGER                                            :: handle
               INTEGER :: i, j, ng, ng1, ng2, ns
 
            CALL timeset(routinen, handle)
 
            IF (pw1%pw_grid%spherical .neqv. pw2%pw_grid%spherical) &
               cpabort("Both grids must be either spherical or non-spherical!")
 
               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) =       cmplx(pw1%array(1:ng), 0.0_dp, kind=dp)
!$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!")
                     END IF
                  ELSE
                     ng1 = SIZE(pw1%array)
                     ng2 = SIZE(pw2%array)
                     ns = 2*max(ng1, ng2)
 
                     IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                        IF (ng1 >= ng2) THEN
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP             PRIVATE(i,j) &
!$OMP             SHARED(ng2, pw1, pw2)
                           DO i = 1, ng2
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) =       cmplx(pw1%array(j), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE
                           CALL pw_zero(pw2)
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP             PRIVATE(i,j) &
!$OMP             SHARED(ng1, pw1, pw2)
                           DO i = 1, ng1
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) =       cmplx(pw1%array(i), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE IF ((pw2%pw_grid%id_nr == pw1%pw_grid%reference)) THEN
                        IF (ng1 >= ng2) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng2, pw1, pw2)
                           DO i = 1, ng2
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) =       cmplx(pw1%array(j), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE
                           CALL pw_zero(pw2)
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng1, pw1, pw2)
                           DO i = 1, ng1
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) =       cmplx(pw1%array(i), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                           cpabort("Copy not implemented!")
                     END IF
 
                  END IF
 
               ELSE
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw1, pw2)
                  pw2%array =       cmplx(pw1%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
               END IF
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_copy_r1d_c1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_to_array_r1d_c1d_gs (pw, array)
            TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw
            COMPLEX(KIND=dp), DIMENSION(:), INTENT(INOUT)   :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
               array(:) =       cmplx(pw%array(:), 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_to_array_r1d_c1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_from_array_r1d_c1d_gs (pw, array)
            TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw
            COMPLEX(KIND=dp), DIMENSION(:), INTENT(IN)      :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
            pw%array =       real(array, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_from_array_r1d_c1d_gs
 
! **************************************************************************************************
!> \brief pw2 = alpha*pw1 + beta*pw2
!>      alpha defaults to 1, beta defaults to 1
!> \param pw1 ...
!> \param pw2 ...
!> \param alpha ...
!> \param beta ...
!> \param allow_noncompatible_grids ...
!> \par History
!>      JGH (21-Feb-2003) : added reference grid functionality
!>      JGH (01-Dec-2007) : rename and remove complex alpha
!> \author apsi
!> \note
!>      Currently only summing up of respective types allowed,
!>      in order to avoid errors
! **************************************************************************************************
         SUBROUTINE pw_axpy_r1d_c1d_gs (pw1, pw2, alpha, beta, allow_noncompatible_grids)
 
            TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw1
            TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw2
            REAL(KIND=dp), INTENT(in), OPTIONAL                :: alpha, beta
            LOGICAL, INTENT(IN), OPTIONAL                      :: allow_noncompatible_grids
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_axpy'
 
            INTEGER                                            :: handle
            LOGICAL                                            :: my_allow_noncompatible_grids
            REAL(KIND=dp)                                      :: my_alpha, my_beta
               INTEGER                                            :: i, j, ng, ng1, ng2
 
            CALL timeset(routinen, handle)
 
            my_alpha = 1.0_dp
            IF (PRESENT(alpha)) my_alpha = alpha
 
            my_beta = 1.0_dp
            IF (PRESENT(beta)) my_beta = beta
 
            my_allow_noncompatible_grids = .false.
            IF (PRESENT(allow_noncompatible_grids)) my_allow_noncompatible_grids = allow_noncompatible_grids
 
            IF (my_beta /= 1.0_dp) THEN
               IF (my_beta == 0.0_dp) THEN
                  CALL pw_zero(pw2)
               ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw2,my_beta)
                  pw2%array = pw2%array*my_beta
!$OMP END PARALLEL WORKSHARE
               END IF
            END IF
 
               IF (ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
 
                  IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw1, pw2)
                     pw2%array = pw2%array +       cmplx(pw1%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                  ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha)
                     pw2%array = pw2%array + my_alpha*      cmplx(pw1%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                  END IF
 
               ELSE IF (pw_compatible(pw1%pw_grid, pw2%pw_grid) .OR. my_allow_noncompatible_grids) THEN
 
                  ng1 = SIZE(pw1%array)
                  ng2 = SIZE(pw2%array)
                  ng = min(ng1, ng2)
 
                  IF (pw1%pw_grid%spherical) THEN
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                        DO i = 1, ng
                           pw2%array(i) = pw2%array(i) +       cmplx(pw1%array(i), 0.0_dp, kind=dp)
                        END DO
!$OMP END PARALLEL DO
                     ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha,ng)
                        DO i = 1, ng
                           pw2%array(i) = pw2%array(i) + my_alpha*      cmplx(pw1%array(i), 0.0_dp, kind=dp)
                        END DO
!$OMP END PARALLEL DO
                     END IF
                  ELSE IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                     IF (ng1 >= ng2) THEN
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) +       cmplx(pw1%array(j), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) + my_alpha*      cmplx(pw1%array(j), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) +       cmplx(pw1%array(i), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) + my_alpha*      cmplx(pw1%array(i), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END IF
                  ELSE IF ((pw2%pw_grid%id_nr == pw1%pw_grid%reference)) THEN
                     IF (ng1 >= ng2) THEN
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) +       cmplx(pw1%array(j), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) + my_alpha*      cmplx(pw1%array(j), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) +       cmplx(pw1%array(i), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) + my_alpha*      cmplx(pw1%array(i), 0.0_dp, kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END IF
                  ELSE
                     cpabort("Grids not compatible")
                  END IF
 
                  ELSE
 
                     cpabort("Grids not compatible")
 
                  END IF
 
                  CALL timestop(handle)
 
                  END SUBROUTINE pw_axpy_r1d_c1d_gs
 
! **************************************************************************************************
!> \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_r1d_c1d_gs (pw_out, pw1, pw2, alpha)
 
                     TYPE(pw_r1d_gs_type), INTENT(INOUT)                       :: pw_out
                     TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_c1d_gs_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 !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + pw1%array*      real(pw2%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      real(pw2%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     END IF
#else
                     IF (my_alpha == 1.0_dp) THEN
                        pw_out%array = pw_out%array + pw1%array*      real(pw2%array, kind=dp)
                     ELSE
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      real(pw2%array, kind=dp)
                     END IF
#endif
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_r1d_c1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
! **************************************************************************************************
                  SUBROUTINE pw_multiply_with_r1d_c1d_gs (pw1, pw2)
                     TYPE(pw_r1d_gs_type), INTENT(INOUT)                       :: pw1
                     TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw2
 
                     CHARACTER(LEN=*), PARAMETER                        :: routineN = 'pw_multiply_with'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) &
                        cpabort("Incompatible grids!")
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                     pw1%array = pw1%array*      real(pw2%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_with_r1d_c1d_gs
 
! **************************************************************************************************
!> \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_r1d_c1d_gs (pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value)
 
                     TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw2
                     INTEGER, INTENT(IN), OPTIONAL                      :: sumtype
                     LOGICAL, INTENT(IN), OPTIONAL                      :: just_sum, local_only
                     REAL(kind=dp)                                      :: integral_value
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_integral_ab_r1d_c1d_gs'
 
                     INTEGER                                            :: handle, loc_sumtype
                     LOGICAL                                            :: my_just_sum, my_local_only
 
                     CALL timeset(routinen, handle)
 
                     loc_sumtype = do_accurate_sum
                     IF (PRESENT(sumtype)) loc_sumtype = sumtype
 
                     my_local_only = .false.
                     IF (PRESENT(local_only)) my_local_only = local_only
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                        cpabort("Grids incompatible")
                     END IF
 
                     my_just_sum = .false.
                     IF (PRESENT(just_sum)) my_just_sum = just_sum
 
                     ! do standard sum
                     IF (loc_sumtype == do_standard_sum) THEN
 
                        ! Do standard sum
 
                           integral_value = sum(pw1%array*real(pw2%array, kind=dp)) !? complex bit
 
                     ELSE
 
                        ! Do accurate sum
                           integral_value = accurate_sum(pw1%array*real(pw2%array, kind=dp)) !? complex bit
 
                     END IF
 
                     IF (.NOT. my_just_sum) THEN
                           integral_value = integral_value*pw1%pw_grid%vol
                     END IF
 
                        IF (pw1%pw_grid%grid_span == halfspace) THEN
                           integral_value = 2.0_dp*integral_value
                           IF (pw1%pw_grid%have_g0) integral_value = integral_value - &
                              pw1%array(1)*real(pw2%array(1), kind=dp)
                           END IF
 
                        IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == pw_mode_distributed) &
                           CALL pw1%pw_grid%para%group%sum(integral_value)
 
                        CALL timestop(handle)
 
                     END FUNCTION pw_integral_ab_r1d_c1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
!> \return ...
! **************************************************************************************************
                        FUNCTION pw_integral_a2b_r1d_c1d (pw1, pw2) RESULT(integral_value)
 
                           TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw1
                           TYPE(pw_c1d_gs_type), INTENT(IN) :: 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
 
                              integral_value = accurate_sum(pw1%array*real(pw2%array, kind=dp)*pw1%pw_grid%gsq)
                           IF (pw1%pw_grid%grid_span == halfspace) THEN
                              integral_value = 2.0_dp*integral_value
                           END IF
 
                           integral_value = integral_value*pw1%pw_grid%vol
 
                           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_r1d_c1d
! **************************************************************************************************
!> \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_r3d_r3d_rs (pw1, pw2)
 
            TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw1
            TYPE(pw_r3d_rs_type), INTENT(INOUT)                       :: pw2
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_copy'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
            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) &
                  cpabort("Spherical grids only exist in reciprocal space!")
 
               IF (any(shape(pw2%array) /= shape(pw1%array))) &
                  cpabort("3D grids must be compatible!")
               IF (pw1%pw_grid%spherical) &
                  cpabort("3D grids must not be spherical!")
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
               pw2%array(:, :, :) =       pw1%array(:, :, :)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_copy_r3d_r3d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_to_array_r3d_r3d_rs (pw, array)
            TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), DIMENSION(:, :, :), INTENT(INOUT)   :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
               array(:, :, :) =       pw%array(:, :, :)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_to_array_r3d_r3d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_from_array_r3d_r3d_rs (pw, array)
            TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), DIMENSION(:, :, :), INTENT(IN)      :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
            pw%array =       array
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_from_array_r3d_r3d_rs
 
! **************************************************************************************************
!> \brief pw2 = alpha*pw1 + beta*pw2
!>      alpha defaults to 1, beta defaults to 1
!> \param pw1 ...
!> \param pw2 ...
!> \param alpha ...
!> \param beta ...
!> \param allow_noncompatible_grids ...
!> \par History
!>      JGH (21-Feb-2003) : added reference grid functionality
!>      JGH (01-Dec-2007) : rename and remove complex alpha
!> \author apsi
!> \note
!>      Currently only summing up of respective types allowed,
!>      in order to avoid errors
! **************************************************************************************************
         SUBROUTINE pw_axpy_r3d_r3d_rs (pw1, pw2, alpha, beta, allow_noncompatible_grids)
 
            TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw1
            TYPE(pw_r3d_rs_type), INTENT(INOUT)                       :: pw2
            REAL(KIND=dp), INTENT(in), OPTIONAL                :: alpha, beta
            LOGICAL, INTENT(IN), OPTIONAL                      :: allow_noncompatible_grids
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_axpy'
 
            INTEGER                                            :: handle
            LOGICAL                                            :: my_allow_noncompatible_grids
            REAL(KIND=dp)                                      :: my_alpha, my_beta
 
            CALL timeset(routinen, handle)
 
            my_alpha = 1.0_dp
            IF (PRESENT(alpha)) my_alpha = alpha
 
            my_beta = 1.0_dp
            IF (PRESENT(beta)) my_beta = beta
 
            my_allow_noncompatible_grids = .false.
            IF (PRESENT(allow_noncompatible_grids)) my_allow_noncompatible_grids = allow_noncompatible_grids
 
            IF (my_beta /= 1.0_dp) THEN
               IF (my_beta == 0.0_dp) THEN
                  CALL pw_zero(pw2)
               ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw2,my_beta)
                  pw2%array = pw2%array*my_beta
!$OMP END PARALLEL WORKSHARE
               END IF
            END IF
 
                  IF (ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1, pw2)
                        pw2%array = pw2%array +       pw1%array
!$OMP END PARALLEL WORKSHARE
                     ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1, pw2, my_alpha)
                        pw2%array = pw2%array + my_alpha*      pw1%array
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                  ELSE IF (pw_compatible(pw1%pw_grid, pw2%pw_grid) .OR. my_allow_noncompatible_grids) THEN
 
                     IF (any(shape(pw1%array) /= shape(pw2%array))) &
                        cpabort("Noncommensurate grids not implemented for 3D grids!")
 
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                        pw2%array = pw2%array +       pw1%array
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2,my_alpha)
                        pw2%array = pw2%array + my_alpha*      pw1%array
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                  ELSE
 
                     cpabort("Grids not compatible")
 
                  END IF
 
                  CALL timestop(handle)
 
                  END SUBROUTINE pw_axpy_r3d_r3d_rs
 
! **************************************************************************************************
!> \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_r3d_r3d_rs (pw_out, pw1, pw2, alpha)
 
                     TYPE(pw_r3d_rs_type), INTENT(INOUT)                       :: pw_out
                     TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_r3d_rs_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 !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
                     END IF
#else
                     IF (my_alpha == 1.0_dp) THEN
                        pw_out%array = pw_out%array + pw1%array*      pw2%array
                     ELSE
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      pw2%array
                     END IF
#endif
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_r3d_r3d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
! **************************************************************************************************
                  SUBROUTINE pw_multiply_with_r3d_r3d_rs (pw1, pw2)
                     TYPE(pw_r3d_rs_type), INTENT(INOUT)                       :: pw1
                     TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw2
 
                     CHARACTER(LEN=*), PARAMETER                        :: routineN = 'pw_multiply_with'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) &
                        cpabort("Incompatible grids!")
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                     pw1%array = pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_with_r3d_r3d_rs
 
! **************************************************************************************************
!> \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_r3d_r3d_rs (pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value)
 
                     TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw2
                     INTEGER, INTENT(IN), OPTIONAL                      :: sumtype
                     LOGICAL, INTENT(IN), OPTIONAL                      :: just_sum, local_only
                     REAL(kind=dp)                                      :: integral_value
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_integral_ab_r3d_r3d_rs'
 
                     INTEGER                                            :: handle, loc_sumtype
                     LOGICAL                                            :: my_just_sum, my_local_only
 
                     CALL timeset(routinen, handle)
 
                     loc_sumtype = do_accurate_sum
                     IF (PRESENT(sumtype)) loc_sumtype = sumtype
 
                     my_local_only = .false.
                     IF (PRESENT(local_only)) my_local_only = local_only
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                        cpabort("Grids incompatible")
                     END IF
 
                     my_just_sum = .false.
                     IF (PRESENT(just_sum)) my_just_sum = just_sum
 
                     ! do standard sum
                     IF (loc_sumtype == do_standard_sum) THEN
 
                        ! Do standard sum
 
                           integral_value = sum(pw1%array*pw2%array)
 
                     ELSE
 
                        ! Do accurate sum
                           integral_value = accurate_dot_product(pw1%array, pw2%array)
 
                     END IF
 
                     IF (.NOT. my_just_sum) THEN
                           integral_value = integral_value*pw1%pw_grid%dvol
                     END IF
 
 
                        IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == pw_mode_distributed) &
                           CALL pw1%pw_grid%para%group%sum(integral_value)
 
                        CALL timestop(handle)
 
                     END FUNCTION pw_integral_ab_r3d_r3d_rs
! **************************************************************************************************
!> \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_r3d_r3d_gs (pw1, pw2)
 
            TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw1
            TYPE(pw_r3d_gs_type), INTENT(INOUT)                       :: pw2
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_copy'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
            IF (pw1%pw_grid%spherical .neqv. pw2%pw_grid%spherical) &
               cpabort("Both grids must be either spherical or non-spherical!")
 
               IF (any(shape(pw2%array) /= shape(pw1%array))) &
                  cpabort("3D grids must be compatible!")
               IF (pw1%pw_grid%spherical) &
                  cpabort("3D grids must not be spherical!")
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
               pw2%array(:, :, :) =       pw1%array(:, :, :)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_copy_r3d_r3d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_to_array_r3d_r3d_gs (pw, array)
            TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), DIMENSION(:, :, :), INTENT(INOUT)   :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
               array(:, :, :) =       pw%array(:, :, :)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_to_array_r3d_r3d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_from_array_r3d_r3d_gs (pw, array)
            TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), DIMENSION(:, :, :), INTENT(IN)      :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
            pw%array =       array
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_from_array_r3d_r3d_gs
 
! **************************************************************************************************
!> \brief pw2 = alpha*pw1 + beta*pw2
!>      alpha defaults to 1, beta defaults to 1
!> \param pw1 ...
!> \param pw2 ...
!> \param alpha ...
!> \param beta ...
!> \param allow_noncompatible_grids ...
!> \par History
!>      JGH (21-Feb-2003) : added reference grid functionality
!>      JGH (01-Dec-2007) : rename and remove complex alpha
!> \author apsi
!> \note
!>      Currently only summing up of respective types allowed,
!>      in order to avoid errors
! **************************************************************************************************
         SUBROUTINE pw_axpy_r3d_r3d_gs (pw1, pw2, alpha, beta, allow_noncompatible_grids)
 
            TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw1
            TYPE(pw_r3d_gs_type), INTENT(INOUT)                       :: pw2
            REAL(KIND=dp), INTENT(in), OPTIONAL                :: alpha, beta
            LOGICAL, INTENT(IN), OPTIONAL                      :: allow_noncompatible_grids
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_axpy'
 
            INTEGER                                            :: handle
            LOGICAL                                            :: my_allow_noncompatible_grids
            REAL(KIND=dp)                                      :: my_alpha, my_beta
 
            CALL timeset(routinen, handle)
 
            my_alpha = 1.0_dp
            IF (PRESENT(alpha)) my_alpha = alpha
 
            my_beta = 1.0_dp
            IF (PRESENT(beta)) my_beta = beta
 
            my_allow_noncompatible_grids = .false.
            IF (PRESENT(allow_noncompatible_grids)) my_allow_noncompatible_grids = allow_noncompatible_grids
 
            IF (my_beta /= 1.0_dp) THEN
               IF (my_beta == 0.0_dp) THEN
                  CALL pw_zero(pw2)
               ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw2,my_beta)
                  pw2%array = pw2%array*my_beta
!$OMP END PARALLEL WORKSHARE
               END IF
            END IF
 
                  IF (ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1, pw2)
                        pw2%array = pw2%array +       pw1%array
!$OMP END PARALLEL WORKSHARE
                     ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1, pw2, my_alpha)
                        pw2%array = pw2%array + my_alpha*      pw1%array
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                  ELSE IF (pw_compatible(pw1%pw_grid, pw2%pw_grid) .OR. my_allow_noncompatible_grids) THEN
 
                     IF (any(shape(pw1%array) /= shape(pw2%array))) &
                        cpabort("Noncommensurate grids not implemented for 3D grids!")
 
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                        pw2%array = pw2%array +       pw1%array
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2,my_alpha)
                        pw2%array = pw2%array + my_alpha*      pw1%array
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                  ELSE
 
                     cpabort("Grids not compatible")
 
                  END IF
 
                  CALL timestop(handle)
 
                  END SUBROUTINE pw_axpy_r3d_r3d_gs
 
! **************************************************************************************************
!> \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_r3d_r3d_gs (pw_out, pw1, pw2, alpha)
 
                     TYPE(pw_r3d_gs_type), INTENT(INOUT)                       :: pw_out
                     TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_r3d_gs_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 !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
                     END IF
#else
                     IF (my_alpha == 1.0_dp) THEN
                        pw_out%array = pw_out%array + pw1%array*      pw2%array
                     ELSE
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      pw2%array
                     END IF
#endif
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_r3d_r3d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
! **************************************************************************************************
                  SUBROUTINE pw_multiply_with_r3d_r3d_gs (pw1, pw2)
                     TYPE(pw_r3d_gs_type), INTENT(INOUT)                       :: pw1
                     TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw2
 
                     CHARACTER(LEN=*), PARAMETER                        :: routineN = 'pw_multiply_with'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) &
                        cpabort("Incompatible grids!")
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                     pw1%array = pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_with_r3d_r3d_gs
 
! **************************************************************************************************
!> \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_r3d_r3d_gs (pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value)
 
                     TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw2
                     INTEGER, INTENT(IN), OPTIONAL                      :: sumtype
                     LOGICAL, INTENT(IN), OPTIONAL                      :: just_sum, local_only
                     REAL(kind=dp)                                      :: integral_value
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_integral_ab_r3d_r3d_gs'
 
                     INTEGER                                            :: handle, loc_sumtype
                     LOGICAL                                            :: my_just_sum, my_local_only
 
                     CALL timeset(routinen, handle)
 
                     loc_sumtype = do_accurate_sum
                     IF (PRESENT(sumtype)) loc_sumtype = sumtype
 
                     my_local_only = .false.
                     IF (PRESENT(local_only)) my_local_only = local_only
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                        cpabort("Grids incompatible")
                     END IF
 
                     my_just_sum = .false.
                     IF (PRESENT(just_sum)) my_just_sum = just_sum
 
                     ! do standard sum
                     IF (loc_sumtype == do_standard_sum) THEN
 
                        ! Do standard sum
 
                           integral_value = sum(pw1%array*pw2%array)
 
                     ELSE
 
                        ! Do accurate sum
                           integral_value = accurate_dot_product(pw1%array, pw2%array)
 
                     END IF
 
                     IF (.NOT. my_just_sum) THEN
                           integral_value = integral_value*pw1%pw_grid%vol
                     END IF
 
 
                        IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == pw_mode_distributed) &
                           CALL pw1%pw_grid%para%group%sum(integral_value)
 
                        CALL timestop(handle)
 
                     END FUNCTION pw_integral_ab_r3d_r3d_gs
 
! **************************************************************************************************
!> \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_r3d_c3d_rs (pw1, pw2)
 
            TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw1
            TYPE(pw_c3d_rs_type), INTENT(INOUT)                       :: pw2
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_copy'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
            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) &
                  cpabort("Spherical grids only exist in reciprocal space!")
 
               IF (any(shape(pw2%array) /= shape(pw1%array))) &
                  cpabort("3D grids must be compatible!")
               IF (pw1%pw_grid%spherical) &
                  cpabort("3D grids must not be spherical!")
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
               pw2%array(:, :, :) =       cmplx(pw1%array(:, :, :), 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_copy_r3d_c3d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_to_array_r3d_c3d_rs (pw, array)
            TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw
            COMPLEX(KIND=dp), DIMENSION(:, :, :), INTENT(INOUT)   :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
               array(:, :, :) =       cmplx(pw%array(:, :, :), 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_to_array_r3d_c3d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_from_array_r3d_c3d_rs (pw, array)
            TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw
            COMPLEX(KIND=dp), DIMENSION(:, :, :), INTENT(IN)      :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
            pw%array =       real(array, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_from_array_r3d_c3d_rs
 
! **************************************************************************************************
!> \brief pw2 = alpha*pw1 + beta*pw2
!>      alpha defaults to 1, beta defaults to 1
!> \param pw1 ...
!> \param pw2 ...
!> \param alpha ...
!> \param beta ...
!> \param allow_noncompatible_grids ...
!> \par History
!>      JGH (21-Feb-2003) : added reference grid functionality
!>      JGH (01-Dec-2007) : rename and remove complex alpha
!> \author apsi
!> \note
!>      Currently only summing up of respective types allowed,
!>      in order to avoid errors
! **************************************************************************************************
         SUBROUTINE pw_axpy_r3d_c3d_rs (pw1, pw2, alpha, beta, allow_noncompatible_grids)
 
            TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw1
            TYPE(pw_c3d_rs_type), INTENT(INOUT)                       :: pw2
            REAL(KIND=dp), INTENT(in), OPTIONAL                :: alpha, beta
            LOGICAL, INTENT(IN), OPTIONAL                      :: allow_noncompatible_grids
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_axpy'
 
            INTEGER                                            :: handle
            LOGICAL                                            :: my_allow_noncompatible_grids
            REAL(KIND=dp)                                      :: my_alpha, my_beta
 
            CALL timeset(routinen, handle)
 
            my_alpha = 1.0_dp
            IF (PRESENT(alpha)) my_alpha = alpha
 
            my_beta = 1.0_dp
            IF (PRESENT(beta)) my_beta = beta
 
            my_allow_noncompatible_grids = .false.
            IF (PRESENT(allow_noncompatible_grids)) my_allow_noncompatible_grids = allow_noncompatible_grids
 
            IF (my_beta /= 1.0_dp) THEN
               IF (my_beta == 0.0_dp) THEN
                  CALL pw_zero(pw2)
               ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw2,my_beta)
                  pw2%array = pw2%array*my_beta
!$OMP END PARALLEL WORKSHARE
               END IF
            END IF
 
                  IF (ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1, pw2)
                        pw2%array = pw2%array +       cmplx(pw1%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1, pw2, my_alpha)
                        pw2%array = pw2%array + my_alpha*      cmplx(pw1%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                  ELSE IF (pw_compatible(pw1%pw_grid, pw2%pw_grid) .OR. my_allow_noncompatible_grids) THEN
 
                     IF (any(shape(pw1%array) /= shape(pw2%array))) &
                        cpabort("Noncommensurate grids not implemented for 3D grids!")
 
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                        pw2%array = pw2%array +       cmplx(pw1%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2,my_alpha)
                        pw2%array = pw2%array + my_alpha*      cmplx(pw1%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                  ELSE
 
                     cpabort("Grids not compatible")
 
                  END IF
 
                  CALL timestop(handle)
 
                  END SUBROUTINE pw_axpy_r3d_c3d_rs
 
! **************************************************************************************************
!> \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_r3d_c3d_rs (pw_out, pw1, pw2, alpha)
 
                     TYPE(pw_r3d_rs_type), INTENT(INOUT)                       :: pw_out
                     TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_c3d_rs_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 !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + pw1%array*      real(pw2%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      real(pw2%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     END IF
#else
                     IF (my_alpha == 1.0_dp) THEN
                        pw_out%array = pw_out%array + pw1%array*      real(pw2%array, kind=dp)
                     ELSE
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      real(pw2%array, kind=dp)
                     END IF
#endif
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_r3d_c3d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
! **************************************************************************************************
                  SUBROUTINE pw_multiply_with_r3d_c3d_rs (pw1, pw2)
                     TYPE(pw_r3d_rs_type), INTENT(INOUT)                       :: pw1
                     TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw2
 
                     CHARACTER(LEN=*), PARAMETER                        :: routineN = 'pw_multiply_with'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) &
                        cpabort("Incompatible grids!")
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                     pw1%array = pw1%array*      real(pw2%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_with_r3d_c3d_rs
 
! **************************************************************************************************
!> \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_r3d_c3d_rs (pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value)
 
                     TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw2
                     INTEGER, INTENT(IN), OPTIONAL                      :: sumtype
                     LOGICAL, INTENT(IN), OPTIONAL                      :: just_sum, local_only
                     REAL(kind=dp)                                      :: integral_value
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_integral_ab_r3d_c3d_rs'
 
                     INTEGER                                            :: handle, loc_sumtype
                     LOGICAL                                            :: my_just_sum, my_local_only
 
                     CALL timeset(routinen, handle)
 
                     loc_sumtype = do_accurate_sum
                     IF (PRESENT(sumtype)) loc_sumtype = sumtype
 
                     my_local_only = .false.
                     IF (PRESENT(local_only)) my_local_only = local_only
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                        cpabort("Grids incompatible")
                     END IF
 
                     my_just_sum = .false.
                     IF (PRESENT(just_sum)) my_just_sum = just_sum
 
                     ! do standard sum
                     IF (loc_sumtype == do_standard_sum) THEN
 
                        ! Do standard sum
 
                           integral_value = sum(pw1%array*real(pw2%array, kind=dp)) !? complex bit
 
                     ELSE
 
                        ! Do accurate sum
                           integral_value = accurate_sum(pw1%array*real(pw2%array, kind=dp)) !? complex bit
 
                     END IF
 
                     IF (.NOT. my_just_sum) THEN
                           integral_value = integral_value*pw1%pw_grid%dvol
                     END IF
 
 
                        IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == pw_mode_distributed) &
                           CALL pw1%pw_grid%para%group%sum(integral_value)
 
                        CALL timestop(handle)
 
                     END FUNCTION pw_integral_ab_r3d_c3d_rs
! **************************************************************************************************
!> \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_r3d_c3d_gs (pw1, pw2)
 
            TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw1
            TYPE(pw_c3d_gs_type), INTENT(INOUT)                       :: pw2
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_copy'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
            IF (pw1%pw_grid%spherical .neqv. pw2%pw_grid%spherical) &
               cpabort("Both grids must be either spherical or non-spherical!")
 
               IF (any(shape(pw2%array) /= shape(pw1%array))) &
                  cpabort("3D grids must be compatible!")
               IF (pw1%pw_grid%spherical) &
                  cpabort("3D grids must not be spherical!")
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
               pw2%array(:, :, :) =       cmplx(pw1%array(:, :, :), 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_copy_r3d_c3d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_to_array_r3d_c3d_gs (pw, array)
            TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw
            COMPLEX(KIND=dp), DIMENSION(:, :, :), INTENT(INOUT)   :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
               array(:, :, :) =       cmplx(pw%array(:, :, :), 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_to_array_r3d_c3d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_from_array_r3d_c3d_gs (pw, array)
            TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw
            COMPLEX(KIND=dp), DIMENSION(:, :, :), INTENT(IN)      :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
            pw%array =       real(array, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_from_array_r3d_c3d_gs
 
! **************************************************************************************************
!> \brief pw2 = alpha*pw1 + beta*pw2
!>      alpha defaults to 1, beta defaults to 1
!> \param pw1 ...
!> \param pw2 ...
!> \param alpha ...
!> \param beta ...
!> \param allow_noncompatible_grids ...
!> \par History
!>      JGH (21-Feb-2003) : added reference grid functionality
!>      JGH (01-Dec-2007) : rename and remove complex alpha
!> \author apsi
!> \note
!>      Currently only summing up of respective types allowed,
!>      in order to avoid errors
! **************************************************************************************************
         SUBROUTINE pw_axpy_r3d_c3d_gs (pw1, pw2, alpha, beta, allow_noncompatible_grids)
 
            TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw1
            TYPE(pw_c3d_gs_type), INTENT(INOUT)                       :: pw2
            REAL(KIND=dp), INTENT(in), OPTIONAL                :: alpha, beta
            LOGICAL, INTENT(IN), OPTIONAL                      :: allow_noncompatible_grids
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_axpy'
 
            INTEGER                                            :: handle
            LOGICAL                                            :: my_allow_noncompatible_grids
            REAL(KIND=dp)                                      :: my_alpha, my_beta
 
            CALL timeset(routinen, handle)
 
            my_alpha = 1.0_dp
            IF (PRESENT(alpha)) my_alpha = alpha
 
            my_beta = 1.0_dp
            IF (PRESENT(beta)) my_beta = beta
 
            my_allow_noncompatible_grids = .false.
            IF (PRESENT(allow_noncompatible_grids)) my_allow_noncompatible_grids = allow_noncompatible_grids
 
            IF (my_beta /= 1.0_dp) THEN
               IF (my_beta == 0.0_dp) THEN
                  CALL pw_zero(pw2)
               ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw2,my_beta)
                  pw2%array = pw2%array*my_beta
!$OMP END PARALLEL WORKSHARE
               END IF
            END IF
 
                  IF (ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1, pw2)
                        pw2%array = pw2%array +       cmplx(pw1%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1, pw2, my_alpha)
                        pw2%array = pw2%array + my_alpha*      cmplx(pw1%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                  ELSE IF (pw_compatible(pw1%pw_grid, pw2%pw_grid) .OR. my_allow_noncompatible_grids) THEN
 
                     IF (any(shape(pw1%array) /= shape(pw2%array))) &
                        cpabort("Noncommensurate grids not implemented for 3D grids!")
 
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                        pw2%array = pw2%array +       cmplx(pw1%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2,my_alpha)
                        pw2%array = pw2%array + my_alpha*      cmplx(pw1%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                  ELSE
 
                     cpabort("Grids not compatible")
 
                  END IF
 
                  CALL timestop(handle)
 
                  END SUBROUTINE pw_axpy_r3d_c3d_gs
 
! **************************************************************************************************
!> \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_r3d_c3d_gs (pw_out, pw1, pw2, alpha)
 
                     TYPE(pw_r3d_gs_type), INTENT(INOUT)                       :: pw_out
                     TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_c3d_gs_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 !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + pw1%array*      real(pw2%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      real(pw2%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     END IF
#else
                     IF (my_alpha == 1.0_dp) THEN
                        pw_out%array = pw_out%array + pw1%array*      real(pw2%array, kind=dp)
                     ELSE
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      real(pw2%array, kind=dp)
                     END IF
#endif
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_r3d_c3d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
! **************************************************************************************************
                  SUBROUTINE pw_multiply_with_r3d_c3d_gs (pw1, pw2)
                     TYPE(pw_r3d_gs_type), INTENT(INOUT)                       :: pw1
                     TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw2
 
                     CHARACTER(LEN=*), PARAMETER                        :: routineN = 'pw_multiply_with'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) &
                        cpabort("Incompatible grids!")
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                     pw1%array = pw1%array*      real(pw2%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_with_r3d_c3d_gs
 
! **************************************************************************************************
!> \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_r3d_c3d_gs (pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value)
 
                     TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw2
                     INTEGER, INTENT(IN), OPTIONAL                      :: sumtype
                     LOGICAL, INTENT(IN), OPTIONAL                      :: just_sum, local_only
                     REAL(kind=dp)                                      :: integral_value
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_integral_ab_r3d_c3d_gs'
 
                     INTEGER                                            :: handle, loc_sumtype
                     LOGICAL                                            :: my_just_sum, my_local_only
 
                     CALL timeset(routinen, handle)
 
                     loc_sumtype = do_accurate_sum
                     IF (PRESENT(sumtype)) loc_sumtype = sumtype
 
                     my_local_only = .false.
                     IF (PRESENT(local_only)) my_local_only = local_only
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                        cpabort("Grids incompatible")
                     END IF
 
                     my_just_sum = .false.
                     IF (PRESENT(just_sum)) my_just_sum = just_sum
 
                     ! do standard sum
                     IF (loc_sumtype == do_standard_sum) THEN
 
                        ! Do standard sum
 
                           integral_value = sum(pw1%array*real(pw2%array, kind=dp)) !? complex bit
 
                     ELSE
 
                        ! Do accurate sum
                           integral_value = accurate_sum(pw1%array*real(pw2%array, kind=dp)) !? complex bit
 
                     END IF
 
                     IF (.NOT. my_just_sum) THEN
                           integral_value = integral_value*pw1%pw_grid%vol
                     END IF
 
 
                        IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == pw_mode_distributed) &
                           CALL pw1%pw_grid%para%group%sum(integral_value)
 
                        CALL timestop(handle)
 
                     END FUNCTION pw_integral_ab_r3d_c3d_gs
 
! **************************************************************************************************
!> \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_c1d_r1d_rs (pw1, pw2)
 
            TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw1
            TYPE(pw_r1d_rs_type), INTENT(INOUT)                       :: pw2
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_copy'
 
            INTEGER                                            :: handle
               INTEGER :: i, j, ng, ng1, ng2, ns
 
            CALL timeset(routinen, handle)
 
            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) &
                  cpabort("Spherical grids only exist in reciprocal space!")
 
               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) =       real(pw1%array(1:ng), kind=dp)
!$OMP END PARALLEL WORKSHARE
                        IF (ng2 > ng) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(ng, ng2, pw2)
                           pw2%array(ng + 1:ng2) =       0.0_dp
!$OMP END PARALLEL WORKSHARE
                        END IF
                     ELSE
                        cpabort("Copies between spherical grids require compatible grids!")
                     END IF
                  ELSE
                     ng1 = SIZE(pw1%array)
                     ng2 = SIZE(pw2%array)
                     ns = 2*max(ng1, ng2)
 
                     IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                        IF (ng1 >= ng2) THEN
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP             PRIVATE(i,j) &
!$OMP             SHARED(ng2, pw1, pw2)
                           DO i = 1, ng2
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) =       real(pw1%array(j), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE
                           CALL pw_zero(pw2)
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP             PRIVATE(i,j) &
!$OMP             SHARED(ng1, pw1, pw2)
                           DO i = 1, ng1
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) =       real(pw1%array(i), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE IF ((pw2%pw_grid%id_nr == pw1%pw_grid%reference)) THEN
                        IF (ng1 >= ng2) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng2, pw1, pw2)
                           DO i = 1, ng2
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) =       real(pw1%array(j), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE
                           CALL pw_zero(pw2)
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng1, pw1, pw2)
                           DO i = 1, ng1
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) =       real(pw1%array(i), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                           cpabort("Copy not implemented!")
                     END IF
 
                  END IF
 
               ELSE
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw1, pw2)
                  pw2%array =       real(pw1%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
               END IF
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_copy_c1d_r1d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_to_array_c1d_r1d_rs (pw, array)
            TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), DIMENSION(:), INTENT(INOUT)   :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
               array(:) =       real(pw%array(:), kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_to_array_c1d_r1d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_from_array_c1d_r1d_rs (pw, array)
            TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), DIMENSION(:), INTENT(IN)      :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
            pw%array =       cmplx(array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_from_array_c1d_r1d_rs
 
! **************************************************************************************************
!> \brief pw2 = alpha*pw1 + beta*pw2
!>      alpha defaults to 1, beta defaults to 1
!> \param pw1 ...
!> \param pw2 ...
!> \param alpha ...
!> \param beta ...
!> \param allow_noncompatible_grids ...
!> \par History
!>      JGH (21-Feb-2003) : added reference grid functionality
!>      JGH (01-Dec-2007) : rename and remove complex alpha
!> \author apsi
!> \note
!>      Currently only summing up of respective types allowed,
!>      in order to avoid errors
! **************************************************************************************************
         SUBROUTINE pw_axpy_c1d_r1d_rs (pw1, pw2, alpha, beta, allow_noncompatible_grids)
 
            TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw1
            TYPE(pw_r1d_rs_type), INTENT(INOUT)                       :: pw2
            REAL(KIND=dp), INTENT(in), OPTIONAL                :: alpha, beta
            LOGICAL, INTENT(IN), OPTIONAL                      :: allow_noncompatible_grids
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_axpy'
 
            INTEGER                                            :: handle
            LOGICAL                                            :: my_allow_noncompatible_grids
            REAL(KIND=dp)                                      :: my_alpha, my_beta
               INTEGER                                            :: i, j, ng, ng1, ng2
 
            CALL timeset(routinen, handle)
 
            my_alpha = 1.0_dp
            IF (PRESENT(alpha)) my_alpha = alpha
 
            my_beta = 1.0_dp
            IF (PRESENT(beta)) my_beta = beta
 
            my_allow_noncompatible_grids = .false.
            IF (PRESENT(allow_noncompatible_grids)) my_allow_noncompatible_grids = allow_noncompatible_grids
 
            IF (my_beta /= 1.0_dp) THEN
               IF (my_beta == 0.0_dp) THEN
                  CALL pw_zero(pw2)
               ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw2,my_beta)
                  pw2%array = pw2%array*my_beta
!$OMP END PARALLEL WORKSHARE
               END IF
            END IF
 
               IF (ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
 
                  IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw1, pw2)
                     pw2%array = pw2%array +       real(pw1%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                  ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha)
                     pw2%array = pw2%array + my_alpha*      real(pw1%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                  END IF
 
               ELSE IF (pw_compatible(pw1%pw_grid, pw2%pw_grid) .OR. my_allow_noncompatible_grids) THEN
 
                  ng1 = SIZE(pw1%array)
                  ng2 = SIZE(pw2%array)
                  ng = min(ng1, ng2)
 
                  IF (pw1%pw_grid%spherical) THEN
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                        DO i = 1, ng
                           pw2%array(i) = pw2%array(i) +       real(pw1%array(i), kind=dp)
                        END DO
!$OMP END PARALLEL DO
                     ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha,ng)
                        DO i = 1, ng
                           pw2%array(i) = pw2%array(i) + my_alpha*      real(pw1%array(i), kind=dp)
                        END DO
!$OMP END PARALLEL DO
                     END IF
                  ELSE IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                     IF (ng1 >= ng2) THEN
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) +       real(pw1%array(j), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) + my_alpha*      real(pw1%array(j), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) +       real(pw1%array(i), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) + my_alpha*      real(pw1%array(i), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END IF
                  ELSE IF ((pw2%pw_grid%id_nr == pw1%pw_grid%reference)) THEN
                     IF (ng1 >= ng2) THEN
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) +       real(pw1%array(j), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) + my_alpha*      real(pw1%array(j), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) +       real(pw1%array(i), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) + my_alpha*      real(pw1%array(i), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END IF
                  ELSE
                     cpabort("Grids not compatible")
                  END IF
 
                  ELSE
 
                     cpabort("Grids not compatible")
 
                  END IF
 
                  CALL timestop(handle)
 
                  END SUBROUTINE pw_axpy_c1d_r1d_rs
 
! **************************************************************************************************
!> \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_c1d_r1d_rs (pw_out, pw1, pw2, alpha)
 
                     TYPE(pw_c1d_rs_type), INTENT(INOUT)                       :: pw_out
                     TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_r1d_rs_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 !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     END IF
#else
                     IF (my_alpha == 1.0_dp) THEN
                        pw_out%array = pw_out%array + pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
                     ELSE
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
                     END IF
#endif
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_c1d_r1d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
! **************************************************************************************************
                  SUBROUTINE pw_multiply_with_c1d_r1d_rs (pw1, pw2)
                     TYPE(pw_c1d_rs_type), INTENT(INOUT)                       :: pw1
                     TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw2
 
                     CHARACTER(LEN=*), PARAMETER                        :: routineN = 'pw_multiply_with'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) &
                        cpabort("Incompatible grids!")
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                     pw1%array = pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_with_c1d_r1d_rs
 
! **************************************************************************************************
!> \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_c1d_r1d_rs (pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value)
 
                     TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_r1d_rs_type), INTENT(IN)                          :: pw2
                     INTEGER, INTENT(IN), OPTIONAL                      :: sumtype
                     LOGICAL, INTENT(IN), OPTIONAL                      :: just_sum, local_only
                     REAL(kind=dp)                                      :: integral_value
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_integral_ab_c1d_r1d_rs'
 
                     INTEGER                                            :: handle, loc_sumtype
                     LOGICAL                                            :: my_just_sum, my_local_only
 
                     CALL timeset(routinen, handle)
 
                     loc_sumtype = do_accurate_sum
                     IF (PRESENT(sumtype)) loc_sumtype = sumtype
 
                     my_local_only = .false.
                     IF (PRESENT(local_only)) my_local_only = local_only
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                        cpabort("Grids incompatible")
                     END IF
 
                     my_just_sum = .false.
                     IF (PRESENT(just_sum)) my_just_sum = just_sum
 
                     ! do standard sum
                     IF (loc_sumtype == do_standard_sum) THEN
 
                        ! Do standard sum
 
                           integral_value = sum(real(pw1%array, kind=dp)*pw2%array) !? complex bit
 
                     ELSE
 
                        ! Do accurate sum
                           integral_value = accurate_sum(real(pw1%array, kind=dp)*pw2%array) !? complex bit
 
                     END IF
 
                     IF (.NOT. my_just_sum) THEN
                           integral_value = integral_value*pw1%pw_grid%dvol
                     END IF
 
                        IF (pw1%pw_grid%grid_span == halfspace) THEN
                           integral_value = 2.0_dp*integral_value
                           IF (pw1%pw_grid%have_g0) integral_value = integral_value - &
                                                                     REAL(conjg(pw1%array(1))*pw2%array(1), kind=dp)
                           END IF
 
                        IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == pw_mode_distributed) &
                           CALL pw1%pw_grid%para%group%sum(integral_value)
 
                        CALL timestop(handle)
 
                     END FUNCTION pw_integral_ab_c1d_r1d_rs
! **************************************************************************************************
!> \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_c1d_r1d_gs (pw1, pw2)
 
            TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw1
            TYPE(pw_r1d_gs_type), INTENT(INOUT)                       :: pw2
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_copy'
 
            INTEGER                                            :: handle
               INTEGER :: i, j, ng, ng1, ng2, ns
 
            CALL timeset(routinen, handle)
 
            IF (pw1%pw_grid%spherical .neqv. pw2%pw_grid%spherical) &
               cpabort("Both grids must be either spherical or non-spherical!")
 
               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) =       real(pw1%array(1:ng), kind=dp)
!$OMP END PARALLEL WORKSHARE
                        IF (ng2 > ng) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(ng, ng2, pw2)
                           pw2%array(ng + 1:ng2) =       0.0_dp
!$OMP END PARALLEL WORKSHARE
                        END IF
                     ELSE
                        cpabort("Copies between spherical grids require compatible grids!")
                     END IF
                  ELSE
                     ng1 = SIZE(pw1%array)
                     ng2 = SIZE(pw2%array)
                     ns = 2*max(ng1, ng2)
 
                     IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                        IF (ng1 >= ng2) THEN
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP             PRIVATE(i,j) &
!$OMP             SHARED(ng2, pw1, pw2)
                           DO i = 1, ng2
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) =       real(pw1%array(j), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE
                           CALL pw_zero(pw2)
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP             PRIVATE(i,j) &
!$OMP             SHARED(ng1, pw1, pw2)
                           DO i = 1, ng1
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) =       real(pw1%array(i), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE IF ((pw2%pw_grid%id_nr == pw1%pw_grid%reference)) THEN
                        IF (ng1 >= ng2) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng2, pw1, pw2)
                           DO i = 1, ng2
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) =       real(pw1%array(j), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE
                           CALL pw_zero(pw2)
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng1, pw1, pw2)
                           DO i = 1, ng1
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) =       real(pw1%array(i), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                           cpabort("Copy not implemented!")
                     END IF
 
                  END IF
 
               ELSE
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw1, pw2)
                  pw2%array =       real(pw1%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
               END IF
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_copy_c1d_r1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_to_array_c1d_r1d_gs (pw, array)
            TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), DIMENSION(:), INTENT(INOUT)   :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
               array(:) =       real(pw%array(:), kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_to_array_c1d_r1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_from_array_c1d_r1d_gs (pw, array)
            TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), DIMENSION(:), INTENT(IN)      :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
            pw%array =       cmplx(array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_from_array_c1d_r1d_gs
 
! **************************************************************************************************
!> \brief pw2 = alpha*pw1 + beta*pw2
!>      alpha defaults to 1, beta defaults to 1
!> \param pw1 ...
!> \param pw2 ...
!> \param alpha ...
!> \param beta ...
!> \param allow_noncompatible_grids ...
!> \par History
!>      JGH (21-Feb-2003) : added reference grid functionality
!>      JGH (01-Dec-2007) : rename and remove complex alpha
!> \author apsi
!> \note
!>      Currently only summing up of respective types allowed,
!>      in order to avoid errors
! **************************************************************************************************
         SUBROUTINE pw_axpy_c1d_r1d_gs (pw1, pw2, alpha, beta, allow_noncompatible_grids)
 
            TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw1
            TYPE(pw_r1d_gs_type), INTENT(INOUT)                       :: pw2
            REAL(KIND=dp), INTENT(in), OPTIONAL                :: alpha, beta
            LOGICAL, INTENT(IN), OPTIONAL                      :: allow_noncompatible_grids
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_axpy'
 
            INTEGER                                            :: handle
            LOGICAL                                            :: my_allow_noncompatible_grids
            REAL(KIND=dp)                                      :: my_alpha, my_beta
               INTEGER                                            :: i, j, ng, ng1, ng2
 
            CALL timeset(routinen, handle)
 
            my_alpha = 1.0_dp
            IF (PRESENT(alpha)) my_alpha = alpha
 
            my_beta = 1.0_dp
            IF (PRESENT(beta)) my_beta = beta
 
            my_allow_noncompatible_grids = .false.
            IF (PRESENT(allow_noncompatible_grids)) my_allow_noncompatible_grids = allow_noncompatible_grids
 
            IF (my_beta /= 1.0_dp) THEN
               IF (my_beta == 0.0_dp) THEN
                  CALL pw_zero(pw2)
               ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw2,my_beta)
                  pw2%array = pw2%array*my_beta
!$OMP END PARALLEL WORKSHARE
               END IF
            END IF
 
               IF (ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
 
                  IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw1, pw2)
                     pw2%array = pw2%array +       real(pw1%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                  ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha)
                     pw2%array = pw2%array + my_alpha*      real(pw1%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                  END IF
 
               ELSE IF (pw_compatible(pw1%pw_grid, pw2%pw_grid) .OR. my_allow_noncompatible_grids) THEN
 
                  ng1 = SIZE(pw1%array)
                  ng2 = SIZE(pw2%array)
                  ng = min(ng1, ng2)
 
                  IF (pw1%pw_grid%spherical) THEN
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                        DO i = 1, ng
                           pw2%array(i) = pw2%array(i) +       real(pw1%array(i), kind=dp)
                        END DO
!$OMP END PARALLEL DO
                     ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha,ng)
                        DO i = 1, ng
                           pw2%array(i) = pw2%array(i) + my_alpha*      real(pw1%array(i), kind=dp)
                        END DO
!$OMP END PARALLEL DO
                     END IF
                  ELSE IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                     IF (ng1 >= ng2) THEN
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) +       real(pw1%array(j), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) + my_alpha*      real(pw1%array(j), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) +       real(pw1%array(i), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) + my_alpha*      real(pw1%array(i), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END IF
                  ELSE IF ((pw2%pw_grid%id_nr == pw1%pw_grid%reference)) THEN
                     IF (ng1 >= ng2) THEN
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) +       real(pw1%array(j), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) + my_alpha*      real(pw1%array(j), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) +       real(pw1%array(i), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) + my_alpha*      real(pw1%array(i), kind=dp)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END IF
                  ELSE
                     cpabort("Grids not compatible")
                  END IF
 
                  ELSE
 
                     cpabort("Grids not compatible")
 
                  END IF
 
                  CALL timestop(handle)
 
                  END SUBROUTINE pw_axpy_c1d_r1d_gs
 
! **************************************************************************************************
!> \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_c1d_r1d_gs (pw_out, pw1, pw2, alpha)
 
                     TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw_out
                     TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_r1d_gs_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 !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     END IF
#else
                     IF (my_alpha == 1.0_dp) THEN
                        pw_out%array = pw_out%array + pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
                     ELSE
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
                     END IF
#endif
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_c1d_r1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
! **************************************************************************************************
                  SUBROUTINE pw_multiply_with_c1d_r1d_gs (pw1, pw2)
                     TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw1
                     TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw2
 
                     CHARACTER(LEN=*), PARAMETER                        :: routineN = 'pw_multiply_with'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) &
                        cpabort("Incompatible grids!")
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                     pw1%array = pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_with_c1d_r1d_gs
 
! **************************************************************************************************
!> \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_c1d_r1d_gs (pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value)
 
                     TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_r1d_gs_type), INTENT(IN)                          :: pw2
                     INTEGER, INTENT(IN), OPTIONAL                      :: sumtype
                     LOGICAL, INTENT(IN), OPTIONAL                      :: just_sum, local_only
                     REAL(kind=dp)                                      :: integral_value
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_integral_ab_c1d_r1d_gs'
 
                     INTEGER                                            :: handle, loc_sumtype
                     LOGICAL                                            :: my_just_sum, my_local_only
 
                     CALL timeset(routinen, handle)
 
                     loc_sumtype = do_accurate_sum
                     IF (PRESENT(sumtype)) loc_sumtype = sumtype
 
                     my_local_only = .false.
                     IF (PRESENT(local_only)) my_local_only = local_only
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                        cpabort("Grids incompatible")
                     END IF
 
                     my_just_sum = .false.
                     IF (PRESENT(just_sum)) my_just_sum = just_sum
 
                     ! do standard sum
                     IF (loc_sumtype == do_standard_sum) THEN
 
                        ! Do standard sum
 
                           integral_value = sum(real(pw1%array, kind=dp)*pw2%array) !? complex bit
 
                     ELSE
 
                        ! Do accurate sum
                           integral_value = accurate_sum(real(pw1%array, kind=dp)*pw2%array) !? complex bit
 
                     END IF
 
                     IF (.NOT. my_just_sum) THEN
                           integral_value = integral_value*pw1%pw_grid%vol
                     END IF
 
                        IF (pw1%pw_grid%grid_span == halfspace) THEN
                           integral_value = 2.0_dp*integral_value
                           IF (pw1%pw_grid%have_g0) integral_value = integral_value - &
                                                                     REAL(conjg(pw1%array(1))*pw2%array(1), kind=dp)
                           END IF
 
                        IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == pw_mode_distributed) &
                           CALL pw1%pw_grid%para%group%sum(integral_value)
 
                        CALL timestop(handle)
 
                     END FUNCTION pw_integral_ab_c1d_r1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
!> \return ...
! **************************************************************************************************
                        FUNCTION pw_integral_a2b_c1d_r1d (pw1, pw2) RESULT(integral_value)
 
                           TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw1
                           TYPE(pw_r1d_gs_type), INTENT(IN) :: 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
 
                                 integral_value = accurate_sum(real(conjg(pw1%array), kind=dp)*pw2%array*pw1%pw_grid%gsq)
                           IF (pw1%pw_grid%grid_span == halfspace) THEN
                              integral_value = 2.0_dp*integral_value
                           END IF
 
                           integral_value = integral_value*pw1%pw_grid%vol
 
                           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_c1d_r1d
! **************************************************************************************************
!> \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_c1d_c1d_rs (pw1, pw2)
 
            TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw1
            TYPE(pw_c1d_rs_type), INTENT(INOUT)                       :: pw2
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_copy'
 
            INTEGER                                            :: handle
               INTEGER :: i, j, ng, ng1, ng2, ns
 
            CALL timeset(routinen, handle)
 
            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) &
                  cpabort("Spherical grids only exist in reciprocal space!")
 
               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) =       pw1%array(1:ng)
!$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!")
                     END IF
                  ELSE
                     ng1 = SIZE(pw1%array)
                     ng2 = SIZE(pw2%array)
                     ns = 2*max(ng1, ng2)
 
                     IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                        IF (ng1 >= ng2) THEN
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP             PRIVATE(i,j) &
!$OMP             SHARED(ng2, pw1, pw2)
                           DO i = 1, ng2
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) =       pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        ELSE
                           CALL pw_zero(pw2)
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP             PRIVATE(i,j) &
!$OMP             SHARED(ng1, pw1, pw2)
                           DO i = 1, ng1
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) =       pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE IF ((pw2%pw_grid%id_nr == pw1%pw_grid%reference)) THEN
                        IF (ng1 >= ng2) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng2, pw1, pw2)
                           DO i = 1, ng2
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) =       pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        ELSE
                           CALL pw_zero(pw2)
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng1, pw1, pw2)
                           DO i = 1, ng1
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) =       pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                           cpabort("Copy not implemented!")
                     END IF
 
                  END IF
 
               ELSE
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw1, pw2)
                  pw2%array =       pw1%array
!$OMP END PARALLEL WORKSHARE
               END IF
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_copy_c1d_c1d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_to_array_c1d_c1d_rs (pw, array)
            TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw
            COMPLEX(KIND=dp), DIMENSION(:), INTENT(INOUT)   :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
               array(:) =       pw%array(:)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_to_array_c1d_c1d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_from_array_c1d_c1d_rs (pw, array)
            TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw
            COMPLEX(KIND=dp), DIMENSION(:), INTENT(IN)      :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
            pw%array =       array
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_from_array_c1d_c1d_rs
 
! **************************************************************************************************
!> \brief pw2 = alpha*pw1 + beta*pw2
!>      alpha defaults to 1, beta defaults to 1
!> \param pw1 ...
!> \param pw2 ...
!> \param alpha ...
!> \param beta ...
!> \param allow_noncompatible_grids ...
!> \par History
!>      JGH (21-Feb-2003) : added reference grid functionality
!>      JGH (01-Dec-2007) : rename and remove complex alpha
!> \author apsi
!> \note
!>      Currently only summing up of respective types allowed,
!>      in order to avoid errors
! **************************************************************************************************
         SUBROUTINE pw_axpy_c1d_c1d_rs (pw1, pw2, alpha, beta, allow_noncompatible_grids)
 
            TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw1
            TYPE(pw_c1d_rs_type), INTENT(INOUT)                       :: pw2
            REAL(KIND=dp), INTENT(in), OPTIONAL                :: alpha, beta
            LOGICAL, INTENT(IN), OPTIONAL                      :: allow_noncompatible_grids
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_axpy'
 
            INTEGER                                            :: handle
            LOGICAL                                            :: my_allow_noncompatible_grids
            REAL(KIND=dp)                                      :: my_alpha, my_beta
               INTEGER                                            :: i, j, ng, ng1, ng2
 
            CALL timeset(routinen, handle)
 
            my_alpha = 1.0_dp
            IF (PRESENT(alpha)) my_alpha = alpha
 
            my_beta = 1.0_dp
            IF (PRESENT(beta)) my_beta = beta
 
            my_allow_noncompatible_grids = .false.
            IF (PRESENT(allow_noncompatible_grids)) my_allow_noncompatible_grids = allow_noncompatible_grids
 
            IF (my_beta /= 1.0_dp) THEN
               IF (my_beta == 0.0_dp) THEN
                  CALL pw_zero(pw2)
               ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw2,my_beta)
                  pw2%array = pw2%array*my_beta
!$OMP END PARALLEL WORKSHARE
               END IF
            END IF
 
               IF (ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
 
                  IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw1, pw2)
                     pw2%array = pw2%array +       pw1%array
!$OMP END PARALLEL WORKSHARE
                  ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha)
                     pw2%array = pw2%array + my_alpha*      pw1%array
!$OMP END PARALLEL WORKSHARE
                  END IF
 
               ELSE IF (pw_compatible(pw1%pw_grid, pw2%pw_grid) .OR. my_allow_noncompatible_grids) THEN
 
                  ng1 = SIZE(pw1%array)
                  ng2 = SIZE(pw2%array)
                  ng = min(ng1, ng2)
 
                  IF (pw1%pw_grid%spherical) THEN
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                        DO i = 1, ng
                           pw2%array(i) = pw2%array(i) +       pw1%array(i)
                        END DO
!$OMP END PARALLEL DO
                     ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha,ng)
                        DO i = 1, ng
                           pw2%array(i) = pw2%array(i) + my_alpha*      pw1%array(i)
                        END DO
!$OMP END PARALLEL DO
                     END IF
                  ELSE IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                     IF (ng1 >= ng2) THEN
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) +       pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) + my_alpha*      pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) +       pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) + my_alpha*      pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END IF
                  ELSE IF ((pw2%pw_grid%id_nr == pw1%pw_grid%reference)) THEN
                     IF (ng1 >= ng2) THEN
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) +       pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) + my_alpha*      pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) +       pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) + my_alpha*      pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END IF
                  ELSE
                     cpabort("Grids not compatible")
                  END IF
 
                  ELSE
 
                     cpabort("Grids not compatible")
 
                  END IF
 
                  CALL timestop(handle)
 
                  END SUBROUTINE pw_axpy_c1d_c1d_rs
 
! **************************************************************************************************
!> \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_c1d_c1d_rs (pw_out, pw1, pw2, alpha)
 
                     TYPE(pw_c1d_rs_type), INTENT(INOUT)                       :: pw_out
                     TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_c1d_rs_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 !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
                     END IF
#else
                     IF (my_alpha == 1.0_dp) THEN
                        pw_out%array = pw_out%array + pw1%array*      pw2%array
                     ELSE
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      pw2%array
                     END IF
#endif
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_c1d_c1d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
! **************************************************************************************************
                  SUBROUTINE pw_multiply_with_c1d_c1d_rs (pw1, pw2)
                     TYPE(pw_c1d_rs_type), INTENT(INOUT)                       :: pw1
                     TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw2
 
                     CHARACTER(LEN=*), PARAMETER                        :: routineN = 'pw_multiply_with'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) &
                        cpabort("Incompatible grids!")
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                     pw1%array = pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_with_c1d_c1d_rs
 
! **************************************************************************************************
!> \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_c1d_c1d_rs (pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value)
 
                     TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_c1d_rs_type), INTENT(IN)                          :: pw2
                     INTEGER, INTENT(IN), OPTIONAL                      :: sumtype
                     LOGICAL, INTENT(IN), OPTIONAL                      :: just_sum, local_only
                     REAL(kind=dp)                                      :: integral_value
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_integral_ab_c1d_c1d_rs'
 
                     INTEGER                                            :: handle, loc_sumtype
                     LOGICAL                                            :: my_just_sum, my_local_only
 
                     CALL timeset(routinen, handle)
 
                     loc_sumtype = do_accurate_sum
                     IF (PRESENT(sumtype)) loc_sumtype = sumtype
 
                     my_local_only = .false.
                     IF (PRESENT(local_only)) my_local_only = local_only
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                        cpabort("Grids incompatible")
                     END IF
 
                     my_just_sum = .false.
                     IF (PRESENT(just_sum)) my_just_sum = just_sum
 
                     ! do standard sum
                     IF (loc_sumtype == do_standard_sum) THEN
 
                        ! Do standard sum
 
                           integral_value = sum(real(conjg(pw1%array) &
                                                     *pw2%array, kind=dp)) !? complex bit
 
                     ELSE
 
                        ! Do accurate sum
                           integral_value = accurate_sum(real(conjg(pw1%array)*pw2%array, kind=dp))
 
                     END IF
 
                     IF (.NOT. my_just_sum) THEN
                           integral_value = integral_value*pw1%pw_grid%dvol
                     END IF
 
                        IF (pw1%pw_grid%grid_span == halfspace) THEN
                           integral_value = 2.0_dp*integral_value
                           IF (pw1%pw_grid%have_g0) integral_value = integral_value - &
                                                                     REAL(conjg(pw1%array(1))*pw2%array(1), kind=dp)
                           END IF
 
                        IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == pw_mode_distributed) &
                           CALL pw1%pw_grid%para%group%sum(integral_value)
 
                        CALL timestop(handle)
 
                     END FUNCTION pw_integral_ab_c1d_c1d_rs
! **************************************************************************************************
!> \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_c1d_c1d_gs (pw1, pw2)
 
            TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw1
            TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw2
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_copy'
 
            INTEGER                                            :: handle
               INTEGER :: i, j, ng, ng1, ng2, ns
 
            CALL timeset(routinen, handle)
 
            IF (pw1%pw_grid%spherical .neqv. pw2%pw_grid%spherical) &
               cpabort("Both grids must be either spherical or non-spherical!")
 
               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) =       pw1%array(1:ng)
!$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!")
                     END IF
                  ELSE
                     ng1 = SIZE(pw1%array)
                     ng2 = SIZE(pw2%array)
                     ns = 2*max(ng1, ng2)
 
                     IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                        IF (ng1 >= ng2) THEN
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP             PRIVATE(i,j) &
!$OMP             SHARED(ng2, pw1, pw2)
                           DO i = 1, ng2
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) =       pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        ELSE
                           CALL pw_zero(pw2)
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP             PRIVATE(i,j) &
!$OMP             SHARED(ng1, pw1, pw2)
                           DO i = 1, ng1
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) =       pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE IF ((pw2%pw_grid%id_nr == pw1%pw_grid%reference)) THEN
                        IF (ng1 >= ng2) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng2, pw1, pw2)
                           DO i = 1, ng2
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) =       pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        ELSE
                           CALL pw_zero(pw2)
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng1, pw1, pw2)
                           DO i = 1, ng1
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) =       pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                           CALL pw_copy_match(pw1, pw2)
                     END IF
 
                  END IF
 
               ELSE
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw1, pw2)
                  pw2%array =       pw1%array
!$OMP END PARALLEL WORKSHARE
               END IF
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_copy_c1d_c1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_to_array_c1d_c1d_gs (pw, array)
            TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw
            COMPLEX(KIND=dp), DIMENSION(:), INTENT(INOUT)   :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
               array(:) =       pw%array(:)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_to_array_c1d_c1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_from_array_c1d_c1d_gs (pw, array)
            TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw
            COMPLEX(KIND=dp), DIMENSION(:), INTENT(IN)      :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
            pw%array =       array
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_from_array_c1d_c1d_gs
 
! **************************************************************************************************
!> \brief pw2 = alpha*pw1 + beta*pw2
!>      alpha defaults to 1, beta defaults to 1
!> \param pw1 ...
!> \param pw2 ...
!> \param alpha ...
!> \param beta ...
!> \param allow_noncompatible_grids ...
!> \par History
!>      JGH (21-Feb-2003) : added reference grid functionality
!>      JGH (01-Dec-2007) : rename and remove complex alpha
!> \author apsi
!> \note
!>      Currently only summing up of respective types allowed,
!>      in order to avoid errors
! **************************************************************************************************
         SUBROUTINE pw_axpy_c1d_c1d_gs (pw1, pw2, alpha, beta, allow_noncompatible_grids)
 
            TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw1
            TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw2
            REAL(KIND=dp), INTENT(in), OPTIONAL                :: alpha, beta
            LOGICAL, INTENT(IN), OPTIONAL                      :: allow_noncompatible_grids
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_axpy'
 
            INTEGER                                            :: handle
            LOGICAL                                            :: my_allow_noncompatible_grids
            REAL(KIND=dp)                                      :: my_alpha, my_beta
               INTEGER                                            :: i, j, ng, ng1, ng2
 
            CALL timeset(routinen, handle)
 
            my_alpha = 1.0_dp
            IF (PRESENT(alpha)) my_alpha = alpha
 
            my_beta = 1.0_dp
            IF (PRESENT(beta)) my_beta = beta
 
            my_allow_noncompatible_grids = .false.
            IF (PRESENT(allow_noncompatible_grids)) my_allow_noncompatible_grids = allow_noncompatible_grids
 
            IF (my_beta /= 1.0_dp) THEN
               IF (my_beta == 0.0_dp) THEN
                  CALL pw_zero(pw2)
               ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw2,my_beta)
                  pw2%array = pw2%array*my_beta
!$OMP END PARALLEL WORKSHARE
               END IF
            END IF
 
               IF (ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
 
                  IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw1, pw2)
                     pw2%array = pw2%array +       pw1%array
!$OMP END PARALLEL WORKSHARE
                  ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL WORKSHARE PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha)
                     pw2%array = pw2%array + my_alpha*      pw1%array
!$OMP END PARALLEL WORKSHARE
                  END IF
 
               ELSE IF (pw_compatible(pw1%pw_grid, pw2%pw_grid) .OR. my_allow_noncompatible_grids) THEN
 
                  ng1 = SIZE(pw1%array)
                  ng2 = SIZE(pw2%array)
                  ng = min(ng1, ng2)
 
                  IF (pw1%pw_grid%spherical) THEN
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                        DO i = 1, ng
                           pw2%array(i) = pw2%array(i) +       pw1%array(i)
                        END DO
!$OMP END PARALLEL DO
                     ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i) DEFAULT(NONE) SHARED(pw2,pw1,my_alpha,ng)
                        DO i = 1, ng
                           pw2%array(i) = pw2%array(i) + my_alpha*      pw1%array(i)
                        END DO
!$OMP END PARALLEL DO
                     END IF
                  ELSE IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                     IF (ng1 >= ng2) THEN
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) +       pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) + my_alpha*      pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) +       pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw2%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) + my_alpha*      pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END IF
                  ELSE IF ((pw2%pw_grid%id_nr == pw1%pw_grid%reference)) THEN
                     IF (ng1 >= ng2) THEN
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) +       pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(i) = pw2%array(i) + my_alpha*      pw1%array(j)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     ELSE
                        IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) +       pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL DO PRIVATE(i,j) DEFAULT(NONE) SHARED(my_alpha, ng, pw1, pw2)
                           DO i = 1, ng
                              j = pw1%pw_grid%gidx(i)
                              pw2%array(j) = pw2%array(j) + my_alpha*      pw1%array(i)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END IF
                  ELSE
                     cpabort("Grids not compatible")
                  END IF
 
                  ELSE
 
                     cpabort("Grids not compatible")
 
                  END IF
 
                  CALL timestop(handle)
 
                  END SUBROUTINE pw_axpy_c1d_c1d_gs
 
! **************************************************************************************************
!> \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_c1d_c1d_gs (pw_out, pw1, pw2, alpha)
 
                     TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw_out
                     TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_c1d_gs_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 !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
                     END IF
#else
                     IF (my_alpha == 1.0_dp) THEN
                        pw_out%array = pw_out%array + pw1%array*      pw2%array
                     ELSE
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      pw2%array
                     END IF
#endif
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_c1d_c1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
! **************************************************************************************************
                  SUBROUTINE pw_multiply_with_c1d_c1d_gs (pw1, pw2)
                     TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw1
                     TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw2
 
                     CHARACTER(LEN=*), PARAMETER                        :: routineN = 'pw_multiply_with'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) &
                        cpabort("Incompatible grids!")
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                     pw1%array = pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_with_c1d_c1d_gs
 
! **************************************************************************************************
!> \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_c1d_c1d_gs (pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value)
 
                     TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw2
                     INTEGER, INTENT(IN), OPTIONAL                      :: sumtype
                     LOGICAL, INTENT(IN), OPTIONAL                      :: just_sum, local_only
                     REAL(kind=dp)                                      :: integral_value
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_integral_ab_c1d_c1d_gs'
 
                     INTEGER                                            :: handle, loc_sumtype
                     LOGICAL                                            :: my_just_sum, my_local_only
 
                     CALL timeset(routinen, handle)
 
                     loc_sumtype = do_accurate_sum
                     IF (PRESENT(sumtype)) loc_sumtype = sumtype
 
                     my_local_only = .false.
                     IF (PRESENT(local_only)) my_local_only = local_only
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                        cpabort("Grids incompatible")
                     END IF
 
                     my_just_sum = .false.
                     IF (PRESENT(just_sum)) my_just_sum = just_sum
 
                     ! do standard sum
                     IF (loc_sumtype == do_standard_sum) THEN
 
                        ! Do standard sum
 
                           integral_value = sum(real(conjg(pw1%array) &
                                                     *pw2%array, kind=dp)) !? complex bit
 
                     ELSE
 
                        ! Do accurate sum
                           integral_value = accurate_sum(real(conjg(pw1%array)*pw2%array, kind=dp))
 
                     END IF
 
                     IF (.NOT. my_just_sum) THEN
                           integral_value = integral_value*pw1%pw_grid%vol
                     END IF
 
                        IF (pw1%pw_grid%grid_span == halfspace) THEN
                           integral_value = 2.0_dp*integral_value
                           IF (pw1%pw_grid%have_g0) integral_value = integral_value - &
                                                                     REAL(conjg(pw1%array(1))*pw2%array(1), kind=dp)
                           END IF
 
                        IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == pw_mode_distributed) &
                           CALL pw1%pw_grid%para%group%sum(integral_value)
 
                        CALL timestop(handle)
 
                     END FUNCTION pw_integral_ab_c1d_c1d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
!> \return ...
! **************************************************************************************************
                        FUNCTION pw_integral_a2b_c1d_c1d (pw1, pw2) RESULT(integral_value)
 
                           TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw1
                           TYPE(pw_c1d_gs_type), INTENT(IN) :: 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
 
                                 integral_value = accurate_sum(real(conjg(pw1%array)*pw2%array, kind=dp)*pw1%pw_grid%gsq)
                           IF (pw1%pw_grid%grid_span == halfspace) THEN
                              integral_value = 2.0_dp*integral_value
                           END IF
 
                           integral_value = integral_value*pw1%pw_grid%vol
 
                           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_c1d_c1d
! **************************************************************************************************
!> \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_c3d_r3d_rs (pw1, pw2)
 
            TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw1
            TYPE(pw_r3d_rs_type), INTENT(INOUT)                       :: pw2
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_copy'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
            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) &
                  cpabort("Spherical grids only exist in reciprocal space!")
 
               IF (any(shape(pw2%array) /= shape(pw1%array))) &
                  cpabort("3D grids must be compatible!")
               IF (pw1%pw_grid%spherical) &
                  cpabort("3D grids must not be spherical!")
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
               pw2%array(:, :, :) =       real(pw1%array(:, :, :), kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_copy_c3d_r3d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_to_array_c3d_r3d_rs (pw, array)
            TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), DIMENSION(:, :, :), INTENT(INOUT)   :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
               array(:, :, :) =       real(pw%array(:, :, :), kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_to_array_c3d_r3d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_from_array_c3d_r3d_rs (pw, array)
            TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), DIMENSION(:, :, :), INTENT(IN)      :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
            pw%array =       cmplx(array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_from_array_c3d_r3d_rs
 
! **************************************************************************************************
!> \brief pw2 = alpha*pw1 + beta*pw2
!>      alpha defaults to 1, beta defaults to 1
!> \param pw1 ...
!> \param pw2 ...
!> \param alpha ...
!> \param beta ...
!> \param allow_noncompatible_grids ...
!> \par History
!>      JGH (21-Feb-2003) : added reference grid functionality
!>      JGH (01-Dec-2007) : rename and remove complex alpha
!> \author apsi
!> \note
!>      Currently only summing up of respective types allowed,
!>      in order to avoid errors
! **************************************************************************************************
         SUBROUTINE pw_axpy_c3d_r3d_rs (pw1, pw2, alpha, beta, allow_noncompatible_grids)
 
            TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw1
            TYPE(pw_r3d_rs_type), INTENT(INOUT)                       :: pw2
            REAL(KIND=dp), INTENT(in), OPTIONAL                :: alpha, beta
            LOGICAL, INTENT(IN), OPTIONAL                      :: allow_noncompatible_grids
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_axpy'
 
            INTEGER                                            :: handle
            LOGICAL                                            :: my_allow_noncompatible_grids
            REAL(KIND=dp)                                      :: my_alpha, my_beta
 
            CALL timeset(routinen, handle)
 
            my_alpha = 1.0_dp
            IF (PRESENT(alpha)) my_alpha = alpha
 
            my_beta = 1.0_dp
            IF (PRESENT(beta)) my_beta = beta
 
            my_allow_noncompatible_grids = .false.
            IF (PRESENT(allow_noncompatible_grids)) my_allow_noncompatible_grids = allow_noncompatible_grids
 
            IF (my_beta /= 1.0_dp) THEN
               IF (my_beta == 0.0_dp) THEN
                  CALL pw_zero(pw2)
               ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw2,my_beta)
                  pw2%array = pw2%array*my_beta
!$OMP END PARALLEL WORKSHARE
               END IF
            END IF
 
                  IF (ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1, pw2)
                        pw2%array = pw2%array +       real(pw1%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1, pw2, my_alpha)
                        pw2%array = pw2%array + my_alpha*      real(pw1%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                  ELSE IF (pw_compatible(pw1%pw_grid, pw2%pw_grid) .OR. my_allow_noncompatible_grids) THEN
 
                     IF (any(shape(pw1%array) /= shape(pw2%array))) &
                        cpabort("Noncommensurate grids not implemented for 3D grids!")
 
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                        pw2%array = pw2%array +       real(pw1%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2,my_alpha)
                        pw2%array = pw2%array + my_alpha*      real(pw1%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                  ELSE
 
                     cpabort("Grids not compatible")
 
                  END IF
 
                  CALL timestop(handle)
 
                  END SUBROUTINE pw_axpy_c3d_r3d_rs
 
! **************************************************************************************************
!> \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_c3d_r3d_rs (pw_out, pw1, pw2, alpha)
 
                     TYPE(pw_c3d_rs_type), INTENT(INOUT)                       :: pw_out
                     TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_r3d_rs_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 !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     END IF
#else
                     IF (my_alpha == 1.0_dp) THEN
                        pw_out%array = pw_out%array + pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
                     ELSE
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
                     END IF
#endif
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_c3d_r3d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
! **************************************************************************************************
                  SUBROUTINE pw_multiply_with_c3d_r3d_rs (pw1, pw2)
                     TYPE(pw_c3d_rs_type), INTENT(INOUT)                       :: pw1
                     TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw2
 
                     CHARACTER(LEN=*), PARAMETER                        :: routineN = 'pw_multiply_with'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) &
                        cpabort("Incompatible grids!")
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                     pw1%array = pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_with_c3d_r3d_rs
 
! **************************************************************************************************
!> \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_c3d_r3d_rs (pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value)
 
                     TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_r3d_rs_type), INTENT(IN)                          :: pw2
                     INTEGER, INTENT(IN), OPTIONAL                      :: sumtype
                     LOGICAL, INTENT(IN), OPTIONAL                      :: just_sum, local_only
                     REAL(kind=dp)                                      :: integral_value
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_integral_ab_c3d_r3d_rs'
 
                     INTEGER                                            :: handle, loc_sumtype
                     LOGICAL                                            :: my_just_sum, my_local_only
 
                     CALL timeset(routinen, handle)
 
                     loc_sumtype = do_accurate_sum
                     IF (PRESENT(sumtype)) loc_sumtype = sumtype
 
                     my_local_only = .false.
                     IF (PRESENT(local_only)) my_local_only = local_only
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                        cpabort("Grids incompatible")
                     END IF
 
                     my_just_sum = .false.
                     IF (PRESENT(just_sum)) my_just_sum = just_sum
 
                     ! do standard sum
                     IF (loc_sumtype == do_standard_sum) THEN
 
                        ! Do standard sum
 
                           integral_value = sum(real(pw1%array, kind=dp)*pw2%array) !? complex bit
 
                     ELSE
 
                        ! Do accurate sum
                           integral_value = accurate_sum(real(pw1%array, kind=dp)*pw2%array) !? complex bit
 
                     END IF
 
                     IF (.NOT. my_just_sum) THEN
                           integral_value = integral_value*pw1%pw_grid%dvol
                     END IF
 
 
                        IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == pw_mode_distributed) &
                           CALL pw1%pw_grid%para%group%sum(integral_value)
 
                        CALL timestop(handle)
 
                     END FUNCTION pw_integral_ab_c3d_r3d_rs
! **************************************************************************************************
!> \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_c3d_r3d_gs (pw1, pw2)
 
            TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw1
            TYPE(pw_r3d_gs_type), INTENT(INOUT)                       :: pw2
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_copy'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
            IF (pw1%pw_grid%spherical .neqv. pw2%pw_grid%spherical) &
               cpabort("Both grids must be either spherical or non-spherical!")
 
               IF (any(shape(pw2%array) /= shape(pw1%array))) &
                  cpabort("3D grids must be compatible!")
               IF (pw1%pw_grid%spherical) &
                  cpabort("3D grids must not be spherical!")
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
               pw2%array(:, :, :) =       real(pw1%array(:, :, :), kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_copy_c3d_r3d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_to_array_c3d_r3d_gs (pw, array)
            TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), DIMENSION(:, :, :), INTENT(INOUT)   :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
               array(:, :, :) =       real(pw%array(:, :, :), kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_to_array_c3d_r3d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_from_array_c3d_r3d_gs (pw, array)
            TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw
            REAL(KIND=dp), DIMENSION(:, :, :), INTENT(IN)      :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
            pw%array =       cmplx(array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_from_array_c3d_r3d_gs
 
! **************************************************************************************************
!> \brief pw2 = alpha*pw1 + beta*pw2
!>      alpha defaults to 1, beta defaults to 1
!> \param pw1 ...
!> \param pw2 ...
!> \param alpha ...
!> \param beta ...
!> \param allow_noncompatible_grids ...
!> \par History
!>      JGH (21-Feb-2003) : added reference grid functionality
!>      JGH (01-Dec-2007) : rename and remove complex alpha
!> \author apsi
!> \note
!>      Currently only summing up of respective types allowed,
!>      in order to avoid errors
! **************************************************************************************************
         SUBROUTINE pw_axpy_c3d_r3d_gs (pw1, pw2, alpha, beta, allow_noncompatible_grids)
 
            TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw1
            TYPE(pw_r3d_gs_type), INTENT(INOUT)                       :: pw2
            REAL(KIND=dp), INTENT(in), OPTIONAL                :: alpha, beta
            LOGICAL, INTENT(IN), OPTIONAL                      :: allow_noncompatible_grids
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_axpy'
 
            INTEGER                                            :: handle
            LOGICAL                                            :: my_allow_noncompatible_grids
            REAL(KIND=dp)                                      :: my_alpha, my_beta
 
            CALL timeset(routinen, handle)
 
            my_alpha = 1.0_dp
            IF (PRESENT(alpha)) my_alpha = alpha
 
            my_beta = 1.0_dp
            IF (PRESENT(beta)) my_beta = beta
 
            my_allow_noncompatible_grids = .false.
            IF (PRESENT(allow_noncompatible_grids)) my_allow_noncompatible_grids = allow_noncompatible_grids
 
            IF (my_beta /= 1.0_dp) THEN
               IF (my_beta == 0.0_dp) THEN
                  CALL pw_zero(pw2)
               ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw2,my_beta)
                  pw2%array = pw2%array*my_beta
!$OMP END PARALLEL WORKSHARE
               END IF
            END IF
 
                  IF (ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1, pw2)
                        pw2%array = pw2%array +       real(pw1%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1, pw2, my_alpha)
                        pw2%array = pw2%array + my_alpha*      real(pw1%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                  ELSE IF (pw_compatible(pw1%pw_grid, pw2%pw_grid) .OR. my_allow_noncompatible_grids) THEN
 
                     IF (any(shape(pw1%array) /= shape(pw2%array))) &
                        cpabort("Noncommensurate grids not implemented for 3D grids!")
 
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                        pw2%array = pw2%array +       real(pw1%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2,my_alpha)
                        pw2%array = pw2%array + my_alpha*      real(pw1%array, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                  ELSE
 
                     cpabort("Grids not compatible")
 
                  END IF
 
                  CALL timestop(handle)
 
                  END SUBROUTINE pw_axpy_c3d_r3d_gs
 
! **************************************************************************************************
!> \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_c3d_r3d_gs (pw_out, pw1, pw2, alpha)
 
                     TYPE(pw_c3d_gs_type), INTENT(INOUT)                       :: pw_out
                     TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_r3d_gs_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 !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
                     END IF
#else
                     IF (my_alpha == 1.0_dp) THEN
                        pw_out%array = pw_out%array + pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
                     ELSE
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
                     END IF
#endif
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_c3d_r3d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
! **************************************************************************************************
                  SUBROUTINE pw_multiply_with_c3d_r3d_gs (pw1, pw2)
                     TYPE(pw_c3d_gs_type), INTENT(INOUT)                       :: pw1
                     TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw2
 
                     CHARACTER(LEN=*), PARAMETER                        :: routineN = 'pw_multiply_with'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) &
                        cpabort("Incompatible grids!")
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                     pw1%array = pw1%array*      cmplx(pw2%array, 0.0_dp, kind=dp)
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_with_c3d_r3d_gs
 
! **************************************************************************************************
!> \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_c3d_r3d_gs (pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value)
 
                     TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_r3d_gs_type), INTENT(IN)                          :: pw2
                     INTEGER, INTENT(IN), OPTIONAL                      :: sumtype
                     LOGICAL, INTENT(IN), OPTIONAL                      :: just_sum, local_only
                     REAL(kind=dp)                                      :: integral_value
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_integral_ab_c3d_r3d_gs'
 
                     INTEGER                                            :: handle, loc_sumtype
                     LOGICAL                                            :: my_just_sum, my_local_only
 
                     CALL timeset(routinen, handle)
 
                     loc_sumtype = do_accurate_sum
                     IF (PRESENT(sumtype)) loc_sumtype = sumtype
 
                     my_local_only = .false.
                     IF (PRESENT(local_only)) my_local_only = local_only
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                        cpabort("Grids incompatible")
                     END IF
 
                     my_just_sum = .false.
                     IF (PRESENT(just_sum)) my_just_sum = just_sum
 
                     ! do standard sum
                     IF (loc_sumtype == do_standard_sum) THEN
 
                        ! Do standard sum
 
                           integral_value = sum(real(pw1%array, kind=dp)*pw2%array) !? complex bit
 
                     ELSE
 
                        ! Do accurate sum
                           integral_value = accurate_sum(real(pw1%array, kind=dp)*pw2%array) !? complex bit
 
                     END IF
 
                     IF (.NOT. my_just_sum) THEN
                           integral_value = integral_value*pw1%pw_grid%vol
                     END IF
 
 
                        IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == pw_mode_distributed) &
                           CALL pw1%pw_grid%para%group%sum(integral_value)
 
                        CALL timestop(handle)
 
                     END FUNCTION pw_integral_ab_c3d_r3d_gs
 
! **************************************************************************************************
!> \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_c3d_c3d_rs (pw1, pw2)
 
            TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw1
            TYPE(pw_c3d_rs_type), INTENT(INOUT)                       :: pw2
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_copy'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
            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) &
                  cpabort("Spherical grids only exist in reciprocal space!")
 
               IF (any(shape(pw2%array) /= shape(pw1%array))) &
                  cpabort("3D grids must be compatible!")
               IF (pw1%pw_grid%spherical) &
                  cpabort("3D grids must not be spherical!")
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
               pw2%array(:, :, :) =       pw1%array(:, :, :)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_copy_c3d_c3d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_to_array_c3d_c3d_rs (pw, array)
            TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw
            COMPLEX(KIND=dp), DIMENSION(:, :, :), INTENT(INOUT)   :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
               array(:, :, :) =       pw%array(:, :, :)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_to_array_c3d_c3d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_from_array_c3d_c3d_rs (pw, array)
            TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw
            COMPLEX(KIND=dp), DIMENSION(:, :, :), INTENT(IN)      :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
            pw%array =       array
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_from_array_c3d_c3d_rs
 
! **************************************************************************************************
!> \brief pw2 = alpha*pw1 + beta*pw2
!>      alpha defaults to 1, beta defaults to 1
!> \param pw1 ...
!> \param pw2 ...
!> \param alpha ...
!> \param beta ...
!> \param allow_noncompatible_grids ...
!> \par History
!>      JGH (21-Feb-2003) : added reference grid functionality
!>      JGH (01-Dec-2007) : rename and remove complex alpha
!> \author apsi
!> \note
!>      Currently only summing up of respective types allowed,
!>      in order to avoid errors
! **************************************************************************************************
         SUBROUTINE pw_axpy_c3d_c3d_rs (pw1, pw2, alpha, beta, allow_noncompatible_grids)
 
            TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw1
            TYPE(pw_c3d_rs_type), INTENT(INOUT)                       :: pw2
            REAL(KIND=dp), INTENT(in), OPTIONAL                :: alpha, beta
            LOGICAL, INTENT(IN), OPTIONAL                      :: allow_noncompatible_grids
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_axpy'
 
            INTEGER                                            :: handle
            LOGICAL                                            :: my_allow_noncompatible_grids
            REAL(KIND=dp)                                      :: my_alpha, my_beta
 
            CALL timeset(routinen, handle)
 
            my_alpha = 1.0_dp
            IF (PRESENT(alpha)) my_alpha = alpha
 
            my_beta = 1.0_dp
            IF (PRESENT(beta)) my_beta = beta
 
            my_allow_noncompatible_grids = .false.
            IF (PRESENT(allow_noncompatible_grids)) my_allow_noncompatible_grids = allow_noncompatible_grids
 
            IF (my_beta /= 1.0_dp) THEN
               IF (my_beta == 0.0_dp) THEN
                  CALL pw_zero(pw2)
               ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw2,my_beta)
                  pw2%array = pw2%array*my_beta
!$OMP END PARALLEL WORKSHARE
               END IF
            END IF
 
                  IF (ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1, pw2)
                        pw2%array = pw2%array +       pw1%array
!$OMP END PARALLEL WORKSHARE
                     ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1, pw2, my_alpha)
                        pw2%array = pw2%array + my_alpha*      pw1%array
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                  ELSE IF (pw_compatible(pw1%pw_grid, pw2%pw_grid) .OR. my_allow_noncompatible_grids) THEN
 
                     IF (any(shape(pw1%array) /= shape(pw2%array))) &
                        cpabort("Noncommensurate grids not implemented for 3D grids!")
 
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                        pw2%array = pw2%array +       pw1%array
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2,my_alpha)
                        pw2%array = pw2%array + my_alpha*      pw1%array
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                  ELSE
 
                     cpabort("Grids not compatible")
 
                  END IF
 
                  CALL timestop(handle)
 
                  END SUBROUTINE pw_axpy_c3d_c3d_rs
 
! **************************************************************************************************
!> \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_c3d_c3d_rs (pw_out, pw1, pw2, alpha)
 
                     TYPE(pw_c3d_rs_type), INTENT(INOUT)                       :: pw_out
                     TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_c3d_rs_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 !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
                     END IF
#else
                     IF (my_alpha == 1.0_dp) THEN
                        pw_out%array = pw_out%array + pw1%array*      pw2%array
                     ELSE
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      pw2%array
                     END IF
#endif
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_c3d_c3d_rs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
! **************************************************************************************************
                  SUBROUTINE pw_multiply_with_c3d_c3d_rs (pw1, pw2)
                     TYPE(pw_c3d_rs_type), INTENT(INOUT)                       :: pw1
                     TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw2
 
                     CHARACTER(LEN=*), PARAMETER                        :: routineN = 'pw_multiply_with'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) &
                        cpabort("Incompatible grids!")
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                     pw1%array = pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_with_c3d_c3d_rs
 
! **************************************************************************************************
!> \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_c3d_c3d_rs (pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value)
 
                     TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_c3d_rs_type), INTENT(IN)                          :: pw2
                     INTEGER, INTENT(IN), OPTIONAL                      :: sumtype
                     LOGICAL, INTENT(IN), OPTIONAL                      :: just_sum, local_only
                     REAL(kind=dp)                                      :: integral_value
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_integral_ab_c3d_c3d_rs'
 
                     INTEGER                                            :: handle, loc_sumtype
                     LOGICAL                                            :: my_just_sum, my_local_only
 
                     CALL timeset(routinen, handle)
 
                     loc_sumtype = do_accurate_sum
                     IF (PRESENT(sumtype)) loc_sumtype = sumtype
 
                     my_local_only = .false.
                     IF (PRESENT(local_only)) my_local_only = local_only
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                        cpabort("Grids incompatible")
                     END IF
 
                     my_just_sum = .false.
                     IF (PRESENT(just_sum)) my_just_sum = just_sum
 
                     ! do standard sum
                     IF (loc_sumtype == do_standard_sum) THEN
 
                        ! Do standard sum
 
                           integral_value = sum(real(conjg(pw1%array) &
                                                     *pw2%array, kind=dp)) !? complex bit
 
                     ELSE
 
                        ! Do accurate sum
                           integral_value = accurate_sum(real(conjg(pw1%array)*pw2%array, kind=dp))
 
                     END IF
 
                     IF (.NOT. my_just_sum) THEN
                           integral_value = integral_value*pw1%pw_grid%dvol
                     END IF
 
 
                        IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == pw_mode_distributed) &
                           CALL pw1%pw_grid%para%group%sum(integral_value)
 
                        CALL timestop(handle)
 
                     END FUNCTION pw_integral_ab_c3d_c3d_rs
! **************************************************************************************************
!> \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_c3d_c3d_gs (pw1, pw2)
 
            TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw1
            TYPE(pw_c3d_gs_type), INTENT(INOUT)                       :: pw2
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_copy'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
            IF (pw1%pw_grid%spherical .neqv. pw2%pw_grid%spherical) &
               cpabort("Both grids must be either spherical or non-spherical!")
 
               IF (any(shape(pw2%array) /= shape(pw1%array))) &
                  cpabort("3D grids must be compatible!")
               IF (pw1%pw_grid%spherical) &
                  cpabort("3D grids must not be spherical!")
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
               pw2%array(:, :, :) =       pw1%array(:, :, :)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
 
         END SUBROUTINE pw_copy_c3d_c3d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_to_array_c3d_c3d_gs (pw, array)
            TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw
            COMPLEX(KIND=dp), DIMENSION(:, :, :), INTENT(INOUT)   :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_to_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
               array(:, :, :) =       pw%array(:, :, :)
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_to_array_c3d_c3d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw ...
!> \param array ...
! **************************************************************************************************
         SUBROUTINE pw_copy_from_array_c3d_c3d_gs (pw, array)
            TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw
            COMPLEX(KIND=dp), DIMENSION(:, :, :), INTENT(IN)      :: array
 
            CHARACTER(len=*), PARAMETER :: routineN = 'pw_copy_from_array'
 
            INTEGER                                            :: handle
 
            CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
            pw%array =       array
!$OMP END PARALLEL WORKSHARE
 
            CALL timestop(handle)
         END SUBROUTINE pw_copy_from_array_c3d_c3d_gs
 
! **************************************************************************************************
!> \brief pw2 = alpha*pw1 + beta*pw2
!>      alpha defaults to 1, beta defaults to 1
!> \param pw1 ...
!> \param pw2 ...
!> \param alpha ...
!> \param beta ...
!> \param allow_noncompatible_grids ...
!> \par History
!>      JGH (21-Feb-2003) : added reference grid functionality
!>      JGH (01-Dec-2007) : rename and remove complex alpha
!> \author apsi
!> \note
!>      Currently only summing up of respective types allowed,
!>      in order to avoid errors
! **************************************************************************************************
         SUBROUTINE pw_axpy_c3d_c3d_gs (pw1, pw2, alpha, beta, allow_noncompatible_grids)
 
            TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw1
            TYPE(pw_c3d_gs_type), INTENT(INOUT)                       :: pw2
            REAL(KIND=dp), INTENT(in), OPTIONAL                :: alpha, beta
            LOGICAL, INTENT(IN), OPTIONAL                      :: allow_noncompatible_grids
 
            CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_axpy'
 
            INTEGER                                            :: handle
            LOGICAL                                            :: my_allow_noncompatible_grids
            REAL(KIND=dp)                                      :: my_alpha, my_beta
 
            CALL timeset(routinen, handle)
 
            my_alpha = 1.0_dp
            IF (PRESENT(alpha)) my_alpha = alpha
 
            my_beta = 1.0_dp
            IF (PRESENT(beta)) my_beta = beta
 
            my_allow_noncompatible_grids = .false.
            IF (PRESENT(allow_noncompatible_grids)) my_allow_noncompatible_grids = allow_noncompatible_grids
 
            IF (my_beta /= 1.0_dp) THEN
               IF (my_beta == 0.0_dp) THEN
                  CALL pw_zero(pw2)
               ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw2,my_beta)
                  pw2%array = pw2%array*my_beta
!$OMP END PARALLEL WORKSHARE
               END IF
            END IF
 
                  IF (ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1, pw2)
                        pw2%array = pw2%array +       pw1%array
!$OMP END PARALLEL WORKSHARE
                     ELSE IF (my_alpha /= 0.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1, pw2, my_alpha)
                        pw2%array = pw2%array + my_alpha*      pw1%array
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                  ELSE IF (pw_compatible(pw1%pw_grid, pw2%pw_grid) .OR. my_allow_noncompatible_grids) THEN
 
                     IF (any(shape(pw1%array) /= shape(pw2%array))) &
                        cpabort("Noncommensurate grids not implemented for 3D grids!")
 
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                        pw2%array = pw2%array +       pw1%array
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2,my_alpha)
                        pw2%array = pw2%array + my_alpha*      pw1%array
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                  ELSE
 
                     cpabort("Grids not compatible")
 
                  END IF
 
                  CALL timestop(handle)
 
                  END SUBROUTINE pw_axpy_c3d_c3d_gs
 
! **************************************************************************************************
!> \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_c3d_c3d_gs (pw_out, pw1, pw2, alpha)
 
                     TYPE(pw_c3d_gs_type), INTENT(INOUT)                       :: pw_out
                     TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_c3d_gs_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 !defined(__INTEL_LLVM_COMPILER) || (20250000 <= __INTEL_LLVM_COMPILER)
                     IF (my_alpha == 1.0_dp) THEN
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
                     ELSE
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(my_alpha, pw_out, pw1, pw2)
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
                     END IF
#else
                     IF (my_alpha == 1.0_dp) THEN
                        pw_out%array = pw_out%array + pw1%array*      pw2%array
                     ELSE
                        pw_out%array = pw_out%array + my_alpha*pw1%array*      pw2%array
                     END IF
#endif
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_c3d_c3d_gs
 
! **************************************************************************************************
!> \brief ...
!> \param pw1 ...
!> \param pw2 ...
! **************************************************************************************************
                  SUBROUTINE pw_multiply_with_c3d_c3d_gs (pw1, pw2)
                     TYPE(pw_c3d_gs_type), INTENT(INOUT)                       :: pw1
                     TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw2
 
                     CHARACTER(LEN=*), PARAMETER                        :: routineN = 'pw_multiply_with'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) &
                        cpabort("Incompatible grids!")
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw1,pw2)
                     pw1%array = pw1%array*      pw2%array
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_multiply_with_c3d_c3d_gs
 
! **************************************************************************************************
!> \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_c3d_c3d_gs (pw1, pw2, sumtype, just_sum, local_only) RESULT(integral_value)
 
                     TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw1
                     TYPE(pw_c3d_gs_type), INTENT(IN)                          :: pw2
                     INTEGER, INTENT(IN), OPTIONAL                      :: sumtype
                     LOGICAL, INTENT(IN), OPTIONAL                      :: just_sum, local_only
                     REAL(kind=dp)                                      :: integral_value
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_integral_ab_c3d_c3d_gs'
 
                     INTEGER                                            :: handle, loc_sumtype
                     LOGICAL                                            :: my_just_sum, my_local_only
 
                     CALL timeset(routinen, handle)
 
                     loc_sumtype = do_accurate_sum
                     IF (PRESENT(sumtype)) loc_sumtype = sumtype
 
                     my_local_only = .false.
                     IF (PRESENT(local_only)) my_local_only = local_only
 
                     IF (.NOT. ASSOCIATED(pw1%pw_grid, pw2%pw_grid)) THEN
                        cpabort("Grids incompatible")
                     END IF
 
                     my_just_sum = .false.
                     IF (PRESENT(just_sum)) my_just_sum = just_sum
 
                     ! do standard sum
                     IF (loc_sumtype == do_standard_sum) THEN
 
                        ! Do standard sum
 
                           integral_value = sum(real(conjg(pw1%array) &
                                                     *pw2%array, kind=dp)) !? complex bit
 
                     ELSE
 
                        ! Do accurate sum
                           integral_value = accurate_sum(real(conjg(pw1%array)*pw2%array, kind=dp))
 
                     END IF
 
                     IF (.NOT. my_just_sum) THEN
                           integral_value = integral_value*pw1%pw_grid%vol
                     END IF
 
 
                        IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == pw_mode_distributed) &
                           CALL pw1%pw_grid%para%group%sum(integral_value)
 
                        CALL timestop(handle)
 
                     END FUNCTION pw_integral_ab_c3d_c3d_gs
 
 
 
 
 
 
 
 
 
 
 
 
 
! **************************************************************************************************
!> \brief Gathers the pw vector from a 3d data field
!> \param pw ...
!> \param c ...
!> \param scale ...
!> \par History
!>      none
!> \author JGH
! **************************************************************************************************
                        SUBROUTINE pw_gather_s_r1d_r3d_2(pw1, pw2, scale)
 
                           TYPE(pw_r3d_gs_type), INTENT(IN)                       :: pw1
                           TYPE(pw_r1d_gs_type), INTENT(INOUT)   :: pw2
                           REAL(KIND=dp), INTENT(IN), OPTIONAL                :: scale
 
                           CALL pw_gather_s_r1d_r3d (pw2, pw1%array, scale)
 
                        END SUBROUTINE pw_gather_s_r1d_r3d_2
 
! **************************************************************************************************
!> \brief Gathers the pw vector from a 3d data field
!> \param pw ...
!> \param c ...
!> \param scale ...
!> \par History
!>      none
!> \author JGH
! **************************************************************************************************
                        SUBROUTINE pw_gather_s_r1d_r3d (pw, c, scale)
 
                           TYPE(pw_r1d_gs_type), INTENT(INOUT)                       :: pw
                           REAL(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)
 
                           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)
 
                              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%array(gpt) = scale*      c(l, m, n)
                                 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
                                    pw%array(gpt) =       c(l, m, n)
                                 END DO
!$OMP END PARALLEL DO
                              END IF
 
                           END associate
 
                           CALL timestop(handle)
 
                        END SUBROUTINE pw_gather_s_r1d_r3d
 
! **************************************************************************************************
!> \brief Scatters a pw vector to a 3d data field
!> \param pw ...
!> \param c ...
!> \param scale ...
!> \par History
!>      none
!> \author JGH
! **************************************************************************************************
                        SUBROUTINE pw_scatter_s_r1d_r3d_2(pw1, pw2, scale)
 
                           TYPE(pw_r1d_gs_type), INTENT(IN)                 :: pw1
                           TYPE(pw_r3d_gs_type), INTENT(INOUT)               :: pw2
                           REAL(KIND=dp), INTENT(IN), OPTIONAL                :: scale
 
                           CALL pw_scatter_s_r1d_r3d (pw1, pw2%array, scale)
 
                        END SUBROUTINE pw_scatter_s_r1d_r3d_2
 
! **************************************************************************************************
!> \brief Scatters a pw vector to a 3d data field
!> \param pw ...
!> \param c ...
!> \param scale ...
!> \par History
!>      none
!> \author JGH
! **************************************************************************************************
                        SUBROUTINE pw_scatter_s_r1d_r3d (pw, c, scale)
 
                           TYPE(pw_r1d_gs_type), INTENT(IN)                 :: pw
                           REAL(kind=dp), DIMENSION(:, :, :), CONTIGUOUS, INTENT(INOUT)               :: c
                           REAL(kind=dp), INTENT(IN), OPTIONAL                :: scale
 
                           CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_scatter_s'
 
                           INTEGER                                            :: gpt, handle, l, m, n
 
                           CALL timeset(routinen, handle)
 
                           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))
 
                              ! should only zero the unused bits (but the zero is needed)
                              IF (.NOT. PRESENT(scale)) c = 0.0_dp
 
                              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%array(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%array(gpt)
                                 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*(      pw%array(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%array(gpt))
                                    END DO
!$OMP END PARALLEL DO
                                 END IF
 
                              END associate
 
                           END IF
 
                           CALL timestop(handle)
 
                        END SUBROUTINE pw_scatter_s_r1d_r3d
 
 
 
 
 
 
 
 
 
 
 
! **************************************************************************************************
!> \brief Gathers the pw vector from a 3d data field
!> \param pw ...
!> \param c ...
!> \param scale ...
!> \par History
!>      none
!> \author JGH
! **************************************************************************************************
                        SUBROUTINE pw_gather_s_r1d_c3d_2(pw1, pw2, scale)
 
                           TYPE(pw_c3d_gs_type), INTENT(IN)                       :: pw1
                           TYPE(pw_r1d_gs_type), INTENT(INOUT)   :: pw2
                           REAL(KIND=dp), INTENT(IN), OPTIONAL                :: scale
 
                           CALL pw_gather_s_r1d_c3d (pw2, pw1%array, scale)
 
                        END SUBROUTINE pw_gather_s_r1d_c3d_2
 
! **************************************************************************************************
!> \brief Gathers the pw vector from a 3d data field
!> \param pw ...
!> \param c ...
!> \param scale ...
!> \par History
!>      none
!> \author JGH
! **************************************************************************************************
                        SUBROUTINE pw_gather_s_r1d_c3d (pw, c, scale)
 
                           TYPE(pw_r1d_gs_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)
 
                           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)
 
                              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%array(gpt) = scale*      real(c(l, m, n), kind=dp)
                                 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
                                    pw%array(gpt) =       real(c(l, m, n), kind=dp)
                                 END DO
!$OMP END PARALLEL DO
                              END IF
 
                           END associate
 
                           CALL timestop(handle)
 
                        END SUBROUTINE pw_gather_s_r1d_c3d
 
! **************************************************************************************************
!> \brief Scatters a pw vector to a 3d data field
!> \param pw ...
!> \param c ...
!> \param scale ...
!> \par History
!>      none
!> \author JGH
! **************************************************************************************************
                        SUBROUTINE pw_scatter_s_r1d_c3d_2(pw1, pw2, scale)
 
                           TYPE(pw_r1d_gs_type), INTENT(IN)                 :: pw1
                           TYPE(pw_c3d_gs_type), INTENT(INOUT)               :: pw2
                           REAL(KIND=dp), INTENT(IN), OPTIONAL                :: scale
 
                           CALL pw_scatter_s_r1d_c3d (pw1, pw2%array, scale)
 
                        END SUBROUTINE pw_scatter_s_r1d_c3d_2
 
! **************************************************************************************************
!> \brief Scatters a pw vector to a 3d data field
!> \param pw ...
!> \param c ...
!> \param scale ...
!> \par History
!>      none
!> \author JGH
! **************************************************************************************************
                        SUBROUTINE pw_scatter_s_r1d_c3d (pw, c, scale)
 
                           TYPE(pw_r1d_gs_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_s'
 
                           INTEGER                                            :: gpt, handle, l, m, n
 
                           CALL timeset(routinen, handle)
 
                           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))
 
                              ! should only zero the unused bits (but the zero is needed)
                              IF (.NOT. PRESENT(scale)) c = 0.0_dp
 
                              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*      cmplx(pw%array(gpt), 0.0_dp, kind=dp)
                                 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) =       cmplx(pw%array(gpt), 0.0_dp, 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*(      cmplx(pw%array(gpt), 0.0_dp, kind=dp))
                                    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) = (      cmplx(pw%array(gpt), 0.0_dp, kind=dp))
                                    END DO
!$OMP END PARALLEL DO
                                 END IF
 
                              END associate
 
                           END IF
 
                           CALL timestop(handle)
 
                        END SUBROUTINE pw_scatter_s_r1d_c3d
 
 
 
 
 
 
 
 
 
 
 
 
! **************************************************************************************************
!> \brief Generic function for 3d FFT of a coefficient_type or pw_r3d_rs_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_r3d_c1d_rs_gs (pw1, pw2, debug)
 
                                 TYPE(pw_r3d_rs_type), INTENT(IN)                  :: pw1
                                 TYPE(pw_c1d_gs_type), INTENT(INOUT)               :: pw2
                                 LOGICAL, INTENT(IN), OPTIONAL                      :: debug
 
                                 CHARACTER(len=*), PARAMETER                        :: routineN = 'fft_wrap_pw1pw2'
 
                                 COMPLEX(KIND=dp), DIMENSION(:, :), CONTIGUOUS, POINTER         :: grays
                                 COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER      :: c_in, c_out
                                 INTEGER                                            ::  handle, handle2, my_pos, nrays, &
                                                                                       out_unit
                                    INTEGER, DIMENSION(3)                              :: nloc
#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW)
                                    LOGICAL                                            :: use_pw_gpu
#endif
                                 INTEGER, DIMENSION(:), POINTER                     :: n
                                 LOGICAL                                            :: test
 
                                 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
 
                                 n => pw1%pw_grid%npts
 
                                 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 "
                                          WRITE (out_unit, '(A,T76,A)') "  Transform direction ", "FWFFT"
                                          WRITE (out_unit, '(A,T72,A)') "  in space ", "REALSPACE"
                                          WRITE (out_unit, '(A,T72,A)') "  out space ", "REALSPACE"
                                    END IF
 
#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW)
                                          CALL pw_gpu_r3dc1d_3d(pw1, pw2)
#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), 1.0_dp/pw1%pw_grid%ngpts, c_out, 1)
                                             CALL pw_gather_s_c1d_c3d(pw2, c_out)
                                          ELSE
                                             CALL pw_copy_to_array(pw1, c_out)
                                             CALL fft3d(fwfft, n, c_out, debug=test)
                                             CALL pw_gather_s_c1d_c3d(pw2, c_out)
                                          END IF
                                          DEALLOCATE (c_out)
#else
                                          ALLOCATE (c_out(n(1), n(2), n(3)))
                                          c_out = 0.0_dp
                                          CALL pw_copy_to_array(pw1, c_out)
                                          CALL fft3d(fwfft, n, c_out, debug=test)
                                          CALL pw_gather_s_c1d_c3d(pw2, c_out)
                                          DEALLOCATE (c_out)
#endif
 
                                    IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " End of FFT Protocol "
 
                                 ELSE
 
                                    !
                                    !..parallel FFT
                                    !
 
                                    IF (test .AND. out_unit > 0) THEN
                                       WRITE (out_unit, '(A)') " FFT Protocol "
                                          WRITE (out_unit, '(A,T76,A)') "  Transform direction ", "FWFFT"
                                          WRITE (out_unit, '(A,T72,A)') "  in space ", "REALSPACE"
                                          WRITE (out_unit, '(A,T72,A)') "  out space ", "REALSPACE"
                                    END IF
 
                                    my_pos = pw1%pw_grid%para%group%mepos
                                    nrays = pw1%pw_grid%para%nyzray(my_pos)
                                    grays => pw1%pw_grid%grays
 
#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)
                                          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(fwfft, n, c_in, grays, pw1%pw_grid%para%group, &
                                                           pw1%pw_grid%para%yzp, pw1%pw_grid%para%nyzray, &
                                                           pw1%pw_grid%para%bo, debug=test)
                                             ELSE
                                                CALL fft3d(fwfft, n, c_in, grays, pw1%pw_grid%para%group, &
                                                           pw1%pw_grid%para%bo, debug=test)
                                             END IF
                                             !..prepare output
                                             IF (test .AND. out_unit > 0) &
                                                WRITE (out_unit, '(A)') "  PW_GATHER : 2d -> 1d "
                                             CALL pw_gather_p_c1d (pw2, grays)
                                             DEALLOCATE (c_in)
 
#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW)
                                          END IF
#endif
                                 END IF
 
                                 IF (test .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_r3d_c1d_rs_gs
 
 
 
 
 
! **************************************************************************************************
!> \brief Generic function for 3d FFT of a coefficient_type or pw_r3d_rs_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_r3d_c3d_rs_gs (pw1, pw2, debug)
 
                                 TYPE(pw_r3d_rs_type), INTENT(IN)                  :: pw1
                                 TYPE(pw_c3d_gs_type), INTENT(INOUT)               :: pw2
                                 LOGICAL, INTENT(IN), OPTIONAL                      :: debug
 
                                 CHARACTER(len=*), PARAMETER                        :: routineN = 'fft_wrap_pw1pw2'
 
                                 COMPLEX(KIND=dp), DIMENSION(:, :), CONTIGUOUS, POINTER         :: grays
                                 COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER      :: c_in, c_out
                                 INTEGER                                            ::  handle, handle2, my_pos, nrays, &
                                                                                       out_unit
                                 INTEGER, DIMENSION(:), POINTER                     :: n
                                 LOGICAL                                            :: test
 
                                 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
 
                                 n => pw1%pw_grid%npts
 
                                 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 "
                                          WRITE (out_unit, '(A,T76,A)') "  Transform direction ", "FWFFT"
                                          WRITE (out_unit, '(A,T72,A)') "  in space ", "REALSPACE"
                                          WRITE (out_unit, '(A,T72,A)') "  out space ", "REALSPACE"
                                    END IF
 
                                          pw2%array = cmplx(pw1%array, 0.0_dp, kind=dp)
                                          c_out => pw2%array
                                          CALL fft3d(fwfft, n, c_out, debug=test)
 
                                    IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " End of FFT Protocol "
 
                                 ELSE
 
                                    !
                                    !..parallel FFT
                                    !
 
                                    IF (test .AND. out_unit > 0) THEN
                                       WRITE (out_unit, '(A)') " FFT Protocol "
                                          WRITE (out_unit, '(A,T76,A)') "  Transform direction ", "FWFFT"
                                          WRITE (out_unit, '(A,T72,A)') "  in space ", "REALSPACE"
                                          WRITE (out_unit, '(A,T72,A)') "  out space ", "REALSPACE"
                                    END IF
 
                                    my_pos = pw1%pw_grid%para%group%mepos
                                    nrays = pw1%pw_grid%para%nyzray(my_pos)
                                    grays => pw1%pw_grid%grays
 
                                 END IF
 
                                 IF (test .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_r3d_c3d_rs_gs
 
 
 
 
 
 
 
 
 
 
 
! **************************************************************************************************
!> \brief Generic function for 3d FFT of a coefficient_type or pw_r3d_rs_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_c1d_r3d_gs_rs (pw1, pw2, debug)
 
                                 TYPE(pw_c1d_gs_type), INTENT(IN)                  :: pw1
                                 TYPE(pw_r3d_rs_type), INTENT(INOUT)               :: pw2
                                 LOGICAL, INTENT(IN), OPTIONAL                      :: debug
 
                                 CHARACTER(len=*), PARAMETER                        :: routineN = 'fft_wrap_pw1pw2'
 
                                 COMPLEX(KIND=dp), DIMENSION(:, :), CONTIGUOUS, POINTER         :: grays
                                 COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER      :: c_in, c_out
                                 INTEGER                                            ::  handle, handle2, my_pos, nrays, &
                                                                                       out_unit
                                    INTEGER, DIMENSION(3)                              :: nloc
#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW)
                                    LOGICAL                                            :: use_pw_gpu
#endif
                                 INTEGER, DIMENSION(:), POINTER                     :: n
                                 LOGICAL                                            :: test
 
                                 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
 
                                 n => pw1%pw_grid%npts
 
                                 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 "
                                          WRITE (out_unit, '(A,T76,A)') "  Transform direction ", "BWFFT"
                                          WRITE (out_unit, '(A,T66,A)') "  in space ", "RECIPROCALSPACE"
                                          WRITE (out_unit, '(A,T66,A)') "  out space ", "RECIPROCALSPACE"
                                    END IF
 
#if defined(__OFFLOAD) && !defined(__NO_OFFLOAD_PW)
                                          CALL pw_gpu_c1dr3d_3d(pw1, pw2)
#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_c1d_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), 1.0_dp, 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_c1d_c3d(pw1, c_out)
                                             ! transform
                                             CALL fft3d(bwfft, n, c_out, 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_c1d_c3d(pw1, c_out)
                                          ! transform
                                          CALL fft3d(bwfft, n, c_out, 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
 
                                    IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " End of FFT Protocol "
 
                                 ELSE
 
                                    !
                                    !..parallel FFT
                                    !
 
                                    IF (test .AND. out_unit > 0) THEN
                                       WRITE (out_unit, '(A)') " FFT Protocol "
                                          WRITE (out_unit, '(A,T76,A)') "  Transform direction ", "BWFFT"
                                          WRITE (out_unit, '(A,T66,A)') "  in space ", "RECIPROCALSPACE"
                                          WRITE (out_unit, '(A,T66,A)') "  out space ", "RECIPROCALSPACE"
                                    END IF
 
                                    my_pos = pw1%pw_grid%para%group%mepos
                                    nrays = pw1%pw_grid%para%nyzray(my_pos)
                                    grays => pw1%pw_grid%grays
 
#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)
                                          ELSE
#endif
!..   prepare input
                                             IF (test .AND. out_unit > 0) &
                                                WRITE (out_unit, '(A)') "  PW_SCATTER : 2d -> 1d "
                                             grays = z_zero
                                             CALL pw_scatter_p_c1d (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(bwfft, n, c_in, grays, pw1%pw_grid%para%group, &
                                                           pw1%pw_grid%para%yzp, pw1%pw_grid%para%nyzray, &
                                                           pw1%pw_grid%para%bo, debug=test)
                                             ELSE
                                                CALL fft3d(bwfft, n, c_in, grays, pw1%pw_grid%para%group, &
                                                           pw1%pw_grid%para%bo, debug=test)
                                             END IF
                                             !..prepare output
                                             IF (test .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 IF
 
                                 IF (test .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_c1d_r3d_gs_rs
 
 
 
! **************************************************************************************************
!> \brief Gathers the pw vector from a 3d data field
!> \param pw ...
!> \param c ...
!> \param scale ...
!> \par History
!>      none
!> \author JGH
! **************************************************************************************************
                        SUBROUTINE pw_gather_s_c1d_r3d_2(pw1, pw2, scale)
 
                           TYPE(pw_r3d_gs_type), INTENT(IN)                       :: pw1
                           TYPE(pw_c1d_gs_type), INTENT(INOUT)   :: pw2
                           REAL(KIND=dp), INTENT(IN), OPTIONAL                :: scale
 
                           CALL pw_gather_s_c1d_r3d (pw2, pw1%array, scale)
 
                        END SUBROUTINE pw_gather_s_c1d_r3d_2
 
! **************************************************************************************************
!> \brief Gathers the pw vector from a 3d data field
!> \param pw ...
!> \param c ...
!> \param scale ...
!> \par History
!>      none
!> \author JGH
! **************************************************************************************************
                        SUBROUTINE pw_gather_s_c1d_r3d (pw, c, scale)
 
                           TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw
                           REAL(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)
 
                           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)
 
                              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%array(gpt) = scale*      cmplx(c(l, m, n), 0.0_dp, kind=dp)
                                 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
                                    pw%array(gpt) =       cmplx(c(l, m, n), 0.0_dp, kind=dp)
                                 END DO
!$OMP END PARALLEL DO
                              END IF
 
                           END associate
 
                           CALL timestop(handle)
 
                        END SUBROUTINE pw_gather_s_c1d_r3d
 
! **************************************************************************************************
!> \brief Scatters a pw vector to a 3d data field
!> \param pw ...
!> \param c ...
!> \param scale ...
!> \par History
!>      none
!> \author JGH
! **************************************************************************************************
                        SUBROUTINE pw_scatter_s_c1d_r3d_2(pw1, pw2, scale)
 
                           TYPE(pw_c1d_gs_type), INTENT(IN)                 :: pw1
                           TYPE(pw_r3d_gs_type), INTENT(INOUT)               :: pw2
                           REAL(KIND=dp), INTENT(IN), OPTIONAL                :: scale
 
                           CALL pw_scatter_s_c1d_r3d (pw1, pw2%array, scale)
 
                        END SUBROUTINE pw_scatter_s_c1d_r3d_2
 
! **************************************************************************************************
!> \brief Scatters a pw vector to a 3d data field
!> \param pw ...
!> \param c ...
!> \param scale ...
!> \par History
!>      none
!> \author JGH
! **************************************************************************************************
                        SUBROUTINE pw_scatter_s_c1d_r3d (pw, c, scale)
 
                           TYPE(pw_c1d_gs_type), INTENT(IN)                 :: pw
                           REAL(kind=dp), DIMENSION(:, :, :), CONTIGUOUS, INTENT(INOUT)               :: c
                           REAL(kind=dp), INTENT(IN), OPTIONAL                :: scale
 
                           CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_scatter_s'
 
                           INTEGER                                            :: gpt, handle, l, m, n
 
                           CALL timeset(routinen, handle)
 
                           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))
 
                              ! should only zero the unused bits (but the zero is needed)
                              IF (.NOT. PRESENT(scale)) c = 0.0_dp
 
                              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*      real(pw%array(gpt), kind=dp)
                                 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) =       real(pw%array(gpt), 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*(      real(pw%array(gpt), kind=dp))
                                    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) = (      real(pw%array(gpt), kind=dp))
                                    END DO
!$OMP END PARALLEL DO
                                 END IF
 
                              END associate
 
                           END IF
 
                           CALL timestop(handle)
 
                        END SUBROUTINE pw_scatter_s_c1d_r3d
 
 
 
 
 
 
 
 
! **************************************************************************************************
!> \brief Generic function for 3d FFT of a coefficient_type or pw_r3d_rs_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_c1d_c3d_gs_rs (pw1, pw2, debug)
 
                                 TYPE(pw_c1d_gs_type), INTENT(IN)                  :: pw1
                                 TYPE(pw_c3d_rs_type), INTENT(INOUT)               :: pw2
                                 LOGICAL, INTENT(IN), OPTIONAL                      :: debug
 
                                 CHARACTER(len=*), PARAMETER                        :: routineN = 'fft_wrap_pw1pw2'
 
                                 COMPLEX(KIND=dp), DIMENSION(:, :), CONTIGUOUS, POINTER         :: grays
                                 COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER      :: c_in, c_out
                                 INTEGER                                            ::  handle, handle2, my_pos, nrays, &
                                                                                       out_unit
                                 INTEGER, DIMENSION(:), POINTER                     :: n
                                 LOGICAL                                            :: test
 
                                 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
 
                                 n => pw1%pw_grid%npts
 
                                 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 "
                                          WRITE (out_unit, '(A,T76,A)') "  Transform direction ", "BWFFT"
                                          WRITE (out_unit, '(A,T66,A)') "  in space ", "RECIPROCALSPACE"
                                          WRITE (out_unit, '(A,T66,A)') "  out space ", "RECIPROCALSPACE"
                                    END IF
 
                                          c_out => pw2%array
                                          IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') "  PW_SCATTER : 3d -> 1d "
                                          CALL pw_scatter_s_c1d_c3d(pw1, c_out)
                                          CALL fft3d(bwfft, n, c_out, debug=test)
 
                                    IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " End of FFT Protocol "
 
                                 ELSE
 
                                    !
                                    !..parallel FFT
                                    !
 
                                    IF (test .AND. out_unit > 0) THEN
                                       WRITE (out_unit, '(A)') " FFT Protocol "
                                          WRITE (out_unit, '(A,T76,A)') "  Transform direction ", "BWFFT"
                                          WRITE (out_unit, '(A,T66,A)') "  in space ", "RECIPROCALSPACE"
                                          WRITE (out_unit, '(A,T66,A)') "  out space ", "RECIPROCALSPACE"
                                    END IF
 
                                    my_pos = pw1%pw_grid%para%group%mepos
                                    nrays = pw1%pw_grid%para%nyzray(my_pos)
                                    grays => pw1%pw_grid%grays
 
                                          !..prepare input
                                          IF (test .AND. out_unit > 0) &
                                             WRITE (out_unit, '(A)') "  PW_SCATTER : 2d -> 1d "
                                          grays = z_zero
                                          CALL pw_scatter_p_c1d (pw1, grays)
                                          c_in => pw2%array
                                          !..transform
                                          IF (pw1%pw_grid%para%ray_distribution) THEN
                                             CALL fft3d(bwfft, n, c_in, grays, pw1%pw_grid%para%group, &
                                                        pw1%pw_grid%para%yzp, pw1%pw_grid%para%nyzray, &
                                                        pw1%pw_grid%para%bo, debug=test)
                                          ELSE
                                             CALL fft3d(bwfft, n, c_in, grays, pw1%pw_grid%para%group, &
                                                        pw1%pw_grid%para%bo, debug=test)
                                          END IF
                                          !..prepare output (nothing to do)
                                 END IF
 
                                 IF (test .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_c1d_c3d_gs_rs
 
 
 
! **************************************************************************************************
!> \brief Gathers the pw vector from a 3d data field
!> \param pw ...
!> \param c ...
!> \param scale ...
!> \par History
!>      none
!> \author JGH
! **************************************************************************************************
                        SUBROUTINE pw_gather_s_c1d_c3d_2(pw1, pw2, scale)
 
                           TYPE(pw_c3d_gs_type), INTENT(IN)                       :: pw1
                           TYPE(pw_c1d_gs_type), INTENT(INOUT)   :: pw2
                           REAL(KIND=dp), INTENT(IN), OPTIONAL                :: scale
 
                           CALL pw_gather_s_c1d_c3d (pw2, pw1%array, scale)
 
                        END SUBROUTINE pw_gather_s_c1d_c3d_2
 
! **************************************************************************************************
!> \brief Gathers the pw vector from a 3d data field
!> \param pw ...
!> \param c ...
!> \param scale ...
!> \par History
!>      none
!> \author JGH
! **************************************************************************************************
                        SUBROUTINE pw_gather_s_c1d_c3d (pw, c, scale)
 
                           TYPE(pw_c1d_gs_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)
 
                           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)
 
                              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%array(gpt) = scale*      c(l, m, n)
                                 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
                                    pw%array(gpt) =       c(l, m, n)
                                 END DO
!$OMP END PARALLEL DO
                              END IF
 
                           END associate
 
                           CALL timestop(handle)
 
                        END SUBROUTINE pw_gather_s_c1d_c3d
 
! **************************************************************************************************
!> \brief Scatters a pw vector to a 3d data field
!> \param pw ...
!> \param c ...
!> \param scale ...
!> \par History
!>      none
!> \author JGH
! **************************************************************************************************
                        SUBROUTINE pw_scatter_s_c1d_c3d_2(pw1, pw2, scale)
 
                           TYPE(pw_c1d_gs_type), INTENT(IN)                 :: pw1
                           TYPE(pw_c3d_gs_type), INTENT(INOUT)               :: pw2
                           REAL(KIND=dp), INTENT(IN), OPTIONAL                :: scale
 
                           CALL pw_scatter_s_c1d_c3d (pw1, pw2%array, scale)
 
                        END SUBROUTINE pw_scatter_s_c1d_c3d_2
 
! **************************************************************************************************
!> \brief Scatters a pw vector to a 3d data field
!> \param pw ...
!> \param c ...
!> \param scale ...
!> \par History
!>      none
!> \author JGH
! **************************************************************************************************
                        SUBROUTINE pw_scatter_s_c1d_c3d (pw, c, scale)
 
                           TYPE(pw_c1d_gs_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_s'
 
                           INTEGER                                            :: gpt, handle, l, m, n
 
                           CALL timeset(routinen, handle)
 
                           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))
 
                              ! should only zero the unused bits (but the zero is needed)
                              IF (.NOT. PRESENT(scale)) c = 0.0_dp
 
                              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%array(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%array(gpt)
                                 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%array(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%array(gpt))
                                    END DO
!$OMP END PARALLEL DO
                                 END IF
 
                              END associate
 
                           END IF
 
                           CALL timestop(handle)
 
                        END SUBROUTINE pw_scatter_s_c1d_c3d
 
 
 
 
 
 
 
 
! **************************************************************************************************
!> \brief Generic function for 3d FFT of a coefficient_type or pw_r3d_rs_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_c3d_r3d_gs_rs (pw1, pw2, debug)
 
                                 TYPE(pw_c3d_gs_type), INTENT(IN)                  :: pw1
                                 TYPE(pw_r3d_rs_type), INTENT(INOUT)               :: pw2
                                 LOGICAL, INTENT(IN), OPTIONAL                      :: debug
 
                                 CHARACTER(len=*), PARAMETER                        :: routineN = 'fft_wrap_pw1pw2'
 
                                 COMPLEX(KIND=dp), DIMENSION(:, :), CONTIGUOUS, POINTER         :: grays
                                 COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER      :: c_in, c_out
                                 INTEGER                                            ::  handle, handle2, my_pos, nrays, &
                                                                                       out_unit
                                 INTEGER, DIMENSION(:), POINTER                     :: n
                                 LOGICAL                                            :: test
 
                                 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
 
                                 n => pw1%pw_grid%npts
 
                                 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 "
                                          WRITE (out_unit, '(A,T76,A)') "  Transform direction ", "BWFFT"
                                          WRITE (out_unit, '(A,T66,A)') "  in space ", "RECIPROCALSPACE"
                                          WRITE (out_unit, '(A,T66,A)') "  out space ", "RECIPROCALSPACE"
                                    END IF
 
                                          c_in => pw1%array
                                          ALLOCATE (c_out(n(1), n(2), n(3)))
                                          CALL fft3d(bwfft, n, c_in, c_out, 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)
 
                                    IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " End of FFT Protocol "
 
                                 ELSE
 
                                    !
                                    !..parallel FFT
                                    !
 
                                    IF (test .AND. out_unit > 0) THEN
                                       WRITE (out_unit, '(A)') " FFT Protocol "
                                          WRITE (out_unit, '(A,T76,A)') "  Transform direction ", "BWFFT"
                                          WRITE (out_unit, '(A,T66,A)') "  in space ", "RECIPROCALSPACE"
                                          WRITE (out_unit, '(A,T66,A)') "  out space ", "RECIPROCALSPACE"
                                    END IF
 
                                    my_pos = pw1%pw_grid%para%group%mepos
                                    nrays = pw1%pw_grid%para%nyzray(my_pos)
                                    grays => pw1%pw_grid%grays
 
                                 END IF
 
                                 IF (test .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_c3d_r3d_gs_rs
 
 
 
 
! **************************************************************************************************
!> \brief Generic function for 3d FFT of a coefficient_type or pw_r3d_rs_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_c3d_c1d_rs_gs (pw1, pw2, debug)
 
                                 TYPE(pw_c3d_rs_type), INTENT(IN)                  :: pw1
                                 TYPE(pw_c1d_gs_type), INTENT(INOUT)               :: pw2
                                 LOGICAL, INTENT(IN), OPTIONAL                      :: debug
 
                                 CHARACTER(len=*), PARAMETER                        :: routineN = 'fft_wrap_pw1pw2'
 
                                 COMPLEX(KIND=dp), DIMENSION(:, :), CONTIGUOUS, POINTER         :: grays
                                 COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER      :: c_in, c_out
                                 INTEGER                                            ::  handle, handle2, my_pos, nrays, &
                                                                                       out_unit
                                 INTEGER, DIMENSION(:), POINTER                     :: n
                                 LOGICAL                                            :: test
 
                                 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
 
                                 n => pw1%pw_grid%npts
 
                                 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 "
                                          WRITE (out_unit, '(A,T76,A)') "  Transform direction ", "FWFFT"
                                          WRITE (out_unit, '(A,T72,A)') "  in space ", "REALSPACE"
                                          WRITE (out_unit, '(A,T72,A)') "  out space ", "REALSPACE"
                                    END IF
 
                                          c_in => pw1%array
                                          ALLOCATE (c_out(n(1), n(2), n(3)))
                                          ! transform
                                          CALL fft3d(fwfft, n, c_in, c_out, 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)
 
                                    IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " End of FFT Protocol "
 
                                 ELSE
 
                                    !
                                    !..parallel FFT
                                    !
 
                                    IF (test .AND. out_unit > 0) THEN
                                       WRITE (out_unit, '(A)') " FFT Protocol "
                                          WRITE (out_unit, '(A,T76,A)') "  Transform direction ", "FWFFT"
                                          WRITE (out_unit, '(A,T72,A)') "  in space ", "REALSPACE"
                                          WRITE (out_unit, '(A,T72,A)') "  out space ", "REALSPACE"
                                    END IF
 
                                    my_pos = pw1%pw_grid%para%group%mepos
                                    nrays = pw1%pw_grid%para%nyzray(my_pos)
                                    grays => pw1%pw_grid%grays
 
                                          !..prepare input
                                          c_in => pw1%array
                                          grays = z_zero
                                          !..transform
                                          IF (pw1%pw_grid%para%ray_distribution) THEN
                                             CALL fft3d(fwfft, n, c_in, grays, pw1%pw_grid%para%group, &
                                                        pw1%pw_grid%para%yzp, pw1%pw_grid%para%nyzray, &
                                                        pw1%pw_grid%para%bo, debug=test)
                                          ELSE
                                             CALL fft3d(fwfft, n, c_in, grays, pw1%pw_grid%para%group, &
                                                        pw1%pw_grid%para%bo, debug=test)
                                          END IF
                                          !..prepare output
                                          IF (test .AND. out_unit > 0) &
                                             WRITE (out_unit, '(A)') "  PW_GATHER : 2d -> 1d "
                                          CALL pw_gather_p_c1d (pw2, grays)
                                 END IF
 
                                 IF (test .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_c3d_c1d_rs_gs
 
 
 
 
 
! **************************************************************************************************
!> \brief Generic function for 3d FFT of a coefficient_type or pw_r3d_rs_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_c3d_c3d_rs_gs (pw1, pw2, debug)
 
                                 TYPE(pw_c3d_rs_type), INTENT(IN)                  :: pw1
                                 TYPE(pw_c3d_gs_type), INTENT(INOUT)               :: pw2
                                 LOGICAL, INTENT(IN), OPTIONAL                      :: debug
 
                                 CHARACTER(len=*), PARAMETER                        :: routineN = 'fft_wrap_pw1pw2'
 
                                 COMPLEX(KIND=dp), DIMENSION(:, :), CONTIGUOUS, POINTER         :: grays
                                 COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER      :: c_in, c_out
                                 INTEGER                                            ::  handle, handle2, my_pos, nrays, &
                                                                                       out_unit
                                 INTEGER, DIMENSION(:), POINTER                     :: n
                                 LOGICAL                                            :: test
 
                                 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
 
                                 n => pw1%pw_grid%npts
 
                                 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 "
                                          WRITE (out_unit, '(A,T76,A)') "  Transform direction ", "FWFFT"
                                          WRITE (out_unit, '(A,T72,A)') "  in space ", "REALSPACE"
                                          WRITE (out_unit, '(A,T72,A)') "  out space ", "REALSPACE"
                                    END IF
 
                                          c_in => pw1%array
                                          c_out => pw2%array
                                          CALL fft3d(fwfft, n, c_in, c_out, debug=test)
 
                                    IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " End of FFT Protocol "
 
                                 ELSE
 
                                    !
                                    !..parallel FFT
                                    !
 
                                    IF (test .AND. out_unit > 0) THEN
                                       WRITE (out_unit, '(A)') " FFT Protocol "
                                          WRITE (out_unit, '(A,T76,A)') "  Transform direction ", "FWFFT"
                                          WRITE (out_unit, '(A,T72,A)') "  in space ", "REALSPACE"
                                          WRITE (out_unit, '(A,T72,A)') "  out space ", "REALSPACE"
                                    END IF
 
                                    my_pos = pw1%pw_grid%para%group%mepos
                                    nrays = pw1%pw_grid%para%nyzray(my_pos)
                                    grays => pw1%pw_grid%grays
 
                                 END IF
 
                                 IF (test .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_c3d_c3d_rs_gs
 
! **************************************************************************************************
!> \brief Generic function for 3d FFT of a coefficient_type or pw_r3d_rs_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_c3d_c3d_gs_rs (pw1, pw2, debug)
 
                                 TYPE(pw_c3d_gs_type), INTENT(IN)                  :: pw1
                                 TYPE(pw_c3d_rs_type), INTENT(INOUT)               :: pw2
                                 LOGICAL, INTENT(IN), OPTIONAL                      :: debug
 
                                 CHARACTER(len=*), PARAMETER                        :: routineN = 'fft_wrap_pw1pw2'
 
                                 COMPLEX(KIND=dp), DIMENSION(:, :), CONTIGUOUS, POINTER         :: grays
                                 COMPLEX(KIND=dp), DIMENSION(:, :, :), CONTIGUOUS, POINTER      :: c_in, c_out
                                 INTEGER                                            ::  handle, handle2, my_pos, nrays, &
                                                                                       out_unit
                                 INTEGER, DIMENSION(:), POINTER                     :: n
                                 LOGICAL                                            :: test
 
                                 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
 
                                 n => pw1%pw_grid%npts
 
                                 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 "
                                          WRITE (out_unit, '(A,T76,A)') "  Transform direction ", "BWFFT"
                                          WRITE (out_unit, '(A,T66,A)') "  in space ", "RECIPROCALSPACE"
                                          WRITE (out_unit, '(A,T66,A)') "  out space ", "RECIPROCALSPACE"
                                    END IF
 
                                          c_in => pw1%array
                                          c_out => pw2%array
                                          CALL fft3d(bwfft, n, c_in, c_out, debug=test)
 
                                    IF (test .AND. out_unit > 0) WRITE (out_unit, '(A)') " End of FFT Protocol "
 
                                 ELSE
 
                                    !
                                    !..parallel FFT
                                    !
 
                                    IF (test .AND. out_unit > 0) THEN
                                       WRITE (out_unit, '(A)') " FFT Protocol "
                                          WRITE (out_unit, '(A,T76,A)') "  Transform direction ", "BWFFT"
                                          WRITE (out_unit, '(A,T66,A)') "  in space ", "RECIPROCALSPACE"
                                          WRITE (out_unit, '(A,T66,A)') "  out space ", "RECIPROCALSPACE"
                                    END IF
 
                                    my_pos = pw1%pw_grid%para%group%mepos
                                    nrays = pw1%pw_grid%para%nyzray(my_pos)
                                    grays => pw1%pw_grid%grays
 
                                 END IF
 
                                 IF (test .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_c3d_c3d_gs_rs
 
 
 
! **************************************************************************************************
!> \brief Multiply all data points with a Gaussian damping factor
!>        Needed for longrange Coulomb potential
!>        V(\vec r)=erf(omega*r)/r
!>        V(\vec g)=\frac{4*\pi}{g**2}*exp(-g**2/omega**2)
!> \param pw ...
!> \param omega ...
!> \par History
!>      Frederick Stein (12-04-2019) created
!> \author Frederick Stein (12-Apr-2019)
!> \note
!>      Performs a Gaussian damping
! **************************************************************************************************
                  SUBROUTINE pw_gauss_damp(pw, omega)
 
                     TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw
                     REAL(kind=dp), INTENT(IN)                          :: omega
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_gauss_damp'
 
                     INTEGER                                            :: handle, i
                     REAL(kind=dp)                                      :: omega_2, tmp
 
                     CALL timeset(routinen, handle)
                     cpassert(omega >= 0)
 
                     omega_2 = omega*omega
                     omega_2 = 0.25_dp/omega_2
 
!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,tmp) SHARED(pw,omega_2)
                     DO i = 1, SIZE(pw%array)
                        tmp = exp(-pw%pw_grid%gsq(i)*omega_2)
                        pw%array(i) = pw%array(i)*tmp
                     END DO
!$OMP END PARALLEL DO
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_gauss_damp
 
! **************************************************************************************************
!> \brief Multiply all data points with the logarithmic derivative of a Gaussian
!> \param pw ...
!> \param omega ...
!> \note
!>      Performs a Gaussian damping
! **************************************************************************************************
                  SUBROUTINE pw_log_deriv_gauss(pw, omega)
 
                     TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw
                     REAL(kind=dp), INTENT(IN)                          :: omega
 
                     CHARACTER(len=*), PARAMETER :: routinen = 'pw_log_deriv_gauss'
 
                     INTEGER                                            :: handle, i
                     REAL(kind=dp)                                      :: omega_2, tmp
 
                     CALL timeset(routinen, handle)
                     cpassert(omega >= 0)
 
                     omega_2 = omega*omega
                     omega_2 = 0.25_dp/omega_2
 
!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,tmp) SHARED(pw,omega_2)
                     DO i = 1, SIZE(pw%array)
                        tmp = 1.0_dp + omega_2*pw%pw_grid%gsq(i)
                        pw%array(i) = pw%array(i)*tmp
                     END DO
!$OMP END PARALLEL DO
 
                     CALL timestop(handle)
                  END SUBROUTINE pw_log_deriv_gauss
 
! **************************************************************************************************
!> \brief Multiply all data points with a Gaussian damping factor
!>        Needed for longrange Coulomb potential
!>        V(\vec r)=erf(omega*r)/r
!>        V(\vec g)=\frac{4*\pi}{g**2}*exp(-g**2/omega**2)
!> \param pw ...
!> \param omega ...
!> \par History
!>      Frederick Stein (12-04-2019) created
!> \author Frederick Stein (12-Apr-2019)
!> \note
!>      Performs a Gaussian damping
! **************************************************************************************************
                  SUBROUTINE pw_compl_gauss_damp(pw, omega)
 
                     TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw
                     REAL(kind=dp), INTENT(IN)                          :: omega
 
                     CHARACTER(len=*), PARAMETER :: routinen = 'pw_compl_gauss_damp'
 
                     INTEGER                                            :: cnt, handle, i
                     REAL(kind=dp)                                      :: omega_2, tmp, tmp2
 
                     CALL timeset(routinen, handle)
 
                     omega_2 = omega*omega
                     omega_2 = 0.25_dp/omega_2
 
                     cnt = SIZE(pw%array)
 
!$OMP PARALLEL DO PRIVATE(i, tmp, tmp2) DEFAULT(NONE) SHARED(cnt, pw,omega_2)
                     DO i = 1, cnt
                        tmp = -omega_2*pw%pw_grid%gsq(i)
                        IF (abs(tmp) > 1.0e-5_dp) THEN
                           tmp2 = 1.0_dp - exp(tmp)
                        ELSE
                           tmp2 = tmp + 0.5_dp*tmp*(tmp + (1.0_dp/3.0_dp)*tmp**2)
                        END IF
                        pw%array(i) = pw%array(i)*tmp2
                     END DO
!$OMP END PARALLEL DO
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_compl_gauss_damp
 
! **************************************************************************************************
!> \brief Multiply all data points with the logarithmic derivative of the complementary Gaussian damping factor
!> \param pw ...
!> \param omega ...
!> \note
! **************************************************************************************************
                  SUBROUTINE pw_log_deriv_compl_gauss(pw, omega)
 
                     TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw
                     REAL(kind=dp), INTENT(IN)                          :: omega
 
                     CHARACTER(len=*), PARAMETER :: routinen = 'pw_log_deriv_compl_gauss'
 
                     INTEGER                                            :: handle, i
                     REAL(kind=dp)                                      :: omega_2, tmp, tmp2
 
                     CALL timeset(routinen, handle)
 
                     omega_2 = omega*omega
                     omega_2 = 0.25_dp/omega_2
 
!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,tmp,tmp2) &
!$OMP             SHARED(pw,omega_2)
                     DO i = 1, SIZE(pw%array)
                        tmp = omega_2*pw%pw_grid%gsq(i)
                        ! For too small arguments, use the Taylor polynomial to prevent division by zero
                        IF (abs(tmp) >= 0.003_dp) THEN
                           tmp2 = 1.0_dp - tmp*exp(-tmp)/(1.0_dp - exp(-tmp))
                        ELSE
                           tmp2 = 0.5_dp*tmp - tmp**2/12.0_dp
                        END IF
                        pw%array(i) = pw%array(i)*tmp2
                     END DO
!$OMP END PARALLEL DO
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_log_deriv_compl_gauss
 
! **************************************************************************************************
!> \brief Multiply all data points with a Gaussian damping factor and mixes it with the original function
!>        Needed for mixed longrange/Coulomb potential
!>        V(\vec r)=(a+b*erf(omega*r))/r
!>        V(\vec g)=\frac{4*\pi}{g**2}*(a+b*exp(-g**2/omega**2))
!> \param pw ...
!> \param omega ...
!> \param scale_coul ...
!> \param scale_long ...
!> \par History
!>      Frederick Stein (16-Dec-2021) created
!> \author Frederick Stein (16-Dec-2021)
!> \note
!>      Performs a Gaussian damping
! **************************************************************************************************
                  SUBROUTINE pw_gauss_damp_mix(pw, omega, scale_coul, scale_long)
 
                     TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw
                     REAL(kind=dp), INTENT(IN)                          :: omega, scale_coul, scale_long
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_gauss_damp_mix'
 
                     INTEGER                                            :: handle, i
                     REAL(kind=dp)                                      :: omega_2, tmp
 
                     CALL timeset(routinen, handle)
 
                     omega_2 = omega*omega
                     omega_2 = 0.25_dp/omega_2
 
!$OMP PARALLEL DO DEFAULT(NONE) SHARED(pw, omega_2, scale_coul, scale_long) PRIVATE(i,tmp)
                     DO i = 1, SIZE(pw%array)
                        tmp = scale_coul + scale_long*exp(-pw%pw_grid%gsq(i)*omega_2)
                        pw%array(i) = pw%array(i)*tmp
                     END DO
!$OMP END PARALLEL DO
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_gauss_damp_mix
 
! **************************************************************************************************
!> \brief Multiply all data points with the logarithmic derivative of the mixed longrange/Coulomb potential
!>        Needed for mixed longrange/Coulomb potential
!> \param pw ...
!> \param omega ...
!> \param scale_coul ...
!> \param scale_long ...
!> \note
! **************************************************************************************************
                  SUBROUTINE pw_log_deriv_mix_cl(pw, omega, scale_coul, scale_long)
 
                     TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw
                     REAL(kind=dp), INTENT(IN)                          :: omega, scale_coul, scale_long
 
                     CHARACTER(len=*), PARAMETER :: routinen = 'pw_log_deriv_mix_cl'
 
                     INTEGER                                            :: handle, i
                     REAL(kind=dp)                                      :: omega_2, tmp, tmp2
 
                     CALL timeset(routinen, handle)
 
                     omega_2 = omega*omega
                     omega_2 = 0.25_dp/omega_2
 
!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,tmp,tmp2) &
!$OMP             SHARED(pw,omega_2,scale_long,scale_coul)
                     DO i = 1, SIZE(pw%array)
                        tmp = omega_2*pw%pw_grid%gsq(i)
                        tmp2 = 1.0_dp + scale_long*tmp*exp(-tmp)/(scale_coul + scale_long*exp(-tmp))
                        pw%array(i) = pw%array(i)*tmp2
                     END DO
!$OMP END PARALLEL DO
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_log_deriv_mix_cl
 
! **************************************************************************************************
!> \brief Multiply all data points with a complementary cosine
!>        Needed for truncated Coulomb potential
!>        V(\vec r)=1/r if r<rc, 0 else
!>        V(\vec g)=\frac{4*\pi}{g**2}*(1-cos(g*rc))
!> \param pw ...
!> \param rcutoff ...
!> \par History
!>      Frederick Stein (07-06-2021) created
!> \author Frederick Stein (07-Jun-2021)
!> \note
!>      Multiplies by complementary cosine
! **************************************************************************************************
                  SUBROUTINE pw_truncated(pw, rcutoff)
 
                     TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw
                     REAL(kind=dp), INTENT(IN)                          :: rcutoff
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_truncated'
 
                     INTEGER                                            :: handle, i
                     REAL(kind=dp)                                      :: tmp, tmp2
 
                     CALL timeset(routinen, handle)
                     cpassert(rcutoff >= 0)
 
!$OMP PARALLEL DO PRIVATE(i,tmp,tmp2) DEFAULT(NONE) SHARED(pw, rcutoff)
                     DO i = 1, SIZE(pw%array)
                        tmp = sqrt(pw%pw_grid%gsq(i))*rcutoff
                        IF (tmp >= 0.005_dp) THEN
                           tmp2 = 1.0_dp - cos(tmp)
                        ELSE
                           tmp2 = tmp**2/2.0_dp*(1.0 - tmp**2/12.0_dp)
                        END IF
                        pw%array(i) = pw%array(i)*tmp2
                     END DO
!$OMP END PARALLEL DO
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_truncated
 
! **************************************************************************************************
!> \brief Multiply all data points with the logarithmic derivative of the complementary cosine
!>        This function is needed for virials using truncated Coulomb potentials
!> \param pw ...
!> \param rcutoff ...
!> \note
! **************************************************************************************************
                  SUBROUTINE pw_log_deriv_trunc(pw, rcutoff)
 
                     TYPE(pw_c1d_gs_type), INTENT(IN)                          :: pw
                     REAL(kind=dp), INTENT(IN)                          :: rcutoff
 
                     CHARACTER(len=*), PARAMETER :: routinen = 'pw_log_deriv_trunc'
 
                     INTEGER                                            :: handle, i
                     REAL(kind=dp)                                      :: rchalf, tmp, tmp2
 
                     CALL timeset(routinen, handle)
                     cpassert(rcutoff >= 0)
 
                     rchalf = 0.5_dp*rcutoff
!$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,tmp,tmp2) &
!$OMP             SHARED(pw,rchalf)
                     DO i = 1, SIZE(pw%array)
                        tmp = rchalf*sqrt(pw%pw_grid%gsq(i))
                        ! For too small arguments, use the Taylor polynomial to prevent division by zero
                        IF (abs(tmp) >= 0.0001_dp) THEN
                           tmp2 = 1.0_dp - tmp/tan(tmp)
                        ELSE
                           tmp2 = tmp**2*(1.0_dp + tmp**2/15.0_dp)/3.0_dp
                        END IF
                        pw%array(i) = pw%array(i)*tmp2
                     END DO
!$OMP END PARALLEL DO
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_log_deriv_trunc
 
! **************************************************************************************************
!> \brief Calculate the derivative of a plane wave vector
!> \param pw ...
!> \param n ...
!> \par History
!>      JGH (06-10-2002) allow only for inplace derivatives
!> \author JGH (25-Feb-2001)
!> \note
!>      Calculate the derivative dx^n(1) dy^n(2) dz^n(3) PW
! **************************************************************************************************
                  SUBROUTINE pw_derive(pw, n)
 
                     TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw
                     INTEGER, DIMENSION(3), INTENT(IN)                  :: n
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_derive'
 
                     COMPLEX(KIND=dp)                                   :: im
                     INTEGER                                            :: handle, m, idx, idir
 
                     CALL timeset(routinen, handle)
 
                     IF (any(n < 0)) &
                        cpabort("Nonnegative exponents are not supported!")
 
                     m = sum(n)
                     im = gaussi**m
 
                     DO idir = 1, 3
                        IF (n(idir) == 1) THEN
!$OMP PARALLEL DO DEFAULT(NONE) SHARED(pw,idir) PRIVATE(idx)
                           DO idx = 1, SIZE(pw%array)
                              pw%array(idx) = pw%array(idx)*pw%pw_grid%g(idir, idx)
                           END DO
!$OMP END PARALLEL DO
                        ELSE IF (n(idir) > 1) THEN
!$OMP PARALLEL DO DEFAULT(NONE) SHARED(n, pw,idir) PRIVATE(idx)
                           DO idx = 1, SIZE(pw%array)
                              pw%array(idx) = pw%array(idx)*pw%pw_grid%g(idir, idx)**n(idir)
                           END DO
!$OMP END PARALLEL DO
                        END IF
                     END DO
 
                     ! 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%array(:) = im*pw%array(:)
!$OMP END PARALLEL WORKSHARE
                     END IF
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_derive
 
! **************************************************************************************************
!> \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
! **************************************************************************************************
                  SUBROUTINE pw_laplace(pw)
 
                     TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_laplace'
 
                     INTEGER                                            :: handle
 
                     CALL timeset(routinen, handle)
 
!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw)
                     pw%array(:) = -pw%array(:)*pw%pw_grid%gsq(:)
!$OMP END PARALLEL WORKSHARE
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_laplace
 
! **************************************************************************************************
!> \brief Calculate the tensorial 2nd derivative of a plane wave vector
!> \param pw ...
!> \param pwdr2 ...
!> \param i ...
!> \param j ...
!> \par History
!>      none
!> \author JGH (05-May-2006)
!> \note
! **************************************************************************************************
                  SUBROUTINE pw_dr2(pw, pwdr2, i, j)
 
                     TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw, pwdr2
                     INTEGER, INTENT(IN)                                :: i, j
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_dr2'
 
                     INTEGER                                            :: cnt, handle, ig
                     REAL(kind=dp)                                      :: gg, o3
 
                     CALL timeset(routinen, handle)
 
                     o3 = 1.0_dp/3.0_dp
 
                     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%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%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
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_dr2
 
! **************************************************************************************************
!> \brief Calculate the tensorial 2nd derivative of a plane wave vector
!>      and divides by |G|^2. pwdr2_gg(G=0) is put to zero.
!> \param pw ...
!> \param pwdr2_gg ...
!> \param i ...
!> \param j ...
!> \par History
!>      none
!> \author RD (20-Nov-2006)
!> \note
!>      Adapted from pw_dr2
! **************************************************************************************************
                  SUBROUTINE pw_dr2_gg(pw, pwdr2_gg, i, j)
 
                     TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw, pwdr2_gg
                     INTEGER, INTENT(IN)                                :: i, j
 
                     INTEGER                                            :: cnt, handle, ig
                     REAL(kind=dp)                                      :: gg, o3
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_dr2_gg'
 
                     CALL timeset(routinen, handle)
 
                     o3 = 1.0_dp/3.0_dp
 
                     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%array(ig) = gg/pw%pw_grid%gsq(ig)*pw%array(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%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%array(1) = 0.0_dp
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_dr2_gg
 
! **************************************************************************************************
!> \brief Multiplies a G-space function with a smoothing factor of the form
!>      f(|G|) = exp((ecut - G^2)/sigma)/(1+exp((ecut - G^2)/sigma))
!> \param pw ...
!> \param ecut ...
!> \param sigma ...
!> \par History
!>      none
!> \author JGH (09-June-2006)
!> \note
! **************************************************************************************************
                  SUBROUTINE pw_smoothing(pw, ecut, sigma)
 
                     TYPE(pw_c1d_gs_type), INTENT(INOUT)                       :: pw
                     REAL(kind=dp), INTENT(IN)                          :: ecut, sigma
 
                     CHARACTER(len=*), PARAMETER                        :: routinen = 'pw_smoothing'
 
                     INTEGER                                            :: cnt, handle, ig
                     REAL(kind=dp)                                      :: arg, f
 
                     CALL timeset(routinen, handle)
 
                     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%array(ig) = f*pw%array(ig)
                     END DO
!$OMP END PARALLEL DO
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_smoothing
 
! **************************************************************************************************
!> \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 the structure factor for point r
!> \param sf ...
!> \param r ...
!> \par History
!>      none
!> \author JGH (05-May-2006)
!> \note
! **************************************************************************************************
                  SUBROUTINE pw_structure_factor(sf, r)
 
                     TYPE(pw_c1d_gs_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)
 
                     cnt = SIZE(sf%array)
 
!$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
 
                     CALL timestop(handle)
 
                  END SUBROUTINE pw_structure_factor
 
                  END MODULE pw_methods