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

! **************************************************************************************************
!> \brief Build up the nuclear potential part of the core Hamiltonian matrix
!>      in the case of an allelectron calculation by computing the nuclear
!>      attraction integral matrix <a|-Z/r|b> and the integral matrix
!>      <a|Z*erf(r)/r|b>.  The integrals <a|Z*erf(r)/r|b> can be rewritten
!>      as the three-center Coulomb integrals <ab||c> with a  primitive
!>      s-type Gaussian function c multiplied by a factor N.
!>
!>                       erfc(r)
!>      <a|V|b> = -Z*<a|---------|b>
!>                          r
!>
!>                       1 - erf(r)
!>              = -Z*<a|------------|b>
!>                           r
!>
!>                        1           erf(r)
!>              = -Z*(<a|---|b> - <a|--------|b>)
!>                        r             r
!>
!>                        1
!>              = -Z*(<a|---|b> - N*<ab||c>)
!>                        r
!>
!>                       1
!>              = -Z*<a|---|b> + Z*N*<ab||c>
!>                       r
!>                   \_______/       \_____/
!>                       |              |
!>                    nuclear        coulomb
!> \par Literature
!>      S. Obara and A. Saika, J. Chem. Phys. 84, 3963 (1986)
!> \par Parameters
!>      -  ax,ay,az  : Angular momentum index numbers of orbital a.
!>      -  bx,by,bz  : Angular momentum index numbers of orbital b.
!>      -  coset     : Cartesian orbital set pointer.
!>      -  dab       : Distance between the atomic centers a and b.
!>      -  dac       : Distance between the atomic centers a and c.
!>      -  dbc       : Distance between the atomic centers b and c.
!>      -  l{a,b}    : Angular momentum quantum number of shell a or b.
!>      -  l{a,b}_max: Maximum angular momentum quantum number of shell a or b.
!>      -  l{a,b}_min: Minimum angular momentum quantum number of shell a or b.
!>      -  ncoset    : Number of orbitals in a Cartesian orbital set.
!>      -  npgf{a,b} : Degree of contraction of shell a or b.
!>      -  rab       : Distance vector between the atomic centers a and b.
!>      -  rab2      : Square of the distance between the atomic centers a and b.
!>      -  rac       : Distance vector between the atomic centers a and c.
!>      -  rac2      : Square of the distance between the atomic centers a and c.
!>      -  rbc2      : Square of the distance between the atomic centers b and c.
!>      -  rpgf{a,b} : Radius of the primitive Gaussian-type function a or b.
!>      -  zet{a,b}  : Exponents of the Gaussian-type functions a or b.
!>      -  zetp      : Reciprocal of the sum of the exponents of orbital a and b.
!>      -  zetw        : Reciprocal of the sum of the exponents of orbital a, b and c.
!> Indices for pVp matrices
!>      -  ax,ay,az                : Angular momentum index numbers of orbital a.
!>      -  n{x1,y1,z1}{x2,y2,z2}   : indices for the pVp matrix elements
!>                                   <p_{x1,y1,z1}a|V|p_{x2,y2,z2}>
!>      -  co{a,b}{m,p}{x,y,z}     : coefficients of the pVp matrix elements: co == coset(lx,ly,lz)
!>                                   m == li - 1; p == li +1; li= x,y,z (which l quantum number is modified); l = a,b
!>                                   coset ( ... -1 ...) = 1  , should be zero, lmi = 1.0 for li >=1 and lmi = 0.0 for li = 0
!>                                  guarantees this as a prefactor
!>      -  f{a,b}{x,y,z},ft{a,b},z : f(t)li: prefactors as a result of derivations of l with respect to i
!>      -  pVpout                  : pVp matrix elements
!>      -  pVp                     : local pVp matrix elements
!>      -  lamin,lbmin             : minimal angular quantum number used in pVp matrices
!>      _  vnucp                   : potential of the nuclei
!>      -  vnuc                    : potential of the electrons
!>      _  pVpa, pVpb              : pVpl=coset(lx,ly,lz)
!>      -  na_pgf,nb_pgf           : indice for primitive gaussian functions
!> \par History
!>      10.2008 added pVp matrix elements (jens)
!> \author Matthias Krack (04.10.2000)
! **************************************************************************************************

MODULE ai_verfc

   USE gamma,                           ONLY: fgamma => fgamma_0
   USE kinds,                           ONLY: dp
   USE mathconstants,                   ONLY: pi
   USE orbital_pointers,                ONLY: coset,&
                                              ncoset
#include "../base/base_uses.f90"

   IMPLICIT NONE
   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'ai_verfc'
   PRIVATE

! *** Public subroutines ***

   PUBLIC :: verfc

CONTAINS

! **************************************************************************************************
!> \brief   Calculation of the primitive three-center nuclear potential
!>          integrals <a|Z*erfc(r)/r|b> over Cartesian Gaussian-type
!>          functions.
!> \param la_max1 ...
!> \param npgfa ...
!> \param zeta ...
!> \param rpgfa ...
!> \param la_min1 ...
!> \param lb_max1 ...
!> \param npgfb ...
!> \param zetb ...
!> \param rpgfb ...
!> \param lb_min1 ...
!> \param zetc ...
!> \param rpgfc ...
!> \param zc ...
!> \param cerf ...
!> \param rab ...
!> \param rab2 ...
!> \param rac ...
!> \param rac2 ...
!> \param rbc2 ...
!> \param vabc ...
!> \param verf ...
!> \param vnuc ...
!> \param f ...
!> \param maxder ...
!> \param vabc_plus ...
!> \param vnabc ...
!> \param pVp_sum ...
!> \param pVp ...
!> \param dkh_erfc ...
!> \date    04.10.2000
!> \author  Matthias Krack
!> \version 1.0
! **************************************************************************************************
   SUBROUTINE verfc(la_max1, npgfa, zeta, rpgfa, la_min1, lb_max1, npgfb, zetb, rpgfb, lb_min1, &
                    zetc, rpgfc, zc, cerf, rab, rab2, rac, rac2, rbc2, vabc, verf, vnuc, f, &
                    maxder, vabc_plus, vnabc, pVp_sum, pVp, dkh_erfc) !JT
      INTEGER, INTENT(IN)                                :: la_max1, npgfa
      REAL(KIND=dp), DIMENSION(:), INTENT(IN)            :: zeta, rpgfa
      INTEGER, INTENT(IN)                                :: la_min1, lb_max1, npgfb
      REAL(KIND=dp), DIMENSION(:), INTENT(IN)            :: zetb, rpgfb
      INTEGER, INTENT(IN)                                :: lb_min1
      REAL(KIND=dp), INTENT(IN)                          :: zetc, rpgfc, zc, cerf
      REAL(KIND=dp), DIMENSION(3), INTENT(IN)            :: rab
      REAL(KIND=dp), INTENT(IN)                          :: rab2
      REAL(KIND=dp), DIMENSION(3), INTENT(IN)            :: rac
      REAL(KIND=dp), INTENT(IN)                          :: rac2, rbc2
      REAL(KIND=dp), DIMENSION(:, :), INTENT(INOUT)      :: vabc
      REAL(KIND=dp), DIMENSION(:, :, :)                  :: verf, vnuc
      REAL(KIND=dp), DIMENSION(0:)                       :: f
      INTEGER, INTENT(IN), OPTIONAL                      :: maxder
      REAL(KIND=dp), DIMENSION(:, :), OPTIONAL           :: vabc_plus, vnabc, pVp_sum, pVp
      LOGICAL, OPTIONAL                                  :: dkh_erfc

      CHARACTER(len=*), PARAMETER :: routineN = 'verfc', routineP = moduleN//':'//routineN

      INTEGER :: ax, ay, az, bx, by, bz, coamx, coamy, coamz, coapx, coapy, coapz, cobmx, cobmy, &
         cobmz, cobpx, cobpy, cobpz, i, ipgf, j, jpgf, la, la_max, la_min, la_start, lb, lb_max, &
         lb_min, maxder_local, n, na, nap, nb, nmax, nxx, nxy, nxz, nyx, nyy, nyz, nzx, nzy, nzz, &
         pVpa, pVpb
      LOGICAL                                            :: do_dkh
      REAL(KIND=dp)                                      :: dab, dac, dbc, f0, f1, f2, f3, f4, fax, &
                                                            fay, faz, fbx, fby, fbz, ferf, fnuc, &
                                                            ftaz, ftbz, fx, fy, fz, rcp2, t, zetp, &
                                                            zetq, zetw
      REAL(KIND=dp), DIMENSION(3)                        :: rap, rbp, rcp, rpw

