module m_Fx_omega_PBE
 use m_Const_Parameters,  only : DP,PAI,PAIsqrt
 implicit none

 real(kind=DP), parameter :: &
                 ca =  1.0161144d0 &
               , cb = -0.37170836d0 &
               , cc = -0.077215461d0 &
               , cd =  0.57786348d0 &
               , ce = -0.051955731d0 &
               , ck = -4.d0/27.d0

 real(kind=DP), parameter :: &
                 a1 = -0.000205484d0 &
               , a2 = -0.109465240d0 &
               , a3 = -0.064078780d0 &
               , a4 = -0.008181735d0 &
               , a5 = -0.000110666d0

 real(kind=DP), parameter :: &
                 b1 =  0.006601306d0 &
               , b2 =  0.259931140d0 &
               , b3 =  0.520352224d0 &
               , b4 =  0.118551043d0 &
               , b5 =  0.046003777d0

 real(kind=DP), parameter :: pi = PAI
 real(kind=DP), parameter :: rpi = PAIsqrt

contains

 function Fx_omega(fk,s,omega)
  implicit none
  real(kind=DP) :: Fx_omega
  real(kind=DP), intent(in) :: fk,s,omega

  real(kind=DP) :: s2, alp1, alp2, bet

  s2 = s*s
  alp1 = s2 * h(s)
  alp2 = alp1 + cd
  bet = omega/fk

  Fx_omega = a1 * yjw1(alp1+b1,bet) &
           + a2 * yjw1(alp1+b2,bet) &
           + a3 * yjw2(alp1+b3,bet) &
           + a4 * yjw2(alp1+b4,bet) &
           + a5 * yjw3(alp1+b5,bet) &
           + cb * yjw1(alp2,bet) &
           + cc * (1.d0+s2*f(s)) * yjw3(alp2,bet) &
           +      (ce+s2eg(s)) * yjw5(alp2,bet)
  Fx_omega = -8.d0/9.d0 * Fx_omega
 end function Fx_omega
 
 function dFxds_omega(fk,s,omega)
  implicit none
  real(kind=DP) :: dFxds_omega
  real(kind=DP), intent(in) :: fk,s,omega

  real(kind=DP) :: s2, alp1, alp2, dalp, bet
  real(kind=DP) :: ff, gg
  real(kind=DP) :: dff, dgg

  s2 = s*s
  alp1 = s2 * h(s)
  alp2 = alp1 + cd 
  dalp = 2.d0*s*h(s) + s2*dh(s)
  bet = omega/fk
  ff = cc * (1.d0+s2*f(s))
  gg = ce+s2eg(s)
  dff = cc * ( 2.d0*s*f(s) + s2*df(s) )
  dgg = 2.d0*s*eg(s) + s2*deg(s)

  dFxds_omega = ( a1 * dyjw1a(alp1+b1,bet) &
                + a2 * dyjw1a(alp1+b2,bet) &
                + a3 * dyjw2a(alp1+b3,bet) &
                + a4 * dyjw2a(alp1+b4,bet) &
                + a5 * dyjw3a(alp1+b5,bet) &
                + cb * dyjw1a(alp2,bet) &
                + ff * dyjw3a(alp2,bet) &
                + gg * dyjw5a(alp2,bet) ) * dalp &
                + dff * yjw3(alp2,bet) &
                + dgg * yjw5(alp2,bet) 
  dFxds_omega = -8.d0/9.d0 * dFxds_omega
 end function dFxds_omega

 function kdFxdk_omega(fk,s,omega)
  implicit none
  real(kind=DP) :: kdFxdk_omega
  real(kind=DP), intent(in) :: fk,s,omega

  real(kind=DP) :: s2, alp1, alp2, bet

  s2 = s*s
  alp1 = s2 * h(s)
  alp2 = alp1 + cd
  bet = omega/fk

  kdFxdk_omega = a1 * dyjw1b(alp1+b1,bet) &
              + a2 * dyjw1b(alp1+b2,bet) &
              + a3 * dyjw2b(alp1+b3,bet) &
              + a4 * dyjw2b(alp1+b4,bet) &
              + a5 * dyjw3b(alp1+b5,bet) &
              + cb * dyjw1b(alp2,bet) &
              + cc * (1.d0+s2*f(s)) * dyjw3b(alp2,bet) &
              +      (ce+s2eg(s)) * dyjw5b(alp2,bet)
  kdFxdk_omega = 8.d0/9.d0 * bet * kdFxdk_omega
 end function kdFxdk_omega

 function k2dFxdk_omega(fk,s,omega)
  implicit none
  real(kind=DP) :: k2dFxdk_omega
  real(kind=DP), intent(in) :: fk,s,omega

  real(kind=DP) :: s2, alp1, alp2, bet

  s2 = s*s
  alp1 = s2 * h(s)
  alp2 = alp1 + cd
  bet = omega/fk

  k2dFxdk_omega = a1 * dyjw1b(alp1+b1,bet) &
              + a2 * dyjw1b(alp1+b2,bet) &
              + a3 * dyjw2b(alp1+b3,bet) &
              + a4 * dyjw2b(alp1+b4,bet) &
              + a5 * dyjw3b(alp1+b5,bet) &
              + cb * dyjw1b(alp2,bet) &
              + cc * (1.d0+s2*f(s)) * dyjw3b(alp2,bet) &
              +      (ce+s2eg(s)) * dyjw5b(alp2,bet)
  k2dFxdk_omega = 8.d0/9.d0 * omega * k2dFxdk_omega
 end function k2dFxdk_omega

 function f(s)
  implicit none
  real(kind=DP) :: f
  real(kind=DP), intent(in) :: s
 
  f = ( h(s) * (16.d0*ca**2 + 36.d0*(cb-ca*cd)) + 9.d0*ck ) / (36.d0*cc)
 end function f

 function df(s)
  implicit none
  real(kind=DP) :: df
  real(kind=DP), intent(in) :: s
 
  df = ( dh(s) * (16.d0*ca**2 + 36.d0*(cb-ca*cd)) ) / (36.d0*cc)
 end function df

 function eg(s)
  implicit none
  real(kind=DP) :: eg
  real(kind=DP), intent(in) :: s

  real(kind=DP) :: a,b,s2,t,d

  s2 = s * s

  t = cd + h(s) * s2
  d = 16.d0 * t**3.5d0

  a = sqrt(pi) * ( 15.d0*ce + t * ( 6.d0*cc*(1.d0+f(s)*s2) &
                  + 4.d0*cb*t + 8.d0*ca*t*t ) ) / d  &
      - 3.d0*pi*sqrt(ca)/4.d0 &
               * exp(9.d0*h(s)*s2/(4.d0*ca)) * erfc(1.5d0*s*sqrt(h(s)/ca))

  b = 15.d0*sqrt(pi)*s2 / d

  eg = - (3.d0*pi/4.d0+a) / b
 end function eg

 function s2eg(s)
  implicit none
  real(kind=DP) :: s2eg
  real(kind=DP), intent(in) :: s

  real(kind=DP) :: a,b,s2,t,d

  s2 = s * s

  t = cd + h(s) * s2
  d = 16.d0 * t**3.5d0

  a = sqrt(pi) * ( 15.d0*ce + t * ( 6.d0*cc*(1.d0+f(s)*s2) &
                  + 4.d0*cb*t + 8.d0*ca*t*t ) ) / d  &
      - 3.d0*pi*sqrt(ca)/4.d0 &
               * exp(9.d0*h(s)*s2/(4.d0*ca)) * erfc(1.5d0*s*sqrt(h(s)/ca))

  b = 15.d0*sqrt(pi) / d

  s2eg = - (3.d0*pi/4.d0+a) / b
 end function s2eg


 function deg(s)
  implicit none
  real(kind=DP) :: deg
  real(kind=DP), intent(in) :: s

  real(kind=DP) :: a,b,b2,s2,t,u,d
  real(kind=DP) :: da,db,dt
  real(kind=DP) :: rh

  s2 = s * s
  t = cd + h(s) * s2
  u = 1.d0 + f(s) * s2
  d = 16.d0 * t**3.5d0

  a = sqrt(pi) * ( 15.d0*ce + t * ( 6.d0*cc*(1.d0+f(s)*s2) &
                  + 4.d0*cb*t + 8.d0*ca*t*t ) ) / d  &
      - 3.d0*pi*sqrt(ca)/4.d0 &
               * exp(9.d0*h(s)*s2/(4.d0*ca)) * erfc(1.5d0*s*sqrt(h(s)/ca))
  b = 15.d0*sqrt(pi)*s2 / d
  b2 = b * b

  dt = dh(s) * s2 + 2.d0 * s * h(s)
  rh = sqrt(h(s))
  da = sqrt(pi) * ( 6.d0*cc*( df(s)*s2 + 2.d0*s*f(s) ) * t &
     &            + ( 6.d0*cc*u + 8.d0*cb*t+24.d0*ca*t*t ) * dt ) &
     &            / d &
     & - 7.d0*sqrt(pi)/32.d0 * ( 15.d0*ce + 6.d0*cc*u*t + 4.d0*cb*t*t + 8.d0*ca*t**3 ) &
     &                      * dt / t**4.5d0 &
     & - 27.d0*pi/(16.d0*sqrt(ca)) * dt * exp(9.d0*h(s)*s2/(4.d0*ca)) * erfc(1.5d0*s*sqrt(h(s)/ca)) &           
     & + 9.d0*sqrt(pi)/4.d0*( rh + 0.5d0*s*dh(s)/rh )
  db = 15.d0*sqrt(pi) * ( 2.d0*s - 3.5d0*s2*dt/t ) / d

  deg = -da/b + db*(3.d0*pi/4.d0+a)/b2 
 end function deg

 function h(s)
  implicit none
  real(kind=DP) :: h
  real(kind=DP), intent(in) :: s

  real(kind=DP) :: s2, s4
  real(kind=DP), parameter :: a1 = 0.00979681d0 &
                           , a2 = 0.0410834d0 &
                           , a3 = 0.187440d0 &
                           , a4 = 0.00120824d0 &
                           , a5 = 0.0347188d0

  s2 = s * s
  s4 = s2 * s2

  h = ( a1 * s2 + a2 * s4 ) / ( 1.d0 + s4 * (a3 + a4 * s + a5 * s2 ) )
 end function h

 function dh(s)
  implicit none
  real(kind=DP) :: dh
  real(kind=DP), intent(in) :: s

  real(kind=DP) :: s2, s4, s5, s6
  real(kind=DP), parameter :: a1 = 0.00979681d0 &
                           , a2 = 0.0410834d0 &
                           , a3 = 0.187440d0 &
                           , a4 = 0.00120824d0 &
                           , a5 = 0.0347188d0

  s2 = s * s
  s4 = s2 * s2
  s5 = s * s4
  s6 = s2 * s4

  dh = -s*( a1*( 2.d0*a3*s4 + 3.d0*a4*s5 + 4.d0*a5*s6 - 2.d0) + a2*s2*(a4*s5+2.d0*a5*s6-4.d0)) &
     &    / ( 1.d0 + s4 * (a3 + a4 * s + a5 * s2 ) )**2
 end function dh

 function yjw1(a,b)
  implicit none
  real(kind=DP) :: yjw1
  real(kind=DP), intent(in) :: a, b
  
  yjw1 = (1.d0-b/sqrt(a+b*b))/(2.d0*a)
 end function yjw1

 function dyjw1a(a,b)
  implicit none
  real(kind=DP) :: dyjw1a
  real(kind=DP), intent(in) :: a, b

  real(kind=DP) :: apb2
  real(kind=DP) :: rapb2

  apb2 = a + b*b
  rapb2 = sqrt(apb2)

  dyjw1a = (b*(2.d0/rapb2+a/(apb2*rapb2))-2.d0)/(4.d0*a*a)
 end function dyjw1a

 function dyjw1b(a,b)
  implicit none
  real(kind=DP) :: dyjw1b
  real(kind=DP), intent(in) :: a, b

  real(kind=DP) :: apb2

  apb2 = a + b*b

  dyjw1b = -0.5d0/apb2**1.5d0
 end function dyjw1b

 function yjw2(a,b)
  implicit none
  real(kind=DP) :: yjw2
  real(kind=DP), intent(in) :: a, b

  real(kind=DP) :: ra, b2

  ra = sqrt(a)
  b2 = b * b

  yjw2 = (-ra*b+(a+b2)*acot(b/ra))/(2.d0*a**(3.d0/2.d0)*(a+b2)*rpi)
 end function yjw2

 function dyjw2a(a,b)
  implicit none
  real(kind=DP) :: dyjw2a
  real(kind=DP), intent(in) :: a, b
 
  real(kind=DP) :: ra, b2

  ra = sqrt(a)
  b2 = b * b

  dyjw2a = (ra*b*(5.d0*a+3.d0*b2)-3.d0*(a+b2)**2*acot(b/ra))/(4.d0*a**(5.d0/2.d0)*(a+b2)**2*rpi)
 end function dyjw2a

 function dyjw2b(a,b)
  implicit none
  real(kind=DP) :: dyjw2b
  real(kind=DP), intent(in) :: a, b

  real(kind=DP) :: ab2

  ab2 = a + b*b

  dyjw2b = -1.d0/(sqrt(pi)*ab2*ab2)
 end function dyjw2b

 function yjw3(a,b)
  implicit none
  real(kind=DP) :: yjw3
  real(kind=DP), intent(in) :: a, b

  real(kind=DP) :: b2, ab2, rab2

  b2 = b * b
  ab2 = a+b2
  rab2 = sqrt(ab2)

  yjw3 = (2.d0*b2*(-b+rab2)+a*(-3.d0*b+2.d0*rab2))/(4.d0*a*a*ab2*rab2)
 end function yjw3

 function dyjw3a(a,b)
  implicit none
  real(kind=DP) :: dyjw3a
  real(kind=DP), intent(in) :: a, b

  real(kind=DP) :: a2, b2, b4, ab2, rab2

  a2 = a * a
  b2 = b * b
  b4 = b2 * b2
  ab2 = a+b2
  rab2 = sqrt(ab2)

  dyjw3a = (a2*(15.d0*b-8.d0*rab2) + 8.d0*b4*(b-rab2) - 4.d0*a*b2*(4.d0*rab2-5.d0*b))/(8.d0*a2*a*ab2*ab2*rab2)
 end function dyjw3a

 function dyjw3b(a,b)
  implicit none
  real(kind=DP) :: dyjw3b
  real(kind=DP), intent(in) :: a, b

  real(kind=DP) :: ab2

  ab2 = a + b*b

  dyjw3b = -0.75d0/ab2**2.5d0
 end function dyjw3b

 function yjw5(a,b)
  implicit none
  real(kind=DP) :: yjw5
  real(kind=DP), intent(in) :: a, b

  real(kind=DP) :: a2, b2, b4, ab2, rab2

  a2 = a * a
  b2 = b * b
  b4 = b2 * b2
  ab2 = a+b2
  rab2 = sqrt(ab2)

  yjw5 = (8.d0*b4*(-b+rab2)+4.d0*a*b2*(-5.d0*b+4.d0*rab2)+a2*(-15.d0*b+8.d0*rab2))/(8.d0*a2*a*ab2*ab2*rab2)
 end function yjw5

 function dyjw5a(a,b)
  implicit none
  real(kind=DP) :: dyjw5a
  real(kind=DP), intent(in) :: a, b

  real(kind=DP) :: a2, a3, a4, b2, b4, b6, ab2, rab2

  a2 = a * a
  a3 = a * a2
  a4 = a2 * a2
  b2 = b * b
  b4 = b2 * b2
  b6 = b2 * b4
  ab2 = a+b2
  rab2 = sqrt(ab2)

  dyjw5a = -3.d0*( 16.d0*b6*(rab2-b) + 8.d0*a*b4*(6.d0*rab2-7.d0*b) + a3*(16.d0*rab2-35.d0*b) &
                & + 2.d0*a2*b2*(24.d0*rab2 - 35.d0*b) ) / (16.d0*a4*ab2*ab2*ab2*rab2)
 end function dyjw5a

 function dyjw5b(a,b)
  implicit none
  real(kind=DP) :: dyjw5b
  real(kind=DP), intent(in) :: a, b

  real(kind=DP) :: ab2

  ab2 = a + b*b

  dyjw5b = -15.d0/(8.d0*ab2**3.5d0)
 end function dyjw5b

 function acot(a)
  implicit none
  real(kind=DP) :: acot
  real(kind=DP), intent(in) :: a
 
  acot = atan(1.d0/a)
 end function acot
 
