chgu Subroutine

subroutine chgu(a, b, x, hu, md)

************80

! CHGU computes the confluent hypergeometric function U(a,b,x).

Licensing:

This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However,
they give permission to incorporate this routine into a user program
provided that the copyright is acknowledged.

Modified:

27 July 2012

Author:

Shanjie Zhang, Jianming Jin

Reference:

Shanjie Zhang, Jianming Jin,
Computation of Special Functions,
Wiley, 1996,
ISBN: 0-471-11963-6,
LC: QA351.C45.

Parameters:

Input, real ( kind = 8 ) A, B, parameters.

Input, real ( kind = 8 ) X, the argument.

Output, real ( kind = 8 ) HU, U(a,b,x).

Output, integer ( kind = 4 ) MD, the method code.

Arguments

Type IntentOptional Attributes Name
real(kind=8) :: a
real(kind=8) :: b
real(kind=8) :: x
real(kind=8) :: hu
integer(kind=4) :: md

Calls

proc~~chgu~2~~CallsGraph proc~chgu~2 chgu chgubi chgubi proc~chgu~2->chgubi chguit chguit proc~chgu~2->chguit chgul chgul proc~chgu~2->chgul chgus chgus proc~chgu~2->chgus

Source Code

subroutine chgu ( a, b, x, hu, md )

  !*****************************************************************************80
  !
  !! CHGU computes the confluent hypergeometric function U(a,b,x).
  !
  !  Licensing:
  !
  !    This routine is copyrighted by Shanjie Zhang and Jianming Jin.  However, 
  !    they give permission to incorporate this routine into a user program 
  !    provided that the copyright is acknowledged.
  !
  !  Modified:
  !
  !    27 July 2012
  !
  !  Author:
  !
  !    Shanjie Zhang, Jianming Jin
  !
  !  Reference:
  !
  !    Shanjie Zhang, Jianming Jin,
  !    Computation of Special Functions,
  !    Wiley, 1996,
  !    ISBN: 0-471-11963-6,
  !    LC: QA351.C45.
  ! 
  !  Parameters:
  !
  !    Input, real ( kind = 8 ) A, B, parameters.
  !
  !    Input, real ( kind = 8 ) X, the argument.
  !
  !    Output, real ( kind = 8 ) HU, U(a,b,x).
  !
  !    Output, integer ( kind = 4 ) MD, the method code.
  !
  implicit none

  real ( kind = 8 ) a
  real ( kind = 8 ) a00
  real ( kind = 8 ) aa
  real ( kind = 8 ) b
  real ( kind = 8 ) b00
  logical bl1
  logical bl2
  logical bl3
  logical bn
  real ( kind = 8 ) hu
  real ( kind = 8 ) hu1
  integer ( kind = 4 ) id
  integer ( kind = 4 ) id1
  logical il1
  logical il2
  logical il3
  integer ( kind = 4 ) md
  real ( kind = 8 ) x

  aa = a - b + 1.0D+00
  il1 = a == int ( a ) .and. a <= 0.0D+00
  il2 = aa == int ( aa ) .and. aa <= 0.0D+00
  il3 = abs ( a * ( a - b + 1.0D+00 ) ) / x <= 2.0D+00
  bl1 = x <= 5.0D+00 .or. ( x <= 10.0D+00 .and. a <= 2.0D+00 )
  bl2 = ( 5.0D+00 < x .and. x <= 12.5D+00 ) .and. &
       ( 1.0D+00 <= a .and. a + 4.0D+00 <= b )
  bl3 = 12.5D+00 < x .and. 5.0D+00 <= a .and. a + 5.0D+00 <= b
  bn = b == int ( b ) .and. b .ne. 0.0D+00
  id1 = -100

  if ( b .ne. int ( b ) ) then
     call chgus ( a, b, x, hu, id1 )
     md = 1
     if ( 6 <= id1 ) then
        return
     end if
     hu1 = hu
  end if

  if ( il1 .or. il2 .or. il3 ) then
     call chgul ( a, b, x, hu, id )
     md = 2
     if ( 6 <= id ) then
        return
     end if
     if ( id < id1 ) then
        md = 1
        id = id1
        hu = hu1
     end if
  end if

  if ( 0.0D+00 <= a ) then
     if ( bn .and. ( bl1 .or. bl2 .or. bl3 ) ) then
        call chgubi ( a, b, x, hu, id )
        md = 3
     else
        call chguit ( a, b, x, hu, id )
        md = 4
     end if
  else
     if ( b <= a ) then
        a00 = a
        b00 = b
        a = a - b + 1.0D+00
        b = 2.0D+00 - b
        call chguit ( a, b, x, hu, id )
        hu = x ** ( 1.0D+00 - b00 ) * hu
        a = a00
        b = b00
        md = 4
     else if ( bn .and. ( .not. il1 ) ) then
        call chgubi ( a, b, x, hu, id )
        md = 3
     end if
  end if

  if ( id < 6 ) then
     write ( *, '(a)' ) ' '
     write ( *, '(a)' ) 'CHGU - Warning!'
     write ( *, '(a)' ) '  Accurate results were not obtained.'
  end if

  return
end subroutine chgu