!--------------------------------------------------------------------------------------------------!
!   CP2K: A general program to perform molecular dynamics simulations                              !
!   Copyright (C) 2000 - 2017  CP2K developers group                                               !
!--------------------------------------------------------------------------------------------------!

! **************************************************************************************************
!> \brief Set of procedures to modify the density matrix, in order to collocate
!>      on the real space grid specific functions of the primitives
!> \author MI 06.2006
! **************************************************************************************************
MODULE qs_modify_pab_block

   USE kinds,                           ONLY: dp
   USE orbital_pointers,                ONLY: coset
#include "./base/base_uses.f90"

   IMPLICIT NONE

   PRIVATE

   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_modify_pab_block'

! *** Public subroutines ***

   PUBLIC :: prepare_dadb, prepare_adb_m_dab, prepare_dab_p_adb, prepare_ardb_m_darb, prepare_arb
   PUBLIC :: prepare_diadib, prepare_dijadijb, prepare_diiadiib
   PUBLIC :: FUNC_AB, FUNC_ARB, FUNC_DADB, FUNC_ADBmDAB, FUNC_ARDBmDARB, FUNC_DABpADB
   PUBLIC :: FUNC_DER, FUNC_DXDY, FUNC_DYDZ, FUNC_DZDX, FUNC_DX, FUNC_DY, FUNC_DZ
   PUBLIC :: FUNC_DXDX, FUNC_DYDY, FUNC_DZDZ

   ! Flags for the type of function to be collocated
   INTEGER, PARAMETER :: FUNC_AB = 401, FUNC_DADB = 402
   INTEGER, PARAMETER :: FUNC_ADBmDAB = 403, FUNC_ARDBmDARB = 404
   INTEGER, PARAMETER :: FUNC_DABpADB = 405, FUNC_ARB = 406
   INTEGER, DIMENSION(0:9), PARAMETER :: FUNC_DER = (/401, 501, 502, 503, 601, 602, 603, 604, 605, 606/)
   INTEGER, PARAMETER :: FUNC_DXDY = 601, FUNC_DYDZ = 602, FUNC_DZDX = 603
   INTEGER, PARAMETER :: FUNC_DXDX = 604, FUNC_DYDY = 605, FUNC_DZDZ = 606
   INTEGER, PARAMETER :: FUNC_DX = 501, FUNC_DY = 502, FUNC_DZ = 503

CONTAINS

!

! **************************************************************************************************
!> \brief create a new pab_local so that mapping pab_local with pgf_a pgf_b
!>      is equivalent to mapping pab with 0.5 * (nabla pgf_a) . (nabla pgf_b)
!>      (ddx pgf_a ) (ddx pgf_b) = (lax pgf_{a-1x} - 2*zeta*pgf_{a+1x})*(lbx pgf_{b-1x} - 2*zetb*pgf_{b+1x})
!> \param pab_local ...
!> \param pab ...
!> \param lxa ...
!> \param lya ...
!> \param lza ...
!> \param lxb ...
!> \param lyb ...
!> \param lzb ...
!> \param o1 ...
!> \param o2 ...
!> \param zeta ...
!> \param zetb ...
! **************************************************************************************************
   SUBROUTINE prepare_dadb(pab_local, pab, lxa, lya, lza, lxb, lyb, lzb, o1, o2, zeta, zetb)

      REAL(dp), DIMENSION(:, :), INTENT(INOUT)           :: pab_local
      REAL(dp), DIMENSION(:, :), INTENT(IN)              :: pab
      INTEGER, INTENT(IN)                                :: lxa, lya, lza, lxb, lyb, lzb, o1, o2
      REAL(dp), INTENT(IN)                               :: zeta, zetb

      INTEGER                                            :: ico, ico_l, jco, jco_l