end module m_Fx_omega_PBE

subroutine ex_omegapbe(amix,omega,nspin,ispin,ista_fftph,iend_fftph,chgrhr_l,grad_rho,f2or1,exc,dFx_drho,dFx_dgradrho,nfft_y)
  use m_Const_Parameters,  only : DP,PAI,PAI4
  use m_Fx_omega_PBE,      only : Fx_omega, dFxds_omega, k2dFxdk_omega
  implicit none

  real(kind=DP),intent(in)  :: amix,omega
  integer,intent(in)        :: nspin,ispin,nfft_y
  integer,intent(in)        :: ista_fftph, iend_fftph
  real(kind=DP),intent(in)  :: chgrhr_l(1:nfft_y,ispin)
  real(kind=DP),intent(in)  :: grad_rho(1:nfft_y,nspin)
  real(kind=DP),intent(in)  :: f2or1(1:nfft_y)  
  real(kind=DP),intent(inout) :: exc
  real(kind=DP),intent(inout) :: dFx_drho(1:nfft_y,nspin)
  real(kind=DP),intent(inout) :: dFx_dgradrho(1:nfft_y,nspin)

  real(kind=DP), parameter :: ax = -0.7385587663820224d0 !! ax = -(3/4)*(3/PI)^(1/3)
  real(kind=DP), parameter :: thrd = 0.33333333333d0, thrd4 = 1.333333333333333d0
  real(kind=DP), parameter :: th8pi = -0.1193662073189215d0

  real(kind=DP) :: facw,d,dd,fk,s,fac,f,ex,fs,ff,exd,exdd,exc0,exc1
  integer       :: is,i