!   ---------------------------------------------------------------------------

      IF (PRESENT(maxder)) THEN
         verf(1:ncoset(la_max1), 1:ncoset(lb_max1), 1) = 0._dp
         vnuc(1:ncoset(la_max1), 1:ncoset(lb_max1), 1) = 0._dp
      END IF

      do_dkh = .FALSE.

      IF (PRESENT(pVp)) THEN
         do_dkh = .TRUE.
         pVp = 0.0_dp
         ! pVp matrices requires angular momentum quantum numbers l+1 and l-1

         la_max = la_max1+1
         IF (PRESENT(maxder)) THEN
            IF (maxder > 0) THEN
               la_max = la_max1
            END IF
         END IF
         lb_max = lb_max1+1

         la_min = MAX(0, la_min1-1)
         lb_min = MAX(0, lb_min1-1)
      ELSE
         do_dkh = .FALSE.
         la_max = la_max1
         lb_max = lb_max1
         la_min = la_min1
         lb_min = lb_min1
      END IF

      nmax = la_max+lb_max+1

      maxder_local = 0
      IF (PRESENT(maxder)) maxder_local = maxder

!   *** Calculate the distances of the centers a, b and c ***

      dab = SQRT(rab2)
      dac = SQRT(rac2)
      dbc = SQRT(rbc2)

!   *** Loop over all pairs of primitive Gaussian-type functions ***

      na = 0
      nap = 0

      DO ipgf = 1, npgfa

!     *** Screening ***

         IF (do_dkh) THEN
            IF (dkh_erfc) THEN
               IF (rpgfa(ipgf)+rpgfc < dac) THEN
                  na = na+ncoset(la_max1-maxder_local) !JT
                  nap = nap+ncoset(la_max1) !JT
                  CYCLE
               END IF
            END IF
         ELSE
            IF (rpgfa(ipgf)+rpgfc < dac) THEN
               na = na+ncoset(la_max1-maxder_local) !JT
               nap = nap+ncoset(la_max1) !JT
               CYCLE
            END IF
         END IF

         nb = 0

         DO jpgf = 1, npgfb

!       *** Screening ***
            IF (do_dkh) THEN
               IF (dkh_erfc) THEN
                  IF ((rpgfb(jpgf)+rpgfc < dbc) .OR. &
                      (rpgfa(ipgf)+rpgfb(jpgf) < dab)) THEN
                     nb = nb+ncoset(lb_max1) !JT
                     CYCLE
                  END IF
               END IF
            ELSE
               IF ((rpgfb(jpgf)+rpgfc < dbc) .OR. &
                   (rpgfa(ipgf)+rpgfb(jpgf) < dab)) THEN
                  nb = nb+ncoset(lb_max1) !JT
                  CYCLE
               END IF
            END IF
!       *** Calculate some prefactors ***

            zetp = 1.0_dp/(zeta(ipgf)+zetb(jpgf))
            zetq = 1.0_dp/zetc
            zetw = 1.0_dp/(zeta(ipgf)+zetb(jpgf)+zetc)

            f1 = zetb(jpgf)*zetp
            f2 = 0.5_dp*zetp
            f4 = -zetc*zetw

            f0 = EXP(-zeta(ipgf)*f1*rab2)

            fnuc = 2.0_dp*pi*zetp*f0
            ferf = 2.0_dp*SQRT(pi**5*zetw)*zetp*zetq*f0

            rap(:) = f1*rab(:)
            rcp(:) = rap(:)-rac(:)
            rpw(:) = f4*rcp(:)

!       *** Calculate the incomplete Gamma function values ***

            rcp2 = rcp(1)*rcp(1)+rcp(2)*rcp(2)+rcp(3)*rcp(3)

            t = rcp2/zetp

            CALL fgamma(nmax-1, t, f)

!       *** Calculate the basic nuclear attraction integrals [s|A(0)|s]{n} ***

            DO n = 1, nmax
               vnuc(1, 1, n) = fnuc*f(n-1)
            END DO

!       *** Calculate the incomplete Gamma function values ***

            t = -f4*rcp2/zetp

            CALL fgamma(nmax-1, t, f)

!       *** Calculate the basic three-center Coulomb integrals [ss||s]{n} ***

            DO n = 1, nmax
               verf(1, 1, n) = ferf*f(n-1)
            END DO

!       *** Recurrence steps: [s|A(0)|s] -> [a|A(0)|b] ***
!       ***                   [ss||s]    -> [ab||s]    ***

            IF (la_max > 0) THEN

!         *** Vertical recurrence steps: [s|A(0)|s] -> [a|A(0)|s] ***
!         ***                            [ss||s]    -> [as||s]    ***

!         *** [p|A(0)|s]{n} = (Pi - Ai)*[s|A(0)|s]{n} -           ***
!         ***                 (Pi - Ci)*[s|A(0)|s]{n+1}           ***
!         *** [ps||s]{n}    = (Pi - Ai)*[ss||s]{n} +              ***
!         ***                 (Wi - Pi)*[ss||s]{n+1}  (i = x,y,z) ***

               DO n = 1, nmax-1
                  vnuc(2, 1, n) = rap(1)*vnuc(1, 1, n)-rcp(1)*vnuc(1, 1, n+1)
                  verf(2, 1, n) = rap(1)*verf(1, 1, n)+rpw(1)*verf(1, 1, n+1)
                  vnuc(3, 1, n) = rap(2)*vnuc(1, 1, n)-rcp(2)*vnuc(1, 1, n+1)
                  verf(3, 1, n) = rap(2)*verf(1, 1, n)+rpw(2)*verf(1, 1, n+1)
                  vnuc(4, 1, n) = rap(3)*vnuc(1, 1, n)-rcp(3)*vnuc(1, 1, n+1)
                  verf(4, 1, n) = rap(3)*verf(1, 1, n)+rpw(3)*verf(1, 1, n+1)
               END DO