! this element of pab results in 12 elements of pab_local

      ico = coset(lxa, lya, lza)
      jco = coset(lxb, lyb, lzb)
      ! x  (all safe if lxa = 0, as the spurious added terms have zero prefactor)

      ico_l = coset(MAX(lxa-1, 0), lya, lza)
      jco_l = coset(MAX(lxb-1, 0), lyb, lzb)
      pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lxa*lxb*pab(o1+ico, o2+jco)
      ico_l = coset(MAX(lxa-1, 0), lya, lza)
      jco_l = coset((lxb+1), lyb, lzb)
      pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*lxa*zetb*pab(o1+ico, o2+jco)
      ico_l = coset((lxa+1), lya, lza)
      jco_l = coset(MAX(lxb-1, 0), lyb, lzb)
      pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*lxb*pab(o1+ico, o2+jco)
      ico_l = coset((lxa+1), lya, lza)
      jco_l = coset((lxb+1), lyb, lzb)
      pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zeta*zetb*pab(o1+ico, o2+jco)

      ! y

      ico_l = coset(lxa, MAX(lya-1, 0), lza)
      jco_l = coset(lxb, MAX(lyb-1, 0), lzb)
      pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lya*lyb*pab(o1+ico, o2+jco)
      ico_l = coset(lxa, MAX(lya-1, 0), lza)
      jco_l = coset(lxb, (lyb+1), lzb)
      pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*lya*zetb*pab(o1+ico, o2+jco)
      ico_l = coset(lxa, (lya+1), lza)
      jco_l = coset(lxb, MAX(lyb-1, 0), lzb)
      pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*lyb*pab(o1+ico, o2+jco)
      ico_l = coset(lxa, (lya+1), lza)
      jco_l = coset(lxb, (lyb+1), lzb)
      pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zeta*zetb*pab(o1+ico, o2+jco)

      ! z

      ico_l = coset(lxa, lya, MAX(lza-1, 0))
      jco_l = coset(lxb, lyb, MAX(lzb-1, 0))
      pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lza*lzb*pab(o1+ico, o2+jco)
      ico_l = coset(lxa, lya, MAX(lza-1, 0))
      jco_l = coset(lxb, lyb, (lzb+1))
      pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*lza*zetb*pab(o1+ico, o2+jco)
      ico_l = coset(lxa, lya, (lza+1))
      jco_l = coset(lxb, lyb, MAX(lzb-1, 0))
      pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*lzb*pab(o1+ico, o2+jco)
      ico_l = coset(lxa, lya, (lza+1))
      jco_l = coset(lxb, lyb, (lzb+1))
      pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zeta*zetb*pab(o1+ico, o2+jco)

   END SUBROUTINE prepare_dadb

!
! **************************************************************************************************
!> \brief create a new pab_local so that mapping pab_local with pgf_a pgf_b
!>      is equivalent to mapping pab with  (ddi pgf_a) . (ddi pgf_b)
!>      (ddx pgf_a ) (ddx pgf_b) = (lax pgf_{a-1x} - 2*zeta*pgf_{a+1x})*(lbx pgf_{b-1x} - 2*zetb*pgf_{b+1x})
!> \param pab_local ...
!> \param pab ...
!> \param ider ...
!> \param lxa ...
!> \param lya ...
!> \param lza ...
!> \param lxb ...
!> \param lyb ...
!> \param lzb ...
!> \param o1 ...
!> \param o2 ...
!> \param zeta ...
!> \param zetb ...
! **************************************************************************************************
   SUBROUTINE prepare_diadib(pab_local, pab, ider, lxa, lya, lza, lxb, lyb, lzb, o1, o2, zeta, zetb)

      REAL(dp), DIMENSION(:, :), INTENT(inout)           :: pab_local
      REAL(dp), DIMENSION(:, :), INTENT(in)              :: pab
      INTEGER, INTENT(in)                                :: ider, lxa, lya, lza, lxb, lyb, lzb, o1, &
                                                            o2
      REAL(dp), INTENT(in)                               :: zeta, zetb

      INTEGER                                            :: ico, ico_l, jco, jco_l