!---- Spin dependency

  facw = ispin
#ifdef NEC_TUNE_MXCP
!CDIR NOCONCUR
#endif
  do is = 1, ispin
     exc1 = 0.d0
#ifdef NEC_TUNE_MXCP
!CDIR INNER
#endif
     do i = 1, nfft_y
        d  = facw * chgrhr_l(i, is)
        if(abs(d) < 1.d-30) d = 1.d-30
        fk = (3*PAI*PAI*d)**thrd
        dd = facw * grad_rho(i, is)
        if(abs(d) > 1.d-05) then
           s = dd/(d*fk*2)
        else
           s = 0.d0
        end if
!-------------------------------------
        f = Fx_omega(fk,s,omega)
        ff = k2dFxdk_omega(fk,s,omega)
        if(abs(s)>1.d-10) then
           fs = dFxds_omega(fk,s,omega)
        else
           fs = 0.d0
           !!write(2000,'("s=",f20.5," f=",f20.5," ff=",f20.5)') s, f, ff
        end if
        fac = ax*d**thrd
        ex  = fac*f*d
        exd = thrd4*fac*(f-s*fs)-ff/PAI4
        exdd = th8pi*fs
!------------------------------------------     
        exc0 = ex / facw
        dFx_drho(i, is) = dFx_drho(i, is) + amix * exd 
        if(dabs(grad_rho(i, is)) > 1.d-9) then
           dFx_dgradrho(i, is) = dFx_dgradrho(i, is) + amix * exdd / grad_rho(i, is)
        endif
        exc1 = exc1 + exc0*f2or1(i)
        !!write(1000,'("i,f,fs,ff,d,dd,fk,s=",i8,1x,7(1x,f20.5))') i,f,fs,ff,d,dd,fk,s
     end do
     exc = exc + amix * exc1
  end do
  !!stop 'Debug: OmegaPBE'
end subroutine ex_omegapbe
