utility_w0gauss_vec Function

public function utility_w0gauss_vec(x, n, error, comm) result(res)

Uses

  • proc~~utility_w0gauss_vec~~UsesGraph proc~utility_w0gauss_vec utility_w0gauss_vec module~w90_constants w90_constants proc~utility_w0gauss_vec->module~w90_constants module~w90_error w90_error proc~utility_w0gauss_vec->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(:)
integer :: 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), allocatable, (:)

output: the value of the function input: the point where to compute the function


Calls

proc~~utility_w0gauss_vec~~CallsGraph proc~utility_w0gauss_vec utility_w0gauss_vec proc~set_error_alloc set_error_alloc proc~utility_w0gauss_vec->proc~set_error_alloc proc~set_error_input set_error_input proc~utility_w0gauss_vec->proc~set_error_input proc~comms_sync_error comms_sync_error proc~set_error_alloc->proc~comms_sync_error proc~set_base_error set_base_error proc~set_error_alloc->proc~set_base_error proc~set_error_input->proc~comms_sync_error proc~set_error_input->proc~set_base_error

Called by

proc~~utility_w0gauss_vec~~CalledByGraph proc~utility_w0gauss_vec utility_w0gauss_vec proc~berry_get_sc_klist berry_get_sc_klist proc~berry_get_sc_klist->proc~utility_w0gauss_vec proc~berry_main berry_main proc~berry_main->proc~berry_get_sc_klist program~postw90 postw90 program~postw90->proc~berry_main

Source Code

  function utility_w0gauss_vec(x, n, error, comm) result(res)
    !-----------------------------------------------------------------------
    !  Stepan Tsirkin: a vectorized version of the outine, gets x as an array.
    !
    !! 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, set_error_alloc

    implicit none

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

    ! local variables
    real(kind=dp) :: sqrtpm1

    allocate (res(size(x)), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error in allocating res in utility_w0gauss_vec', comm)
      return
    end if
    allocate (arg(size(x)), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error in allocating arg in utility_w0gauss_vec', comm)
      return
    end if

    sqrtpm1 = 1.0_dp/sqrt(pi)

    if (n .eq. -99) then
      call set_error_input(error, 'utility_w0gauss_vec not implemented for n == 99', comm)
      return
    end if

    ! cold smearing  (Marzari-Vanderbilt)
    if (n .eq. -1) then
      call set_error_input(error, 'utility_w0gauss_vec not implemented for n == -1', comm)
      return
    end if

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

    ! Methfessel-Paxton
    arg = min(200.0_dp, x**2)
    res = exp(-arg)*sqrtpm1

    if (n .eq. 0) then
      return
    else
      call set_error_input(error, 'utility_w0gauss_vec not implemented for n >0 ', comm)
      return
    end if
  end function utility_w0gauss_vec