! this element of pab results in 12 elements of pab_local

      ico = coset(lxa, lya, lza)
      jco = coset(lxb, lyb, lzb)
      IF (ider == 1) THEN
         ! x  (all safe if lxa = 0, as the spurious added terms have zero prefactor)
         ico_l = coset(MAX(lxa-1, 0), lya, lza)
         jco_l = coset(MAX(lxb-1, 0), lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lxa*lxb*pab(o1+ico, o2+jco)
         ico_l = coset(MAX(lxa-1, 0), lya, lza)
         jco_l = coset((lxb+1), lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*lxa*zetb*pab(o1+ico, o2+jco)
         ico_l = coset((lxa+1), lya, lza)
         jco_l = coset(MAX(lxb-1, 0), lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*lxb*pab(o1+ico, o2+jco)
         ico_l = coset((lxa+1), lya, lza)
         jco_l = coset((lxb+1), lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zeta*zetb*pab(o1+ico, o2+jco)

      ELSEIF (ider == 2) THEN
         ! y

         ico_l = coset(lxa, MAX(lya-1, 0), lza)
         jco_l = coset(lxb, MAX(lyb-1, 0), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lya*lyb*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, MAX(lya-1, 0), lza)
         jco_l = coset(lxb, (lyb+1), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*lya*zetb*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, (lya+1), lza)
         jco_l = coset(lxb, MAX(lyb-1, 0), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*lyb*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, (lya+1), lza)
         jco_l = coset(lxb, (lyb+1), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zeta*zetb*pab(o1+ico, o2+jco)
      ELSEIF (ider == 3) THEN
         ! z
         ico_l = coset(lxa, lya, MAX(lza-1, 0))
         jco_l = coset(lxb, lyb, MAX(lzb-1, 0))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lza*lzb*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, lya, MAX(lza-1, 0))
         jco_l = coset(lxb, lyb, (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*lza*zetb*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, lya, (lza+1))
         jco_l = coset(lxb, lyb, MAX(lzb-1, 0))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*lzb*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, lya, (lza+1))
         jco_l = coset(lxb, lyb, (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zeta*zetb*pab(o1+ico, o2+jco)
      END IF

   END SUBROUTINE prepare_diadib
!
! **************************************************************************************************
!> \brief create a new pab_local so that mapping pab_local with pgf_a pgf_b
!>      is equivalent to mapping pab with  (ddidj pgf_a) . (ddidj pgf_b)
!>      (ddxdy pgf_a ) (ddxdy pgf_b) =
!> \param pab_local ...
!> \param pab ...
!> \param ider1 ...
!> \param ider2 ...
!> \param lxa ...
!> \param lya ...
!> \param lza ...
!> \param lxb ...
!> \param lyb ...
!> \param lzb ...
!> \param o1 ...
!> \param o2 ...
!> \param zeta ...
!> \param zetb ...
! **************************************************************************************************
   SUBROUTINE prepare_dijadijb(pab_local, pab, ider1, ider2, lxa, lya, lza, lxb, lyb, lzb, o1, o2, zeta, zetb)

      REAL(dp), DIMENSION(:, :), INTENT(inout)           :: pab_local
      REAL(dp), DIMENSION(:, :), INTENT(in)              :: pab
      INTEGER, INTENT(in)                                :: ider1, ider2, lxa, lya, lza, lxb, lyb, &
                                                            lzb, o1, o2
      REAL(dp), INTENT(in)                               :: zeta, zetb

      INTEGER                                            :: ico, ico_l, jco
      REAL(dp)                                           :: func_a

! this element of pab results in 12 elements of pab_local

      ico = coset(lxa, lya, lza)
      jco = coset(lxb, lyb, lzb)

      IF ((ider1 == 1 .AND. ider2 == 2) .OR. (ider1 == 2 .AND. ider2 == 1)) THEN ! xy
         ico_l = coset(MAX(lxa-1, 0), MAX(lya-1, 0), lza)
         func_a = lxa*lya*pab(o1+ico, o2+jco)
         CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=1)
         ico_l = coset(lxa+1, MAX(lya-1, 0), lza)
         func_a = -2.0_dp*zeta*lya*pab(o1+ico, o2+jco)
         CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=1)
         ico_l = coset(MAX(lxa-1, 0), lya+1, lza)
         func_a = -2.0_dp*zeta*lxa*pab(o1+ico, o2+jco)
         CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=1)
         ico_l = coset(lxa+1, lya+1, lza)
         func_a = 4.0_dp*zeta*zeta*pab(o1+ico, o2+jco)
         CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=1)
      ELSEIF ((ider1 == 2 .AND. ider2 == 3) .OR. (ider1 == 3 .AND. ider2 == 2)) THEN ! yz
         ico_l = coset(lxa, MAX(lya-1, 0), MAX(lza-1, 0))
         func_a = lya*lza*pab(o1+ico, o2+jco)
         CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=2)
         ico_l = coset(lxa, lya+1, MAX(lza-1, 0))
         func_a = -2.0_dp*zeta*lza*pab(o1+ico, o2+jco)
         CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=2)
         ico_l = coset(lxa, MAX(lya-1, 0), lza+1)
         func_a = -2.0_dp*zeta*lya*pab(o1+ico, o2+jco)
         CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=2)
         ico_l = coset(lxa, lya+1, lza+1)
         func_a = 4.0_dp*zeta*zeta*pab(o1+ico, o2+jco)
         CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=2)
      ELSEIF ((ider1 == 3 .AND. ider2 == 1) .OR. (ider1 == 1 .AND. ider2 == 3)) THEN ! zx
         ico_l = coset(MAX(lxa-1, 0), lya, MAX(lza-1, 0))
         func_a = lza*lxa*pab(o1+ico, o2+jco)
         CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=3)
         ico_l = coset(MAX(lxa-1, 0), lya, lza+1)
         func_a = -2.0_dp*zeta*lxa*pab(o1+ico, o2+jco)
         CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=3)
         ico_l = coset(lxa+1, lya, MAX(lza-1, 0))
         func_a = -2.0_dp*zeta*lza*pab(o1+ico, o2+jco)
         CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=3)
         ico_l = coset(lxa+1, lya, lza+1)
         func_a = 4.0_dp*zeta*zeta*pab(o1+ico, o2+jco)
         CALL oneterm_dijdij(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=3)
      END IF

   END SUBROUTINE prepare_dijadijb

