utility_w0gauss Function

public function utility_w0gauss(x, n, error, comm)

Uses

  • proc~~utility_w0gauss~~UsesGraph proc~utility_w0gauss utility_w0gauss module~w90_constants w90_constants proc~utility_w0gauss->module~w90_constants module~w90_error w90_error proc~utility_w0gauss->module~w90_error module~w90_comms w90_comms module~w90_error->module~w90_comms module~w90_error_base w90_error_base module~w90_error->module~w90_error_base module~w90_comms->module~w90_constants module~w90_comms->module~w90_error_base

the derivative of utility_wgauss: an approximation to the delta function

(n>=0) : derivative of the corresponding Methfessel-Paxton utility_wgauss

(n=-1 ): derivative of cold smearing: 1/sqrt(pi)exp(-(x-1/sqrt(2))2)(2-sqrt(2)*x)

(n=-99): derivative of Fermi-Dirac function: 0.5/(1.0+cosh(x))

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(in) :: x

input: the point where to compute the function
integer, intent(in) :: n

input: the order of the smearing function
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm

Return Value real(kind=dp)

output: the value of the function


Calls

proc~~utility_w0gauss~~CallsGraph proc~utility_w0gauss utility_w0gauss proc~set_error_input set_error_input proc~utility_w0gauss->proc~set_error_input proc~comms_sync_error comms_sync_error proc~set_error_input->proc~comms_sync_error proc~set_base_error set_base_error proc~set_error_input->proc~set_base_error

Called by

proc~~utility_w0gauss~~CalledByGraph proc~utility_w0gauss utility_w0gauss proc~berry_get_kubo_k berry_get_kubo_k proc~berry_get_kubo_k->proc~utility_w0gauss proc~dos_get_k dos_get_k proc~dos_get_k->proc~utility_w0gauss proc~gyrotropic_get_k_list gyrotropic_get_k_list proc~gyrotropic_get_k_list->proc~utility_w0gauss proc~tdf_kpt TDF_kpt proc~tdf_kpt->proc~utility_w0gauss proc~berry_main berry_main proc~berry_main->proc~berry_get_kubo_k proc~calctdfanddos calcTDFandDOS proc~calctdfanddos->proc~dos_get_k proc~calctdfanddos->proc~tdf_kpt proc~dos_main dos_main proc~dos_main->proc~dos_get_k proc~gyrotropic_main gyrotropic_main proc~gyrotropic_main->proc~gyrotropic_get_k_list proc~boltzwann_main boltzwann_main proc~boltzwann_main->proc~calctdfanddos program~postw90 postw90 program~postw90->proc~berry_main program~postw90->proc~dos_main program~postw90->proc~gyrotropic_main program~postw90->proc~boltzwann_main

Source Code

  function utility_w0gauss(x, n, error, comm)
    !-----------------------------------------------------------------------
    !
    !! the derivative of utility_wgauss:  an approximation to the delta function
    !!
    !! (n>=0) : derivative of the corresponding Methfessel-Paxton utility_wgauss
    !!
    !! (n=-1 ): derivative of cold smearing:
    !!              1/sqrt(pi)*exp(-(x-1/sqrt(2))**2)*(2-sqrt(2)*x)
    !!
    !! (n=-99): derivative of Fermi-Dirac function: 0.5/(1.0+cosh(x))
    !
    use w90_constants, only: dp, pi
    use w90_error, only: w90_error_type, set_error_input

    implicit none

    ! arguments
    real(kind=dp) :: utility_w0gauss
    !! *output*: the value of the function
    real(kind=dp), intent(in) :: x
    !! *input*: the point where to compute the function
    integer, intent(in) :: n
    !! *input*: the order of the smearing function
    type(w90_error_type), allocatable, intent(out) :: error
    type(w90_comm_type), intent(in) :: comm

    ! local variables
    real(kind=dp) :: a, arg, hp, hd, sqrtpm1
    ! the coefficients a_n
    ! the argument of the exponential
    ! the hermite function
    ! the hermite function

    integer :: i, ni
    ! counter on n values
    ! counter on 2n values

    utility_w0gauss = 0.d0 ! in case of error return

    ! Fermi-Dirac smearing
    sqrtpm1 = 1.0_dp/sqrt(pi)

    if (n .eq. -99) then
      if (abs(x) .le. 36.0) then
        utility_w0gauss = 1.00_dp/(2.00_dp + exp(-x) + exp(+x))
        ! in order to avoid problems for large values of x in the e
      else
        utility_w0gauss = 0.0_dp
      end if
      return

    end if
    ! cold smearing  (Marzari-Vanderbilt)
    if (n .eq. -1) then
      arg = min(200.0_dp, (x - 1.00_dp/sqrt(2.00_dp))**2)
      utility_w0gauss = sqrtpm1*exp(-arg)*(2.00_dp - sqrt(2.00_dp)*x)
      return

    end if

    if (n .gt. 10 .or. n .lt. 0) then
      call set_error_input(error, 'utility_w0gauss higher order (n>10) smearing is untested and unstable', comm)
      return
    end if

    ! Methfessel-Paxton
    arg = min(200.0_dp, x**2)
    utility_w0gauss = exp(-arg)*sqrtpm1
    if (n .eq. 0) return
    hd = 0.00_dp
    hp = exp(-arg)
    ni = 0
    a = sqrtpm1
    do i = 1, n
      hd = 2.00_dp*x*hp - 2.00_dp*DBLE(ni)*hd
      ni = ni + 1
      a = -a/(DBLE(i)*4.00_dp)
      hp = 2.00_dp*x*hd - 2.00_dp*DBLE(ni)*hp
      ni = ni + 1
      utility_w0gauss = utility_w0gauss + a*hp
    end do
    return
  end function utility_w0gauss