subroutine LYP_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc)

! Compute LYP correlation potential

  implicit none
  include 'parameters.h'

! Input variables

  integer,intent(in)            :: nGrid
  double precision,intent(in)   :: weight(nGrid)
  integer,intent(in)            :: nBas
  double precision,intent(in)   :: AO(nBas,nGrid)
  double precision,intent(in)   :: dAO(ncart,nBas,nGrid)
  double precision,intent(in)   :: rho(nGrid,nspin)
  double precision,intent(in)   :: drho(ncart,nGrid,nspin)

! Local variables

  integer                       :: mu,nu,iG
  double precision              :: vAO,gaAO,gbAO
  double precision              :: ra,rb,r
  double precision              :: ga,gab,gb,g
  double precision              :: dfdra,dfdrb
  double precision              :: dfdga,dfdgab,dfdgb
  double precision              :: dodra,dodrb,dddra,dddrb

  double precision              :: a,b,c,d
  double precision              :: Cf,omega,delta

! Output variables

  double precision,intent(out)  :: Fc(nBas,nBas,nspin)

! Prameter of the functional

  a = 0.04918d0
  b = 0.132d0
  c = 0.2533d0
  d = 0.349d0

  Cf = 3d0/10d0*(3d0*pi**2)**(2d0/3d0)