! **************************************************************************************************
!> \brief ...
!> \param pab_local ...
!> \param func_a ...
!> \param ico_l ...
!> \param lx ...
!> \param ly ...
!> \param lz ...
!> \param zet ...
!> \param idir ...
! **************************************************************************************************
   SUBROUTINE oneterm_dijdij(pab_local, func_a, ico_l, lx, ly, lz, zet, idir)

      REAL(dp), DIMENSION(:, :), INTENT(inout)           :: pab_local
      REAL(dp), INTENT(in)                               :: func_a
      INTEGER, INTENT(in)                                :: ico_l, lx, ly, lz
      REAL(dp), INTENT(in)                               :: zet
      INTEGER, INTENT(in)                                :: idir

      INTEGER                                            :: jco_l, l1, l2

      IF (idir == 1) THEN
         l1 = lx
         l2 = ly
         jco_l = coset(MAX(lx-1, 0), MAX(ly-1, 0), lz)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+l1*l2*func_a
         jco_l = coset(lx+1, MAX(ly-1, 0), lz)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*l2*func_a
         jco_l = coset(MAX(lx-1, 0), ly+1, lz)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*l1*func_a
         jco_l = coset(lx+1, ly+1, lz)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zet*zet*func_a
      ELSEIF (idir == 2) THEN
         l1 = ly
         l2 = lz
         jco_l = coset(lx, MAX(ly-1, 0), MAX(lz-1, 0))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+l1*l2*func_a
         jco_l = coset(lx, ly+1, MAX(lz-1, 0))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*l2*func_a
         jco_l = coset(lx, MAX(ly-1, 0), lz+1)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*l1*func_a
         jco_l = coset(lx, ly+1, lz+1)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zet*zet*func_a
      ELSEIF (idir == 3) THEN
         l1 = lz
         l2 = lx
         jco_l = coset(MAX(lx-1, 0), ly, MAX(lz-1, 0))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+l1*l2*func_a
         jco_l = coset(MAX(lx-1, 0), ly, lz+1)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*l2*func_a
         jco_l = coset(lx+1, ly, MAX(lz-1, 0))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*l1*func_a
         jco_l = coset(lx+1, ly, lz+1)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zet*zet*func_a

      END IF
   END SUBROUTINE oneterm_dijdij

!
! **************************************************************************************************
!> \brief create a new pab_local so that mapping pab_local with pgf_a pgf_b
!>      is equivalent to mapping pab with  (ddidj pgf_a) . (ddidj pgf_b)
!>      (ddxdx pgf_a ) (ddxdx pgf_b) =
!> \param pab_local ...
!> \param pab ...
!> \param ider ...
!> \param lxa ...
!> \param lya ...
!> \param lza ...
!> \param lxb ...
!> \param lyb ...
!> \param lzb ...
!> \param o1 ...
!> \param o2 ...
!> \param zeta ...
!> \param zetb ...
! **************************************************************************************************
   SUBROUTINE prepare_diiadiib(pab_local, pab, ider, lxa, lya, lza, lxb, lyb, lzb, o1, o2, zeta, zetb)

      REAL(dp), DIMENSION(:, :), INTENT(inout)           :: pab_local
      REAL(dp), DIMENSION(:, :), INTENT(in)              :: pab
      INTEGER, INTENT(in)                                :: ider, lxa, lya, lza, lxb, lyb, lzb, o1, &
                                                            o2
      REAL(dp), INTENT(in)                               :: zeta, zetb

      INTEGER                                            :: ico, ico_l, jco
      REAL(dp)                                           :: func_a