!         *** [a|A(0)|s]{n} = (Pi - Ai)*[a-1i|A(0)|s]{n} -       ***
!         ***                 (Pi - Ci)*[a-1i|A(0)|s]{n+1} +     ***
!         ***                 f2*Ni(a-1i)*([a-2i|A(0)|s]{n} -    ***
!         ***                              [a-2i|A(0)|s]{n+1}    ***
!         *** [as||s]{n}    = (Pi - Ai)*[(a-1i)s||s]{n} +        ***
!         ***                 (Wi - Pi)*[(a-1i)s||s]{n+1} +      ***
!         ***                 f2*Ni(a-1i)*(   [(a-2i)s||s]{n} +  ***
!         ***                              f4*[(a-2i)s||s]{n+1}) ***

               DO la = 2, la_max

                  DO n = 1, nmax-la

!             *** Increase the angular momentum component z of function a ***

                     vnuc(coset(0, 0, la), 1, n) = &
                        rap(3)*vnuc(coset(0, 0, la-1), 1, n)- &
                        rcp(3)*vnuc(coset(0, 0, la-1), 1, n+1)+ &
                        f2*REAL(la-1, dp)*(vnuc(coset(0, 0, la-2), 1, n)- &
                                           vnuc(coset(0, 0, la-2), 1, n+1))
                     verf(coset(0, 0, la), 1, n) = &
                        rap(3)*verf(coset(0, 0, la-1), 1, n)+ &
                        rpw(3)*verf(coset(0, 0, la-1), 1, n+1)+ &
                        f2*REAL(la-1, dp)*(verf(coset(0, 0, la-2), 1, n)+ &
                                           f4*verf(coset(0, 0, la-2), 1, n+1))

!             *** Increase the angular momentum component y of function a ***

                     az = la-1
                     vnuc(coset(0, 1, az), 1, n) = &
                        rap(2)*vnuc(coset(0, 0, az), 1, n)- &
                        rcp(2)*vnuc(coset(0, 0, az), 1, n+1)
                     verf(coset(0, 1, az), 1, n) = &
                        rap(2)*verf(coset(0, 0, az), 1, n)+ &
                        rpw(2)*verf(coset(0, 0, az), 1, n+1)

                     DO ay = 2, la
                        az = la-ay
                        vnuc(coset(0, ay, az), 1, n) = &
                           rap(2)*vnuc(coset(0, ay-1, az), 1, n)- &
                           rcp(2)*vnuc(coset(0, ay-1, az), 1, n+1)+ &
                           f2*REAL(ay-1, dp)*(vnuc(coset(0, ay-2, az), 1, n)- &
                                              vnuc(coset(0, ay-2, az), 1, n+1))
                        verf(coset(0, ay, az), 1, n) = &
                           rap(2)*verf(coset(0, ay-1, az), 1, n)+ &
                           rpw(2)*verf(coset(0, ay-1, az), 1, n+1)+ &
                           f2*REAL(ay-1, dp)*(verf(coset(0, ay-2, az), 1, n)+ &
                                              f4*verf(coset(0, ay-2, az), 1, n+1))
                     END DO

!             *** Increase the angular momentum component x of function a ***

                     DO ay = 0, la-1
                        az = la-1-ay
                        vnuc(coset(1, ay, az), 1, n) = &
                           rap(1)*vnuc(coset(0, ay, az), 1, n)- &
                           rcp(1)*vnuc(coset(0, ay, az), 1, n+1)
                        verf(coset(1, ay, az), 1, n) = &
                           rap(1)*verf(coset(0, ay, az), 1, n)+ &
                           rpw(1)*verf(coset(0, ay, az), 1, n+1)
                     END DO

                     DO ax = 2, la
                        f3 = f2*REAL(ax-1, dp)
                        DO ay = 0, la-ax
                           az = la-ax-ay
                           vnuc(coset(ax, ay, az), 1, n) = &
                              rap(1)*vnuc(coset(ax-1, ay, az), 1, n)- &
                              rcp(1)*vnuc(coset(ax-1, ay, az), 1, n+1)+ &
                              f3*(vnuc(coset(ax-2, ay, az), 1, n)- &
                                  vnuc(coset(ax-2, ay, az), 1, n+1))
                           verf(coset(ax, ay, az), 1, n) = &
                              rap(1)*verf(coset(ax-1, ay, az), 1, n)+ &
                              rpw(1)*verf(coset(ax-1, ay, az), 1, n+1)+ &
                              f3*(verf(coset(ax-2, ay, az), 1, n)+ &
                                  f4*verf(coset(ax-2, ay, az), 1, n+1))
                        END DO
                     END DO

                  END DO

               END DO

!         *** Recurrence steps: [a|A(0)|s] -> [a|A(0)|b] ***
!         ***                   [as||s]    -> [ab||s]    ***

               IF (lb_max > 0) THEN

!           *** Horizontal recurrence steps ***

                  rbp(:) = rap(:)-rab(:)

!           *** [a||A(0)|p]{n} = [a+1i|A(0)|s]{n} - (Bi - Ai)*[a|A(0)|s]{n} ***
!           *** [ap||s]{n}     = [(a+1i)s||s]{n}  - (Bi - Ai)*[as||s]{n}    ***

                  la_start = MAX(0, la_min-1)

                  DO la = la_start, la_max-1
                     DO n = 1, nmax-la-1
                        DO ax = 0, la
                           DO ay = 0, la-ax
                              az = la-ax-ay
                              vnuc(coset(ax, ay, az), 2, n) = &
                                 vnuc(coset(ax+1, ay, az), 1, n)- &
                                 rab(1)*vnuc(coset(ax, ay, az), 1, n)
                              verf(coset(ax, ay, az), 2, n) = &
                                 verf(coset(ax+1, ay, az), 1, n)- &
                                 rab(1)*verf(coset(ax, ay, az), 1, n)
                              vnuc(coset(ax, ay, az), 3, n) = &
                                 vnuc(coset(ax, ay+1, az), 1, n)- &
                                 rab(2)*vnuc(coset(ax, ay, az), 1, n)
                              verf(coset(ax, ay, az), 3, n) = &
                                 verf(coset(ax, ay+1, az), 1, n)- &
                                 rab(2)*verf(coset(ax, ay, az), 1, n)
                              vnuc(coset(ax, ay, az), 4, n) = &
                                 vnuc(coset(ax, ay, az+1), 1, n)- &
                                 rab(3)*vnuc(coset(ax, ay, az), 1, n)
                              verf(coset(ax, ay, az), 4, n) = &
                                 verf(coset(ax, ay, az+1), 1, n)- &
                                 rab(3)*verf(coset(ax, ay, az), 1, n)
                           END DO
                        END DO
                     END DO
                  END DO

!           *** Vertical recurrence step ***

!           *** [a|A(0)|p]{n} = (Pi - Bi)*[a|A(0)|s]{n} -        ***
!           ***                 (Pi - Ci)*[a|A(0)|s]{n+1} +      ***
!           ***                 f2*Ni(a)*([a-1i|A(0)|s]{n} -     ***
!           ***                           [a-1i|A(0)|s]{n+1})    ***
!           *** [ap||s]{n}    = (Pi - Bi)*[as||s]{n} +           ***
!           ***                 (Wi - Pi)*[as||s]{n+1} +         ***
!           ***                  f2*Ni(a)*(   [(a-1i)s||s]{n} +  ***
!           ***                            f4*[(a-1i)s||s]{n+1}) ***

                  DO n = 1, nmax-la_max-1
                     DO ax = 0, la_max
                        fx = f2*REAL(ax, dp)
                        DO ay = 0, la_max-ax
                           fy = f2*REAL(ay, dp)
                           az = la_max-ax-ay
                           fz = f2*REAL(az, dp)

                           IF (ax == 0) THEN
                              vnuc(coset(ax, ay, az), 2, n) = &
                                 rbp(1)*vnuc(coset(ax, ay, az), 1, n)- &
                                 rcp(1)*vnuc(coset(ax, ay, az), 1, n+1)
                              verf(coset(ax, ay, az), 2, n) = &
                                 rbp(1)*verf(coset(ax, ay, az), 1, n)+ &
                                 rpw(1)*verf(coset(ax, ay, az), 1, n+1)
                           ELSE
                              vnuc(coset(ax, ay, az), 2, n) = &
                                 rbp(1)*vnuc(coset(ax, ay, az), 1, n)- &
                                 rcp(1)*vnuc(coset(ax, ay, az), 1, n+1)+ &
                                 fx*(vnuc(coset(ax-1, ay, az), 1, n)- &
                                     vnuc(coset(ax-1, ay, az), 1, n+1))
                              verf(coset(ax, ay, az), 2, n) = &
                                 rbp(1)*verf(coset(ax, ay, az), 1, n)+ &
                                 rpw(1)*verf(coset(ax, ay, az), 1, n+1)+ &
                                 fx*(verf(coset(ax-1, ay, az), 1, n)+ &
                                     f4*verf(coset(ax-1, ay, az), 1, n+1))
                           END IF

                           IF (ay == 0) THEN
                              vnuc(coset(ax, ay, az), 3, n) = &
                                 rbp(2)*vnuc(coset(ax, ay, az), 1, n)- &
                                 rcp(2)*vnuc(coset(ax, ay, az), 1, n+1)
                              verf(coset(ax, ay, az), 3, n) = &
                                 rbp(2)*verf(coset(ax, ay, az), 1, n)+ &
                                 rpw(2)*verf(coset(ax, ay, az), 1, n+1)
                           ELSE
                              vnuc(coset(ax, ay, az), 3, n) = &
                                 rbp(2)*vnuc(coset(ax, ay, az), 1, n)- &
                                 rcp(2)*vnuc(coset(ax, ay, az), 1, n+1)+ &
                                 fy*(vnuc(coset(ax, ay-1, az), 1, n)- &
                                     vnuc(coset(ax, ay-1, az), 1, n+1))
                              verf(coset(ax, ay, az), 3, n) = &
                                 rbp(2)*verf(coset(ax, ay, az), 1, n)+ &
                                 rpw(2)*verf(coset(ax, ay, az), 1, n+1)+ &
                                 fy*(verf(coset(ax, ay-1, az), 1, n)+ &
                                     f4*verf(coset(ax, ay-1, az), 1, n+1))
                           END IF

                           IF (az == 0) THEN
                              vnuc(coset(ax, ay, az), 4, n) = &
                                 rbp(3)*vnuc(coset(ax, ay, az), 1, n)- &
                                 rcp(3)*vnuc(coset(ax, ay, az), 1, n+1)
                              verf(coset(ax, ay, az), 4, n) = &
                                 rbp(3)*verf(coset(ax, ay, az), 1, n)+ &
                                 rpw(3)*verf(coset(ax, ay, az), 1, n+1)
                           ELSE
                              vnuc(coset(ax, ay, az), 4, n) = &
                                 rbp(3)*vnuc(coset(ax, ay, az), 1, n)- &
                                 rcp(3)*vnuc(coset(ax, ay, az), 1, n+1)+ &
                                 fz*(vnuc(coset(ax, ay, az-1), 1, n)- &
                                     vnuc(coset(ax, ay, az-1), 1, n+1))
                              verf(coset(ax, ay, az), 4, n) = &
                                 rbp(3)*verf(coset(ax, ay, az), 1, n)+ &
                                 rpw(3)*verf(coset(ax, ay, az), 1, n+1)+ &
                                 fz*(verf(coset(ax, ay, az-1), 1, n)+ &
                                     f4*verf(coset(ax, ay, az-1), 1, n+1))
                           END IF

                        END DO
                     END DO
                  END DO

!           *** Recurrence steps: [a|A(0)|p] -> [a|A(0)|b] ***
!           ***                   [ap||s]    -> [ab||s]    ***

                  DO lb = 2, lb_max

!             *** Horizontal recurrence steps ***

!             *** [a||A(0)|b]{n} = [a+1i|A(0)|b-1i]{n} -      ***
!             ***                  (Bi - Ai)*[a|A(0)|b-1i]{n} ***
!             *** [ab||s]{n}     = [(a+1i)(b-1i)||s]{n} -     ***
!             ***                  (Bi - Ai)*[a(b-1i)||s]{n}  ***

                     la_start = MAX(0, la_min-1)

                     DO la = la_start, la_max-1
                        DO n = 1, nmax-la-lb
                           DO ax = 0, la
                              DO ay = 0, la-ax
                                 az = la-ax-ay

!                     *** Shift of angular momentum component z from a to b ***

                                 vnuc(coset(ax, ay, az), coset(0, 0, lb), n) = &
                                    vnuc(coset(ax, ay, az+1), coset(0, 0, lb-1), n)- &
                                    rab(3)*vnuc(coset(ax, ay, az), coset(0, 0, lb-1), n)
                                 verf(coset(ax, ay, az), coset(0, 0, lb), n) = &
                                    verf(coset(ax, ay, az+1), coset(0, 0, lb-1), n)- &
                                    rab(3)*verf(coset(ax, ay, az), coset(0, 0, lb-1), n)

!                     *** Shift of angular momentum component y from a to b ***

                                 DO by = 1, lb
                                    bz = lb-by
                                    vnuc(coset(ax, ay, az), coset(0, by, bz), n) = &
                                       vnuc(coset(ax, ay+1, az), coset(0, by-1, bz), n)- &
                                       rab(2)*vnuc(coset(ax, ay, az), coset(0, by-1, bz), n)
                                    verf(coset(ax, ay, az), coset(0, by, bz), n) = &
                                       verf(coset(ax, ay+1, az), coset(0, by-1, bz), n)- &
                                       rab(2)*verf(coset(ax, ay, az), coset(0, by-1, bz), n)
                                 END DO

!                     *** Shift of angular momentum component x from a to b ***

                                 DO bx = 1, lb
                                    DO by = 0, lb-bx
                                       bz = lb-bx-by
                                       vnuc(coset(ax, ay, az), coset(bx, by, bz), n) = &
                                          vnuc(coset(ax+1, ay, az), coset(bx-1, by, bz), n)- &
                                          rab(1)*vnuc(coset(ax, ay, az), coset(bx-1, by, bz), n)
                                       verf(coset(ax, ay, az), coset(bx, by, bz), n) = &
                                          verf(coset(ax+1, ay, az), coset(bx-1, by, bz), n)- &
                                          rab(1)*verf(coset(ax, ay, az), coset(bx-1, by, bz), n)
                                    END DO
                                 END DO

                              END DO
                           END DO
                        END DO
                     END DO

!             *** Vertical recurrence step ***

!             *** [a|A(0)|b]{n} = (Pi - Bi)*[a|A(0)|b-1i]{n} -         ***
!             ***                 (Pi - Ci)*[a|A(0)|b-1i]{n+1} +       ***
!             ***                 f2*Ni(a)*([a-1i|A(0)|b-1i]{n} -      ***
!             ***                           [a-1i|A(0)|b-1i]{n+1}) +   ***
!             ***                 f2*Ni(b-1i)*([a|A(0)|b-2i]{n} -      ***
!             ***                              [a|A(0)|b-2i]{n+1})     ***
!             *** [ab||s]{n}    = (Pi - Bi)*[a(b-1i)||s]{n} +          ***
!             ***                 (Wi - Pi)*[a(b-1i)||s]{n+1} +        ***
!             ***                 f2*Ni(a)*(   [(a-1i)(b-1i)||s]{n} +  ***
!             ***                           f4*[(a-1i)(b-1i)||s]{n+1}) ***
!             ***                 f2*Ni(b-1i)*(   [a(b-2i)||s]{n} +    ***
!             ***                              f4*[a(b-2i)||s]{n+1})   ***

                     DO n = 1, nmax-la_max-lb
                        DO ax = 0, la_max
                           fx = f2*REAL(ax, dp)
                           DO ay = 0, la_max-ax
                              fy = f2*REAL(ay, dp)
                              az = la_max-ax-ay
                              fz = f2*REAL(az, dp)

!                   *** Shift of angular momentum component z from a to b ***

                              f3 = f2*REAL(lb-1, dp)

                              IF (az == 0) THEN
                                 vnuc(coset(ax, ay, az), coset(0, 0, lb), n) = &
                                    rbp(3)*vnuc(coset(ax, ay, az), coset(0, 0, lb-1), n)- &
                                    rcp(3)*vnuc(coset(ax, ay, az), coset(0, 0, lb-1), n+1)+ &
                                    f3*(vnuc(coset(ax, ay, az), coset(0, 0, lb-2), n)- &
                                        vnuc(coset(ax, ay, az), coset(0, 0, lb-2), n+1))
                                 verf(coset(ax, ay, az), coset(0, 0, lb), n) = &
                                    rbp(3)*verf(coset(ax, ay, az), coset(0, 0, lb-1), n)+ &
                                    rpw(3)*verf(coset(ax, ay, az), coset(0, 0, lb-1), n+1)+ &
                                    f3*(verf(coset(ax, ay, az), coset(0, 0, lb-2), n)+ &
                                        f4*verf(coset(ax, ay, az), coset(0, 0, lb-2), n+1))
                              ELSE
                                 vnuc(coset(ax, ay, az), coset(0, 0, lb), n) = &
                                    rbp(3)*vnuc(coset(ax, ay, az), coset(0, 0, lb-1), n)- &
                                    rcp(3)*vnuc(coset(ax, ay, az), coset(0, 0, lb-1), n+1)+ &
                                    fz*(vnuc(coset(ax, ay, az-1), coset(0, 0, lb-1), n)- &
                                        vnuc(coset(ax, ay, az-1), coset(0, 0, lb-1), n+1))+ &
                                    f3*(vnuc(coset(ax, ay, az), coset(0, 0, lb-2), n)- &
                                        vnuc(coset(ax, ay, az), coset(0, 0, lb-2), n+1))
                                 verf(coset(ax, ay, az), coset(0, 0, lb), n) = &
                                    rbp(3)*verf(coset(ax, ay, az), coset(0, 0, lb-1), n)+ &
                                    rpw(3)*verf(coset(ax, ay, az), coset(0, 0, lb-1), n+1)+ &
                                    fz*(verf(coset(ax, ay, az-1), coset(0, 0, lb-1), n)+ &
                                        f4*verf(coset(ax, ay, az-1), coset(0, 0, lb-1), n+1))+ &
                                    f3*(verf(coset(ax, ay, az), coset(0, 0, lb-2), n)+ &
                                        f4*verf(coset(ax, ay, az), coset(0, 0, lb-2), n+1))
                              END IF

!                   *** Shift of angular momentum component y from a to b ***

                              IF (ay == 0) THEN
                                 bz = lb-1
                                 vnuc(coset(ax, ay, az), coset(0, 1, bz), n) = &
                                    rbp(2)*vnuc(coset(ax, ay, az), coset(0, 0, bz), n)- &
                                    rcp(2)*vnuc(coset(ax, ay, az), coset(0, 0, bz), n+1)
                                 verf(coset(ax, ay, az), coset(0, 1, bz), n) = &
                                    rbp(2)*verf(coset(ax, ay, az), coset(0, 0, bz), n)+ &
                                    rpw(2)*verf(coset(ax, ay, az), coset(0, 0, bz), n+1)
                                 DO by = 2, lb
                                    bz = lb-by
                                    f3 = f2*REAL(by-1, dp)
                                    vnuc(coset(ax, ay, az), coset(0, by, bz), n) = &
                                       rbp(2)*vnuc(coset(ax, ay, az), coset(0, by-1, bz), n)- &
                                       rcp(2)*vnuc(coset(ax, ay, az), coset(0, by-1, bz), n+1)+ &
                                       f3*(vnuc(coset(ax, ay, az), coset(0, by-2, bz), n)- &
                                           vnuc(coset(ax, ay, az), coset(0, by-2, bz), n+1))
                                    verf(coset(ax, ay, az), coset(0, by, bz), n) = &
                                       rbp(2)*verf(coset(ax, ay, az), coset(0, by-1, bz), n)+ &
                                       rpw(2)*verf(coset(ax, ay, az), coset(0, by-1, bz), n+1)+ &
                                       f3*(verf(coset(ax, ay, az), coset(0, by-2, bz), n)+ &
                                           f4*verf(coset(ax, ay, az), coset(0, by-2, bz), n+1))
                                 END DO
                              ELSE
                                 bz = lb-1
                                 vnuc(coset(ax, ay, az), coset(0, 1, bz), n) = &
                                    rbp(2)*vnuc(coset(ax, ay, az), coset(0, 0, bz), n)- &
                                    rcp(2)*vnuc(coset(ax, ay, az), coset(0, 0, bz), n+1)+ &
                                    fy*(vnuc(coset(ax, ay-1, az), coset(0, 0, bz), n)- &
                                        vnuc(coset(ax, ay-1, az), coset(0, 0, bz), n+1))
                                 verf(coset(ax, ay, az), coset(0, 1, bz), n) = &
                                    rbp(2)*verf(coset(ax, ay, az), coset(0, 0, bz), n)+ &
                                    rpw(2)*verf(coset(ax, ay, az), coset(0, 0, bz), n+1)+ &
                                    fy*(verf(coset(ax, ay-1, az), coset(0, 0, bz), n)+ &
                                        f4*verf(coset(ax, ay-1, az), coset(0, 0, bz), n+1))
                                 DO by = 2, lb
                                    bz = lb-by
                                    f3 = f2*REAL(by-1, dp)
                                    vnuc(coset(ax, ay, az), coset(0, by, bz), n) = &
                                       rbp(2)*vnuc(coset(ax, ay, az), coset(0, by-1, bz), n)- &
                                       rcp(2)*vnuc(coset(ax, ay, az), coset(0, by-1, bz), n+1)+ &
                                       fy*(vnuc(coset(ax, ay-1, az), coset(0, by-1, bz), n)- &
                                           vnuc(coset(ax, ay-1, az), coset(0, by-1, bz), n+1))+ &
                                       f3*(vnuc(coset(ax, ay, az), coset(0, by-2, bz), n)- &
                                           vnuc(coset(ax, ay, az), coset(0, by-2, bz), n+1))
                                    verf(coset(ax, ay, az), coset(0, by, bz), n) = &
                                       rbp(2)*verf(coset(ax, ay, az), coset(0, by-1, bz), n)+ &
                                       rpw(2)*verf(coset(ax, ay, az), coset(0, by-1, bz), n+1)+ &
                                       fy*(verf(coset(ax, ay-1, az), coset(0, by-1, bz), n)+ &
                                           f4*verf(coset(ax, ay-1, az), &
                                                   coset(0, by-1, bz), n+1))+ &
                                       f3*(verf(coset(ax, ay, az), coset(0, by-2, bz), n)+ &
                                           f4*verf(coset(ax, ay, az), coset(0, by-2, bz), n+1))
                                 END DO
                              END IF

!                   *** Shift of angular momentum component x from a to b ***

                              IF (ax == 0) THEN
                                 DO by = 0, lb-1
                                    bz = lb-1-by
                                    vnuc(coset(ax, ay, az), coset(1, by, bz), n) = &
                                       rbp(1)*vnuc(coset(ax, ay, az), coset(0, by, bz), n)- &
                                       rcp(1)*vnuc(coset(ax, ay, az), coset(0, by, bz), n+1)
                                    verf(coset(ax, ay, az), coset(1, by, bz), n) = &
                                       rbp(1)*verf(coset(ax, ay, az), coset(0, by, bz), n)+ &
                                       rpw(1)*verf(coset(ax, ay, az), coset(0, by, bz), n+1)
                                 END DO
                                 DO bx = 2, lb
                                    f3 = f2*REAL(bx-1, dp)
                                    DO by = 0, lb-bx
                                       bz = lb-bx-by
                                       vnuc(coset(ax, ay, az), coset(bx, by, bz), n) = &
                                          rbp(1)*vnuc(coset(ax, ay, az), coset(bx-1, by, bz), n)- &
                                          rcp(1)*vnuc(coset(ax, ay, az), &
                                                      coset(bx-1, by, bz), n+1)+ &
                                          f3*(vnuc(coset(ax, ay, az), coset(bx-2, by, bz), n)- &
                                              vnuc(coset(ax, ay, az), coset(bx-2, by, bz), n+1))
                                       verf(coset(ax, ay, az), coset(bx, by, bz), n) = &
                                          rbp(1)*verf(coset(ax, ay, az), coset(bx-1, by, bz), n)+ &
                                          rpw(1)*verf(coset(ax, ay, az), &
                                                      coset(bx-1, by, bz), n+1)+ &
                                          f3*(verf(coset(ax, ay, az), coset(bx-2, by, bz), n)+ &
                                              f4*verf(coset(ax, ay, az), coset(bx-2, by, bz), n+1))
                                    END DO
                                 END DO
                              ELSE
                                 DO by = 0, lb-1
                                    bz = lb-1-by
                                    vnuc(coset(ax, ay, az), coset(1, by, bz), n) = &
                                       rbp(1)*vnuc(coset(ax, ay, az), coset(0, by, bz), n)- &
                                       rcp(1)*vnuc(coset(ax, ay, az), coset(0, by, bz), n+1)+ &
                                       fx*(vnuc(coset(ax-1, ay, az), coset(0, by, bz), n)- &
                                           vnuc(coset(ax-1, ay, az), coset(0, by, bz), n+1))
                                    verf(coset(ax, ay, az), coset(1, by, bz), n) = &
                                       rbp(1)*verf(coset(ax, ay, az), coset(0, by, bz), n)+ &
                                       rpw(1)*verf(coset(ax, ay, az), coset(0, by, bz), n+1)+ &
                                       fx*(verf(coset(ax-1, ay, az), coset(0, by, bz), n)+ &
                                           f4*verf(coset(ax-1, ay, az), coset(0, by, bz), n+1))
                                 END DO
                                 DO bx = 2, lb
                                    f3 = f2*REAL(bx-1, dp)
                                    DO by = 0, lb-bx
                                       bz = lb-bx-by
                                       vnuc(coset(ax, ay, az), coset(bx, by, bz), n) = &
                                          rbp(1)*vnuc(coset(ax, ay, az), coset(bx-1, by, bz), n)- &
                                          rcp(1)*vnuc(coset(ax, ay, az), &
                                                      coset(bx-1, by, bz), n+1)+ &
                                          fx*(vnuc(coset(ax-1, ay, az), coset(bx-1, by, bz), n)- &
                                              vnuc(coset(ax-1, ay, az), &
                                                   coset(bx-1, by, bz), n+1))+ &
                                          f3*(vnuc(coset(ax, ay, az), coset(bx-2, by, bz), n)- &
                                              vnuc(coset(ax, ay, az), coset(bx-2, by, bz), n+1))
                                       verf(coset(ax, ay, az), coset(bx, by, bz), n) = &
                                          rbp(1)*verf(coset(ax, ay, az), coset(bx-1, by, bz), n)+ &
                                          rpw(1)*verf(coset(ax, ay, az), &
                                                      coset(bx-1, by, bz), n+1)+ &
                                          fx*(verf(coset(ax-1, ay, az), &
                                                   coset(bx-1, by, bz), n)+ &
                                              f4*verf(coset(ax-1, ay, az), &
                                                      coset(bx-1, by, bz), n+1))+ &
                                          f3*(verf(coset(ax, ay, az), coset(bx-2, by, bz), n)+ &
                                              f4*verf(coset(ax, ay, az), coset(bx-2, by, bz), n+1))
                                    END DO
                                 END DO
                              END IF

                           END DO
                        END DO
                     END DO

                  END DO

               END IF

            ELSE

               IF (lb_max > 0) THEN

!           *** Vertical recurrence steps: [s|A(0)|s] -> [s|A(0)|b] ***
!           ***                            [ss||s]    -> [sb||s]    ***

                  rbp(:) = rap(:)-rab(:)

!           *** [s|A(0)|p]{n} = (Pi - Bi)*[s|A(0)|s]{n} - ***
!           ***                 (Pi - Ci)*[s|A(0)|s]{n+1} ***
!           *** [sp||s]{n}    = (Pi - Bi)*[ss||s]{n} +    ***
!           ***                 (Wi - Pi)*[ss||s]{n+1}    ***

                  DO n = 1, nmax-1
                     vnuc(1, 2, n) = rbp(1)*vnuc(1, 1, n)-rcp(1)*vnuc(1, 1, n+1)
                     verf(1, 2, n) = rbp(1)*verf(1, 1, n)+rpw(1)*verf(1, 1, n+1)
                     vnuc(1, 3, n) = rbp(2)*vnuc(1, 1, n)-rcp(2)*vnuc(1, 1, n+1)
                     verf(1, 3, n) = rbp(2)*verf(1, 1, n)+rpw(2)*verf(1, 1, n+1)
                     vnuc(1, 4, n) = rbp(3)*vnuc(1, 1, n)-rcp(3)*vnuc(1, 1, n+1)
                     verf(1, 4, n) = rbp(3)*verf(1, 1, n)+rpw(3)*verf(1, 1, n+1)
                  END DO

!           *** [s|A(0)|b]{n} = (Pi - Bi)*[s|A(0)|b-1i]{n} -       ***
!           ***                 (Pi - Ci)*[s|A(0)|b-1i]{n+1} +     ***
!           ***                 f2*Ni(b-1i)*([s|A(0)|b-2i]{n} -    ***
!           ***                              [s|A(0)|b-2i]{n+1}    ***
!           *** [sb||s]{n}    = (Pi - Bi)*[s(b-1i)||s]{n} +        ***
!           ***                 (Wi - Pi)*[s(b-1i)||s]{n+1} +      ***
!           ***                 f2*Ni(b-1i)*(   [s(b-2i)||s]{n} +  ***
!           ***                              f4*[s(b-2i)||s]{n+1}) ***

                  DO lb = 2, lb_max

                     DO n = 1, nmax-lb

!               *** Increase the angular momentum component z of function b ***

                        vnuc(1, coset(0, 0, lb), n) = &
                           rbp(3)*vnuc(1, coset(0, 0, lb-1), n)- &
                           rcp(3)*vnuc(1, coset(0, 0, lb-1), n+1)+ &
                           f2*REAL(lb-1, dp)*(vnuc(1, coset(0, 0, lb-2), n)- &
                                              vnuc(1, coset(0, 0, lb-2), n+1))
                        verf(1, coset(0, 0, lb), n) = &
                           rbp(3)*verf(1, coset(0, 0, lb-1), n)+ &
                           rpw(3)*verf(1, coset(0, 0, lb-1), n+1)+ &
                           f2*REAL(lb-1, dp)*(verf(1, coset(0, 0, lb-2), n)+ &
                                              f4*verf(1, coset(0, 0, lb-2), n+1))

!               *** Increase the angular momentum component y of function b ***

                        bz = lb-1
                        vnuc(1, coset(0, 1, bz), n) = &
                           rbp(2)*vnuc(1, coset(0, 0, bz), n)- &
                           rcp(2)*vnuc(1, coset(0, 0, bz), n+1)
                        verf(1, coset(0, 1, bz), n) = &
                           rbp(2)*verf(1, coset(0, 0, bz), n)+ &
                           rpw(2)*verf(1, coset(0, 0, bz), n+1)

                        DO by = 2, lb
                           bz = lb-by
                           vnuc(1, coset(0, by, bz), n) = &
                              rbp(2)*vnuc(1, coset(0, by-1, bz), n)- &
                              rcp(2)*vnuc(1, coset(0, by-1, bz), n+1)+ &
                              f2*REAL(by-1, dp)*(vnuc(1, coset(0, by-2, bz), n)- &
                                                 vnuc(1, coset(0, by-2, bz), n+1))
                           verf(1, coset(0, by, bz), n) = &
                              rbp(2)*verf(1, coset(0, by-1, bz), n)+ &
                              rpw(2)*verf(1, coset(0, by-1, bz), n+1)+ &
                              f2*REAL(by-1, dp)*(verf(1, coset(0, by-2, bz), n)+ &
                                                 f4*verf(1, coset(0, by-2, bz), n+1))
                        END DO

!               *** Increase the angular momentum component x of function b ***

                        DO by = 0, lb-1
                           bz = lb-1-by
                           vnuc(1, coset(1, by, bz), n) = &
                              rbp(1)*vnuc(1, coset(0, by, bz), n)- &
                              rcp(1)*vnuc(1, coset(0, by, bz), n+1)
                           verf(1, coset(1, by, bz), n) = &
                              rbp(1)*verf(1, coset(0, by, bz), n)+ &
                              rpw(1)*verf(1, coset(0, by, bz), n+1)
                        END DO

                        DO bx = 2, lb
                           f3 = f2*REAL(bx-1, dp)
                           DO by = 0, lb-bx
                              bz = lb-bx-by
                              vnuc(1, coset(bx, by, bz), n) = &
                                 rbp(1)*vnuc(1, coset(bx-1, by, bz), n)- &
                                 rcp(1)*vnuc(1, coset(bx-1, by, bz), n+1)+ &
                                 f3*(vnuc(1, coset(bx-2, by, bz), n)- &
                                     vnuc(1, coset(bx-2, by, bz), n+1))
                              verf(1, coset(bx, by, bz), n) = &
                                 rbp(1)*verf(1, coset(bx-1, by, bz), n)+ &
                                 rpw(1)*verf(1, coset(bx-1, by, bz), n+1)+ &
                                 f3*(verf(1, coset(bx-2, by, bz), n)+ &
                                     f4*verf(1, coset(bx-2, by, bz), n+1))
                           END DO
                        END DO

                     END DO

                  END DO

               END IF

            END IF

!       *** Add the contribution of the current pair ***
!       *** of primitive Gaussian-type functions     ***

!JT
            IF (do_dkh) THEN
               DO j = 1, ncoset(lb_max1)
                  DO i = ncoset(la_min1-1)+1, ncoset(la_max1-maxder_local)
                     vnabc(na+i, nb+j) = vnabc(na+i, nb+j)+cerf*verf(i, j, 1)
                  END DO
               END DO
               DO j = 1, ncoset(lb_max1)
                  DO i = ncoset(la_min1-1)+1, ncoset(la_max1-maxder_local)
                     vabc(na+i, nb+j) = vabc(na+i, nb+j)-zc*vnuc(i, j, 1)
                  END DO
               END DO
            ELSE
               DO j = 1, ncoset(lb_max1) !JT
                  DO i = ncoset(la_min1-1)+1, ncoset(la_max1-maxder_local) !JT
                     vabc(na+i, nb+j) = vabc(na+i, nb+j)- &
                                        zc*vnuc(i, j, 1)+cerf*verf(i, j, 1)
                  END DO
               END DO
            END IF
!JT

            IF (PRESENT(maxder)) THEN
               DO j = 1, ncoset(lb_max1) !JT
                  DO i = 1, ncoset(la_max1) !JT
                     vabc_plus(nap+i, nb+j) = vabc_plus(nap+i, nb+j)- &
                                              zc*vnuc(i, j, 1)+cerf*verf(i, j, 1)
                  END DO
               END DO
            END IF
!JTs
            IF (do_dkh) THEN
               ! *********** Calculate pVp matrix **************
               ! [pa|V|pb]=4*zeta*zetb*[a+i|V|b+i]-2*zetb*Ni(a)*[a-i|V|b+i]-2*zeta*Ni(b)*[a+i|V|b-i]+Ni(a)*Ni(b)*[a-i|V|b-i]
               ! Every integral has been calculated before (except [-1|V|-1],[a|V|-1] and [-1|V|b],
               ! which do not contribute, because their prefactor Ni(a) or Ni(b) is zero)
               ! and is given by verf/vnuc(coset(ax,ay,az),coset(bx,by,bz),1)
               ! ***********************************************
               ftaz = 2.0_dp*zeta(ipgf)
               ftbz = 2.0_dp*zetb(jpgf)
               nxx = 1
               nyy = 2
               nzz = 3
               nxy = 4
               nxz = 5
               nyx = 6
               nyz = 7
               nzx = 8
               nzy = 9
               DO la = 0, la_max1
                  DO ax = 0, la
                     fax = REAL(ax, dp)
                     DO ay = 0, la-ax
                        fay = REAL(ay, dp)
                        az = la-ax-ay
                        faz = REAL(az, dp)
                        pVpa = coset(ax, ay, az)
                        coamx = coset(ax-1, ay, az)
                        coamy = coset(ax, ay-1, az)
                        coamz = coset(ax, ay, az-1)
                        coapx = coset(ax+1, ay, az)
                        coapy = coset(ax, ay+1, az)
                        coapz = coset(ax, ay, az+1)
                        DO lb = 0, lb_max1
                           DO bx = 0, lb
                              fbx = REAL(bx, dp)
                              DO by = 0, lb-bx
                                 fby = REAL(by, dp)
                                 bz = lb-bx-by
                                 fbz = REAL(bz, dp)
                                 pVpb = coset(bx, by, bz)
                                 cobmx = coset(bx-1, by, bz)
                                 cobmy = coset(bx, by-1, bz)
                                 cobmz = coset(bx, by, bz-1)
                                 cobpx = coset(bx+1, by, bz)
                                 cobpy = coset(bx, by+1, bz)
                                 cobpz = coset(bx, by, bz+1)
                                 IF (dkh_erfc) THEN
                                    pVp(pVpa, pVpb) = ftaz*ftbz*(-zc*vnuc(coapx, cobpx, 1)+cerf*verf(coapx, cobpx, 1))- &
                                                      ftaz*fbx*(-zc*vnuc(coapx, cobmx, 1)+cerf*verf(coapx, cobmx, 1))- &
                                                      ftbz*fax*(-zc*vnuc(coamx, cobpx, 1)+cerf*verf(coamx, cobpx, 1))+ &
                                                      fax*fbx*(-zc*vnuc(coamx, cobmx, 1)+cerf*verf(coamx, cobmx, 1))+ &
                                                      ftaz*ftbz*(-zc*vnuc(coapy, cobpy, 1)+cerf*verf(coapy, cobpy, 1))- &
                                                      ftaz*fby*(-zc*vnuc(coapy, cobmy, 1)+cerf*verf(coapy, cobmy, 1))- &
                                                      ftbz*fay*(-zc*vnuc(coamy, cobpy, 1)+cerf*verf(coamy, cobpy, 1))+ &
                                                      fay*fby*(-zc*vnuc(coamy, cobmy, 1)+cerf*verf(coamy, cobmy, 1))+ &
                                                      ftaz*ftbz*(-zc*vnuc(coapz, cobpz, 1)+cerf*verf(coapz, cobpz, 1))- &
                                                      ftaz*fbz*(-zc*vnuc(coapz, cobmz, 1)+cerf*verf(coapz, cobmz, 1))- &
                                                      ftbz*faz*(-zc*vnuc(coamz, cobpz, 1)+cerf*verf(coamz, cobpz, 1))+ &
                                                      faz*fbz*(-zc*vnuc(coamz, cobmz, 1)+cerf*verf(coamz, cobmz, 1))
                                 ELSE
                                    pVp(pVpa, pVpb) = ftaz*ftbz*(-zc*vnuc(coapx, cobpx, 1))- &
                                                      ftaz*fbx*(-zc*vnuc(coapx, cobmx, 1))- &
                                                      ftbz*fax*(-zc*vnuc(coamx, cobpx, 1))+ &
                                                      fax*fbx*(-zc*vnuc(coamx, cobmx, 1))+ &
                                                      ftaz*ftbz*(-zc*vnuc(coapy, cobpy, 1))- &
                                                      ftaz*fby*(-zc*vnuc(coapy, cobmy, 1))- &
                                                      ftbz*fay*(-zc*vnuc(coamy, cobpy, 1))+ &
                                                      fay*fby*(-zc*vnuc(coamy, cobmy, 1))+ &
                                                      ftaz*ftbz*(-zc*vnuc(coapz, cobpz, 1))- &
                                                      ftaz*fbz*(-zc*vnuc(coapz, cobmz, 1))- &
                                                      ftbz*faz*(-zc*vnuc(coamz, cobpz, 1))+ &
                                                      faz*fbz*(-zc*vnuc(coamz, cobmz, 1))
                                 END IF
                              END DO
                           END DO
                        END DO
                     END DO
                  END DO
               END DO

               DO j = 1, ncoset(lb_max1)
                  DO i = ncoset(la_min1-1)+1, ncoset(la_max1-maxder_local)
                     pVp_sum(na+i, nb+j) = pVp_sum(na+i, nb+j)+pVp(i, j)
                  END DO
               END DO
            END IF
!JTe
            nb = nb+ncoset(lb_max1) !JT

         END DO

         na = na+ncoset(la_max1-maxder_local) !JT
         nap = nap+ncoset(la_max1) !JT

      END DO

   END SUBROUTINE verfc

END MODULE ai_verfc