! Compute matrix elements in the AO basis

  Fc(:,:,:) = 0d0

  do mu=1,nBas
    do nu=1,nBas
      do iG=1,nGrid

        ra = max(0d0,rho(iG,1))
        rb = max(0d0,rho(iG,2))
        r  = ra + rb
 
        if(r > threshold) then

          ga  = drho(1,iG,1)*drho(1,iG,1) + drho(2,iG,1)*drho(2,iG,1) + drho(3,iG,1)*drho(3,iG,1)
          gb  = drho(1,iG,2)*drho(1,iG,2) + drho(2,iG,2)*drho(2,iG,2) + drho(3,iG,2)*drho(3,iG,2)
          gab = drho(1,iG,1)*drho(1,iG,2) + drho(2,iG,1)*drho(2,iG,2) + drho(3,iG,1)*drho(3,iG,2)
          g   = ga + 2d0*gab + gb

          omega = exp(-c*r**(-1d0/3d0))/(1d0 + d*r**(-1d0/3d0))*r**(-11d0/3d0)
          delta = c*r**(-1d0/3d0) + d*r**(-1d0/3d0)/(1d0 + d*r**(-1d0/3d0))

          vAO = weight(iG)*AO(mu,iG)*AO(nu,iG)

          dodra = (d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0))) + c/(3d0*r**(4d0/3d0)) - 11d0/(3d0*r))*omega
          dodrb = dodra
         
          dddra = - c/3d0*r**(-4d0/3d0)                                 & 
                  + d**2/(3d0*(1d0 + d*r**(-1d0/3d0))**2)*r**(-5d0/3d0) &
                  - d/(3d0*(1d0 + d*r**(-1d0/3d0)))*r**(-4d0/3d0)
          dddrb = dddra

          dfdra = - 4d0*a/(1d0 + d*r**(-1d0/3d0))*rb/r                        & 
                  - 4d0/3d0*a*d/(1d0 + d*r**(-1d0/3d0))**2*ra*rb/r**(7d0/3d0) &
                  + 4d0*a/(1d0 + d*r**(-1d0/3d0))*ra*rb/r**2                  &
                  - a*b*omega*rb*(                                            &
                    + 2d0**(11d0/3d0)*Cf*(ra**(8d0/3d0) + rb**(8d0/3d0))      &
                    + (47d0/18d0 - 7d0*delta/18d0)*g                          &
                    - (5d0/2d0 - delta/18d0)*(ga + gb)                        &
                    - (delta - 11d0)/9d0*(ra/r*ga + rb/r*gb)                  &
                    - 4d0/3d0*r/rb*g                                          &
                    + (4d0/3d0*r/rb - 2d0*ra/rb)*gb                           &
                    + 4d0/3d0*r/rb*ga )                                       &
                  - a*b*omega*ra*rb*(                                         &
                    + 8d0/3d0*2d0**(11d0/3d0)*Cf*ra**(5d0/3d0)                &
                    - 7d0*dddra/18d0*g                                        &
                    + dddra/18d0*(ga + gb)                                    &
                    - dddra/9d0*(ra/r*ga + rb/r*gb)                           &
                    - (delta - 11d0)/(9d0*r)*(-ra/r*ga - rb/r*gb + ga) )      &
                  - a*b*dodra*ra*rb*(                                         &
                    + 2d0**(11d0/3d0)*Cf*(ra**(8d0/3d0) + rb**(8d0/3d0))      &
                    + (47d0/18d0 - 7d0*delta/18d0)*g                          &
                    - (5d0/2d0 - delta/18d0)*(ga + gb)                        &
                    - (delta - 11d0)/9d0*(ra/r*ga + rb/r*gb) )                &
                  - a*b*dodra*(                                               &
                    - 2d0*r**2/3d0*g                                          &
                    + (2d0*r**2/3d0 - ra**2)*gb                               &
                    + (2d0*r**2/3d0 - rb**2)*ga )

          dfdrb = - 4d0*a/(1d0 + d*r**(-1d0/3d0))*ra/r                        & 
                  - 4d0/3d0*a*d/(1d0 + d*r**(-1d0/3d0))**2*ra*rb/r**(7d0/3d0) &
                  + 4d0*a/(1d0 + d*r**(-1d0/3d0))*ra*rb/r**2                  &
                  - a*b*omega*ra*(                                            &
                    + 2d0**(11d0/3d0)*Cf*(ra**(8d0/3d0) + rb**(8d0/3d0))      &
                    + (47d0/18d0 - 7d0*delta/18d0)*g                          &
                    - (5d0/2d0 - delta/18d0)*(ga + gb)                        &
                    - (delta - 11d0)/9d0*(ra/r*ga + rb/r*gb)                  &
                    - 4d0/3d0*r/ra*g                                          &
                    + (4d0/3d0*r/ra - 2d0*rb/ra)*ga                           &
                    + 4d0/3d0*r/ra*gb )                                       &
                  - a*b*omega*ra*rb*(                                         &
                    + 8d0/3d0*2d0**(11d0/3d0)*Cf*rb**(5d0/3d0)                &
                    - 7d0*dddrb/18d0*g                                        &
                    + dddrb/18d0*(ga + gb)                                    &
                    - dddrb/9d0*(ra/r*ga + rb/r*gb)                           &
                    - (delta - 11d0)/(9d0*r)*(-ra/r*ga - rb/r*gb + gb) )      &
                  - a*b*dodrb*ra*rb*(                                         &
                    + 2d0**(11d0/3d0)*Cf*(ra**(8d0/3d0) + rb**(8d0/3d0))      &
                    + (47d0/18d0 - 7d0*delta/18d0)*g                          &
                    - (5d0/2d0 - delta/18d0)*(ga + gb)                        &
                    - (delta - 11d0)/9d0*(ra/r*ga + rb/r*gb) )                &
                  - a*b*dodrb*(                                               &
                    - 2d0*r**2/3d0*g                                          &
                    + (2d0*r**2/3d0 - ra**2)*gb                               &
                    + (2d0*r**2/3d0 - rb**2)*ga )

          Fc(mu,nu,1) = Fc(mu,nu,1) + vAO*dfdra
          Fc(mu,nu,2) = Fc(mu,nu,2) + vAO*dfdrb
          
          gaAO = drho(1,iG,1)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & 
               + drho(2,iG,1)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & 
               + drho(3,iG,1)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG))
          gaAO = weight(iG)*gaAO

          gbAO = drho(1,iG,2)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & 
               + drho(2,iG,2)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & 
               + drho(3,iG,2)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG))
          gbAO = weight(iG)*gbAO

          dfdga  = -a*b*omega*(-rb**2 + ra*rb*(1d0/9d0 - (delta-11d0)/9d0*ra/r - delta/3d0))
          dfdgab = -a*b*omega*(-4d0/3d0*r**2 + 2d0*ra*rb*(47d0/18d0 - 7d0*delta/18d0))
          dfdgb  = -a*b*omega*(-ra**2 + ra*rb*(1d0/9d0 - (delta-11d0)/9d0*rb/r - delta/3d0))
          
          Fc(mu,nu,1) = Fc(mu,nu,1) + 2d0*gaAO*dfdga + gbAO*dfdgab
          Fc(mu,nu,2) = Fc(mu,nu,2) + 2d0*gbAO*dfdgb + gaAO*dfdgab

        end if

      end do
    end do
  end do

end subroutine LYP_gga_correlation_potential