! this element of pab results in  9 elements of pab_local

      ico = coset(lxa, lya, lza)
      jco = coset(lxb, lyb, lzb)

      IF (ider == 1) THEN ! x
         ico_l = coset(MAX(lxa-2, 0), lya, lza)
         func_a = lxa*(lxa-1)*pab(o1+ico, o2+jco)
         CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=1)
         ico_l = coset(lxa, lya, lza)
         func_a = -2.0_dp*zeta*(2*lxa+1)*pab(o1+ico, o2+jco)
         CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=1)
         ico_l = coset(lxa+2, lya, lza)
         func_a = 4.0_dp*zeta*zeta*pab(o1+ico, o2+jco)
         CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=1)
      ELSEIF (ider == 2) THEN ! y
         ico_l = coset(lxa, MAX(lya-2, 0), lza)
         func_a = lya*(lya-1)*pab(o1+ico, o2+jco)
         CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=2)
         ico_l = coset(lxa, lya, lza)
         func_a = -2.0_dp*zeta*(2*lya+1)*pab(o1+ico, o2+jco)
         CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=2)
         ico_l = coset(lxa, lya+2, lza)
         func_a = 4.0_dp*zeta*zeta*pab(o1+ico, o2+jco)
         CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=2)
      ELSEIF (ider == 3) THEN ! z
         ico_l = coset(lxa, lya, MAX(lza-2, 0))
         func_a = lza*(lza-1)*pab(o1+ico, o2+jco)
         CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=3)
         ico_l = coset(lxa, lya, lza)
         func_a = -2.0_dp*zeta*(2*lza+1)*pab(o1+ico, o2+jco)
         CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=3)
         ico_l = coset(lxa, lya, lza+2)
         func_a = 4.0_dp*zeta*zeta*pab(o1+ico, o2+jco)
         CALL oneterm_diidii(pab_local, func_a, ico_l, lxb, lyb, lzb, zetb, idir=3)
      END IF

   END SUBROUTINE prepare_diiadiib

! **************************************************************************************************
!> \brief ...
!> \param pab_local ...
!> \param func_a ...
!> \param ico_l ...
!> \param lx ...
!> \param ly ...
!> \param lz ...
!> \param zet ...
!> \param idir ...
! **************************************************************************************************
   SUBROUTINE oneterm_diidii(pab_local, func_a, ico_l, lx, ly, lz, zet, idir)
      REAL(dp), DIMENSION(:, :), INTENT(inout)           :: pab_local
      REAL(dp), INTENT(in)                               :: func_a
      INTEGER, INTENT(in)                                :: ico_l, lx, ly, lz
      REAL(dp), INTENT(in)                               :: zet
      INTEGER, INTENT(in)                                :: idir

      INTEGER                                            :: jco_l, l1

      IF (idir == 1) THEN
         l1 = lx
         jco_l = coset(MAX(lx-2, 0), ly, lz)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+l1*(l1-1)*func_a
         jco_l = coset(lx, ly, lz)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*(2*l1+1)*func_a
         jco_l = coset(lx+2, ly, lz)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zet*zet*func_a
      ELSEIF (idir == 2) THEN
         l1 = ly
         jco_l = coset(lx, MAX(ly-2, 0), lz)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+l1*(l1-1)*func_a
         jco_l = coset(lx, ly, lz)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*(2*l1+1)*func_a
         jco_l = coset(lx, ly+2, lz)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zet*zet*func_a
      ELSEIF (idir == 3) THEN
         l1 = lz
         jco_l = coset(lx, ly, MAX(lz-2, 0))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+l1*(l1-1)*func_a
         jco_l = coset(lx, ly, lz)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zet*(2*l1+1)*func_a
         jco_l = coset(lx, ly, lz+2)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+4.0_dp*zet*zet*func_a
      END IF

   END SUBROUTINE oneterm_diidii

! **************************************************************************************************
!> \brief create a new pab_local so that mapping pab_local with pgf_a pgf_b
!>      is equivalent to mapping pab with  pgf_a (nabla_{idir} pgf_b) - (nabla_{idir} pgf_a) pgf_b
!>      ( pgf_a ) (ddx pgf_b) - (ddx pgf_a)( pgf_b ) =
!>              pgf_a *(lbx pgf_{b-1x} - 2*zetb*pgf_{b+1x}) - (lax pgf_{a-1x} - 2*zeta*pgf_{a+1x}) pgf_b
!> \param pab_local ...
!> \param pab ...
!> \param idir ...
!> \param lxa ...
!> \param lya ...
!> \param lza ...
!> \param lxb ...
!> \param lyb ...
!> \param lzb ...
!> \param o1 ...
!> \param o2 ...
!> \param zeta ...
!> \param zetb ...
! **************************************************************************************************
   SUBROUTINE prepare_adb_m_dab(pab_local, pab, idir, lxa, lya, lza, lxb, lyb, lzb, o1, o2, zeta, zetb)

      REAL(dp), DIMENSION(:, :), INTENT(INOUT)           :: pab_local
      REAL(dp), DIMENSION(:, :), INTENT(IN)              :: pab
      INTEGER, INTENT(IN)                                :: idir, lxa, lya, lza, lxb, lyb, lzb, o1, &
                                                            o2
      REAL(dp), INTENT(IN)                               :: zeta, zetb

      INTEGER                                            :: ico, ico_l, jco, jco_l

! this element of pab results in 4 elements of pab_local

      ico = coset(lxa, lya, lza)
      jco = coset(lxb, lyb, lzb)

      IF (idir == 1) THEN ! x
         ico_l = coset(lxa, lya, lza)
         jco_l = coset(MAX(lxb-1, 0), lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lxb*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, lya, lza)
         jco_l = coset((lxb+1), lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco)
         ico_l = coset(MAX(lxa-1, 0), lya, lza)
         jco_l = coset(lxb, lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lxa*pab(o1+ico, o2+jco)
         ico_l = coset((lxa+1), lya, lza)
         jco_l = coset(lxb, lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco)
      ELSEIF (idir == 2) THEN ! y
         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, MAX(lyb-1, 0), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lyb*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, (lyb+1), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, MAX(lya-1, 0), lza)
         jco_l = coset(lxb, lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lya*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, (lya+1), lza)
         jco_l = coset(lxb, lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco)
      ELSE ! z
         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, lyb, MAX(lzb-1, 0))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lzb*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, lyb, (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, lya, MAX(lza-1, 0))
         jco_l = coset(lxb, lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lza*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, lya, (lza+1))
         jco_l = coset(lxb, lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco)
      END IF

   END SUBROUTINE prepare_adb_m_dab

!
! **************************************************************************************************
!> \brief create a new pab_local so that mapping pab_local with pgf_a pgf_b
!>      is equivalent to mapping pab with  pgf_a (nabla_{idir} pgf_b) + (nabla_{idir} pgf_a) pgf_b
!>      ( pgf_a ) (ddx pgf_b) + (ddx pgf_a)( pgf_b ) =
!>              pgf_a *(lbx pgf_{b-1x} - 2*zetb*pgf_{b+1x}) + (lax pgf_{a-1x} - 2*zeta*pgf_{a+1x}) pgf_b
!> \param pab_local ...
!> \param pab ...
!> \param idir ...
!> \param lxa ...
!> \param lya ...
!> \param lza ...
!> \param lxb ...
!> \param lyb ...
!> \param lzb ...
!> \param o1 ...
!> \param o2 ...
!> \param zeta ...
!> \param zetb ...
! **************************************************************************************************
   SUBROUTINE prepare_dab_p_adb(pab_local, pab, idir, lxa, lya, lza, lxb, lyb, lzb, o1, o2, zeta, zetb)

      REAL(dp), DIMENSION(:, :), INTENT(INOUT)           :: pab_local
      REAL(dp), DIMENSION(:, :), INTENT(IN)              :: pab
      INTEGER, INTENT(IN)                                :: idir, lxa, lya, lza, lxb, lyb, lzb, o1, &
                                                            o2
      REAL(dp), INTENT(IN)                               :: zeta, zetb

      INTEGER                                            :: ico, ico_l, jco, jco_l

! this element of pab results in 4 elements of pab_local

      ico = coset(lxa, lya, lza)
      jco = coset(lxb, lyb, lzb)

      IF (idir == 1) THEN ! x
         ico_l = coset(lxa, lya, lza)
         jco_l = coset(MAX(lxb-1, 0), lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lxb*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, lya, lza)
         jco_l = coset((lxb+1), lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco)
         ico_l = coset(MAX(lxa-1, 0), lya, lza)
         jco_l = coset(lxb, lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lxa*pab(o1+ico, o2+jco)
         ico_l = coset((lxa+1), lya, lza)
         jco_l = coset(lxb, lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*pab(o1+ico, o2+jco)
      ELSEIF (idir == 2) THEN ! y
         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, MAX(lyb-1, 0), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lyb*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, (lyb+1), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, MAX(lya-1, 0), lza)
         jco_l = coset(lxb, lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lya*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, (lya+1), lza)
         jco_l = coset(lxb, lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*pab(o1+ico, o2+jco)
      ELSE ! z
         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, lyb, MAX(lzb-1, 0))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lzb*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, lyb, (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, lya, MAX(lza-1, 0))
         jco_l = coset(lxb, lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lza*pab(o1+ico, o2+jco)
         ico_l = coset(lxa, lya, (lza+1))
         jco_l = coset(lxb, lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zeta*pab(o1+ico, o2+jco)
      END IF

   END SUBROUTINE prepare_dab_p_adb

!

! **************************************************************************************************
!> \brief create a new pab_local so that mapping pab_local with pgf_a pgf_b
!>      pgf_a (r-Rb)_{ir} (nabla_{idir} pgf_b) - (nabla_{idir} pgf_a) (r-Rb)_{ir}  pgf_b
!>       ( pgf_a )(r-Rb)_{ir} (ddx pgf_b) - (ddx pgf_a) (r-Rb)_{ir} ( pgf_b ) =
!>                     pgf_a *(lbx pgf_{b-1x+1ir} - 2*zetb*pgf_{b+1x+1ir}) -
!>                              (lax pgf_{a-1x} - 2*zeta*pgf_{a+1x}) pgf_{b+1ir}
!> \param pab_local ...
!> \param pab ...
!> \param idir ...
!> \param ir ...
!> \param lxa ...
!> \param lya ...
!> \param lza ...
!> \param lxb ...
!> \param lyb ...
!> \param lzb ...
!> \param o1 ...
!> \param o2 ...
!> \param zeta ...
!> \param zetb ...
! **************************************************************************************************
   SUBROUTINE prepare_ardb_m_darb(pab_local, pab, idir, ir, lxa, lya, lza, lxb, lyb, lzb, o1, o2, zeta, zetb)

      REAL(dp), DIMENSION(:, :), INTENT(INOUT)           :: pab_local
      REAL(dp), DIMENSION(:, :), INTENT(IN)              :: pab
      INTEGER, INTENT(IN)                                :: idir, ir, lxa, lya, lza, lxb, lyb, lzb, &
                                                            o1, o2
      REAL(dp), INTENT(IN)                               :: zeta, zetb

      INTEGER                                            :: ico, ico_l, jco, jco_l

! this element of pab results in 4 elements of pab_local

      ico = coset(lxa, lya, lza)
      jco = coset(lxb, lyb, lzb)

      IF (idir == 1 .AND. ir == 1) THEN

         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lxb*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, lya, lza)
         jco_l = coset((lxb+2), lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco)

         ico_l = coset(MAX(lxa-1, 0), lya, lza)
         jco_l = coset((lxb+1), lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lxa*pab(o1+ico, o2+jco)

         ico_l = coset((lxa+1), lya, lza)
         jco_l = coset((lxb+1), lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco)

      ELSEIF (idir == 1 .AND. ir == 2) THEN

         ico_l = coset(lxa, lya, lza)
         jco_l = coset(MAX(lxb-1, 0), (lyb+1), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lxb*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, lya, lza)
         jco_l = coset((lxb+1), (lyb+1), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco)

         ico_l = coset(MAX(lxa-1, 0), lya, lza)
         jco_l = coset(lxb, (lyb+1), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lxa*pab(o1+ico, o2+jco)

         ico_l = coset((lxa+1), lya, lza)
         jco_l = coset(lxb, (lyb+1), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco)

      ELSEIF (idir == 1 .AND. ir == 3) THEN

         ico_l = coset(lxa, lya, lza)
         jco_l = coset(MAX(lxb-1, 0), lyb, (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lxb*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, lya, lza)
         jco_l = coset((lxb+1), lyb, (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco)

         ico_l = coset(MAX(lxa-1, 0), lya, lza)
         jco_l = coset(lxb, lyb, (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lxa*pab(o1+ico, o2+jco)

         ico_l = coset((lxa+1), lya, lza)
         jco_l = coset(lxb, lyb, (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco)

      ELSEIF (idir == 2 .AND. ir == 1) THEN

         ico_l = coset(lxa, lya, lza)
         jco_l = coset((lxb+1), MAX(lyb-1, 0), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lyb*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, lya, lza)
         jco_l = coset((lxb+1), (lyb+1), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, MAX(lya-1, 0), lza)
         jco_l = coset((lxb+1), lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lya*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, (lya+1), lza)
         jco_l = coset((lxb+1), lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco)

      ELSEIF (idir == 2 .AND. ir == 2) THEN

         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lyb*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, (lyb+2), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, MAX(lya-1, 0), lza)
         jco_l = coset(lxb, (lyb+1), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lya*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, (lya+1), lza)
         jco_l = coset(lxb, (lyb+1), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco)

      ELSEIF (idir == 2 .AND. ir == 3) THEN

         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, MAX(lyb-1, 0), (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lyb*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, (lyb+1), (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, MAX(lya-1, 0), lza)
         jco_l = coset(lxb, lyb, (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lya*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, (lya+1), lza)
         jco_l = coset(lxb, lyb, (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco)

      ELSEIF (idir == 3 .AND. ir == 1) THEN

         ico_l = coset(lxa, lya, lza)
         jco_l = coset((lxb+1), lyb, MAX(lzb-1, 0))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lzb*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, lya, lza)
         jco_l = coset((lxb+1), lyb, (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, lya, MAX(lza-1, 0))
         jco_l = coset((lxb+1), lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lza*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, lya, (lza+1))
         jco_l = coset((lxb+1), lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco)

      ELSEIF (idir == 3 .AND. ir == 2) THEN

         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, (lyb+1), MAX(lzb-1, 0))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lzb*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, (lyb+1), (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, lya, MAX(lza-1, 0))
         jco_l = coset(lxb, (lyb+1), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lza*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, lya, (lza+1))
         jco_l = coset(lxb, (lyb+1), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco)

      ELSEIF (idir == 3 .AND. ir == 3) THEN

         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+lzb*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, lyb, (lzb+2))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-2.0_dp*zetb*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, lya, MAX(lza-1, 0))
         jco_l = coset(lxb, lyb, (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)-lza*pab(o1+ico, o2+jco)

         ico_l = coset(lxa, lya, (lza+1))
         jco_l = coset(lxb, lyb, (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+2.0_dp*zeta*pab(o1+ico, o2+jco)

      END IF

   END SUBROUTINE prepare_ardb_m_darb

! **************************************************************************************************
!> \brief create a new pab_local so that mapping pab_local with pgf_a pgf_b
!>    pgf_a (r-Rb)_{ir} pgf_b = pgf_a * pgf_b{+1ir}
!> \param pab_local ...
!> \param pab ...
!> \param ir ...
!> \param lxa ...
!> \param lya ...
!> \param lza ...
!> \param lxb ...
!> \param lyb ...
!> \param lzb ...
!> \param o1 ...
!> \param o2 ...
! **************************************************************************************************
   SUBROUTINE prepare_arb(pab_local, pab, ir, lxa, lya, lza, lxb, lyb, lzb, o1, o2)

      REAL(dp), DIMENSION(:, :), INTENT(INOUT)           :: pab_local
      REAL(dp), DIMENSION(:, :), INTENT(IN)              :: pab
      INTEGER, INTENT(IN)                                :: ir, lxa, lya, lza, lxb, lyb, lzb, o1, o2

      INTEGER                                            :: ico, ico_l, jco, jco_l

      ico = coset(lxa, lya, lza)
      jco = coset(lxb, lyb, lzb)

      IF (ir == 1) THEN

         ico_l = coset(lxa, lya, lza)
         jco_l = coset((lxb+1), lyb, lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+pab(o1+ico, o2+jco)

      ELSEIF (ir == 2) THEN

         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, (lyb+1), lzb)
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+pab(o1+ico, o2+jco)

      ELSEIF (ir == 3) THEN

         ico_l = coset(lxa, lya, lza)
         jco_l = coset(lxb, lyb, (lzb+1))
         pab_local(ico_l, jco_l) = pab_local(ico_l, jco_l)+pab(o1+ico, o2+jco)

      END IF

   END SUBROUTINE prepare_arb

END MODULE qs_modify_pab_block

