program main

!*******************************************************************************
!
!! TOMS757_PRB tests the routines in TOMS757.
!
!  Discussion:
!
!    This program tests the 37 functions in the MISCFUN package.
!    It is a fairly simple code with each function being tested
!    at 20 different arguments.  The code compares the value
!    from the function with a pre-computed value, and produces
!    the absolute and relative errors.
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
  implicit none

  call timestamp ( )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TOMS757_PRB:'
  write ( *, '(a)' ) '  Test the uncommon special function routines in TOMS757.'

  call test01
  call test02
  call test03
  call test04
  call test05
  call test06
  call test07
  call test08
  call test09

  call test10
  call test11
  call test12
  call test13
  call test14
  call test15
  call test16
  call test17
  call test18
  call test19

  call test20
  call test21
  call test22
  call test23
  call test24
  call test25
  call test26
  call test27
  call test28
  call test29

  call test30
  call test31
  call test32
  call test33
  call test34
  call test35
  call test36
  call test37

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TOMS757_PRB:'
  write ( *, '(a)' ) '  Normal end of execution.'

  write ( *, '(a)' ) ' '
  call timestamp ( )

  !stop
end
subroutine test01

!*******************************************************************************
!
!! TEST01 tests ABRAM0.
!
  implicit none

  real ( kind = 8 ) abram0
  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST01'
  write ( *, '(a)' ) '  Testing function ABRAM0'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call abram0_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = abram0 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test02

!*******************************************************************************
!
!! TEST02 tests ABRAM1.
!
  implicit none
!
  real ( kind = 8 ) abram1
  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST02'
  write ( *, '(a)' ) '  Testing function ABRAM1'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call abram1_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = abram1 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test03

!*******************************************************************************
!
!! TEST03 tests ABRAM2.
!
  implicit none

  real ( kind = 8 ) abram2
  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST03'
  write ( *, '(a)' ) '  Testing function ABRAM2'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call abram2_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = abram2 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test04

!*******************************************************************************
!
!! TEST04 tests AIRY_AI_INT.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) airy_ai_int
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST04'
  write ( *, '(a)' ) '  Testing function AIRY_AI_INT'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call airy_ai_int_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = airy_ai_int ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test05

!*******************************************************************************
!
!! TEST05 tests AIRY_BI_INT.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) airy_bi_int
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST05'
  write ( *, '(a)' ) '  Testing function AIRY_BI_INT'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call airy_bi_int_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = airy_bi_int ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test06

!*******************************************************************************
!
!! TEST06 tests AIRY_GI.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) airy_gi
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST06'
  write ( *, '(a)' ) '  Testing function AIRY_GI'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call airy_gi_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = airy_gi ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test07

!*******************************************************************************
!
!! TEST07 tests AIRY_HI.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) airy_hi
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST07'
  write ( *, '(a)' ) '  Testing function AIRY_HI'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call airy_hi_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = airy_hi ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test08

!*******************************************************************************
!
!! TEST08 tests ARCTAN_INT.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) arctan_int
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST08'
  write ( *, '(a)' ) '  Testing function ARCTAN_INT'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call arctan_int_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = arctan_int ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test09

!*******************************************************************************
!
!! TEST09 tests BESSEL_I0_INT.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) bessel_i0_int
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST09'
  write ( *, '(a)' ) '  Testing function BESSEL_I0_INT'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call bessel_i0_int_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = bessel_i0_int ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test10

!*******************************************************************************
!
!! TEST10 tests BESSEL_J0_INT.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) bessel_j0_int
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST10'
  write ( *, '(a)' ) '  Testing function BESSEL_J0_INT'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call bessel_j0_int_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = bessel_j0_int ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test11

!*******************************************************************************
!
!! TEST11 tests BESSEL_K0_INT.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) bessel_k0_int
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST11'
  write ( *, '(a)' ) '  Testing function BESSEL_K0_INT'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call bessel_k0_int_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = bessel_k0_int ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test12

!*******************************************************************************
!
!! TEST12 tests BESSEL_Y0_INT.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) bessel_y0_int
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST12'
  write ( *, '(a)' ) '  Testing function BESSEL_Y0_INT'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call bessel_y0_int_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = bessel_y0_int ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test13

!*******************************************************************************
!
!! TEST13 tests CLAUSEN.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) clausen
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST13'
  write ( *, '(a)' ) '  Testing function CLAUSEN'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call clausen_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = clausen ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test14

!*******************************************************************************
!
!! TEST14 tests DEBYE1.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) debye1
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST14'
  write ( *, '(a)' ) '  Testing function DEBYE1'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call debye1_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = debye1 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test15

!*******************************************************************************
!
!! TEST15 tests DEBYE2.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) debye2
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST15'
  write ( *, '(a)' ) '  Testing function DEBYE2'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call debye2_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = debye2 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test16

!*******************************************************************************
!
!! TEST16 tests DEBYE3.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) debye3
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST16'
  write ( *, '(a)' ) '  Testing function DEBYE3'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call debye3_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = debye3 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test17

!*******************************************************************************
!
!! TEST17 tests DEBYE4.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) debye4
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST17'
  write ( *, '(a)' ) '  Testing function DEBYE4'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call debye4_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = debye4 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test18

!*******************************************************************************
!
!! TEST18 tests EXP3_INT.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) exp3_int
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST18'
  write ( *, '(a)' ) '  Testing function EXP3_INT'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call exp3_int_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = exp3_int ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test19

!*******************************************************************************
!
!! TEST19 tests GOODWIN.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  real ( kind = 8 ) goodwin
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST19'
  write ( *, '(a)' ) '  Testing function GOODWIN'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call goodwin_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = goodwin ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test20

!*******************************************************************************
!
!! TEST20 tests I0ML0.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  real ( kind = 8 ) i0ml0
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST20'
  write ( *, '(a)' ) '  Testing function I0ML0'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call i0ml0_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = i0ml0 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test21

!*******************************************************************************
!
!! TEST21 tests I1ML1.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  real ( kind = 8 ) i1ml1
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST21'
  write ( *, '(a)' ) '  Testing function I1ML1'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call i1ml1_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = i1ml1 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test22

!*******************************************************************************
!
!! TEST22 tests LOBACHEVSKY.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  real ( kind = 8 ) lobachevsky
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST22'
  write ( *, '(a)' ) '  Testing function LOBACHEVSKY'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call lobachevsky_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = lobachevsky ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test23

!*******************************************************************************
!
!! TEST23 tests STROMGEN.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) stromgen
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST23'
  write ( *, '(a)' ) '  Testing function STROMGEN'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call stromgen_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = stromgen ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test24

!*******************************************************************************
!
!! TEST24 tests STRUVE_H0.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) struve_h0
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST24'
  write ( *, '(a)' ) '  Testing function STRUVE_H0'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call struve_h0_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = struve_h0 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test25

!*******************************************************************************
!
!! TEST25 tests STRUVE_H1.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) struve_h1
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST25'
  write ( *, '(a)' ) '  Testing function STRUVE_H1'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call struve_h1_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = struve_h1 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test26

!*******************************************************************************
!
!! TEST26 tests STRUVE_L0.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) struve_l0
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST26'
  write ( *, '(a)' ) '  Testing function STRUVE_L0'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call struve_l0_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = struve_l0 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test27

!*******************************************************************************
!
!! TEST27 tests STRUVE_L1.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) struve_l1
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST27'
  write ( *, '(a)' ) '  Testing function STRUVE_L1'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call struve_l1_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = struve_l1 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test28

!*******************************************************************************
!
!! TEST28 tests SYNCH1.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) synch1
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST28'
  write ( *, '(a)' ) '  Testing function SYNCH1'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call synch1_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = synch1 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test29

!*******************************************************************************
!
!! TEST29 tests SYNCH2.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) synch2
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST29'
  write ( *, '(a)' ) '  Testing function SYNCH2'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call synch2_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = synch2 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test30

!*******************************************************************************
!
!! TEST30 tests TRAN02.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) tran02
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST30'
  write ( *, '(a)' ) '  Testing function TRAN02'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call tran02_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = tran02 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test31

!*******************************************************************************
!
!! TEST31 tests TRAN03.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) tran03
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST31'
  write ( *, '(a)' ) '  Testing function TRAN03'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call tran03_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = tran03 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test32

!*******************************************************************************
!
!! TEST32 tests TRAN04.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) tran04
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST32'
  write ( *, '(a)' ) '  Testing function TRAN04'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call tran04_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = tran04 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test33

!*******************************************************************************
!
!! TEST33 tests TRAN05.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) tran05
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST33'
  write ( *, '(a)' ) '  Testing function TRAN05'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call tran05_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = tran05 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test34

!*******************************************************************************
!
!! TEST34 tests TRAN06.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) tran06
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST34'
  write ( *, '(a)' ) '  Testing function TRAN06'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call tran06_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = tran06 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test35

!*******************************************************************************
!
!! TEST35 tests TRAN07.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) tran07
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST35'
  write ( *, '(a)' ) '  Testing function TRAN07'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call tran07_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = tran07 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test36

!*******************************************************************************
!
!! TEST36 tests TRAN08.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) tran08
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST36'
  write ( *, '(a)' ) '  Testing function TRAN08'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call tran08_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = tran08 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end
subroutine test37

!*******************************************************************************
!
!! TEST37 tests TRAN09.
!
  implicit none

  real ( kind = 8 ) abserr
  real ( kind = 8 ) comp
  real ( kind = 8 ) fx
  integer n_data
  real ( kind = 8 ) relerr
  real ( kind = 8 ) tran09
  real ( kind = 8 ) x

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST37'
  write ( *, '(a)' ) '  Testing function TRAN09'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '     Argument             Abs. error             Rel. error'
  write ( *, '(a)' ) ' '

  n_data = 0

  do

    call tran09_values ( n_data, x, fx )

    if ( n_data <= 0 ) then
      exit
    end if

    comp = tran09 ( x )
    abserr = abs ( fx - comp )
    relerr = abserr / abs ( fx )
    write ( *, '(2x,f15.10,2x,d15.5,8x,d15.5)' ) x, abserr, relerr

  end do

  return
end

function abram0 ( xvalue )

!*******************************************************************************
!
!! ABRAM0 evaluates the Abramowitz function of order 0.
!
!  Discussion:
!
!    The function is defined by:
!
!      ABRAM0(x) = Integral ( 0 <= t < infinity ) exp ( -t^2 - x / t ) dt
!
!    The code uses Chebyshev expansions with the coefficients
!    given to an accuracy of 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) ABRAM0, the value of the function.
!
  implicit none

  real ( kind = 8 ), dimension(0:8) :: ab0f = (/ &
    real ( -0.68121927093549469816d0, kind = 8 ), &
    real ( -0.78867919816149252495d0, kind = 8 ), &
    real (  0.5121581776818819543d-1, kind = 8 ), &
    real ( -0.71092352894541296d-3, kind = 8 ), &
    real (  0.368681808504287d-5, kind = 8 ), &
    real ( -0.917832337237d-8, kind = 8 ), &
    real (  0.1270202563d-10, kind = 8 ), &
    real ( -0.1076888d-13, kind = 8 ), &
    real (  0.599d-17, kind = 8 ) /)
  real ( kind = 8 ), dimension(0:8) :: ab0g = (/ &
    real ( -0.60506039430868273190d0, kind = 8 ),  &
    real ( -0.41950398163201779803d0, kind = 8 ),  &
    real (  0.1703265125190370333d-1, kind = 8 ),  &
    real ( -0.16938917842491397d-3, kind = 8 ),  &
    real (  0.67638089519710d-6, kind = 8 ),  &
    real ( -0.135723636255d-8, kind = 8 ),  &
    real (  0.156297065d-11, kind = 8 ),  &
    real ( -0.112887d-14, kind = 8 ),  &
    real (  0.55d-18, kind = 8 ) /)
  real ( kind = 8 ), dimension(0:8) :: ab0h = (/ &
    real (  1.38202655230574989705d0, kind = 8 ),  &
    real ( -0.30097929073974904355d0, kind = 8 ),  &
    real (  0.794288809364887241d-2, kind = 8 ),  &
    real ( -0.6431910276847563d-4, kind = 8 ),  &
    real (  0.22549830684374d-6, kind = 8 ),  &
    real ( -0.41220966195d-9, kind = 8 ),  &
    real (  0.44185282d-12, kind = 8 ),  &
    real ( -0.30123d-15, kind = 8 ),  &
    real (  0.14d-18, kind = 8 )  /)
  real ( kind = 8 ), dimension(0:27) :: ab0as = (/ &
    real (  1.97755499723693067407d+0, kind = 8 ),  &
    real ( -0.1046024792004819485d-1, kind = 8 ),  &
    real (  0.69680790253625366d-3, kind = 8 ),  &
    real ( -0.5898298299996599d-4, kind = 8 ),  &
    real (  0.577164455305320d-5, kind = 8 ),  &
    real ( -0.61523013365756d-6, kind = 8 ),  &
    real (  0.6785396884767d-7, kind = 8 ),  &
    real ( -0.723062537907d-8, kind = 8 ),  &
    real (  0.63306627365d-9, kind = 8 ),  &
    real ( -0.989453793d-11, kind = 8 ),  &
    real ( -0.1681980530d-10, kind = 8 ),  &
    real (  0.673799551d-11, kind = 8 ),  &
    real ( -0.200997939d-11, kind = 8 ),  &
    real (  0.54055903d-12, kind = 8 ),  &
    real ( -0.13816679d-12, kind = 8 ),  &
    real (  0.3422205d-13, kind = 8 ),  &
    real ( -0.826686d-14, kind = 8 ),  &
    real (  0.194566d-14, kind = 8 ),  &
    real ( -0.44268d-15, kind = 8 ),  &
    real (  0.9562d-16, kind = 8 ),  &
    real ( -0.1883d-16, kind = 8 ),  &
    real (  0.301d-17, kind = 8 ),  &
    real ( -0.19d-18, kind = 8 ),  &
    real ( -0.14d-18, kind = 8 ),  &
    real (  0.11d-18, kind = 8 ),  &
    real ( -0.4d-19, kind = 8 ),  &
    real (  0.2d-19, kind = 8 ),  &
    real ( -0.1d-19, kind = 8 ) /)
  real ( kind = 8 ) abram0
  real ( kind = 8 ) asln
  real ( kind = 8 ) asval
  real ( kind = 8 ) cheval
  real ( kind = 8 ) fval
  real ( kind = 8 ) gval
  real ( kind = 8 ), parameter :: gval0 = 0.13417650264770070909D+00
  real ( kind = 8 ), parameter :: half = 0.5D+00
  real ( kind = 8 ) hval
  real ( kind = 8 ), parameter :: lnxmin = -708.3964D+00
  integer, parameter :: nterma = 22
  integer, parameter :: ntermf = 8
  integer, parameter :: ntermg = 8
  integer, parameter :: ntermh = 8
  real ( kind = 8 ), parameter :: onerpi = 0.56418958354775628695D+00
  real ( kind = 8 ), parameter :: rt3bpi = 0.97720502380583984317D+00
  real ( kind = 8 ), parameter :: rtpib2 = 0.88622692545275801365D+00
  real ( kind = 8 ), parameter :: six = 6.0D+00
  real ( kind = 8 ) t
  real ( kind = 8 ), parameter :: three = 3.0D+00
  real ( kind = 8 ), parameter :: two = 2.0D+00
  real ( kind = 8 ) v
  real ( kind = 8 ) x
  real ( kind = 8 ), parameter :: xlow1 = 1.490116D-08
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'ABRAM0 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    abram0 = zero
  else if ( x == zero ) then
    abram0 = rtpib2
  else if ( x < xlow1 ) then
    abram0 = rtpib2 + x * ( log ( x ) - gval0 )
  else if ( x <= two ) then
    t =  ( x * x / two - half ) - half
    fval = cheval ( ntermf, ab0f, t )
    gval = cheval ( ntermg, ab0g, t )
    hval = cheval ( ntermh, ab0h, t )
    abram0 = fval / onerpi + x * ( log ( x ) * hval - gval )
  else
    v = three * ( ( x / two ) ** ( two / three ) )
    t = ( six / v - half ) - half
    asval = cheval ( nterma, ab0as, t )
    asln = log ( asval / rt3bpi ) - v
    if ( asln < lnxmin ) then
      abram0 = zero
    else
      abram0 = exp ( asln )
    end if
  end if

  return
end
subroutine abram0_values ( n_data, x, fx )

!*******************************************************************************
!
!! ABRAM0_VALUES returns some values of the Abramowitz0 function.
!
!  Discussion:
!
!    The function is defined by:
!
!      ABRAM0(x) = Integral ( 0 <= t < infinity ) exp ( -t^2 - x / t ) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    21 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none

  integer, parameter :: n_max = 20

  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.87377726306985360531D+00, kind = 8 ), &
    real ( 0.84721859650456925922D+00, kind = 8 ), &
    real ( 0.77288934483988301615D+00, kind = 8 ), &
    real ( 0.59684345853450151603D+00, kind = 8 ), &
    real ( 0.29871735283675888392D+00, kind = 8 ), &
    real ( 0.15004596450516388138D+00, kind = 8 ), &
    real ( 0.11114662419157955096D+00, kind = 8 ), &
    real ( 0.83909567153151897766D-01, kind = 8 ), &
    real ( 0.56552321717943417515D-01, kind = 8 ), &
    real ( 0.49876496603033790206D-01, kind = 8 ), &
    real ( 0.44100889219762791328D-01, kind = 8 ), &
    real ( 0.19738535180254062496D-01, kind = 8 ), &
    real ( 0.86193088287161479900D-02, kind = 8 ), &
    real ( 0.40224788162540127227D-02, kind = 8 ), &
    real ( 0.19718658458164884826D-02, kind = 8 ), &
    real ( 0.10045868340133538505D-02, kind = 8 ), &
    real ( 0.15726917263304498649D-03, kind = 8 ), &
    real ( 0.10352666912350263437D-04, kind = 8 ), &
    real ( 0.91229759190956745069E-06, kind = 8 ), &
    real ( 0.25628287737952698742E-09, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real ( 0.0019531250D+00, kind = 8 ), &
    real ( 0.0078125000D+00, kind = 8 ), &
    real ( 0.0312500000D+00, kind = 8 ), &
    real ( 0.1250000000D+00, kind = 8 ), &
    real ( 0.5000000000D+00, kind = 8 ), &
    real ( 1.0000000000D+00, kind = 8 ), &
    real ( 1.2500000000D+00, kind = 8 ), &
    real ( 1.5000000000D+00, kind = 8 ), &
    real ( 1.8750000000D+00, kind = 8 ), &
    real ( 2.0000000000D+00, kind = 8 ), &
    real ( 2.1250000000D+00, kind = 8 ), &
    real ( 3.0000000000D+00, kind = 8 ), &
    real ( 4.0000000000D+00, kind = 8 ), &
    real ( 5.0000000000D+00, kind = 8 ), &
    real ( 6.0000000000D+00, kind = 8 ), &
    real ( 7.0000000000D+00, kind = 8 ), &
    real ( 10.0000000000D+00, kind = 8 ), &
    real ( 15.0000000000D+00, kind = 8 ), &
    real ( 20.0000000000D+00, kind = 8 ), &
    real ( 40.0000000000D+00, kind = 8 ) /)

  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function abram1 ( xvalue )

!*******************************************************************************
!
!! ABRAM1 evaluates the Abramowitz function of order 1.
!
!  Discussion:
!
!    The function is defined by:
!
!      ABRAM1(x) = Integral ( 0 <= t < infinity ) t * exp ( -t^2 - x / t ) dt
!
!    The code uses Chebyshev expansions with the coefficients
!    given to an accuracy of 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) ABRAM1, the value of the function.
!
  implicit none

  real ( kind = 8 ) ab1as(0:27)
  real ( kind = 8 ) ab1f(0:9)
  real ( kind = 8 ) ab1g(0:8)
  real ( kind = 8 ) ab1h(0:8)
  real ( kind = 8 ) abram1
  real ( kind = 8 ) asln
  real ( kind = 8 ) asval
  real ( kind = 8 ) cheval
  real ( kind = 8 ) fval
  real ( kind = 8 ) gval
  real ( kind = 8 ), parameter :: half = 0.5D+00
  real ( kind = 8 ) hval
  real ( kind = 8 ) lnxmin
  integer, parameter :: nterma = 23
  integer, parameter :: ntermf = 9
  integer, parameter :: ntermg = 8
  integer, parameter :: ntermh = 8
  real ( kind = 8 ), parameter :: one = 1.0D+00
  real ( kind = 8 ) onerpi
  real ( kind = 8 ), parameter :: rt3bpi = 0.97720502380583984317D+00
  real ( kind = 8 ), parameter :: six = 6.0D+00
  real ( kind = 8 ) t
  real ( kind = 8 ), parameter :: three = 3.0D+00
  real ( kind = 8 ), parameter :: two = 2.0D+00
  real ( kind = 8 ) v
  real ( kind = 8 ) x
  real ( kind = 8 ) xlow
  real ( kind = 8 ) xlow1
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  data ab1f/1.47285192577978807369d0, &
            0.10903497570168956257d0, &
           -0.12430675360056569753d0, &
            0.306197946853493315d-2, &
           -0.2218410323076511d-4, &
            0.6989978834451d-7, &
           -0.11597076444d-9, &
            0.11389776d-12, &
           -0.7173d-16, &
            0.3d-19/
  data ab1g/0.39791277949054503528d0, &
           -0.29045285226454720849d0, &
            0.1048784695465363504d-1, &
           -0.10249869522691336d-3, &
            0.41150279399110d-6, &
           -0.83652638940d-9, &
            0.97862595d-12, &
           -0.71868d-15, &
            0.35d-18/
  data ab1h/0.84150292152274947030d0, &
           -0.7790050698774143395d-1, &
            0.133992455878390993d-2, &
           -0.808503907152788d-5, &
            0.2261858281728d-7, &
           -0.3441395838d-10, &
            0.3159858d-13, &
           -0.1884d-16, &
            0.1d-19/
  data ab1as(0)/  2.13013643429065549448d0/
  data ab1as(1)/  0.6371526795218539933d-1/
  data ab1as(2)/ -0.129334917477510647d-2/
  data ab1as(3)/  0.5678328753228265d-4/
  data ab1as(4)/ -0.279434939177646d-5/
  data ab1as(5)/  0.5600214736787d-7/
  data ab1as(6)/  0.2392009242798d-7/
  data ab1as(7)/ -0.750984865009d-8/
  data ab1as(8)/  0.173015330776d-8/
  data ab1as(9)/ -0.36648877955d-9/
  data ab1as(10)/ 0.7520758307d-10/
  data ab1as(11)/-0.1517990208d-10/
  data ab1as(12)/ 0.301713710d-11/
  data ab1as(13)/-0.58596718d-12/
  data ab1as(14)/ 0.10914455d-12/
  data ab1as(15)/-0.1870536d-13/
  data ab1as(16)/ 0.262542d-14/
  data ab1as(17)/-0.14627d-15/
  data ab1as(18)/-0.9500d-16/
  data ab1as(19)/ 0.5873d-16/
  data ab1as(20)/-0.2420d-16/
  data ab1as(21)/ 0.868d-17/
  data ab1as(22)/-0.290d-17/
  data ab1as(23)/ 0.93d-18/
  data ab1as(24)/-0.29d-18/
  data ab1as(25)/ 0.9d-19/
  data ab1as(26)/-0.3d-19/
  data ab1as(27)/ 0.1d-19/
  data onerpi/ 0.56418958354775628695d0/
!
!  Machine-dependent constants (suitable for IEEE machines)
!
  data xlow,xlow1,lnxmin/1.11023d-16,1.490116d-8,-708.3964d0/

  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'ABRAM1 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    abram1 = zero
  else if ( x == zero ) then
    abram1 = half
  else if ( x < xlow ) then
    abram1 = half
  else if ( x < xlow1 ) then
    abram1 = ( one - x / onerpi - x * x * log ( x ) ) * half
  else if ( x <= two ) then
    t = ( x * x / two - half ) - half
    fval = cheval ( ntermf, ab1f, t )
    gval = cheval ( ntermg, ab1g, t )
    hval = cheval ( ntermh, ab1h, t )
    abram1 = fval - x * ( gval / onerpi + x * log ( x ) * hval )
  else
    v = three *  ( ( x / two ) ** ( two / three ) )
    t =  ( six / v - half ) - half
    asval = cheval ( nterma, ab1as, t )
    asln = log ( asval * sqrt ( v / three ) / rt3bpi ) - v
    if ( asln < lnxmin ) then
      abram1 = zero
    else
      abram1 = exp ( asln )
    end if
  end if

  return
end
subroutine abram1_values ( n_data, x, fx )

!*******************************************************************************
!
!! ABRAM1_VALUES returns some values of the Abramowitz1 function.
!
!  Discussion:
!
!    The function is defined by:
!
!      ABRAM1(x) = Integral ( 0 <= t < infinity ) t * exp ( -t^2 - x / t ) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    21 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none

  integer, parameter :: n_max = 20

  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.49828219848799921792D+00, kind = 8 ), &
    real ( 0.49324391773047288556D+00, kind = 8 ), &
    real ( 0.47431612784691234649D+00, kind = 8 ), &
    real ( 0.41095983258760410149D+00, kind = 8 ), &
    real ( 0.25317617388227035867D+00, kind = 8 ), &
    real ( 0.14656338138597777543D+00, kind = 8 ), &
    real ( 0.11421547056018366587D+00, kind = 8 ), &
    real ( 0.90026307383483764795D-01, kind = 8 ), &
    real ( 0.64088214170742303375D-01, kind = 8 ), &
    real ( 0.57446614314166191085D-01, kind = 8 ), &
    real ( 0.51581624564800730959D-01, kind = 8 ), &
    real ( 0.25263719555776416016D-01, kind = 8 ), &
    real ( 0.11930803330196594536D-01, kind = 8 ), &
    real ( 0.59270542280915272465D-02, kind = 8 ), &
    real ( 0.30609215358017829567D-02, kind = 8 ), &
    real ( 0.16307382136979552833D-02, kind = 8 ), &
    real ( 0.28371851916959455295D-03, kind = 8 ), &
    real ( 0.21122150121323238154D-04, kind = 8 ), &
    real ( 0.20344578892601627337D-05, kind = 8 ), &
    real ( 0.71116517236209642290E-09, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real ( 0.0019531250D+00, kind = 8 ), &
    real ( 0.0078125000D+00, kind = 8 ), &
    real ( 0.0312500000D+00, kind = 8 ), &
    real ( 0.1250000000D+00, kind = 8 ), &
    real ( 0.5000000000D+00, kind = 8 ), &
    real ( 1.0000000000D+00, kind = 8 ), &
    real ( 1.2500000000D+00, kind = 8 ), &
    real ( 1.5000000000D+00, kind = 8 ), &
    real ( 1.8750000000D+00, kind = 8 ), &
    real ( 2.0000000000D+00, kind = 8 ), &
    real ( 2.1250000000D+00, kind = 8 ), &
    real ( 3.0000000000D+00, kind = 8 ), &
    real ( 4.0000000000D+00, kind = 8 ), &
    real ( 5.0000000000D+00, kind = 8 ), &
    real ( 6.0000000000D+00, kind = 8 ), &
    real ( 7.0000000000D+00, kind = 8 ), &
    real ( 10.0000000000D+00, kind = 8 ), &
    real ( 15.0000000000D+00, kind = 8 ), &
    real ( 20.0000000000D+00, kind = 8 ), &
    real ( 40.0000000000D+00, kind = 8 ) /)

  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function abram2 ( xvalue )

!*******************************************************************************
!
!! ABRAM2 evaluates the Abramowitz function of order 2.
!
!  Discussion:
!
!    The function is defined by:
!
!      ABRAM2(x) = Integral ( 0 <= t < infinity ) t^2 * exp ( -t^2 - x / t ) dt
!
!    The code uses Chebyshev expansions with the coefficients
!    given to an accuracy of 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) ABRAM2, the value of the function.
!
  implicit none

  real ( kind = 8 ) abram2
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer, parameter :: nterma = 23
  integer, parameter :: ntermf = 9
  integer, parameter :: ntermg = 8
  integer, parameter :: ntermh = 7
  real ( kind = 8 ), parameter :: six = real ( 6.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: three = 3.0D+00
  real ( kind = 8 ), parameter :: two = 2.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) ab2f(0:9),ab2g(0:8),ab2h(0:7),ab2as(0:26), &
       asln,asval,fval,gval,hval,lnxmin, &
       onerpi,rtpib4,rt3bpi,t, &
       v,xlow,xlow1
  data ab2f/1.03612162804243713846d0, &
            0.19371246626794570012d0, &
           -0.7258758839233007378d-1, &
            0.174790590864327399d-2, &
           -0.1281223233756549d-4, &
            0.4115018153651d-7, &
           -0.6971047256d-10, &
            0.6990183d-13, &
           -0.4492d-16, &
            0.2d-19/
  data ab2g/1.46290157198630741150d0, &
            0.20189466883154014317d0, &
           -0.2908292087997129022d-1, &
            0.47061049035270050d-3, &
           -0.257922080359333d-5, &
            0.656133712946d-8, &
           -0.914110203d-11, &
            0.774276d-14, &
           -0.429d-17/
  data ab2h/0.30117225010910488881d0, &
           -0.1588667818317623783d-1, &
            0.19295936935584526d-3, &
           -0.90199587849300d-6, &
            0.206105041837d-8, &
           -0.265111806d-11, &
            0.210864d-14, &
           -0.111d-17/
  data ab2as(0)/  2.46492325304334856893d0/
  data ab2as(1)/  0.23142797422248905432d0/
  data ab2as(2)/ -0.94068173010085773d-3/
  data ab2as(3)/  0.8290270038089733d-4/
  data ab2as(4)/ -0.883894704245866d-5/
  data ab2as(5)/  0.106638543567985d-5/
  data ab2as(6)/ -0.13991128538529d-6/
  data ab2as(7)/  0.1939793208445d-7/
  data ab2as(8)/ -0.277049938375d-8/
  data ab2as(9)/  0.39590687186d-9/
  data ab2as(10)/-0.5408354342d-10/
  data ab2as(11)/ 0.635546076d-11/
  data ab2as(12)/-0.38461613d-12/
  data ab2as(13)/-0.11696067d-12/
  data ab2as(14)/ 0.6896671d-13/
  data ab2as(15)/-0.2503113d-13/
  data ab2as(16)/ 0.785586d-14/
  data ab2as(17)/-0.230334d-14/
  data ab2as(18)/ 0.64914d-15/
  data ab2as(19)/-0.17797d-15/
  data ab2as(20)/ 0.4766d-16/
  data ab2as(21)/-0.1246d-16/
  data ab2as(22)/ 0.316d-17/
  data ab2as(23)/-0.77d-18/
  data ab2as(24)/ 0.18d-18/
  data ab2as(25)/-0.4d-19/
  data ab2as(26)/ 0.1d-19/
  data rt3bpi/ 0.97720502380583984317d0/
  data rtpib4/ 0.44311346272637900682d0/
  data onerpi/ 0.56418958354775628695d0/
!
!   Machine-dependent constants (suitable for IEEE machines)
!
  data xlow,xlow1,lnxmin/2.22045d-16,1.490116d-8,-708.3964d0/

  x = xvalue

  if ( x < zero ) then

    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'ABRAM2 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    abram2 = zero

  else if ( x == zero ) then

    abram2 = rtpib4

  else if ( x < xlow ) then

    abram2 = rtpib4

  else if ( x < xlow1 ) then

    abram2 = rtpib4 - half * x + x * x * x * log ( x ) / six

  else if ( x <= 2.0D+00 ) then

    t =  ( x * x / two - half ) - half
    fval = cheval ( ntermf, ab2f, t )
    gval = cheval ( ntermg, ab2g, t )
    hval = cheval ( ntermh, ab2h, t )
    abram2 = fval / onerpi + x * ( x * x * log ( x ) * hval - gval )

  else

    v = three * ( ( x / two ) ** ( two / three ) )
    t = ( six / v - half ) - half
    asval = cheval ( nterma, ab2as, t )
    asln = log ( asval / rt3bpi ) + log ( v / three ) - v

    if ( asln < lnxmin ) then
      abram2 = zero
    else
      abram2 = exp ( asln )
    end if

  end if

  return
end
subroutine abram2_values ( n_data, x, fx )

!*******************************************************************************
!
!! ABRAM2_VALUES returns some values of the Abramowitz2 function.
!
!  Discussion:
!
!    The function is defined by:
!
!      ABRAM2(x) = Integral ( 0 <= t < infinity ) t^2 * exp ( -t^2 - x / t ) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    22 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none

  integer, parameter :: n_max = 20

  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.44213858162107913430D+00, kind = 8 ), &
    real ( 0.43923379545684026308D+00, kind = 8 ), &
    real ( 0.42789857297092602234D+00, kind = 8 ), &
    real ( 0.38652825661854504406D+00, kind = 8 ), &
    real ( 0.26538204413231368110D+00, kind = 8 ), &
    real ( 0.16848734838334595000D+00, kind = 8 ), &
    real ( 0.13609200032513227112D+00, kind = 8 ), &
    real ( 0.11070330027727917352D+00, kind = 8 ), &
    real ( 0.82126019995530382267D-01, kind = 8 ), &
    real ( 0.74538781999594581763D-01, kind = 8 ), &
    real ( 0.67732034377612811390D-01, kind = 8 ), &
    real ( 0.35641808698811851022D-01, kind = 8 ), &
    real ( 0.17956589956618269083D-01, kind = 8 ), &
    real ( 0.94058737143575370625D-02, kind = 8 ), &
    real ( 0.50809356204299213556D-02, kind = 8 ), &
    real ( 0.28149565414209719359D-02, kind = 8 ), &
    real ( 0.53808696422559303431D-03, kind = 8 ), &
    real ( 0.44821756380146327259D-04, kind = 8 ), &
    real ( 0.46890678427324100410D-05, kind = 8 ), &
    real ( 0.20161544850996420504D-08, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real ( 0.0019531250D+00, kind = 8 ), &
    real ( 0.0078125000D+00, kind = 8 ), &
    real ( 0.0312500000D+00, kind = 8 ), &
    real ( 0.1250000000D+00, kind = 8 ), &
    real ( 0.5000000000D+00, kind = 8 ), &
    real ( 1.0000000000D+00, kind = 8 ), &
    real ( 1.2500000000D+00, kind = 8 ), &
    real ( 1.5000000000D+00, kind = 8 ), &
    real ( 1.8750000000D+00, kind = 8 ), &
    real ( 2.0000000000D+00, kind = 8 ), &
    real ( 2.1250000000D+00, kind = 8 ), &
    real ( 3.0000000000D+00, kind = 8 ), &
    real ( 4.0000000000D+00, kind = 8 ), &
    real ( 5.0000000000D+00, kind = 8 ), &
    real ( 6.0000000000D+00, kind = 8 ), &
    real ( 7.0000000000D+00, kind = 8 ), &
    real ( 10.0000000000D+00, kind = 8 ), &
    real ( 15.0000000000D+00, kind = 8 ), &
    real ( 20.0000000000D+00, kind = 8 ), &
    real ( 40.0000000000D+00, kind = 8 ) /)

  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function airy_ai_int ( xvalue )

!*******************************************************************************
!
!! AIRY_AI_INT calculates the integral of the Airy function Ai.
!
!  Discussion:
!
!    The function is defined by:
!
!      AIRY_AI_INT(x) = Integral ( 0 <= t <= x ) Ai(t) dt
!
!    The program uses Chebyshev expansions, the coefficients of which
!    are given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) AIRY_AI_INT, the value of the function.
!
  implicit none

  real ( kind = 8 ) aaint1(0:25)
  real ( kind = 8 ) aaint2(0:21)
  real ( kind = 8 ) aaint3(0:40)
  real ( kind = 8 ) aaint4(0:17)
  real ( kind = 8 ) aaint5(0:17)
  real ( kind = 8 ) airy_ai_int
  real ( kind = 8 ) airzer
  real ( kind = 8 ) arg
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: eight = 8.0D+00
  real ( kind = 8 ) forty1
  real ( kind = 8 ), parameter :: four = 4.0D+00
  real ( kind = 8 ) fr996
  real ( kind = 8 ) gval
  real ( kind = 8 ) hval
  real ( kind = 8 ) nine
  real ( kind = 8 ) ninhun
  integer, parameter :: nterm1 = 22
  integer, parameter :: nterm2 = 17
  integer, parameter :: nterm3 = 37
  integer nterm4
  integer nterm5
  real ( kind = 8 ), parameter :: one = 1.0D+00
  real ( kind = 8 ) piby4
  real ( kind = 8 ) pitim6
  real ( kind = 8 ) rt2b3p
  real ( kind = 8 ) t
  real ( kind = 8 ) temp
  real ( kind = 8 ), parameter :: three = 3.0D+00
  real ( kind = 8 ), parameter :: two = 2.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xhigh1
  real ( kind = 8 ) xlow1
  real ( kind = 8 ) xneg1
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00
  real ( kind = 8 ) z

  data aaint1(0)/  0.37713517694683695526d0/
  data aaint1(1)/ -0.13318868432407947431d0/
  data aaint1(2)/  0.3152497374782884809d-1/
  data aaint1(3)/ -0.318543076436574077d-2/
  data aaint1(4)/ -0.87398764698621915d-3/
  data aaint1(5)/  0.46699497655396971d-3/
  data aaint1(6)/ -0.9544936738983692d-4/
  data aaint1(7)/  0.542705687156716d-5/
  data aaint1(8)/  0.239496406252188d-5/
  data aaint1(9)/ -0.75690270205649d-6/
  data aaint1(10)/ 0.9050138584518d-7/
  data aaint1(11)/ 0.320529456043d-8/
  data aaint1(12)/-0.303825536444d-8/
  data aaint1(13)/ 0.48900118596d-9/
  data aaint1(14)/-0.1839820572d-10/
  data aaint1(15)/-0.711247519d-11/
  data aaint1(16)/ 0.151774419d-11/
  data aaint1(17)/-0.10801922d-12/
  data aaint1(18)/-0.963542d-14/
  data aaint1(19)/ 0.313425d-14/
  data aaint1(20)/-0.29446d-15/
  data aaint1(21)/-0.477d-17/
  data aaint1(22)/ 0.461d-17/
  data aaint1(23)/-0.53d-18/
  data aaint1(24)/ 0.1d-19/
  data aaint1(25)/ 0.1d-19/
  data aaint2(0)/  1.92002524081984009769d0/
  data aaint2(1)/ -0.4220049417256287021d-1/
  data aaint2(2)/ -0.239457722965939223d-2/
  data aaint2(3)/ -0.19564070483352971d-3/
  data aaint2(4)/ -0.1547252891056112d-4/
  data aaint2(5)/ -0.140490186137889d-5/
  data aaint2(6)/ -0.12128014271367d-6/
  data aaint2(7)/ -0.1179186050192d-7/
  data aaint2(8)/ -0.104315578788d-8/
  data aaint2(9)/ -0.10908209293d-9/
  data aaint2(10)/-0.929633045d-11/
  data aaint2(11)/-0.110946520d-11/
  data aaint2(12)/-0.7816483d-13/
  data aaint2(13)/-0.1319661d-13/
  data aaint2(14)/-0.36823d-15/
  data aaint2(15)/-0.21505d-15/
  data aaint2(16)/ 0.1238d-16/
  data aaint2(17)/-0.557d-17/
  data aaint2(18)/ 0.84d-18/
  data aaint2(19)/-0.21d-18/
  data aaint2(20)/ 0.4d-19/
  data aaint2(21)/-0.1d-19/
  data aaint3(0)/  0.47985893264791052053d0/
  data aaint3(1)/ -0.19272375126169608863d0/
  data aaint3(2)/  0.2051154129525428189d-1/
  data aaint3(3)/  0.6332000070732488786d-1/
  data aaint3(4)/ -0.5093322261845754082d-1/
  data aaint3(5)/  0.1284424078661663016d-1/
  data aaint3(6)/  0.2760137088989479413d-1/
  data aaint3(7)/ -0.1547066673866649507d-1/
  data aaint3(8)/ -0.1496864655389316026d-1/
  data aaint3(9)/  0.336617614173574541d-2/
  data aaint3(10)/ 0.530851163518892985d-2/
  data aaint3(11)/ 0.41371226458555081d-3/
  data aaint3(12)/-0.102490579926726266d-2/
  data aaint3(13)/-0.32508221672025853d-3/
  data aaint3(14)/ 0.8608660957169213d-4/
  data aaint3(15)/ 0.6671367298120775d-4/
  data aaint3(16)/ 0.449205999318095d-5/
  data aaint3(17)/-0.670427230958249d-5/
  data aaint3(18)/-0.196636570085009d-5/
  data aaint3(19)/ 0.22229677407226d-6/
  data aaint3(20)/ 0.22332222949137d-6/
  data aaint3(21)/ 0.2803313766457d-7/
  data aaint3(22)/-0.1155651663619d-7/
  data aaint3(23)/-0.433069821736d-8/
  data aaint3(24)/-0.6227777938d-10/
  data aaint3(25)/ 0.26432664903d-9/
  data aaint3(26)/ 0.5333881114d-10/
  data aaint3(27)/-0.522957269d-11/
  data aaint3(28)/-0.382229283d-11/
  data aaint3(29)/-0.40958233d-12/
  data aaint3(30)/ 0.11515622d-12/
  data aaint3(31)/ 0.3875766d-13/
  data aaint3(32)/ 0.140283d-14/
  data aaint3(33)/-0.141526d-14/
  data aaint3(34)/-0.28746d-15/
  data aaint3(35)/ 0.923d-17/
  data aaint3(36)/ 0.1224d-16/
  data aaint3(37)/ 0.157d-17/
  data aaint3(38)/-0.19d-18/
  data aaint3(39)/-0.8d-19/
  data aaint3(40)/-0.1d-19/
  data aaint4/1.99653305828522730048d0, &
             -0.187541177605417759d-2, &
             -0.15377536280305750d-3, &
             -0.1283112967682349d-4, &
             -0.108128481964162d-5, &
             -0.9182131174057d-7, &
             -0.784160590960d-8, &
             -0.67292453878d-9, &
             -0.5796325198d-10, &
             -0.501040991d-11, &
             -0.43420222d-12, &
             -0.3774305d-13, &
             -0.328473d-14, &
             -0.28700d-15, &
             -0.2502d-16, &
             -0.220d-17, &
             -0.19d-18, &
             -0.2d-19/
  data aaint5/1.13024602034465716133d0, &
             -0.464718064639872334d-2, &
             -0.35137413382693203d-3, &
             -0.2768117872545185d-4, &
             -0.222057452558107d-5, &
             -0.18089142365974d-6, &
             -0.1487613383373d-7, &
             -0.123515388168d-8, &
             -0.10310104257d-9, &
             -0.867493013d-11, &
             -0.73080054d-12, &
             -0.6223561d-13, &
             -0.525128d-14, &
             -0.45677d-15, &
             -0.3748d-16, &
             -0.356d-17, &
             -0.23d-18, &
             -0.4d-19/
  data nine,forty1/ 9.0d0, 41.0d0/
  data ninhun,fr996/ 900.0d0, 4996.0d0 /
  data piby4/0.78539816339744830962d0/
  data pitim6/18.84955592153875943078d0/
  data rt2b3p/0.46065886596178063902d0/
  data airzer/0.35502805388781723926d0/
!
!   Machine-dependant constants (suitable for IEEE machines)
!
  data nterm4,nterm5/15,15/
  data xlow1,xhigh1,xneg1/2.22045d-16,14.480884d0,-2.727134d10/

  x = xvalue

  if ( x < xneg1 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'AIRY_AI_INT - Fatal error!'
    write ( *, '(a)' ) '  X too negative for accurate computation.'
    airy_ai_int = -two / three
    return
  else if ( x < -eight ) then
    z = - ( x + x ) * sqrt ( -x ) / three
    arg = z + piby4
    temp = nine * z * z
    t = ( fr996 - temp ) / ( ninhun + temp )
    gval = cheval ( nterm4, aaint4, t )
    hval = cheval ( nterm5, aaint5, t )
    temp = gval * cos ( arg ) + hval * sin ( arg ) / z
    airy_ai_int = rt2b3p * temp / sqrt ( z ) - two / three
  else if ( x <= -xlow1 )then
    t = -x / four - one
    airy_ai_int = x * cheval ( nterm3, aaint3, t )
  else if ( x < xlow1 ) then
    airy_ai_int = airzer * x
  else if ( x <= four ) then
    t = x / two - one
    airy_ai_int = cheval ( nterm1, aaint1, t ) * x
  else if ( x <= xhigh1 ) then
    z = ( x + x ) * sqrt ( x ) / three
    temp = three * z
    t = ( forty1 - temp ) / ( nine + temp )
    temp = exp ( -z ) * cheval ( nterm2, aaint2, t ) / sqrt ( pitim6 * z )
    airy_ai_int = one / three - temp
  else
    airy_ai_int = one / three
  end if

  return
end
subroutine airy_ai_int_values ( n_data, x, fx )

!*******************************************************************************
!
!! AIRY_AI_INT_VALUES returns some values of the integral of the Airy function.
!
!  Discussion:
!
!    The function is defined by:
!
!      AIRY_AI_INT(x) = Integral ( 0 <= t <= x ) Ai(t) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    22 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none

  integer, parameter :: n_max = 20

  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( -0.75228838916610124300D+00, kind = 8 ), &
    real ( -0.57348350185854889466D+00, kind = 8 ), &
    real ( -0.76569840313421291743D+00, kind = 8 ), &
    real ( -0.65181015505382467421D+00, kind = 8 ), &
    real ( -0.55881974894471876922D+00, kind = 8 ), &
    real ( -0.56902352870716815309D+00, kind = 8 ), &
    real ( -0.47800749642926168100D+00, kind = 8 ), &
    real ( -0.46567398346706861416D+00, kind = 8 ), &
    real ( -0.96783140945618013679D-01, kind = 8 ), &
    real ( -0.34683049857035607494D-03, kind = 8 ), &
    real (  0.34658366917927930790D-03, kind = 8 ), &
    real (  0.27657581846051227124D-02, kind = 8 ), &
    real (  0.14595330491185717833D+00, kind = 8 ), &
    real (  0.23631734191710977960D+00, kind = 8 ), &
    real (  0.33289264538612212697D+00, kind = 8 ), &
    real (  0.33318759129779422976D+00, kind = 8 ), &
    real (  0.33332945170523851439D+00, kind = 8 ), &
    real (  0.33333331724248357420D+00, kind = 8 ), &
    real (  0.33333333329916901594D+00, kind = 8 ), &
    real (  0.33333333333329380187D+00, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real ( -12.0000000000D+00, kind = 8 ), &
    real ( -11.0000000000D+00, kind = 8 ), &
    real ( -10.0000000000D+00, kind = 8 ), &
    real (  -9.5000000000D+00, kind = 8 ), &
    real (  -9.0000000000D+00, kind = 8 ), &
    real (  -6.5000000000D+00, kind = 8 ), &
    real (  -4.0000000000D+00, kind = 8 ), &
    real (  -1.0000000000D+00, kind = 8 ), &
    real (  -0.2500000000D+00, kind = 8 ), &
    real (  -0.0009765625D+00, kind = 8 ), &
    real (   0.0009765625D+00, kind = 8 ), &
    real (   0.0078125000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.5000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  12.0000000000D+00, kind = 8 ) /)

  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function airy_bi_int ( xvalue )

!*******************************************************************************
!
!! AIRY_BI_INT calculates the integral of the Airy function Bi.
!
!  Discussion:
!
!    The function is defined by:
!
!      AIRY_BI_INT(x) = Integral ( 0 <= t <= x ) Bi(t) dt
!
!    The program uses Chebyshev expansions, the coefficients of which
!    are given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) AIRY_BI_INT, the value of the function.
!
  implicit none

  real ( kind = 8 ) abint1(0:36)
  real ( kind = 8 ) abint2(0:37)
  real ( kind = 8 ) abint3(0:37)
  real ( kind = 8 ) abint4(0:20)
  real ( kind = 8 ) abint5(0:20)
  real ( kind = 8 ) airy_bi_int
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: eight = real ( 8.0, kind = 8 )
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  integer, parameter :: nterm1 = 33
  integer, parameter :: nterm2 = 30
  integer, parameter :: nterm3 = 34
  integer nterm4
  integer nterm5
  real ( kind = 8 ), parameter :: one = 1.0D+00
  real ( kind = 8 ), parameter :: three = 3.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) arg,birzer,f1,f2,nine,ninhun, &
       onept5,piby4,rt2b3p,sixten,seven,t,temp, &
       thr644,xlow1,xhigh1,xmax,xneg1, &
       z
  data abint1(0)/  0.38683352445038543350d0/
  data abint1(1)/ -0.8823213550888908821d-1/
  data abint1(2)/  0.21463937440355429239d0/
  data abint1(3)/ -0.4205347375891315126d-1/
  data abint1(4)/  0.5932422547496086771d-1/
  data abint1(5)/ -0.840787081124270210d-2/
  data abint1(6)/  0.871824772778487955d-2/
  data abint1(7)/ -0.12191600199613455d-3/
  data abint1(8)/  0.44024821786023234d-3/
  data abint1(9)/  0.27894686666386678d-3/
  data abint1(10)/-0.7052804689785537d-4/
  data abint1(11)/ 0.5901080066770100d-4/
  data abint1(12)/-0.1370862587982142d-4/
  data abint1(13)/ 0.505962573749073d-5/
  data abint1(14)/-0.51598837766735d-6/
  data abint1(15)/ 0.397511312349d-8/
  data abint1(16)/ 0.9524985978055d-7/
  data abint1(17)/-0.3681435887321d-7/
  data abint1(18)/ 0.1248391688136d-7/
  data abint1(19)/-0.249097619137d-8/
  data abint1(20)/ 0.31775245551d-9/
  data abint1(21)/ 0.5434365270d-10/
  data abint1(22)/-0.4024566915d-10/
  data abint1(23)/ 0.1393855527d-10/
  data abint1(24)/-0.303817509d-11/
  data abint1(25)/ 0.40809511d-12/
  data abint1(26)/ 0.1634116d-13/
  data abint1(27)/-0.2683809d-13/
  data abint1(28)/ 0.896641d-14/
  data abint1(29)/-0.183089d-14/
  data abint1(30)/ 0.21333d-15/
  data abint1(31)/ 0.1108d-16/
  data abint1(32)/-0.1276d-16/
  data abint1(33)/ 0.363d-17/
  data abint1(34)/-0.62d-18/
  data abint1(35)/ 0.5d-19/
  data abint1(36)/ 0.1d-19/
  data abint2(0)/  2.04122078602516135181d0/
  data abint2(1)/  0.2124133918621221230d-1/
  data abint2(2)/  0.66617599766706276d-3/
  data abint2(3)/  0.3842047982808254d-4/
  data abint2(4)/  0.362310366020439d-5/
  data abint2(5)/  0.50351990115074d-6/
  data abint2(6)/  0.7961648702253d-7/
  data abint2(7)/  0.717808442336d-8/
  data abint2(8)/ -0.267770159104d-8/
  data abint2(9)/ -0.168489514699d-8/
  data abint2(10)/-0.36811757255d-9/
  data abint2(11)/ 0.4757128727d-10/
  data abint2(12)/ 0.5263621945d-10/
  data abint2(13)/ 0.778973500d-11/
  data abint2(14)/-0.460546143d-11/
  data abint2(15)/-0.183433736d-11/
  data abint2(16)/ 0.32191249d-12/
  data abint2(17)/ 0.29352060d-12/
  data abint2(18)/-0.1657935d-13/
  data abint2(19)/-0.4483808d-13/
  data abint2(20)/ 0.27907d-15/
  data abint2(21)/ 0.711921d-14/
  data abint2(22)/-0.1042d-16/
  data abint2(23)/-0.119591d-14/
  data abint2(24)/ 0.4606d-16/
  data abint2(25)/ 0.20884d-15/
  data abint2(26)/-0.2416d-16/
  data abint2(27)/-0.3638d-16/
  data abint2(28)/ 0.863d-17/
  data abint2(29)/ 0.591d-17/
  data abint2(30)/-0.256d-17/
  data abint2(31)/-0.77d-18/
  data abint2(32)/ 0.66d-18/
  data abint2(33)/ 0.3d-19/
  data abint2(34)/-0.15d-18/
  data abint2(35)/ 0.2d-19/
  data abint2(36)/ 0.3d-19/
  data abint2(37)/-0.1d-19/
  data abint3(0)/  0.31076961598640349251d0/
  data abint3(1)/ -0.27528845887452542718d0/
  data abint3(2)/  0.17355965706136543928d0/
  data abint3(3)/ -0.5544017909492843130d-1/
  data abint3(4)/ -0.2251265478295950941d-1/
  data abint3(5)/  0.4107347447812521894d-1/
  data abint3(6)/  0.984761275464262480d-2/
  data abint3(7)/ -0.1555618141666041932d-1/
  data abint3(8)/ -0.560871870730279234d-2/
  data abint3(9)/  0.246017783322230475d-2/
  data abint3(10)/ 0.165740392292336978d-2/
  data abint3(11)/-0.3277587501435402d-4/
  data abint3(12)/-0.24434680860514925d-3/
  data abint3(13)/-0.5035305196152321d-4/
  data abint3(14)/ 0.1630264722247854d-4/
  data abint3(15)/ 0.851914057780934d-5/
  data abint3(16)/ 0.29790363004664d-6/
  data abint3(17)/-0.64389707896401d-6/
  data abint3(18)/-0.15046988145803d-6/
  data abint3(19)/ 0.1587013535823d-7/
  data abint3(20)/ 0.1276766299622d-7/
  data abint3(21)/ 0.140578534199d-8/
  data abint3(22)/-0.46564739741d-9/
  data abint3(23)/-0.15682748791d-9/
  data abint3(24)/-0.403893560d-11/
  data abint3(25)/ 0.666708192d-11/
  data abint3(26)/ 0.128869380d-11/
  data abint3(27)/-0.6968663d-13/
  data abint3(28)/-0.6254319d-13/
  data abint3(29)/-0.718392d-14/
  data abint3(30)/ 0.115296d-14/
  data abint3(31)/ 0.42276d-15/
  data abint3(32)/ 0.2493d-16/
  data abint3(33)/-0.971d-17/
  data abint3(34)/-0.216d-17/
  data abint3(35)/-0.2d-19/
  data abint3(36)/ 0.6d-19/
  data abint3(37)/ 0.1d-19/
  data abint4(0)/  1.99507959313352047614d0/
  data abint4(1)/ -0.273736375970692738d-2/
  data abint4(2)/ -0.30897113081285850d-3/
  data abint4(3)/ -0.3550101982798577d-4/
  data abint4(4)/ -0.412179271520133d-5/
  data abint4(5)/ -0.48235892316833d-6/
  data abint4(6)/ -0.5678730727927d-7/
  data abint4(7)/ -0.671874810365d-8/
  data abint4(8)/ -0.79811649857d-9/
  data abint4(9)/ -0.9514271478d-10/
  data abint4(10)/-0.1137468966d-10/
  data abint4(11)/-0.136359969d-11/
  data abint4(12)/-0.16381418d-12/
  data abint4(13)/-0.1972575d-13/
  data abint4(14)/-0.237844d-14/
  data abint4(15)/-0.28752d-15/
  data abint4(16)/-0.3475d-16/
  data abint4(17)/-0.422d-17/
  data abint4(18)/-0.51d-18/
  data abint4(19)/-0.6d-19/
  data abint4(20)/-0.1d-19/
  data abint5(0)/  1.12672081961782566017d0/
  data abint5(1)/ -0.671405567525561198d-2/
  data abint5(2)/ -0.69812918017832969d-3/
  data abint5(3)/ -0.7561689886425276d-4/
  data abint5(4)/ -0.834985574510207d-5/
  data abint5(5)/ -0.93630298232480d-6/
  data abint5(6)/ -0.10608556296250d-6/
  data abint5(7)/ -0.1213128916741d-7/
  data abint5(8)/ -0.139631129765d-8/
  data abint5(9)/ -0.16178918054d-9/
  data abint5(10)/-0.1882307907d-10/
  data abint5(11)/-0.220272985d-11/
  data abint5(12)/-0.25816189d-12/
  data abint5(13)/-0.3047964d-13/
  data abint5(14)/-0.358370d-14/
  data abint5(15)/-0.42831d-15/
  data abint5(16)/-0.4993d-16/
  data abint5(17)/-0.617d-17/
  data abint5(18)/-0.68d-18/
  data abint5(19)/-0.10d-18/
  data abint5(20)/-0.1d-19/
  data onept5/ 1.5d0 /
  data seven/ 7.0d0 /
  data nine,sixten/ 9.0d0 , 16.0d0 /
  data ninhun,thr644/900.0d0 , 3644.0d0 /
  data piby4/0.78539816339744830962d0/
  data rt2b3p/0.46065886596178063902d0/
  data birzer/0.61492662744600073515d0/
!
!   Machine-dependent parameters (suitable for IEEE machines)
!
  data nterm4,nterm5/17,17/
  data xlow1,xhigh1/2.22044604d-16,104.587632d0/
  data xneg1,xmax/-2.727134d10,1.79d308/

  x = xvalue

  if ( x < xneg1 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'AIRY_BI_INT - Warning!'
    write ( *, '(a)' ) '  Argument is too negative for accurate computation.'
    airy_bi_int = zero
  else if ( x < -seven ) then
    z = - ( x + x ) * sqrt ( -x ) / three
    arg = z + piby4
    temp = nine * z * z
    t = ( thr644 - temp ) / ( ninhun + temp )
    f1 = cheval ( nterm4, abint4, t ) * sin ( arg )
    f2 = cheval ( nterm5, abint5, t ) * cos ( arg ) / z
    airy_bi_int = ( f2 - f1 ) * rt2b3p / sqrt ( z )
  else if ( x <= -xlow1 ) then
    t = - ( x + x ) / seven - one
    airy_bi_int = x * cheval ( nterm3, abint3, t )
  else if ( x < xlow1 ) then
    airy_bi_int = birzer * x
  else if ( x <= eight ) then
    t = x / four - one
    airy_bi_int = x * exp ( onept5 * x ) * cheval ( nterm1, abint1, t )
  else if ( x <= xhigh1 ) then
    t = sixten * sqrt ( eight / x ) / x - one
    z = ( x + x ) * sqrt ( x ) / three
    temp = rt2b3p * cheval ( nterm2, abint2, t ) / sqrt ( z )
    temp = z + log ( temp )
    airy_bi_int = exp ( temp )
  else
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'AIRY_BI_INT - Warning!'
    write ( *, '(a)' ) '  Argument is too large for accurate computation.'
    airy_bi_int = xmax
  end if

  return
end
subroutine airy_bi_int_values ( n_data, x, fx )

!*******************************************************************************
!
!! AIRY_BI_INT_VALUES returns some values of the integral of the Airy function.
!
!  Discussion:
!
!    The function is defined by:
!
!      AIRY_BI_INT(x) = Integral ( 0 <= t <= x ) Bi(t) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    23 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none

  integer, parameter :: n_max = 20

  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real (  0.17660819031554631869D-01, kind = 8 ), &
    real ( -0.15040424806140020451D-01, kind = 8 ), &
    real (  0.14756446293227661920D-01, kind = 8 ), &
    real ( -0.11847304264848446271D+00, kind = 8 ), &
    real ( -0.64916741266165856037D-01, kind = 8 ), &
    real (  0.97260832464381044540D-01, kind = 8 ), &
    real (  0.50760058495287539119D-01, kind = 8 ), &
    real ( -0.37300500963429492179D+00, kind = 8 ), &
    real ( -0.13962988442666578531D+00, kind = 8 ), &
    real ( -0.12001735266723296160D-02, kind = 8 ), &
    real (  0.12018836117890354598D-02, kind = 8 ), &
    real (  0.36533846550952011043D+00, kind = 8 ), &
    real (  0.87276911673800812196D+00, kind = 8 ), &
    real (  0.48219475263803429675D+02, kind = 8 ), &
    real (  0.44006525804904178439D+06, kind = 8 ), &
    real (  0.17608153976228301458D+07, kind = 8 ), &
    real (  0.73779211705220007228D+07, kind = 8 ), &
    real (  0.14780980310740671617D+09, kind = 8 ), &
    real (  0.97037614223613433849D+11, kind = 8 ), &
    real (  0.11632737638809878460D+15, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real ( -12.0000000000D+00, kind = 8 ), &
    real ( -10.0000000000D+00, kind = 8 ), &
    real (  -8.0000000000D+00, kind = 8 ), &
    real (  -7.5000000000D+00, kind = 8 ), &
    real (  -7.0000000000D+00, kind = 8 ), &
    real (  -6.5000000000D+00, kind = 8 ), &
    real (  -4.0000000000D+00, kind = 8 ), &
    real (  -1.0000000000D+00, kind = 8 ), &
    real (  -0.2500000000D+00, kind = 8 ), &
    real (  -0.0019531250D+00, kind = 8 ), &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (   8.5000000000D+00, kind = 8 ), &
    real (   9.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  12.0000000000D+00, kind = 8 ), &
    real (  14.0000000000D+00, kind = 8 ) /)

  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function airy_gi ( xvalue )

!*******************************************************************************
!
!! AIRY_GI computes the modified Airy function Gi(x).
!
!  Discussion:
!
!    The function is defined by:
!
!      AIRY_GI(x) = Integral ( 0 <= t < infinity ) sin ( x*t+t^3/3) dt / pi
!
!    The approximation uses Chebyshev expansions with the coefficients
!    given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) AIRY_GI, the value of the function.
!
  implicit none

  real ( kind = 8 ) airy_gi
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  integer, parameter :: nterm1 = 28
  integer, parameter :: nterm2 = 23
  integer, parameter :: nterm3 = 39
  integer nterm4
  integer nterm5
  integer nterm6
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ), parameter :: three = 3.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) argip1(0:30),argip2(0:29),argin1(0:42), &
       arbin1(0:10),arbin2(0:11),arhin1(0:15), &
       bi,cheb1,cheb2,cosz,five,five14, &
       gizero,minate,nine,onebpi,one76,one024,piby4, &
       rtpiin,seven,seven2,sinz,t,temp,twelhu,twent8, &
       xcube,xhigh1,xhigh2,xhigh3,xlow1,xminus, &
       zeta
  data argip1(0)/  0.26585770795022745082d0/
  data argip1(1)/ -0.10500333097501922907d0/
  data argip1(2)/  0.841347475328454492d-2/
  data argip1(3)/  0.2021067387813439541d-1/
  data argip1(4)/ -0.1559576113863552234d-1/
  data argip1(5)/  0.564342939043256481d-2/
  data argip1(6)/ -0.59776844826655809d-3/
  data argip1(7)/ -0.42833850264867728d-3/
  data argip1(8)/  0.22605662380909027d-3/
  data argip1(9)/ -0.3608332945592260d-4/
  data argip1(10)/-0.785518988788901d-5/
  data argip1(11)/ 0.473252480746370d-5/
  data argip1(12)/-0.59743513977694d-6/
  data argip1(13)/-0.15917609165602d-6/
  data argip1(14)/ 0.6336129065570d-7/
  data argip1(15)/-0.276090232648d-8/
  data argip1(16)/-0.256064154085d-8/
  data argip1(17)/ 0.47798676856d-9/
  data argip1(18)/ 0.4488131863d-10/
  data argip1(19)/-0.2346508882d-10/
  data argip1(20)/ 0.76839085d-12/
  data argip1(21)/ 0.73227985d-12/
  data argip1(22)/-0.8513687d-13/
  data argip1(23)/-0.1630201d-13/
  data argip1(24)/ 0.356769d-14/
  data argip1(25)/ 0.25001d-15/
  data argip1(26)/-0.10859d-15/
  data argip1(27)/-0.158d-17/
  data argip1(28)/ 0.275d-17/
  data argip1(29)/-0.5d-19/
  data argip1(30)/-0.6d-19/
  data argip2(0)/  2.00473712275801486391d0/
  data argip2(1)/  0.294184139364406724d-2/
  data argip2(2)/  0.71369249006340167d-3/
  data argip2(3)/  0.17526563430502267d-3/
  data argip2(4)/  0.4359182094029882d-4/
  data argip2(5)/  0.1092626947604307d-4/
  data argip2(6)/  0.272382418399029d-5/
  data argip2(7)/  0.66230900947687d-6/
  data argip2(8)/  0.15425323370315d-6/
  data argip2(9)/  0.3418465242306d-7/
  data argip2(10)/ 0.728157724894d-8/
  data argip2(11)/ 0.151588525452d-8/
  data argip2(12)/ 0.30940048039d-9/
  data argip2(13)/ 0.6149672614d-10/
  data argip2(14)/ 0.1202877045d-10/
  data argip2(15)/ 0.233690586d-11/
  data argip2(16)/ 0.43778068d-12/
  data argip2(17)/ 0.7996447d-13/
  data argip2(18)/ 0.1494075d-13/
  data argip2(19)/ 0.246790d-14/
  data argip2(20)/ 0.37672d-15/
  data argip2(21)/ 0.7701d-16/
  data argip2(22)/ 0.354d-17/
  data argip2(23)/-0.49d-18/
  data argip2(24)/ 0.62d-18/
  data argip2(25)/-0.40d-18/
  data argip2(26)/-0.1d-19/
  data argip2(27)/ 0.2d-19/
  data argip2(28)/-0.3d-19/
  data argip2(29)/ 0.1d-19/
  data argin1(0)/ -0.20118965056732089130d0/
  data argin1(1)/ -0.7244175303324530499d-1/
  data argin1(2)/  0.4505018923894780120d-1/
  data argin1(3)/ -0.24221371122078791099d0/
  data argin1(4)/  0.2717884964361678294d-1/
  data argin1(5)/ -0.5729321004818179697d-1/
  data argin1(6)/ -0.18382107860337763587d0/
  data argin1(7)/  0.7751546082149475511d-1/
  data argin1(8)/  0.18386564733927560387d0/
  data argin1(9)/  0.2921504250185567173d-1/
  data argin1(10)/-0.6142294846788018811d-1/
  data argin1(11)/-0.2999312505794616238d-1/
  data argin1(12)/ 0.585937118327706636d-2/
  data argin1(13)/ 0.822221658497402529d-2/
  data argin1(14)/ 0.132579817166846893d-2/
  data argin1(15)/-0.96248310766565126d-3/
  data argin1(16)/-0.45065515998211807d-3/
  data argin1(17)/ 0.772423474325474d-5/
  data argin1(18)/ 0.5481874134758052d-4/
  data argin1(19)/ 0.1245898039742876d-4/
  data argin1(20)/-0.246196891092083d-5/
  data argin1(21)/-0.169154183545285d-5/
  data argin1(22)/-0.16769153169442d-6/
  data argin1(23)/ 0.9636509337672d-7/
  data argin1(24)/ 0.3253314928030d-7/
  data argin1(25)/ 0.5091804231d-10/
  data argin1(26)/-0.209180453553d-8/
  data argin1(27)/-0.41237387870d-9/
  data argin1(28)/ 0.4163338253d-10/
  data argin1(29)/ 0.3032532117d-10/
  data argin1(30)/ 0.340580529d-11/
  data argin1(31)/-0.88444592d-12/
  data argin1(32)/-0.31639612d-12/
  data argin1(33)/-0.1505076d-13/
  data argin1(34)/ 0.1104148d-13/
  data argin1(35)/ 0.246508d-14/
  data argin1(36)/-0.3107d-16/
  data argin1(37)/-0.9851d-16/
  data argin1(38)/-0.1453d-16/
  data argin1(39)/ 0.118d-17/
  data argin1(40)/ 0.67d-18/
  data argin1(41)/ 0.6d-19/
  data argin1(42)/-0.1d-19/
  data arbin1/1.99983763583586155980d0, &
             -0.8104660923669418d-4, &
              0.13475665984689d-6, &
             -0.70855847143d-9, &
              0.748184187d-11, &
             -0.12902774d-12, &
              0.322504d-14, &
             -0.10809d-15, &
              0.460d-17, &
             -0.24d-18, &
              0.1d-19/
  data arbin2/0.13872356453879120276d0, &
             -0.8239286225558228d-4, &
              0.26720919509866d-6, &
             -0.207423685368d-8, &
              0.2873392593d-10, &
             -0.60873521d-12, &
              0.1792489d-13, &
             -0.68760d-15, &
              0.3280d-16, &
             -0.188d-17, &
              0.13d-18, &
             -0.1d-19/
  data arhin1/1.99647720399779650525d0, &
             -0.187563779407173213d-2, &
             -0.12186470897787339d-3, &
             -0.814021609659287d-5, &
             -0.55050925953537d-6, &
             -0.3763008043303d-7, &
             -0.258858362365d-8, &
             -0.17931829265d-9, &
             -0.1245916873d-10, &
             -0.87171247d-12, &
             -0.6084943d-13, &
             -0.431178d-14, &
             -0.29787d-15, &
             -0.2210d-16, &
             -0.136d-17, &
             -0.14d-18/
  data five,seven,minate/ 5.0d0, 7.0d0 , -8.0d0 /
  data nine,twent8,seven2/ 9.0d0, 28.0d0 , 72.0d0 /
  data one76,five14/ 176.0d0 , 514.0d0 /
  data one024,twelhu/ 1024.0d0, 1200.0d0 /
  data gizero/0.20497554248200024505d0/
  data onebpi/0.31830988618379067154d0/
  data piby4/0.78539816339744830962d0/
  data rtpiin/0.56418958354775628695d0/
!
!   Machine-dependent constants (suitable for IEEE machines)
!
  data nterm4,nterm5,nterm6/9,10,14/
  data xlow1,xhigh1/2.22045d-16,208063.8307d0/
  data xhigh2,xhigh3/0.14274d308,-2097152.0d0/

  x = xvalue

  if ( x < -xhigh1 * xhigh1 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'AIRY_GI - Fatal error!'
    write ( *, '(a)' ) '  Argument too negative for accurate computation.'
    airy_gi = zero
  else if ( x <= xhigh3 ) then
    xminus = -x
    t = xminus * sqrt ( xminus )
    zeta = ( t + t ) / three
    temp = rtpiin / sqrt ( sqrt ( xminus ) )
    cosz = cos ( zeta + piby4 )
    sinz = sin ( zeta + piby4 ) / zeta
    xcube = x * x * x
    bi = ( cosz + sinz * five / seven2 ) * temp
    t = ( xcube + twelhu ) / ( one76 - xcube )
    airy_gi = bi + cheval ( nterm6, arhin1, t ) * onebpi / x
  else if ( x < minate ) then
    xminus = -x
    t = xminus * sqrt ( xminus )
    zeta = ( t + t ) / three
    temp = rtpiin / sqrt ( sqrt ( xminus ) )
    cosz = cos ( zeta + piby4 )
    sinz = sin ( zeta + piby4 ) / zeta
    xcube = x * x * x
    t = - ( one024 / ( xcube ) + one )
    cheb1 = cheval ( nterm4, arbin1, t )
    cheb2 = cheval ( nterm5, arbin2, t )
    bi = ( cosz * cheb1 + sinz * cheb2 ) * temp
    t = ( xcube + twelhu ) / ( one76 - xcube )
    airy_gi = bi + cheval ( nterm6, arhin1, t ) * onebpi / x
  else if ( x <= -xlow1 ) then
    t = -( x + four ) / four
    airy_gi = cheval ( nterm3, argin1, t )
  else if ( x < xlow1 ) then
    airy_gi = gizero
  else if ( x <= seven ) then
    t = ( nine * x - twent8 ) / ( x + twent8 )
    airy_gi = cheval ( nterm1, argip1, t )
  else if ( x <= xhigh1 ) then
    xcube = x * x * x
    t = ( twelhu - xcube ) / ( five14 + xcube )
    airy_gi = onebpi * cheval ( nterm2, argip2, t ) / x
  else if ( x <= xhigh2 ) then
    airy_gi = onebpi / x
  else
    airy_gi = zero
  end if

  return
end
subroutine airy_gi_values ( n_data, x, fx )

!*******************************************************************************
!
!! AIRY_GI_VALUES returns some values of the Airy Gi function.
!
!  Discussion:
!
!    The function is defined by:
!
!      AIRY_GI(x) = Integral ( 0 <= t < infinity ) sin ( x*t+t^3/3) dt / pi
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    24 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none

  integer, parameter :: n_max = 20

  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real (  0.20468308070040542435D+00, kind = 8 ), &
    real (  0.18374662832557904078D+00, kind = 8 ), &
    real ( -0.11667221729601528265D+00, kind = 8 ), &
    real (  0.31466934902729557596D+00, kind = 8 ), &
    real ( -0.37089040722426257729D+00, kind = 8 ), &
    real ( -0.25293059772424019694D+00, kind = 8 ), &
    real (  0.28967410658692701936D+00, kind = 8 ), &
    real ( -0.34644836492634090590D+00, kind = 8 ), &
    real (  0.28076035913873049496D+00, kind = 8 ), &
    real (  0.21814994508094865815D+00, kind = 8 ), &
    real (  0.20526679000810503329D+00, kind = 8 ), &
    real (  0.22123695363784773258D+00, kind = 8 ), &
    real (  0.23521843981043793760D+00, kind = 8 ), &
    real (  0.82834303363768729338D-01, kind = 8 ), &
    real (  0.45757385490989281893D-01, kind = 8 ), &
    real (  0.44150012014605159922D-01, kind = 8 ), &
    real (  0.39951133719508907541D-01, kind = 8 ), &
    real (  0.35467706833949671483D-01, kind = 8 ), &
    real (  0.31896005100679587981D-01, kind = 8 ), &
    real (  0.26556892713512410405D-01, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (  -0.0019531250D+00, kind = 8 ), &
    real (  -0.1250000000D+00, kind = 8 ), &
    real (  -1.0000000000D+00, kind = 8 ), &
    real (  -4.0000000000D+00, kind = 8 ), &
    real (  -8.0000000000D+00, kind = 8 ), &
    real (  -8.2500000000D+00, kind = 8 ), &
    real (  -9.0000000000D+00, kind = 8 ), &
    real ( -10.0000000000D+00, kind = 8 ), &
    real ( -11.0000000000D+00, kind = 8 ), &
    real ( -13.0000000000D+00, kind = 8 ), &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   7.0000000000D+00, kind = 8 ), &
    real (   7.2500000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (   9.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  12.0000000000D+00, kind = 8 ) /)

  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function airy_hi ( xvalue )

!*******************************************************************************
!
!! AIRY_HI computes the modified Airy function Hi(x).
!
!  Discussion:
!
!    The function is defined by:
!
!      AIRY_HI(x) = Integral ( 0 <= t < infinity ) exp(x*t-t^3/3) dt / pi
!
!    The approximation uses Chebyshev expansions with the coefficients
!    given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) AIRY_HI, the value of the function.
!
  implicit none

  real ( kind = 8 ) airy_hi
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  integer, parameter :: nterm1 = 29
  integer, parameter :: nterm2 = 17
  integer, parameter :: nterm3 = 22
  integer nterm4
  integer nterm5
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ), parameter :: three = 3.0D+00
  real ( kind = 8 ), parameter :: two = 2.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) arhip(0:31),arbip(0:23),argip1(0:29), &
       arhin1(0:21),arhin2(0:15), &
       bi,five14,gi,hizero,lnrtpi, &
       minate,onebpi,one76,seven,t,temp, &
       thre43,twelhu,twelve,xcube, &
       xhigh1,xlow1,xmax,xneg1,xneg2, &
       zeta
  data arhip(0)/ 1.24013562561762831114d0/
  data arhip(1)/ 0.64856341973926535804d0/
  data arhip(2)/ 0.55236252592114903246d0/
  data arhip(3)/ 0.20975122073857566794d0/
  data arhip(4)/ 0.12025669118052373568d0/
  data arhip(5)/ 0.3768224931095393785d-1/
  data arhip(6)/ 0.1651088671548071651d-1/
  data arhip(7)/ 0.455922755211570993d-2/
  data arhip(8)/ 0.161828480477635013d-2/
  data arhip(9)/ 0.40841282508126663d-3/
  data arhip(10)/0.12196479721394051d-3/
  data arhip(11)/0.2865064098657610d-4/
  data arhip(12)/0.742221556424344d-5/
  data arhip(13)/0.163536231932831d-5/
  data arhip(14)/0.37713908188749d-6/
  data arhip(15)/0.7815800336008d-7/
  data arhip(16)/0.1638447121370d-7/
  data arhip(17)/0.319857665992d-8/
  data arhip(18)/0.61933905307d-9/
  data arhip(19)/0.11411161191d-9/
  data arhip(20)/0.2064923454d-10/
  data arhip(21)/0.360018664d-11/
  data arhip(22)/0.61401849d-12/
  data arhip(23)/0.10162125d-12/
  data arhip(24)/0.1643701d-13/
  data arhip(25)/0.259084d-14/
  data arhip(26)/0.39931d-15/
  data arhip(27)/0.6014d-16/
  data arhip(28)/0.886d-17/
  data arhip(29)/0.128d-17/
  data arhip(30)/0.18d-18/
  data arhip(31)/0.3d-19/
  data arbip(0)/  2.00582138209759064905d0/
  data arbip(1)/  0.294478449170441549d-2/
  data arbip(2)/  0.3489754514775355d-4/
  data arbip(3)/  0.83389733374343d-6/
  data arbip(4)/  0.3136215471813d-7/
  data arbip(5)/  0.167865306015d-8/
  data arbip(6)/  0.12217934059d-9/
  data arbip(7)/  0.1191584139d-10/
  data arbip(8)/  0.154142553d-11/
  data arbip(9)/  0.24844455d-12/
  data arbip(10)/ 0.4213012d-13/
  data arbip(11)/ 0.505293d-14/
  data arbip(12)/-0.60032d-15/
  data arbip(13)/-0.65474d-15/
  data arbip(14)/-0.22364d-15/
  data arbip(15)/-0.3015d-16/
  data arbip(16)/ 0.959d-17/
  data arbip(17)/ 0.616d-17/
  data arbip(18)/ 0.97d-18/
  data arbip(19)/-0.37d-18/
  data arbip(20)/-0.21d-18/
  data arbip(21)/-0.1d-19/
  data arbip(22)/ 0.2d-19/
  data arbip(23)/ 0.1d-19/
  data argip1(0)/  2.00473712275801486391d0/
  data argip1(1)/  0.294184139364406724d-2/
  data argip1(2)/  0.71369249006340167d-3/
  data argip1(3)/  0.17526563430502267d-3/
  data argip1(4)/  0.4359182094029882d-4/
  data argip1(5)/  0.1092626947604307d-4/
  data argip1(6)/  0.272382418399029d-5/
  data argip1(7)/  0.66230900947687d-6/
  data argip1(8)/  0.15425323370315d-6/
  data argip1(9)/  0.3418465242306d-7/
  data argip1(10)/ 0.728157724894d-8/
  data argip1(11)/ 0.151588525452d-8/
  data argip1(12)/ 0.30940048039d-9/
  data argip1(13)/ 0.6149672614d-10/
  data argip1(14)/ 0.1202877045d-10/
  data argip1(15)/ 0.233690586d-11/
  data argip1(16)/ 0.43778068d-12/
  data argip1(17)/ 0.7996447d-13/
  data argip1(18)/ 0.1494075d-13/
  data argip1(19)/ 0.246790d-14/
  data argip1(20)/ 0.37672d-15/
  data argip1(21)/ 0.7701d-16/
  data argip1(22)/ 0.354d-17/
  data argip1(23)/-0.49d-18/
  data argip1(24)/ 0.62d-18/
  data argip1(25)/-0.40d-18/
  data argip1(26)/-0.1d-19/
  data argip1(27)/ 0.2d-19/
  data argip1(28)/-0.3d-19/
  data argip1(29)/ 0.1d-19/
  data arhin1(0)/  0.31481017206423404116d0/
  data arhin1(1)/ -0.16414499216588964341d0/
  data arhin1(2)/  0.6176651597730913071d-1/
  data arhin1(3)/ -0.1971881185935933028d-1/
  data arhin1(4)/  0.536902830023331343d-2/
  data arhin1(5)/ -0.124977068439663038d-2/
  data arhin1(6)/  0.24835515596994933d-3/
  data arhin1(7)/ -0.4187024096746630d-4/
  data arhin1(8)/  0.590945437979124d-5/
  data arhin1(9)/ -0.68063541184345d-6/
  data arhin1(10)/ 0.6072897629164d-7/
  data arhin1(11)/-0.367130349242d-8/
  data arhin1(12)/ 0.7078017552d-10/
  data arhin1(13)/ 0.1187894334d-10/
  data arhin1(14)/-0.120898723d-11/
  data arhin1(15)/ 0.1189656d-13/
  data arhin1(16)/ 0.594128d-14/
  data arhin1(17)/-0.32257d-15/
  data arhin1(18)/-0.2290d-16/
  data arhin1(19)/ 0.253d-17/
  data arhin1(20)/ 0.9d-19/
  data arhin1(21)/-0.2d-19/
  data arhin2/1.99647720399779650525d0, &
             -0.187563779407173213d-2, &
             -0.12186470897787339d-3, &
             -0.814021609659287d-5, &
             -0.55050925953537d-6, &
             -0.3763008043303d-7, &
             -0.258858362365d-8, &
             -0.17931829265d-9, &
             -0.1245916873d-10, &
             -0.87171247d-12, &
             -0.6084943d-13, &
             -0.431178d-14, &
             -0.29787d-15, &
             -0.2210d-16, &
             -0.136d-17, &
             -0.14d-18/
  data seven/ 7.0d0 /
  data minate,twelve,one76/ -8.0d0 , 12.0d0 , 176.0d0 /
  data thre43,five14,twelhu/ 343.0d0, 514.0d0, 1200.0d0 /
  data hizero/0.40995108496400049010d0/
  data lnrtpi/0.57236494292470008707d0/
  data onebpi/0.31830988618379067154d0/
!
!   Machine-dependent constants (suitable for IEEE machines)
!
  data nterm4,nterm5/19,14/
  data xlow1,xhigh1/2.220446d-16,104.4175d0/
  data xneg1,xneg2,xmax/-0.14274d308,-208063.831d0,1.79d308/

  x = xvalue

  if ( xhigh1 < x ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'AIRY_HI - Fatal error!'
    write ( *, '(a)' ) '  Argument too large.'
    airy_hi = xmax
    return
  end if
!
!  Code for x < 0.0
!
  if ( x < zero ) then

    if ( x < minate ) then

      if ( x < xneg1 ) then
        airy_hi = zero
      else
        if ( x < xneg2 ) then
          temp = one
          airy_hi = - temp * onebpi / x
        else
          xcube = x * x * x
          t = ( xcube + twelhu ) / ( one76 - xcube )
          temp = cheval ( nterm5, arhin2, t )
          airy_hi = - temp * onebpi / x
        end if

      end if
    else
      if ( -xlow1 < x ) then
        airy_hi = hizero
      else
        t = ( four * x + twelve ) / ( x - twelve )
        airy_hi = cheval ( nterm4, arhin1, t )
      end if

    end if
!
!   Code for x >= 0.0
!
  else

    if ( x <= seven ) then
      if ( x < xlow1 ) then
        airy_hi = hizero
      else
        t = ( x + x ) / seven - one
        temp = ( x + x + x ) / two
        airy_hi = exp ( temp ) * cheval ( nterm1, arhip, t )
      end if
    else
      xcube = x * x * x
      temp = sqrt ( xcube )
      zeta = ( temp + temp ) / three
      t = two * ( sqrt ( thre43 / xcube ) ) - one
      temp = cheval ( nterm2, arbip, t )
      temp = zeta + log ( temp ) - log ( x ) / four - lnrtpi
      bi = exp ( temp )
      t = ( twelhu - xcube ) / ( xcube + five14 )
      gi = cheval ( nterm3, argip1, t ) * onebpi / x
      airy_hi = bi - gi
    end if

  end if

  return
end
subroutine airy_hi_values ( n_data, x, fx )

!*******************************************************************************
!
!! AIRY_HI_VALUES returns some values of the Airy Hi function.
!
!  Discussion:
!
!    The function is defined by:
!
!      AIRY_HI(x) = Integral ( 0 <= t < infinity ) exp ( x * t - t^3 / 3 ) dt / pi
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    24 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none

  integer, parameter :: n_max = 20

  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.40936798278458884024D+00, kind = 8 ), &
    real ( 0.37495291608048868619D+00, kind = 8 ), &
    real ( 0.22066960679295989454D+00, kind = 8 ), &
    real ( 0.77565356679703713590D-01, kind = 8 ), &
    real ( 0.39638826473124717315D-01, kind = 8 ), &
    real ( 0.38450072575004151871D-01, kind = 8 ), &
    real ( 0.35273216868317898556D-01, kind = 8 ), &
    real ( 0.31768535282502272742D-01, kind = 8 ), &
    real ( 0.28894408288051391369D-01, kind = 8 ), &
    real ( 0.24463284011678541180D-01, kind = 8 ), &
    real ( 0.41053540139998941517D+00, kind = 8 ), &
    real ( 0.44993502381204990817D+00, kind = 8 ), &
    real ( 0.97220515514243332184D+00, kind = 8 ), &
    real ( 0.83764237105104371193D+02, kind = 8 ), &
    real ( 0.80327744952044756016D+05, kind = 8 ), &
    real ( 0.15514138847749108298D+06, kind = 8 ), &
    real ( 0.11995859641733262114D+07, kind = 8 ), &
    real ( 0.21472868855967642259D+08, kind = 8 ), &
    real ( 0.45564115351632913590D+09, kind = 8 ), &
    real ( 0.32980722582904761929D+12, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (  -0.0019531250D+00, kind = 8 ), &
    real (  -0.1250000000D+00, kind = 8 ), &
    real (  -1.0000000000D+00, kind = 8 ), &
    real (  -4.0000000000D+00, kind = 8 ), &
    real (  -8.0000000000D+00, kind = 8 ), &
    real (  -8.2500000000D+00, kind = 8 ), &
    real (  -9.0000000000D+00, kind = 8 ), &
    real ( -10.0000000000D+00, kind = 8 ), &
    real ( -11.0000000000D+00, kind = 8 ), &
    real ( -13.0000000000D+00, kind = 8 ), &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   7.0000000000D+00, kind = 8 ), &
    real (   7.2500000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (   9.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  12.0000000000D+00, kind = 8 ) /)

  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function arctan_int ( xvalue )

!*******************************************************************************
!
!! ARCTAN_INT calculates the inverse tangent integral.
!
!  Discussion:
!
!    The function is defined by:
!
!      ARCTAN_INT(x) = Integral ( 0 <= t <= x ) arctan ( t ) / t dt
!
!    The approximation uses Chebyshev series with the coefficients
!    given to an accuracy of 20D.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    24 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) ARCTAN_INT, the value of the function.
!
  implicit none

  real ( kind = 8 ), dimension ( 0:22 ) :: atnina = (/ &
     1.91040361296235937512d0, &
    -0.4176351437656746940d-1, &
     0.275392550786367434d-2, &
    -0.25051809526248881d-3, &
     0.2666981285121171d-4, &
    -0.311890514107001d-5, &
     0.38833853132249d-6, &
    -0.5057274584964d-7, &
     0.681225282949d-8, &
    -0.94212561654d-9, &
     0.13307878816d-9, &
    -0.1912678075d-10, &
     0.278912620d-11, &
    -0.41174820d-12, &
     0.6142987d-13, &
    -0.924929d-14, &
     0.140387d-14, &
    -0.21460d-15, &
     0.3301d-16, &
    -0.511d-17, &
     0.79d-18, &
    -0.12d-18, &
     0.2d-19 /)
  real ( kind = 8 ) arctan_int
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer ind
  integer, parameter :: nterms = 19
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ) t
  real ( kind = 8 ), parameter :: twobpi = real ( 0.63661977236758134308d0, &
    kind = 8 )
  real ( kind = 8 ) x
  real ( kind = 8 ), parameter :: xlow = real ( 7.4505806d-9, kind = 8 )
  real ( kind = 8 ), parameter :: xupper = real ( 4.5036d15, kind = 8 )
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  ind = 1
  x = xvalue

  if ( x < zero ) then
    x = -x
    ind = -1
  end if

  if ( x < xlow ) then
    arctan_int = x
  else if ( x <= one ) then
    t = x * x
    t =  ( t - half ) + ( t - half )
    arctan_int = x * cheval ( nterms, atnina, t )
  else if ( x <= xupper ) then
    t = one / ( x * x )
    t = ( t - half ) + ( t - half )
    arctan_int = log ( x ) / twobpi + cheval ( nterms, atnina, t ) / x
  else
    arctan_int = log ( x ) / twobpi
  end if

  if ( ind < 0 ) then
    arctan_int = -arctan_int
  end if

  return
end
subroutine arctan_int_values ( n_data, x, fx )

!*******************************************************************************
!
!! ARCTAN_INT_VALUES returns some values of the inverse tangent integral.
!
!  Discussion:
!
!    The function is defined by:
!
!      ARCTAN_INT(x) = Integral ( 0 <= t <= x ) arctan ( t ) / t dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    25 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none

  integer, parameter :: n_max = 20

  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real (  0.19531241721588483191D-02, kind = 8 ), &
    real ( -0.39062433772980711281D-02, kind = 8 ), &
    real (  0.78124470192576499535D-02, kind = 8 ), &
    real (  0.15624576181996527280D-01, kind = 8 ), &
    real ( -0.31246610349485401551D-01, kind = 8 ), &
    real (  0.62472911335014397321D-01, kind = 8 ), &
    real (  0.12478419717389654039D+00, kind = 8 ), &
    real ( -0.24830175098230686908D+00, kind = 8 ), &
    real (  0.48722235829452235711D+00, kind = 8 ), &
    real (  0.91596559417721901505D+00, kind = 8 ), &
    real (  0.12749694484943800618D+01, kind = 8 ), &
    real ( -0.15760154034463234224D+01, kind = 8 ), &
    real (  0.24258878412859089996D+01, kind = 8 ), &
    real (  0.33911633326292997361D+01, kind = 8 ), &
    real (  0.44176450919422186583D+01, kind = 8 ), &
    real ( -0.47556713749547247774D+01, kind = 8 ), &
    real (  0.50961912150934111303D+01, kind = 8 ), &
    real (  0.53759175735714876256D+01, kind = 8 ), &
    real ( -0.61649904785027487422D+01, kind = 8 ), &
    real (  0.72437843013083534973D+01, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (  -0.0039062500D+00, kind = 8 ), &
    real (   0.0078125000D+00, kind = 8 ), &
    real (   0.0156250000D+00, kind = 8 ), &
    real (  -0.0312500000D+00, kind = 8 ), &
    real (   0.0625000000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (  -0.2500000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (  -2.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  16.0000000000D+00, kind = 8 ), &
    real ( -20.0000000000D+00, kind = 8 ), &
    real (  25.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real ( -50.0000000000D+00, kind = 8 ), &
    real ( 100.0000000000D+00, kind = 8 ) /)

  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function bessel_i0_int ( xvalue )

!*******************************************************************************
!
!! BESSEL_I0_INT computes the integral of the modified Bessel function I0(X).
!
!  Discussion:
!
!    The function is defined by:
!
!      I0_INT(x) = Integral ( 0 <= t <= x ) I0(t) dt
!
!    The program uses Chebyshev expansions, the coefficients of
!    which are given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    29 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) BESSEL_I0_INT, the value of the function.
!
  implicit none

  real ( kind = 8 ) ari01(0:28)
  real ( kind = 8 ) ari0a(0:33)
  real ( kind = 8 ), parameter :: ateen = real ( 18.0D+00, kind = 8 )
  real ( kind = 8 ) bessel_i0_int
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer ind
  real ( kind = 8 ), parameter :: lnr2pi = &
    real ( 0.91893853320467274178d0, kind = 8 )
  integer, parameter :: nterm1 = 25
  integer, parameter :: nterm2 = 27
  real ( kind = 8 ) t
  real ( kind = 8 ) temp
  real ( kind = 8 ), parameter :: thirt6 = real ( 36.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: three = 3.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ), parameter :: xhigh = real ( 713.758339d0, kind = 8 )
  real ( kind = 8 ), parameter :: xlow = real ( 0.5161914d-7, kind = 8 )
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  data ari01(0)/  0.41227906926781516801d0/
  data ari01(1)/ -0.34336345150081519562d0/
  data ari01(2)/  0.22667588715751242585d0/
  data ari01(3)/ -0.12608164718742260032d0/
  data ari01(4)/  0.6012484628777990271d-1/
  data ari01(5)/ -0.2480120462913358248d-1/
  data ari01(6)/  0.892773389565563897d-2/
  data ari01(7)/ -0.283253729936696605d-2/
  data ari01(8)/  0.79891339041712994d-3/
  data ari01(9)/ -0.20053933660964890d-3/
  data ari01(10)/ 0.4416816783014313d-4/
  data ari01(11)/-0.822377042246068d-5/
  data ari01(12)/ 0.120059794219015d-5/
  data ari01(13)/-0.11350865004889d-6/
  data ari01(14)/ 0.69606014466d-9/
  data ari01(15)/ 0.180622772836d-8/
  data ari01(16)/-0.26039481370d-9/
  data ari01(17)/-0.166188103d-11/
  data ari01(18)/ 0.510500232d-11/
  data ari01(19)/-0.41515879d-12/
  data ari01(20)/-0.7368138d-13/
  data ari01(21)/ 0.1279323d-13/
  data ari01(22)/ 0.103247d-14/
  data ari01(23)/-0.30379d-15/
  data ari01(24)/-0.1789d-16/
  data ari01(25)/ 0.673d-17/
  data ari01(26)/ 0.44d-18/
  data ari01(27)/-0.14d-18/
  data ari01(28)/-0.1d-19/
  data ari0a(0)/  2.03739654571143287070d0/
  data ari0a(1)/  0.1917631647503310248d-1/
  data ari0a(2)/  0.49923334519288147d-3/
  data ari0a(3)/  0.2263187103659815d-4/
  data ari0a(4)/  0.158682108285561d-5/
  data ari0a(5)/  0.16507855636318d-6/
  data ari0a(6)/  0.2385058373640d-7/
  data ari0a(7)/  0.392985182304d-8/
  data ari0a(8)/  0.46042714199d-9/
  data ari0a(9)/ -0.7072558172d-10/
  data ari0a(10)/-0.6747183961d-10/
  data ari0a(11)/-0.2026962001d-10/
  data ari0a(12)/-0.87320338d-12/
  data ari0a(13)/ 0.175520014d-11/
  data ari0a(14)/ 0.60383944d-12/
  data ari0a(15)/-0.3977983d-13/
  data ari0a(16)/-0.8049048d-13/
  data ari0a(17)/-0.1158955d-13/
  data ari0a(18)/ 0.827318d-14/
  data ari0a(19)/ 0.282290d-14/
  data ari0a(20)/-0.77667d-15/
  data ari0a(21)/-0.48731d-15/
  data ari0a(22)/ 0.7279d-16/
  data ari0a(23)/ 0.7873d-16/
  data ari0a(24)/-0.785d-17/
  data ari0a(25)/-0.1281d-16/
  data ari0a(26)/ 0.121d-17/
  data ari0a(27)/ 0.214d-17/
  data ari0a(28)/-0.27d-18/
  data ari0a(29)/-0.36d-18/
  data ari0a(30)/ 0.7d-19/
  data ari0a(31)/ 0.6d-19/
  data ari0a(32)/-0.2d-19/
  data ari0a(33)/-0.1d-19/

  ind = 1
  x = xvalue

  if ( xvalue < zero ) then
    ind = -1
    x = -x
  end if

  if ( x < xlow ) then
    bessel_i0_int = x
  else if ( x <= ateen ) then
    t = ( three * x - ateen ) / ( x + ateen )
    bessel_i0_int = x * exp ( x ) * cheval ( nterm1, ari01, t )
  else if ( x <= xhigh ) then
    t = ( thirt6 / x - half ) - half
    temp = x - half * log ( x ) - lnr2pi + log ( cheval ( nterm2, ari0a, t ))
    bessel_i0_int = exp ( temp )
  else
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'BESSEL_I0_INT - Fatal error!'
    write ( *, '(a)' ) '  Argument magnitude too large.'
    bessel_i0_int = exp ( xhigh - lnr2pi - half * log ( xhigh ) )
  end if

  if ( ind == -1 ) then
    bessel_i0_int = -bessel_i0_int
  end if

  return
end
subroutine bessel_i0_int_values ( n_data, x, fx )

!*******************************************************************************
!
!! BESSEL_I0_INT_VALUES returns some values of the Bessel I0 integral.
!
!  Discussion:
!
!    The function is defined by:
!
!      I0_INT(x) = Integral ( 0 <= t <= x ) I0(t) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    29 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none

  integer, parameter :: n_max = 20

  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real (  0.19531256208818052282D-02, kind = 8 ), &
    real ( -0.39062549670565734544D-02, kind = 8 ), &
    real (  0.62520348032546565850D-01, kind = 8 ), &
    real (  0.12516285581366971819D+00, kind = 8 ), &
    real ( -0.51051480879740303760D+00, kind = 8 ), &
    real (  0.10865210970235898158D+01, kind = 8 ), &
    real (  0.27750019054282535299D+01, kind = 8 ), &
    real ( -0.13775208868039716639D+02, kind = 8 ), &
    real (  0.46424372058106108576D+03, kind = 8 ), &
    real (  0.64111867658021584522D+07, kind = 8 ), &
    real ( -0.10414860803175857953D+08, kind = 8 ), &
    real (  0.44758598913855743089D+08, kind = 8 ), &
    real ( -0.11852985311558287888D+09, kind = 8 ), &
    real (  0.31430078220715992752D+09, kind = 8 ), &
    real ( -0.83440212900794309620D+09, kind = 8 ), &
    real (  0.22175367579074298261D+10, kind = 8 ), &
    real (  0.58991731842803636487D+10, kind = 8 ), &
    real ( -0.41857073244691522147D+11, kind = 8 ), &
    real (  0.79553885818472357663D+12, kind = 8 ), &
    real (  0.15089715082719201025D+17, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (  -0.0039062500D+00, kind = 8 ), &
    real (   0.0625000000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (  -0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (  -4.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  18.0000000000D+00, kind = 8 ), &
    real ( -18.5000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real ( -21.0000000000D+00, kind = 8 ), &
    real (  22.0000000000D+00, kind = 8 ), &
    real ( -23.0000000000D+00, kind = 8 ), &
    real (  24.0000000000D+00, kind = 8 ), &
    real (  25.0000000000D+00, kind = 8 ), &
    real ( -27.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  40.0000000000D+00, kind = 8 ) /)

  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function bessel_j0_int ( xvalue )

!*******************************************************************************
!
!! BESSEL_J0_INT calculates the integral of the Bessel function J0.
!
!  Discussion:
!
!    The function is defined by:
!
!      J0_INT(x) = Integral ( 0 <= t <= x ) J0(t) dt
!
!    The code uses Chebyshev expansions whose coefficients are
!    given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) BESSEL_J0_INT, the value of the function.
!
  implicit none

  real ( kind = 8 ) bessel_j0_int
  real ( kind = 8 ) cheval
  integer ind
  integer, parameter :: nterm1 = 22
  integer, parameter :: nterm2 = 18
  integer, parameter :: nterm3 = 16
  real ( kind = 8 ), parameter :: one = 1.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) arj01(0:23),arj0a1(0:21),arj0a2(0:18), &
       five12,one28,pib41,pib411,pib412, &
       pib42,rt2bpi,sixten,t,temp,xhigh,xlow, &
       xmpi4
  data sixten/ 16.0d0 /
  data one28,five12/ 128.0d0 , 512d0 /
  data rt2bpi/0.79788456080286535588d0/
  data pib411,pib412/ 201.0d0 , 256.0d0/
  data pib42/0.24191339744830961566d-3/
  data arj01(0)/  0.38179279321690173518d0/
  data arj01(1)/ -0.21275636350505321870d0/
  data arj01(2)/  0.16754213407215794187d0/
  data arj01(3)/ -0.12853209772196398954d0/
  data arj01(4)/  0.10114405455778847013d0/
  data arj01(5)/ -0.9100795343201568859d-1/
  data arj01(6)/  0.6401345264656873103d-1/
  data arj01(7)/ -0.3066963029926754312d-1/
  data arj01(8)/  0.1030836525325064201d-1/
  data arj01(9)/ -0.255670650399956918d-2/
  data arj01(10)/ 0.48832755805798304d-3/
  data arj01(11)/-0.7424935126036077d-4/
  data arj01(12)/ 0.922260563730861d-5/
  data arj01(13)/-0.95522828307083d-6/
  data arj01(14)/ 0.8388355845986d-7/
  data arj01(15)/-0.633184488858d-8/
  data arj01(16)/ 0.41560504221d-9/
  data arj01(17)/-0.2395529307d-10/
  data arj01(18)/ 0.122286885d-11/
  data arj01(19)/-0.5569711d-13/
  data arj01(20)/ 0.227820d-14/
  data arj01(21)/-0.8417d-16/
  data arj01(22)/ 0.282d-17/
  data arj01(23)/-0.9d-19/
  data arj0a1(0)/  1.24030133037518970827d0/
  data arj0a1(1)/ -0.478125353632280693d-2/
  data arj0a1(2)/  0.6613148891706678d-4/
  data arj0a1(3)/ -0.186042740486349d-5/
  data arj0a1(4)/  0.8362735565080d-7/
  data arj0a1(5)/ -0.525857036731d-8/
  data arj0a1(6)/  0.42606363251d-9/
  data arj0a1(7)/ -0.4211761024d-10/
  data arj0a1(8)/  0.488946426d-11/
  data arj0a1(9)/ -0.64834929d-12/
  data arj0a1(10)/ 0.9617234d-13/
  data arj0a1(11)/-0.1570367d-13/
  data arj0a1(12)/ 0.278712d-14/
  data arj0a1(13)/-0.53222d-15/
  data arj0a1(14)/ 0.10844d-15/
  data arj0a1(15)/-0.2342d-16/
  data arj0a1(16)/ 0.533d-17/
  data arj0a1(17)/-0.127d-17/
  data arj0a1(18)/ 0.32d-18/
  data arj0a1(19)/-0.8d-19/
  data arj0a1(20)/ 0.2d-19/
  data arj0a1(21)/-0.1d-19/
  data arj0a2(0)/  1.99616096301341675339d0/
  data arj0a2(1)/ -0.190379819246668161d-2/
  data arj0a2(2)/  0.1539710927044226d-4/
  data arj0a2(3)/ -0.31145088328103d-6/
  data arj0a2(4)/  0.1110850971321d-7/
  data arj0a2(5)/ -0.58666787123d-9/
  data arj0a2(6)/  0.4139926949d-10/
  data arj0a2(7)/ -0.365398763d-11/
  data arj0a2(8)/  0.38557568d-12/
  data arj0a2(9)/ -0.4709800d-13/
  data arj0a2(10)/ 0.650220d-14/
  data arj0a2(11)/-0.99624d-15/
  data arj0a2(12)/ 0.16700d-15/
  data arj0a2(13)/-0.3028d-16/
  data arj0a2(14)/ 0.589d-17/
  data arj0a2(15)/-0.122d-17/
  data arj0a2(16)/ 0.27d-18/
  data arj0a2(17)/-0.6d-19/
  data arj0a2(18)/ 0.1d-19/
!
!   Machine-dependent constants (suitable for IEEE machines)
!
  data xlow,xhigh/3.650024d-8,9.0072d15/

  x = xvalue
  ind = 1

  if ( x < zero ) then
    x = -x
    ind = -1
  end if

  if ( x < xlow ) then
    bessel_j0_int = x
  else if ( x <= sixten ) then
    t = x * x / one28 - one
    bessel_j0_int = x * cheval ( nterm1, arj01, t )
  else if ( x <= xhigh ) then
    t = five12 / ( x * x ) - one
    pib41 = pib411 / pib412
    xmpi4 = ( x - pib41 ) - pib42
    temp = cos ( xmpi4 ) * cheval ( nterm2, arj0a1, t ) / x
    temp = temp - sin ( xmpi4) * cheval ( nterm3, arj0a2, t )
    bessel_j0_int = one - rt2bpi * temp / sqrt ( x )
  else
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'BESSEL_J0_INT - Fatal error!'
    write ( *, '(a)' ) '  Argument magnitude too large.'
    bessel_j0_int = one
  end if

  if ( ind == -1 ) then
    bessel_j0_int = -bessel_j0_int
  end if

  return
end
subroutine bessel_j0_int_values ( n_data, x, fx )

!*******************************************************************************
!
!! BESSEL_J0_INT_VALUES returns some values of the Bessel J0 integral.
!
!  Discussion:
!
!    The function is defined by:
!
!      J0_INT(x) = Integral ( 0 <= t <= x ) J0(t) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    29 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none

  integer, parameter :: n_max = 20

  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real (  0.97656242238978822427D-03, kind = 8 ), &
    real (  0.39062450329491108875D-02, kind = 8 ), &
    real ( -0.62479657927917933620D-01, kind = 8 ), &
    real (  0.12483733492120479139D+00, kind = 8 ), &
    real ( -0.48968050664604505505D+00, kind = 8 ), &
    real (  0.91973041008976023931D+00, kind = 8 ), &
    real ( -0.14257702931970265690D+01, kind = 8 ), &
    real (  0.10247341594606064818D+01, kind = 8 ), &
    real ( -0.12107468348304501655D+01, kind = 8 ), &
    real (  0.11008652032736190799D+01, kind = 8 ), &
    real ( -0.10060334829904124192D+01, kind = 8 ), &
    real (  0.81330572662485953519D+00, kind = 8 ), &
    real ( -0.10583788214211277585D+01, kind = 8 ), &
    real (  0.87101492116545875169D+00, kind = 8 ), &
    real ( -0.88424908882547488420D+00, kind = 8 ), &
    real (  0.11257761503599914603D+01, kind = 8 ), &
    real ( -0.90141212258183461184D+00, kind = 8 ), &
    real (  0.91441344369647797803D+00, kind = 8 ), &
    real ( -0.94482281938334394886D+00, kind = 8 ), &
    real (  0.92266255696016607257D+00, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0009765625D+00, kind = 8 ), &
    real (   0.0039062500D+00, kind = 8 ), &
    real (  -0.0625000000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (  -0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (  -2.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (  -8.0000000000D+00, kind = 8 ), &
    real (  16.0000000000D+00, kind = 8 ), &
    real ( -16.5000000000D+00, kind = 8 ), &
    real (  18.0000000000D+00, kind = 8 ), &
    real ( -20.0000000000D+00, kind = 8 ), &
    real (  25.0000000000D+00, kind = 8 ), &
    real ( -30.0000000000D+00, kind = 8 ), &
    real (  40.0000000000D+00, kind = 8 ), &
    real ( -50.0000000000D+00, kind = 8 ), &
    real (  75.0000000000D+00, kind = 8 ), &
    real ( -80.0000000000D+00, kind = 8 ), &
    real ( 100.0000000000D+00, kind = 8 ) /)

  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function bessel_k0_int ( xvalue )

!*******************************************************************************
!
!! BESSEL_K0_INT calculates the integral of the modified Bessel function K0(X).
!
!  Discussion:
!
!    The function is defined by:
!
!      K0_INT(x) = Integral ( 0 <= t <= x ) K0(t) dt
!
!    The code uses Chebyshev expansions, whose coefficients are
!    given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    29 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) BESSEL_K0_INT, the value of the function.
!
  implicit none

  real ( kind = 8 ) bessel_k0_int
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer, parameter :: nterm1 = 14
  integer, parameter :: nterm2 = 14
  integer, parameter :: nterm3 = 23
  real ( kind = 8 ), parameter :: six = real ( 6.0D+00, kind = 8 )
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) ak0in1(0:15),ak0in2(0:15),ak0ina(0:27), &
       const1,const2,eightn,fval, &
       piby2,rt2bpi,t,temp,twelve, &
       xhigh,xlow
  data twelve,eightn / 12.0d0 , 18.0d0 /
  data const1/1.11593151565841244881d0/
  data const2/-0.11593151565841244881d0/
  data piby2/1.57079632679489661923d0/
  data rt2bpi/0.79788456080286535588d0/
  data ak0in1/16.79702714464710959477d0, &
               9.79134687676889407070d0, &
               2.80501316044337939300d0, &
               0.45615620531888502068d0, &
               0.4716224457074760784d-1, &
               0.335265148269698289d-2, &
               0.17335181193874727d-3, &
               0.679951889364702d-5, &
               0.20900268359924d-6, &
               0.516603846976d-8, &
               0.10485708331d-9, &
               0.177829320d-11, &
               0.2556844d-13, &
               0.31557d-15, &
               0.338d-17, &
               0.3d-19/
  data ak0in2/10.76266558227809174077d0, &
               5.62333479849997511550d0, &
               1.43543664879290867158d0, &
               0.21250410143743896043d0, &
               0.2036537393100009554d-1, &
               0.136023584095623632d-2, &
               0.6675388699209093d-4, &
               0.250430035707337d-5, &
               0.7406423741728d-7, &
               0.176974704314d-8, &
               0.3485775254d-10, &
               0.57544785d-12, &
               0.807481d-14, &
               0.9747d-16, &
               0.102d-17, &
               0.1d-19/
  data ak0ina(0)/  1.91172065445060453895d0/
  data ak0ina(1)/ -0.4183064565769581085d-1/
  data ak0ina(2)/  0.213352508068147486d-2/
  data ak0ina(3)/ -0.15859497284504181d-3/
  data ak0ina(4)/  0.1497624699858351d-4/
  data ak0ina(5)/ -0.167955955322241d-5/
  data ak0ina(6)/  0.21495472478804d-6/
  data ak0ina(7)/ -0.3058356654790d-7/
  data ak0ina(8)/  0.474946413343d-8/
  data ak0ina(9)/ -0.79424660432d-9/
  data ak0ina(10)/ 0.14156555325d-9/
  data ak0ina(11)/-0.2667825359d-10/
  data ak0ina(12)/ 0.528149717d-11/
  data ak0ina(13)/-0.109263199d-11/
  data ak0ina(14)/ 0.23518838d-12/
  data ak0ina(15)/-0.5247991d-13/
  data ak0ina(16)/ 0.1210191d-13/
  data ak0ina(17)/-0.287632d-14/
  data ak0ina(18)/ 0.70297d-15/
  data ak0ina(19)/-0.17631d-15/
  data ak0ina(20)/ 0.4530d-16/
  data ak0ina(21)/-0.1190d-16/
  data ak0ina(22)/ 0.319d-17/
  data ak0ina(23)/-0.87d-18/
  data ak0ina(24)/ 0.24d-18/
  data ak0ina(25)/-0.7d-19/
  data ak0ina(26)/ 0.2d-19/
  data ak0ina(27)/-0.1d-19/
!
!   Machine-dependent values (suitable for IEEE machines)
!
  data xlow,xhigh/4.47034836d-8,36.0436534d0/

  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'BESSEL_K0_INT - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    bessel_k0_int = zero
  else if ( x == zero ) then
    bessel_k0_int = zero
  else if ( x < xlow ) then
    bessel_k0_int = x * ( const1 - log ( x ) )
  else if ( x <= six ) then
    t = ( ( x * x ) / eightn - half ) - half
    fval = ( const2 + log ( x ) ) * cheval ( nterm2, ak0in2, t )
    bessel_k0_int = x * ( cheval ( nterm1, ak0in1, t ) - fval )
  else if ( x < xhigh ) then
    fval = piby2
    t = ( twelve / x - half ) - half
    temp = exp ( -x ) * cheval ( nterm3, ak0ina, t )
    fval = fval - temp / ( sqrt ( x ) * rt2bpi )
    bessel_k0_int = fval
  else
    bessel_k0_int = piby2
  end if

  return
end
subroutine bessel_k0_int_values ( n_data, x, fx )

!*******************************************************************************
!
!! BESSEL_K0_INT_VALUES returns some values of the Bessel K0 integral.
!
!  Discussion:
!
!    The function is defined by:
!
!      K0_INT(x) = Integral ( 0 <= t <= x ) K0(t) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    29 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none

  integer, parameter :: n_max = 20

  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.78587929563466784589D-02, kind = 8 ), &
    real ( 0.26019991617330578111D-01, kind = 8 ), &
    real ( 0.24311842237541167904D+00, kind = 8 ), &
    real ( 0.39999633750480508861D+00, kind = 8 ), &
    real ( 0.92710252093114907345D+00, kind = 8 ), &
    real ( 0.12425098486237782662D+01, kind = 8 ), &
    real ( 0.14736757343168286825D+01, kind = 8 ), &
    real ( 0.15606495706051741364D+01, kind = 8 ), &
    real ( 0.15673873907283660493D+01, kind = 8 ), &
    real ( 0.15696345532693743714D+01, kind = 8 ), &
    real ( 0.15701153443250786355D+01, kind = 8 ), &
    real ( 0.15706574852894436220D+01, kind = 8 ), &
    real ( 0.15707793116159788598D+01, kind = 8 ), &
    real ( 0.15707942066465767196D+01, kind = 8 ), &
    real ( 0.15707962315469192247D+01, kind = 8 ), &
    real ( 0.15707963262340149876D+01, kind = 8 ), &
    real ( 0.15707963267948756308D+01, kind = 8 ), &
    real ( 0.15707963267948966192D+01, kind = 8 ), &
    real ( 0.15707963267948966192D+01, kind = 8 ), &
    real ( 0.15707963267948966192D+01, kind = 8 )  /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0009765625D+00, kind = 8 ), &
    real (   0.0039062500D+00, kind = 8 ), &
    real (   0.0625000000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   6.5000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  12.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ), &
    real (  80.0000000000D+00, kind = 8 ), &
    real ( 100.0000000000D+00, kind = 8 ) /)

  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function bessel_y0_int ( xvalue )

!*******************************************************************************
!
!! BESSEL_Y0_INT calculates the integral of the Bessel function Y0.
!
!  Discussion:
!
!    The function is defined by:
!
!      Y0_INT(x) = Integral ( 0 <= t <= x ) Y0(t) dt
!
!    The code uses Chebyshev expansions whose coefficients are
!    given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    23 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) BESSEL_Y0_INT, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) bessel_y0_int
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: nine = real ( 9.0, kind = 8 )
  integer, parameter :: nterm1 = 22
  integer, parameter :: nterm2 = 22
  integer, parameter :: nterm3 = 17
  integer, parameter :: nterm4 = 15
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ), parameter :: sixten = real ( 16.0, kind = 8 )
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) arj01(0:23),ary01(0:24),ary0a1(0:21), &
       ary0a2(0:18),five12,gal2m1,gamln2, &
       one28,pib41,pib411,pib412, &
       pib42,rt2bpi,t,temp,twobpi,xhigh, &
       xlow,xmpi4
  data one28,five12/ 128.0d0 , 512.0d0 /
  data rt2bpi/0.79788456080286535588d0/
  data pib411,pib412/ 201.0d0, 256.0d0/
  data pib42/0.24191339744830961566d-3/
  data twobpi/0.63661977236758134308d0/
  data gal2m1/-1.11593151565841244881d0/
  data gamln2/-0.11593151565841244881d0/
  data arj01(0)/  0.38179279321690173518d0/
  data arj01(1)/ -0.21275636350505321870d0/
  data arj01(2)/  0.16754213407215794187d0/
  data arj01(3)/ -0.12853209772196398954d0/
  data arj01(4)/  0.10114405455778847013d0/
  data arj01(5)/ -0.9100795343201568859d-1/
  data arj01(6)/  0.6401345264656873103d-1/
  data arj01(7)/ -0.3066963029926754312d-1/
  data arj01(8)/  0.1030836525325064201d-1/
  data arj01(9)/ -0.255670650399956918d-2/
  data arj01(10)/ 0.48832755805798304d-3/
  data arj01(11)/-0.7424935126036077d-4/
  data arj01(12)/ 0.922260563730861d-5/
  data arj01(13)/-0.95522828307083d-6/
  data arj01(14)/ 0.8388355845986d-7/
  data arj01(15)/-0.633184488858d-8/
  data arj01(16)/ 0.41560504221d-9/
  data arj01(17)/-0.2395529307d-10/
  data arj01(18)/ 0.122286885d-11/
  data arj01(19)/-0.5569711d-13/
  data arj01(20)/ 0.227820d-14/
  data arj01(21)/-0.8417d-16/
  data arj01(22)/ 0.282d-17/
  data arj01(23)/-0.9d-19/
  data ary01(0)/  0.54492696302724365490d0/
  data ary01(1)/ -0.14957323588684782157d0/
  data ary01(2)/  0.11085634486254842337d0/
  data ary01(3)/ -0.9495330018683777109d-1/
  data ary01(4)/  0.6820817786991456963d-1/
  data ary01(5)/ -0.10324653383368200408d0/
  data ary01(6)/  0.10625703287534425491d0/
  data ary01(7)/ -0.6258367679961681990d-1/
  data ary01(8)/  0.2385645760338293285d-1/
  data ary01(9)/ -0.644864913015404481d-2/
  data ary01(10)/ 0.131287082891002331d-2/
  data ary01(11)/-0.20988088174989640d-3/
  data ary01(12)/ 0.2716042484138347d-4/
  data ary01(13)/-0.291199114014694d-5/
  data ary01(14)/ 0.26344333093795d-6/
  data ary01(15)/-0.2041172069780d-7/
  data ary01(16)/ 0.137124781317d-8/
  data ary01(17)/-0.8070680792d-10/
  data ary01(18)/ 0.419883057d-11/
  data ary01(19)/-0.19459104d-12/
  data ary01(20)/ 0.808782d-14/
  data ary01(21)/-0.30329d-15/
  data ary01(22)/ 0.1032d-16/
  data ary01(23)/-0.32d-18/
  data ary01(24)/ 0.1d-19/
  data ary0a1(0)/  1.24030133037518970827d0/
  data ary0a1(1)/ -0.478125353632280693d-2/
  data ary0a1(2)/  0.6613148891706678d-4/
  data ary0a1(3)/ -0.186042740486349d-5/
  data ary0a1(4)/  0.8362735565080d-7/
  data ary0a1(5)/ -0.525857036731d-8/
  data ary0a1(6)/  0.42606363251d-9/
  data ary0a1(7)/ -0.4211761024d-10/
  data ary0a1(8)/  0.488946426d-11/
  data ary0a1(9)/ -0.64834929d-12/
  data ary0a1(10)/ 0.9617234d-13/
  data ary0a1(11)/-0.1570367d-13/
  data ary0a1(12)/ 0.278712d-14/
  data ary0a1(13)/-0.53222d-15/
  data ary0a1(14)/ 0.10844d-15/
  data ary0a1(15)/-0.2342d-16/
  data ary0a1(16)/ 0.533d-17/
  data ary0a1(17)/-0.127d-17/
  data ary0a1(18)/ 0.32d-18/
  data ary0a1(19)/-0.8d-19/
  data ary0a1(20)/ 0.2d-19/
  data ary0a1(21)/-0.1d-19/
  data ary0a2(0)/  1.99616096301341675339d0/
  data ary0a2(1)/ -0.190379819246668161d-2/
  data ary0a2(2)/  0.1539710927044226d-4/
  data ary0a2(3)/ -0.31145088328103d-6/
  data ary0a2(4)/  0.1110850971321d-7/
  data ary0a2(5)/ -0.58666787123d-9/
  data ary0a2(6)/  0.4139926949d-10/
  data ary0a2(7)/ -0.365398763d-11/
  data ary0a2(8)/  0.38557568d-12/
  data ary0a2(9)/ -0.4709800d-13/
  data ary0a2(10)/ 0.650220d-14/
  data ary0a2(11)/-0.99624d-15/
  data ary0a2(12)/ 0.16700d-15/
  data ary0a2(13)/-0.3028d-16/
  data ary0a2(14)/ 0.589d-17/
  data ary0a2(15)/-0.122d-17/
  data ary0a2(16)/ 0.27d-18/
  data ary0a2(17)/-0.6d-19/
  data ary0a2(18)/ 0.1d-19/
!
!   Machine-dependent constants (suitable for IEEE machines)
!
  data xlow,xhigh/3.16101364d-8,9.007199256d15/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'BESSEL_Y0_INT - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    bessel_y0_int = zero
  else if ( x == zero ) then
    bessel_y0_int = zero
  else if ( x < xlow ) then
    bessel_y0_int = ( log ( x ) + gal2m1 ) * twobpi * x
  else if ( x <= sixten ) then
    t = x * x / one28 - one
    temp = ( log ( x ) + gamln2 ) * cheval ( nterm1, arj01, t )
    temp = temp - cheval ( nterm2, ary01, t )
    bessel_y0_int = twobpi * x * temp
  else if ( x <= xhigh ) then
    t = five12 / ( x * x ) - one
    pib41 = pib411 / pib412
    xmpi4 = ( x - pib41 ) - pib42
    temp = sin ( xmpi4 ) * cheval ( nterm3, ary0a1, t ) / x
    temp = temp + cos ( xmpi4 ) * cheval ( nterm4, ary0a2, t )
    bessel_y0_int = - rt2bpi * temp / sqrt ( x )
  else
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'BESSEL_Y0_INT - Fatal error!'
    write ( *, '(a)' ) '  Argument too large.'
    bessel_y0_int = zero
  end if

  return
end
subroutine bessel_y0_int_values ( n_data, x, fx )

!*******************************************************************************
!
!! BESSEL_Y0_INT_VALUES returns some values of the Bessel Y0 integral.
!
!  Discussion:
!
!    The function is defined by:
!
!      Y0_INT(x) = Integral ( 0 <= t <= x ) Y0(t) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    30 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( -0.91442642860172110926D-02, kind = 8 ), &
    real ( -0.29682047390397591290D-01, kind = 8 ), &
    real ( -0.25391431276585388961D+00, kind = 8 ), &
    real ( -0.56179545591464028187D+00, kind = 8 ), &
    real ( -0.63706937660742309754D+00, kind = 8 ), &
    real ( -0.28219285008510084123D+00, kind = 8 ), &
    real (  0.38366964785312561103D+00, kind = 8 ), &
    real ( -0.12595061285798929390D+00, kind = 8 ), &
    real (  0.24129031832266684828D+00, kind = 8 ), &
    real (  0.17138069757627037938D+00, kind = 8 ), &
    real (  0.18958142627134083732D+00, kind = 8 ), &
    real (  0.17203846136449706946D+00, kind = 8 ), &
    real ( -0.16821597677215029611D+00, kind = 8 ), &
    real ( -0.93607927351428988679D-01, kind = 8 ), &
    real (  0.88229711948036648408D-01, kind = 8 ), &
    real ( -0.89324662736274161841D-02, kind = 8 ), &
    real ( -0.54814071000063488284D-01, kind = 8 ), &
    real ( -0.94958246003466381588D-01, kind = 8 ), &
    real ( -0.19598064853404969850D-01, kind = 8 ), &
    real ( -0.83084772357154773468D-02, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0078125000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  16.0000000000D+00, kind = 8 ), &
    real (  16.2500000000D+00, kind = 8 ), &
    real (  17.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  25.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  40.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ), &
    real (  70.0000000000D+00, kind = 8 ), &
    real ( 100.0000000000D+00, kind = 8 ), &
    real ( 125.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function cheval ( n, a, t )

!*******************************************************************************
!
!! CHEVAL evaluates a Chebyshev series.
!
!  Discussion:
!
!    This function evaluates a Chebyshev series, using the
!    Clenshaw method with Reinsch modification, as analysed
!    in the paper by Oliver.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!    J Oliver,
!    "An error analysis of the modified Clenshaw method for
!    evaluating Chebyshev and Fourier series",
!    J.I.M.A., Volume 20, 1977, pages 379-391.
!
!  Parameters:
!
!    Input, integer N, the number of terms in the sequence.
!
!    Input, real ( kind = 8 ) A(0:N), the coefficients of the Chebyshev series.
!
!    Input, real ( kind = 8 ) T, the value at which the series is
!    to be evaluated.
!
!    Output, real ( kind = 8 ) CHEVAL, the value of the Chebyshev series at T.
!
  implicit none
!
  integer n
!
  real ( kind = 8 ) :: a(0:n)
  real ( kind = 8 ) :: cheval
  real ( kind = 8 ) :: d1
  real ( kind = 8 ) :: d2
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer i
  real ( kind = 8 ) :: t
  real ( kind = 8 ), parameter :: test = real ( 0.6, kind = 8 )
  real ( kind = 8 ) :: tt
  real ( kind = 8 ), parameter :: two = 2.0D+00
  real ( kind = 8 ) :: u0
  real ( kind = 8 ) :: u1
  real ( kind = 8 ) :: u2
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  u1 = zero
!
!  T <= -0.6, Reinsch modification.
!
  if ( t <= -test ) then

    d1 = zero
    tt = ( t + half ) + half
    tt = tt + tt

    do i = n, 0, -1
      d2 = d1
      u2 = u1
      d1 = tt * u2 + a(i) - d2
      u1 = d1 - u2
    end do

    cheval = ( d1 - d2 ) / two
!
!  -0.6 < T < 0.6, Standard Clenshaw method.
!
  else if ( t < test ) then

    u0 = zero
    tt = t + t

    do i = n, 0, -1
      u2 = u1
      u1 = u0
      u0 = tt * u1 + a(i) - u2
    end do

    cheval = ( u0 - u2 ) / two
!
!  0.6 <= T, Reinsch modification.
!
  else

    d1 = zero
    tt = ( t - half ) - half
    tt = tt + tt

    do i = n, 0, -1
      d2 = d1
      u2 = u1
      d1 = tt * u2 + a(i) + d2
      u1 = d1 + u2
    end do

    cheval = ( d1 + d2 ) / two

  end if

  return
end
function clausen ( xvalue )

!*******************************************************************************
!
!! CLAUSEN calculates Clausen's integral.
!
!  Discussion:
!
!    The function is defined by:
!
!      CLAUSEN(x) = Integral ( 0 <= t <= x ) -ln ( 2 * sin ( t / 2 ) ) dt
!
!    The code uses Chebyshev expansions with the coefficients
!    given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) CLAUSEN, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) aclaus(0:15)
  real ( kind = 8 ) cheval
  real ( kind = 8 ) clausen
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer indx
  integer, parameter :: nterms = 13
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ), parameter :: pi = real ( 3.1415926535897932385d0, kind = 8 )
  real ( kind = 8 ), parameter :: pisq = &
    real ( 9.8696044010893586188d0, kind = 8 )
  real ( kind = 8 ) t
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) twopi,twopia,twopib,xhigh,xsmall
  data twopi/6.2831853071795864769d0/
  data twopia,twopib/6.28125d0, 0.19353071795864769253d-2/
  data aclaus/2.14269436376668844709d0, &
              0.7233242812212579245d-1, &
              0.101642475021151164d-2, &
              0.3245250328531645d-4, &
              0.133315187571472d-5, &
              0.6213240591653d-7, &
              0.313004135337d-8, &
              0.16635723056d-9, &
              0.919659293d-11, &
              0.52400462d-12, &
              0.3058040d-13, &
              0.181969d-14, &
              0.11004d-15, &
              0.675d-17, &
              0.42d-18, &
              0.3d-19/
!
!  Set machine-dependent constants (suitable for IEEE machines)
!
  data xsmall,xhigh/2.3406689d-8,4.5036d15/
!
  x = xvalue

  if ( xhigh < abs ( x ) ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'CLAUSEN - Warning!'
    write ( *, '(a)' ) '  Argument magnitude too large for accurate computation.'
    clausen = zero
    return
  end if

  indx = 1
  if ( x < zero ) then
    x = -x
    indx = -1
  end if
!
!  Argument reduced using simulated extra precision
!
  if ( twopi < x ) then
    t = aint ( x / twopi )
    x =  ( x - t * twopia ) - t * twopib
  end if

  if ( pi < x ) then
    x = ( twopia - x ) + twopib
    indx = -indx
  end if

  if ( x == zero ) then
    clausen = zero
  else if ( x < xsmall ) then
    clausen = x * ( one - log ( x ) )
  else
    t = ( x * x ) / pisq - half
    t = t + t
    if ( one < t ) then
      t = one
    end if

    clausen = x * cheval ( nterms, aclaus, t ) - x * log ( x )

  end if

  if ( indx < 0 ) then
    clausen = -clausen
  end if

  return
end
subroutine clausen_values ( n_data, x, fx )

!*******************************************************************************
!
!! CLAUSEN_VALUES returns some values of the Clausen's integral.
!
!  Discussion:
!
!    The function is defined by:
!
!      CLAUSEN(x) = Integral ( 0 <= t <= x ) -ln ( 2 * sin ( t / 2 ) ) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    25 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real (  0.14137352886760576684D-01, kind = 8 ), &
    real (  0.13955467081981281934D+00, kind = 8 ), &
    real ( -0.38495732156574238507D+00, kind = 8 ), &
    real (  0.84831187770367927099D+00, kind = 8 ), &
    real (  0.10139591323607685043D+01, kind = 8 ), &
    real ( -0.93921859275409211003D+00, kind = 8 ), &
    real (  0.72714605086327924743D+00, kind = 8 ), &
    real (  0.43359820323553277936D+00, kind = 8 ), &
    real ( -0.98026209391301421161D-01, kind = 8 ), &
    real ( -0.56814394442986978080D+00, kind = 8 ), &
    real ( -0.70969701784448921625D+00, kind = 8 ), &
    real (  0.99282013254695671871D+00, kind = 8 ), &
    real ( -0.98127747477447367875D+00, kind = 8 ), &
    real ( -0.64078266570172320959D+00, kind = 8 ), &
    real (  0.86027963733231192456D+00, kind = 8 ), &
    real (  0.39071647608680211043D+00, kind = 8 ), &
    real (  0.47574793926539191502D+00, kind = 8 ), &
    real (  0.10105014481412878253D+01, kind = 8 ), &
    real (  0.96332089044363075154D+00, kind = 8 ), &
    real ( -0.61782699481929311757D+00, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (  -0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (  -1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   2.5000000000D+00, kind = 8 ), &
    real (  -3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.2500000000D+00, kind = 8 ), &
    real (  -5.0000000000D+00, kind = 8 ), &
    real (   5.5000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real ( -10.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real ( -30.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ) /)

  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function debye1 ( xvalue )

!*******************************************************************************
!
!! DEBYE1 calculates the Debye function of order 1.
!
!  Discussion:
!
!    The function is defined by:
!
!      DEBYE1(x) = 1 / x * Integral ( 0 <= t <= x ) t / ( exp ( t ) - 1 ) dt
!
!    The code uses Chebyshev series whose coefficients
!    are given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) DEBYE1, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) adeb1(0:18)
  real ( kind = 8 ) cheval
  real ( kind = 8 ) debye1
  real ( kind = 8 ), parameter :: eight = 8.0D+00
  real ( kind = 8 ), parameter :: four = 4.0D+00
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer i
  integer nexp
  integer, parameter :: nterms = 15
  real ( kind = 8 ), parameter :: one = 1.0D+00
  real ( kind = 8 ), parameter :: quart = 0.25D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) debinf,expmx, &
       nine,rk,sum1,t,thirt6,xk,xlim,xlow, &
       xupper
  data nine,thirt6 /9.0d0, 36.0d0 /
  data debinf/0.60792710185402662866d0/
  data adeb1/2.40065971903814101941d0, &
             0.19372130421893600885d0, &
            -0.623291245548957703d-2, &
             0.35111747702064800d-3, &
            -0.2282224667012310d-4, &
             0.158054678750300d-5, &
            -0.11353781970719d-6, &
             0.835833611875d-8, &
            -0.62644247872d-9, &
             0.4760334890d-10, &
            -0.365741540d-11, &
             0.28354310d-12, &
            -0.2214729d-13, &
             0.174092d-14, &
            -0.13759d-15, &
             0.1093d-16, &
            -0.87d-18, &
             0.7d-19, &
            -0.1d-19/
!
!   Machine-dependent constants (suitable for IEEE machines)
!
  data xlow,xupper,xlim/0.298023d-7,35.35051d0,708.39642d0/

  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'DEBYE1 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    debye1 = zero
  else if ( x < xlow ) then
    debye1 = ( ( x - nine ) * x + thirt6 ) / thirt6
  else if ( x <= four ) then
    t = ( ( x * x / eight ) - half ) - half
    debye1 = cheval ( nterms, adeb1, t ) - quart * x
  else

    debye1 = one / ( x * debinf )
    if ( x < xlim ) then
      expmx = exp ( -x )
      if ( xupper < x ) then
        debye1 = debye1 - expmx * ( one + one / x )
      else
        sum1 = zero
        rk = aint ( xlim / x )
        nexp = int ( rk )
        xk = rk * x
        do i = nexp, 1, -1
          t = ( one + one / xk ) / rk
          sum1 = sum1 * expmx + t
          rk = rk - one
          xk = xk - x
        end do
        debye1 = debye1 - sum1 * expmx
      end if
    end if
  end if

  return
end
subroutine debye1_values ( n_data, x, fx )

!*******************************************************************************
!
!! DEBYE1_VALUES returns some values of Debye's function of order 1.
!
!  Discussion:
!
!    The function is defined by:
!
!      DEBYE1(x) = 1 / x * Integral ( 0 <= t <= x ) t / ( exp ( t ) - 1 ) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    27 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real (  0.99951182471380889183D+00, kind = 8 ), &
    real (  0.99221462647120597836D+00, kind = 8 ), &
    real (  0.96918395997895308324D+00, kind = 8 ), &
    real (  0.88192715679060552968D+00, kind = 8 ), &
    real (  0.77750463411224827642D+00, kind = 8 ), &
    real (  0.68614531078940204342D+00, kind = 8 ), &
    real (  0.60694728460981007205D+00, kind = 8 ), &
    real (  0.53878956907785587703D+00, kind = 8 ), &
    real (  0.48043521957304283829D+00, kind = 8 ), &
    real (  0.38814802129793784501D+00, kind = 8 ), &
    real (  0.36930802829242526815D+00, kind = 8 ), &
    real (  0.32087619770014612104D+00, kind = 8 ), &
    real (  0.29423996623154246701D+00, kind = 8 ), &
    real (  0.27126046678502189985D+00, kind = 8 ), &
    real (  0.20523930310221503723D+00, kind = 8 ), &
    real (  0.16444346567994602563D+00, kind = 8 ), &
    real (  0.10966194482735821276D+00, kind = 8 ), &
    real (  0.82246701178200016086D-01, kind = 8 ), &
    real (  0.54831135561510852445D-01, kind = 8 ), &
    real (  0.32898681336964528729D-01, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   2.5000000000D+00, kind = 8 ), &
    real (   3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.2500000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   5.5000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function debye2 ( xvalue )

!*******************************************************************************
!
!! DEBYE2 calculates the Debye function of order 2.
!
!  Discussion:
!
!    The function is defined by:
!
!      DEBYE2(x) = 2 / x^2 * Integral ( 0 <= t <= x ) t^2 / ( exp ( t ) - 1 ) dt
!
!    The code uses Chebyshev series whose coefficients
!    are given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    24 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) DEBYE2, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ) debye2
  real ( kind = 8 ), parameter :: eight = real ( 8.0, kind = 8 )
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer i
  integer nexp
  integer, parameter :: nterms = 17
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ), parameter :: three = 3.0D+00
  real ( kind = 8 ), parameter :: two = 2.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) adeb2(0:18),debinf,expmx, &
       rk,sum1,t,twent4,xk,xlim1, &
       xlim2,xlow,xupper
  data twent4/24.0d0/
  data debinf/4.80822761263837714160d0/
  data adeb2/2.59438102325707702826d0, &
             0.28633572045307198337d0, &
            -0.1020626561580467129d-1, &
             0.60491097753468435d-3, &
            -0.4052576589502104d-4, &
             0.286338263288107d-5, &
            -0.20863943030651d-6, &
             0.1552378758264d-7, &
            -0.117312800866d-8, &
             0.8973585888d-10, &
            -0.693176137d-11, &
             0.53980568d-12, &
            -0.4232405d-13, &
             0.333778d-14, &
            -0.26455d-15, &
             0.2106d-16, &
            -0.168d-17, &
             0.13d-18, &
            -0.1d-19/
!
!   Machine-dependent constants
!
  data xlow,xupper/0.298023d-7,35.35051d0/
  data xlim1,xlim2/708.39642d0,2.1572317d154/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'DEBYE2 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    debye2 = zero
  else if ( x < xlow ) then
    debye2 = ( ( x - eight ) * x + twent4 ) / twent4
  else if ( x <= four ) then
    t = ( ( x * x / eight ) - half ) - half
    debye2 = cheval ( nterms, adeb2, t ) - x / three
  else if ( x <= xupper ) then

    expmx = exp ( -x )
    sum1 = zero
    rk = aint ( xlim1 / x )
    nexp = int ( rk )
    xk = rk * x
    do i = nexp, 1, -1
      t =  ( one + two / xk + two / ( xk * xk ) ) / rk
      sum1 = sum1 * expmx + t
      rk = rk - one
      xk = xk - x
    end do
    debye2 = debinf / ( x * x ) - two * sum1 * expmx

  else if ( x < xlim1 ) then

    expmx = exp ( -x )
    sum1 = ( ( x + two ) * x + two ) / ( x * x )
    debye2 = debinf / ( x * x ) - two * sum1 * expmx

  else if ( x <= xlim2 ) then
    debye2 = debinf / ( x * x )
  else
    debye2 = zero
  end if

  return
end
subroutine debye2_values ( n_data, x, fx )

!*******************************************************************************
!
!! DEBYE2_VALUES returns some values of Debye's function of order 2.
!
!  Discussion:
!
!    The function is defined by:
!
!      DEBYE2(x) = 2 / x^2 * Integral ( 0 <= t <= x ) t^2 / ( exp ( t ) - 1 ) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    27 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real (  0.99934911727904599738D+00, kind = 8 ), &
    real (  0.98962402299599181205D+00, kind = 8 ), &
    real (  0.95898426200345986743D+00, kind = 8 ), &
    real (  0.84372119334725358934D+00, kind = 8 ), &
    real (  0.70787847562782928288D+00, kind = 8 ), &
    real (  0.59149637225671282917D+00, kind = 8 ), &
    real (  0.49308264399053185014D+00, kind = 8 ), &
    real (  0.41079413579749669069D+00, kind = 8 ), &
    real (  0.34261396060786351671D+00, kind = 8 ), &
    real (  0.24055368752127897660D+00, kind = 8 ), &
    real (  0.22082770061202308232D+00, kind = 8 ), &
    real (  0.17232915939014138975D+00, kind = 8 ), &
    real (  0.14724346738730182894D+00, kind = 8 ), &
    real (  0.12666919046715789982D+00, kind = 8 ), &
    real (  0.74268805954862854626D-01, kind = 8 ), &
    real (  0.47971498020121871622D-01, kind = 8 ), &
    real (  0.21369201683658373846D-01, kind = 8 ), &
    real (  0.12020564476446432799D-01, kind = 8 ), &
    real (  0.53424751249537071952D-02, kind = 8 ), &
    real (  0.19232910450553508562D-02, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   2.5000000000D+00, kind = 8 ), &
    real (   3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.2500000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   5.5000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function debye3 ( xvalue )

!*******************************************************************************
!
!! DEBYE3 calculates the Debye function of order 3.
!
!  Discussion:
!
!    The function is defined by:
!
!      DEBYE3(x) = 3 / x^3 * Integral ( 0 <= t <= x ) t^3 / ( exp ( t ) - 1 ) dt
!
!    The code uses Chebyshev series whose coefficients
!    are given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) DEBYE3, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ) debye3
  real ( kind = 8 ), parameter :: eight = real ( 8.0, kind = 8 )
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer i
  integer nexp
  integer, parameter :: nterms = 16
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ), parameter :: six = real ( 6.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: three = 3.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) adeb3(0:18),debinf,expmx, &
       pt375,rk,sevp5,sum1,t,twenty, &
       xk,xki,xlim1,xlim2,xlow,xupper
  data pt375/0.375d0/
  data sevp5,twenty/7.5d0 , 20.0d0/
  data debinf/0.51329911273421675946d-1/
  data adeb3/2.70773706832744094526d0, &
             0.34006813521109175100d0, &
            -0.1294515018444086863d-1, &
             0.79637553801738164d-3, &
            -0.5463600095908238d-4, &
             0.392430195988049d-5, &
            -0.28940328235386d-6, &
             0.2173176139625d-7, &
            -0.165420999498d-8, &
             0.12727961892d-9, &
            -0.987963459d-11, &
             0.77250740d-12, &
            -0.6077972d-13, &
             0.480759d-14, &
            -0.38204d-15, &
             0.3048d-16, &
            -0.244d-17, &
             0.20d-18, &
            -0.2d-19/
!
!   Machine-dependent constants
!
  data xlow,xupper/0.298023d-7,35.35051d0/
  data xlim1,xlim2/708.39642d0,0.9487163d103/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'DEBYE3 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    debye3 = zero
    return
  end if

  if ( x < xlow ) then
    debye3 = ( ( x - sevp5 ) * x + twenty ) / twenty
  else if ( x <= 4 ) then
    t = ( ( x * x / eight ) - half ) - half
    debye3 = cheval ( nterms, adeb3, t ) - pt375 * x
  else
!
!   Code for x > 4.0
!
     if ( xlim2 < x ) then
        debye3 = zero
     else
        debye3 = one / ( debinf * x * x * x )
        if ( x < xlim1 ) then
           expmx = exp ( -x )
           if ( xupper < x ) then
              sum1 = ((( x + three ) * x + six ) * x + six ) / ( x * x * x )
           else
              sum1 = zero
              rk = aint ( xlim1 / x )
              nexp = int ( rk )
              xk = rk * x
              do i = nexp, 1, -1
                 xki = one / xk
                 t =  ((( six * xki + six ) * xki + three ) * xki + one ) / rk
                 sum1 = sum1 * expmx + t
                 rk = rk - one
                 xk = xk - x
              end do
           end if
           debye3 = debye3 - three * sum1 * expmx
        end if
     end if
  end if

  return
end
subroutine debye3_values ( n_data, x, fx )

!*******************************************************************************
!
!! DEBYE3_VALUES returns some values of Debye's function of order 3.
!
!  Discussion:
!
!    The function is defined by:
!
!      DEBYE3(x) = 3 / x^3 * Integral ( 0 <= t <= x ) t^3 / ( exp ( t ) - 1 ) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    28 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real (  0.99926776885985461940D+00, kind = 8 ), &
    real (  0.98833007755734698212D+00, kind = 8 ), &
    real (  0.95390610472023510237D+00, kind = 8 ), &
    real (  0.82496296897623372315D+00, kind = 8 ), &
    real (  0.67441556407781468010D+00, kind = 8 ), &
    real (  0.54710665141286285468D+00, kind = 8 ), &
    real (  0.44112847372762418113D+00, kind = 8 ), &
    real (  0.35413603481042394211D+00, kind = 8 ), &
    real (  0.28357982814342246206D+00, kind = 8 ), &
    real (  0.18173691382177474795D+00, kind = 8 ), &
    real (  0.16277924385112436877D+00, kind = 8 ), &
    real (  0.11759741179993396450D+00, kind = 8 ), &
    real (  0.95240802723158889887D-01, kind = 8 ), &
    real (  0.77581324733763020269D-01, kind = 8 ), &
    real (  0.36560295673194845002D-01, kind = 8 ), &
    real (  0.19295765690345489563D-01, kind = 8 ), &
    real (  0.57712632276188798621D-02, kind = 8 ), &
    real (  0.24352200674805479827D-02, kind = 8 ), &
    real (  0.72154882216335666096D-03, kind = 8 ), &
    real (  0.15585454565440389896D-03, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   2.5000000000D+00, kind = 8 ), &
    real (   3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.2500000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   5.5000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function debye4 ( xvalue )

!*******************************************************************************
!
!! DEBYE4 calculates the Debye function of order 4.
!
!  Discussion:
!
!    The function is defined by:
!
!      DEBYE4(x) = 4 / x^4 * Integral ( 0 <= t <= x ) t^4 / ( exp ( t ) - 1 ) dt
!
!    The code uses Chebyshev series whose coefficients
!    are given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) DEBYE4, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ) debye4
  real ( kind = 8 ), parameter :: eight = real ( 8.0, kind = 8 )
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer i
  integer nexp
  integer, parameter :: nterms = 16
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) adeb4(0:18),debinf,eightn,expmx, &
       five,forty5,rk,sum1,t,twelve,twent4, &
       twopt5,xk,xki,xlim1,xlim2,xlow,xupper
  data twopt5,five/2.5d0, 5.0d0/
  data twelve,eightn/ 12.0d0 , 18.0d0/
  data twent4,forty5 /24.0d0 , 45.0d0 /
  data debinf/99.54506449376351292781d0/
  data adeb4/2.78186941502052346008d0, &
             0.37497678352689286364d0, &
            -0.1494090739903158326d-1, &
             0.94567981143704274d-3, &
            -0.6613291613893255d-4, &
             0.481563298214449d-5, &
            -0.35880839587593d-6, &
             0.2716011874160d-7, &
            -0.208070991223d-8, &
             0.16093838692d-9, &
            -0.1254709791d-10, &
             0.98472647d-12, &
            -0.7772369d-13, &
             0.616483d-14, &
            -0.49107d-15, &
             0.3927d-16, &
            -0.315d-17, &
             0.25d-18, &
            -0.2d-19/
!
!   Machine-dependent constants
!
  data xlow,xupper/0.298023d-7,35.35051d0/
  data xlim1,xlim2/708.39642d0,2.5826924d77/
!
  x = xvalue
!
!   Check XVALUE >= 0.0
!
  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'DEBYE4 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    debye4 = zero
    return
  end if

  if ( x < xlow ) then
    debye4 = ( ( twopt5 * x - eightn ) * x + forty5 ) / forty5
  else if ( x <= four ) then
    t = ( ( x * x / eight ) - half ) - half
    debye4 = cheval ( nterms, adeb4, t ) - ( x + x ) / five
  else
!
!   Code for x > 4.0
!
     if ( xlim2 < x ) then
        debye4 = zero
     else
        t = x * x
        debye4 = ( debinf / t ) / t
        if ( x < xlim1 ) then
           expmx = exp ( -x )
           if ( xupper < x ) then
              sum1 = ( ( ( ( x + four ) * x + twelve ) * x + &
                    twent4 ) * x + twent4 ) / ( x * x * x * x )
           else
              sum1 = zero
              rk = aint ( xlim1 / x )
              nexp = int ( rk )
              xk = rk * x
              do i = nexp, 1, -1
                 xki = one / xk
                 t =  ( ( ( ( twent4 * xki + twent4 ) * xki + &
                      twelve ) * xki + four ) * xki + one ) / rk
                 sum1 = sum1 * expmx + t
                 rk = rk - one
                 xk = xk - x
              end do
           end if
           debye4 = debye4 - four * sum1 * expmx
        end if
     end if
  end if

  return
end
subroutine debye4_values ( n_data, x, fx )

!*******************************************************************************
!
!! DEBYE4_VALUES returns some values of Debye's function of order 4.
!
!  Discussion:
!
!    The function is defined by:
!
!      DEBYE4(x) = 4 / x^4 * Integral ( 0 <= t <= x ) t^4 / ( exp ( t ) - 1 ) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    28 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real (  0.99921896192761576256D+00, kind = 8 ), &
    real (  0.98755425280996071022D+00, kind = 8 ), &
    real (  0.95086788606389739976D+00, kind = 8 ), &
    real (  0.81384569172034042516D+00, kind = 8 ), &
    real (  0.65487406888673697092D+00, kind = 8 ), &
    real (  0.52162830964878715188D+00, kind = 8 ), &
    real (  0.41189273671788528876D+00, kind = 8 ), &
    real (  0.32295434858707304628D+00, kind = 8 ), &
    real (  0.25187863642883314410D+00, kind = 8 ), &
    real (  0.15185461258672022043D+00, kind = 8 ), &
    real (  0.13372661145921413299D+00, kind = 8 ), &
    real (  0.91471377664481164749D-01, kind = 8 ), &
    real (  0.71227828197462523663D-01, kind = 8 ), &
    real (  0.55676547822738862783D-01, kind = 8 ), &
    real (  0.21967566525574960096D-01, kind = 8 ), &
    real (  0.96736755602711590082D-02, kind = 8 ), &
    real (  0.19646978158351837850D-02, kind = 8 ), &
    real (  0.62214648623965450200D-03, kind = 8 ), &
    real (  0.12289514092077854510D-03, kind = 8 ), &
    real (  0.15927210319002161231D-04, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   2.5000000000D+00, kind = 8 ), &
    real (   3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.2500000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   5.5000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function exp3_int ( xvalue )

!*******************************************************************************
!
!! EXP3_INT calculates the integral of exp(-t^3).
!
!  Discussion:
!
!    The function is defined by:
!
!      EXP3_INT(x) = Integral ( 0 <= t <= x ) exp ( -t^3 ) dt
!
!    The code uses Chebyshev expansions, whose coefficients are
!    given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) EXP3_INT, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ) exp3_int
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer, parameter :: nterm1 = 22
  integer, parameter :: nterm2 = 20
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ), parameter :: three = 3.0D+00
  real ( kind = 8 ), parameter :: two = 2.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) aexp3(0:24),aexp3a(0:24), &
         funinf,sixten,t, &
         xlow,xupper
  data sixten /16.0d0 /
  data funinf/0.89297951156924921122d0/
  data aexp3(0)/  1.26919841422112601434d0/
  data aexp3(1)/ -0.24884644638414098226d0/
  data aexp3(2)/  0.8052622071723104125d-1/
  data aexp3(3)/ -0.2577273325196832934d-1/
  data aexp3(4)/  0.759987887307377429d-2/
  data aexp3(5)/ -0.203069558194040510d-2/
  data aexp3(6)/  0.49083458669932917d-3/
  data aexp3(7)/ -0.10768223914202077d-3/
  data aexp3(8)/  0.2155172626428984d-4/
  data aexp3(9)/ -0.395670513738429d-5/
  data aexp3(10)/ 0.66992409338956d-6/
  data aexp3(11)/-0.10513218080703d-6/
  data aexp3(12)/ 0.1536258019825d-7/
  data aexp3(13)/-0.209909603636d-8/
  data aexp3(14)/ 0.26921095381d-9/
  data aexp3(15)/-0.3251952422d-10/
  data aexp3(16)/ 0.371148157d-11/
  data aexp3(17)/-0.40136518d-12/
  data aexp3(18)/ 0.4123346d-13/
  data aexp3(19)/-0.403375d-14/
  data aexp3(20)/ 0.37658d-15/
  data aexp3(21)/-0.3362d-16/
  data aexp3(22)/ 0.288d-17/
  data aexp3(23)/-0.24d-18/
  data aexp3(24)/ 0.2d-19/
  data aexp3a(0)/  1.92704649550682737293d0/
  data aexp3a(1)/ -0.3492935652048138054d-1/
  data aexp3a(2)/  0.145033837189830093d-2/
  data aexp3a(3)/ -0.8925336718327903d-4/
  data aexp3a(4)/  0.705423921911838d-5/
  data aexp3a(5)/ -0.66717274547611d-6/
  data aexp3a(6)/  0.7242675899824d-7/
  data aexp3a(7)/ -0.878258256056d-8/
  data aexp3a(8)/  0.116722344278d-8/
  data aexp3a(9)/ -0.16766312812d-9/
  data aexp3a(10)/ 0.2575501577d-10/
  data aexp3a(11)/-0.419578881d-11/
  data aexp3a(12)/ 0.72010412d-12/
  data aexp3a(13)/-0.12949055d-12/
  data aexp3a(14)/ 0.2428703d-13/
  data aexp3a(15)/-0.473311d-14/
  data aexp3a(16)/ 0.95531d-15/
  data aexp3a(17)/-0.19914d-15/
  data aexp3a(18)/ 0.4277d-16/
  data aexp3a(19)/-0.944d-17/
  data aexp3a(20)/ 0.214d-17/
  data aexp3a(21)/-0.50d-18/
  data aexp3a(22)/ 0.12d-18/
  data aexp3a(23)/-0.3d-19/
  data aexp3a(24)/ 0.1d-19/
!
!   Machine-dependent constants (suitable for IEEE machines)
!
  data xlow,xupper/0.762939d-5,3.3243018d0/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'EXP3_INT - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    exp3_int = zero
  else if ( x < xlow ) then
    exp3_int = x
  else if ( x <= two ) then
    t = ( ( x * x * x / four ) - half ) - half
    exp3_int = x * cheval ( nterm1, aexp3, t )
  else if ( x <= xupper ) then
    t = ( ( sixten / ( x * x * x ) ) - half ) - half
    t = cheval ( nterm2, aexp3a, t )
    t = t * exp ( -x * x * x ) / ( three * x * x )
    exp3_int = funinf - t
  else
    exp3_int = funinf
  end if

  return
end
subroutine exp3_int_values ( n_data, x, fx )

!*******************************************************************************
!
!! EXP3_INT_VALUES returns some values of the EXP3 integral function.
!
!  Discussion:
!
!    The function is defined by:
!
!      EXP3_INT(x) = Integral ( 0 <= t <= x ) exp ( -t^3 ) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    28 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real (  0.19531249963620212007D-02, kind = 8 ), &
    real (  0.78124990686775522671D-02, kind = 8 ), &
    real (  0.31249761583499728667D-01, kind = 8 ), &
    real (  0.12493899888803079984D+00, kind = 8 ), &
    real (  0.48491714311363971332D+00, kind = 8 ), &
    real (  0.80751118213967145286D+00, kind = 8 ), &
    real (  0.86889265412623270696D+00, kind = 8 ), &
    real (  0.88861722235357162648D+00, kind = 8 ), &
    real (  0.89286018500218176869D+00, kind = 8 ), &
    real (  0.89295351429387631138D+00, kind = 8 ), &
    real (  0.89297479112737843939D+00, kind = 8 ), &
    real (  0.89297880579798112220D+00, kind = 8 ), &
    real (  0.89297950317496621294D+00, kind = 8 ), &
    real (  0.89297951152951902903D+00, kind = 8 ), &
    real (  0.89297951156918122102D+00, kind = 8 ), &
    real (  0.89297951156924734716D+00, kind = 8 ), &
    real (  0.89297951156924917298D+00, kind = 8 ), &
    real (  0.89297951156924921121D+00, kind = 8 ), &
    real (  0.89297951156924921122D+00, kind = 8 ), &
    real (  0.89297951156924921122D+00, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (  0.0019531250D+00, kind = 8 ), &
    real (  0.0078125000D+00, kind = 8 ), &
    real (  0.0312500000D+00, kind = 8 ), &
    real (  0.1250000000D+00, kind = 8 ), &
    real (  0.5000000000D+00, kind = 8 ), &
    real (  1.0000000000D+00, kind = 8 ), &
    real (  1.2500000000D+00, kind = 8 ), &
    real (  1.5000000000D+00, kind = 8 ), &
    real (  1.8750000000D+00, kind = 8 ), &
    real (  2.0000000000D+00, kind = 8 ), &
    real (  2.1250000000D+00, kind = 8 ), &
    real (  2.2500000000D+00, kind = 8 ), &
    real (  2.5000000000D+00, kind = 8 ), &
    real (  2.7500000000D+00, kind = 8 ), &
    real (  3.0000000000D+00, kind = 8 ), &
    real (  3.1250000000D+00, kind = 8 ), &
    real (  3.2500000000D+00, kind = 8 ), &
    real (  3.5000000000D+00, kind = 8 ), &
    real (  3.7500000000D+00, kind = 8 ), &
    real (  4.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function goodwin ( xvalue )

!*******************************************************************************
!
!! GOODWIN calculates the integral of exp(-t^2/(t+x)).
!
!  Discussion:
!
!    The function is defined by:
!
!      GOODWIN(x) = Integral ( 0 <= t < infinity ) exp ( -t^2 ) / ( t + x ) dt
!
!    The code uses Chebyshev expansions whose coefficients are
!    given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    29 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) GOODWIN, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ) goodwin
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer, parameter :: nterm1 = 26
  integer, parameter :: nterm2 = 20
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ), parameter :: six = real ( 6.0, kind = 8 )
  real ( kind = 8 ), parameter :: two = 2.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) agost(0:28),agosta(0:23), &
       fval,gamby2,rtpib2, &
       t,xhigh,xlow
  data gamby2/0.28860783245076643030d0/
  data rtpib2/0.88622692545275801365d0/
  data agost(0)/  0.63106560560398446247d0/
  data agost(1)/  0.25051737793216708827d0/
  data agost(2)/ -0.28466205979018940757d0/
  data agost(3)/  0.8761587523948623552d-1/
  data agost(4)/  0.682602267221252724d-2/
  data agost(5)/ -0.1081129544192254677d-1/
  data agost(6)/  0.169101244117152176d-2/
  data agost(7)/  0.50272984622615186d-3/
  data agost(8)/ -0.18576687204100084d-3/
  data agost(9)/ -0.428703674168474d-5/
  data agost(10)/ 0.1009598903202905d-4/
  data agost(11)/-0.86529913517382d-6/
  data agost(12)/-0.34983874320734d-6/
  data agost(13)/ 0.6483278683494d-7/
  data agost(14)/ 0.757592498583d-8/
  data agost(15)/-0.277935424362d-8/
  data agost(16)/-0.4830235135d-10/
  data agost(17)/ 0.8663221283d-10/
  data agost(18)/-0.394339687d-11/
  data agost(19)/-0.209529625d-11/
  data agost(20)/ 0.21501759d-12/
  data agost(21)/ 0.3959015d-13/
  data agost(22)/-0.692279d-14/
  data agost(23)/-0.54829d-15/
  data agost(24)/ 0.17108d-15/
  data agost(25)/ 0.376d-17/
  data agost(26)/-0.349d-17/
  data agost(27)/ 0.7d-19/
  data agost(28)/ 0.6d-19/
  data agosta(0)/  1.81775467984718758767d0/
  data agosta(1)/ -0.9921146570744097467d-1/
  data agosta(2)/ -0.894058645254819243d-2/
  data agosta(3)/ -0.94955331277726785d-3/
  data agosta(4)/ -0.10971379966759665d-3/
  data agosta(5)/ -0.1346694539578590d-4/
  data agosta(6)/ -0.172749274308265d-5/
  data agosta(7)/ -0.22931380199498d-6/
  data agosta(8)/ -0.3127844178918d-7/
  data agosta(9)/ -0.436197973671d-8/
  data agosta(10)/-0.61958464743d-9/
  data agosta(11)/-0.8937991276d-10/
  data agosta(12)/-0.1306511094d-10/
  data agosta(13)/-0.193166876d-11/
  data agosta(14)/-0.28844270d-12/
  data agosta(15)/-0.4344796d-13/
  data agosta(16)/-0.659518d-14/
  data agosta(17)/-0.100801d-14/
  data agosta(18)/-0.15502d-15/
  data agosta(19)/-0.2397d-16/
  data agosta(20)/-0.373d-17/
  data agosta(21)/-0.58d-18/
  data agosta(22)/-0.9d-19/
  data agosta(23)/-0.1d-19/
!
!   Machine-dependent constants (suitable for IEEE machines)
!
  data xlow,xhigh/1.11022303d-16,1.80144d16/
!
  x = xvalue

  if ( x <= zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'GOODWIN - Fatal error!'
    write ( *, '(a)' ) '  Argument X <= 0.'
    goodwin = zero
  else if ( x < xlow ) then
    goodwin = - gamby2 - log ( x )
  else if ( x <= two ) then
    t = ( x - half ) - half
    goodwin = cheval ( nterm1, agost, t ) - exp ( -x * x ) * log ( x )
  else if ( x <= xhigh ) then
    fval = rtpib2 / x
    t = ( six - x ) / ( two + x )
    goodwin = fval * cheval ( nterm2, agosta, t )
  else
    goodwin = rtpib2 / x
  end if

  return
end
subroutine goodwin_values ( n_data, x, fx )

!*******************************************************************************
!
!! GOODWIN_VALUES returns some values of the Goodwin and Staton function.
!
!  Discussion:
!
!    The function is defined by:
!
!      GOODWIN(x) = Integral ( 0 <= t < infinity ) exp ( -t^2 ) / ( t + x ) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    29 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real (  0.59531540040441651584D+01, kind = 8 ), &
    real (  0.45769601268624494109D+01, kind = 8 ), &
    real (  0.32288921331902217638D+01, kind = 8 ), &
    real (  0.19746110873568719362D+01, kind = 8 ), &
    real (  0.96356046208697728563D+00, kind = 8 ), &
    real (  0.60513365250334458174D+00, kind = 8 ), &
    real (  0.51305506459532198016D+00, kind = 8 ), &
    real (  0.44598602820946133091D+00, kind = 8 ), &
    real (  0.37344458206879749357D+00, kind = 8 ), &
    real (  0.35433592884953063055D+00, kind = 8 ), &
    real (  0.33712156518881920994D+00, kind = 8 ), &
    real (  0.29436170729362979176D+00, kind = 8 ), &
    real (  0.25193499644897222840D+00, kind = 8 ), &
    real (  0.22028778222123939276D+00, kind = 8 ), &
    real (  0.19575258237698917033D+00, kind = 8 ), &
    real (  0.17616303166670699424D+00, kind = 8 ), &
    real (  0.16015469479664778673D+00, kind = 8 ), &
    real (  0.14096116876193391066D+00, kind = 8 ), &
    real (  0.13554987191049066274D+00, kind = 8 ), &
    real (  0.11751605060085098084D+00, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (  0.0019531250D+00, kind = 8 ), &
    real (  0.0078125000D+00, kind = 8 ), &
    real (  0.0312500000D+00, kind = 8 ), &
    real (  0.1250000000D+00, kind = 8 ), &
    real (  0.5000000000D+00, kind = 8 ), &
    real (  1.0000000000D+00, kind = 8 ), &
    real (  1.2500000000D+00, kind = 8 ), &
    real (  1.5000000000D+00, kind = 8 ), &
    real (  1.8750000000D+00, kind = 8 ), &
    real (  2.0000000000D+00, kind = 8 ), &
    real (  2.1250000000D+00, kind = 8 ), &
    real (  2.5000000000D+00, kind = 8 ), &
    real (  3.0000000000D+00, kind = 8 ), &
    real (  3.5000000000D+00, kind = 8 ), &
    real (  4.0000000000D+00, kind = 8 ), &
    real (  4.5000000000D+00, kind = 8 ), &
    real (  5.0000000000D+00, kind = 8 ), &
    real (  5.7500000000D+00, kind = 8 ), &
    real (  6.0000000000D+00, kind = 8 ), &
    real (  7.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function i0ml0 ( xvalue )

!*******************************************************************************
!
!! I0ML0 calculates the difference between the Bessel I0 and Struve L0 functions.
!
!  Discussion:
!
!    The function is defined by:
!
!      I0ML0(x) = I0(x) - L0(x)
!
!    I0(x) is the modified Bessel function of the first kind of order 0,
!    L0(x) is the modified Struve function of order 0.
!
!    The code uses Chebyshev expansions with the coefficients
!    given to an accuracy of 20D.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    29 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) I0ML0, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) ai0l0(0:23)
  real ( kind = 8 ) ai0l0a(0:23)
  real ( kind = 8 ) cheval
  real ( kind = 8 ) i0ml0
  integer, parameter :: nterm1 = 21
  integer, parameter :: nterm2 = 21
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ), parameter :: six = real ( 6.0D+00, kind = 8 )
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) atehun, &
       forty,sixten,t,twobpi,two88,xhigh, &
       xlow,xsq
  data sixten/ 16.0d0 /
  data forty / 40.0d0 /
  data two88,atehun/ 288.0d0, 800.0d0 /
  data twobpi/0.63661977236758134308d0/
  data ai0l0(0)/  0.52468736791485599138d0/
  data ai0l0(1)/ -0.35612460699650586196d0/
  data ai0l0(2)/  0.20487202864009927687d0/
  data ai0l0(3)/ -0.10418640520402693629d0/
  data ai0l0(4)/  0.4634211095548429228d-1/
  data ai0l0(5)/ -0.1790587192403498630d-1/
  data ai0l0(6)/  0.597968695481143177d-2/
  data ai0l0(7)/ -0.171777547693565429d-2/
  data ai0l0(8)/  0.42204654469171422d-3/
  data ai0l0(9)/ -0.8796178522094125d-4/
  data ai0l0(10)/ 0.1535434234869223d-4/
  data ai0l0(11)/-0.219780769584743d-5/
  data ai0l0(12)/ 0.24820683936666d-6/
  data ai0l0(13)/-0.2032706035607d-7/
  data ai0l0(14)/ 0.90984198421d-9/
  data ai0l0(15)/ 0.2561793929d-10/
  data ai0l0(16)/-0.710609790d-11/
  data ai0l0(17)/ 0.32716960d-12/
  data ai0l0(18)/ 0.2300215d-13/
  data ai0l0(19)/-0.292109d-14/
  data ai0l0(20)/-0.3566d-16/
  data ai0l0(21)/ 0.1832d-16/
  data ai0l0(22)/-0.10d-18/
  data ai0l0(23)/-0.11d-18/
  data ai0l0a(0)/ 2.00326510241160643125d0/
  data ai0l0a(1)/ 0.195206851576492081d-2/
  data ai0l0a(2)/ 0.38239523569908328d-3/
  data ai0l0a(3)/ 0.7534280817054436d-4/
  data ai0l0a(4)/ 0.1495957655897078d-4/
  data ai0l0a(5)/ 0.299940531210557d-5/
  data ai0l0a(6)/ 0.60769604822459d-6/
  data ai0l0a(7)/ 0.12399495544506d-6/
  data ai0l0a(8)/ 0.2523262552649d-7/
  data ai0l0a(9)/ 0.504634857332d-8/
  data ai0l0a(10)/0.97913236230d-9/
  data ai0l0a(11)/0.18389115241d-9/
  data ai0l0a(12)/0.3376309278d-10/
  data ai0l0a(13)/0.611179703d-11/
  data ai0l0a(14)/0.108472972d-11/
  data ai0l0a(15)/0.18861271d-12/
  data ai0l0a(16)/0.3280345d-13/
  data ai0l0a(17)/0.565647d-14/
  data ai0l0a(18)/0.93300d-15/
  data ai0l0a(19)/0.15881d-15/
  data ai0l0a(20)/0.2791d-16/
  data ai0l0a(21)/0.389d-17/
  data ai0l0a(22)/0.70d-18/
  data ai0l0a(23)/0.16d-18/
!
!   MACHINE-DEPENDENT CONSTANTS (suitable for IEEE-arithmetic machines)
!
  data xlow,xhigh/1.11022303d-16,1.8981253d9/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'I0ML0 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    i0ml0 = zero
  else if ( x < xlow ) then
    i0ml0 = one
  else if ( x <= sixten ) then
    t = ( six * x - forty ) / ( x + forty )
    i0ml0 = cheval ( nterm1, ai0l0, t )
  else if ( x <= xhigh ) then
    xsq = x * x
    t = ( atehun - xsq ) / ( two88 + xsq )
    i0ml0 = cheval ( nterm2, ai0l0a, t ) * twobpi / x
  else
    i0ml0 = twobpi / x
  end if

  return
end
subroutine i0ml0_values ( n_data, x, fx )

!*******************************************************************************
!
!! I0ML0_VALUES returns some values of the I0ML0 function.
!
!  Discussion:
!
!    The function is defined by:
!
!      I0ML0(x) = I0(x) - L0(x)
!
!    I0(x) is the modified Bessel function of the first kind of order 0,
!    L0(x) is the modified Struve function of order 0.
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    30 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.99875755515461749793D+00, kind = 8 ), &
    real ( 0.99011358230706643807D+00, kind = 8 ), &
    real ( 0.92419435310023947018D+00, kind = 8 ), &
    real ( 0.73624267134714273902D+00, kind = 8 ), &
    real ( 0.55582269181411744686D+00, kind = 8 ), &
    real ( 0.34215154434462160628D+00, kind = 8 ), &
    real ( 0.17087174888774706539D+00, kind = 8 ), &
    real ( 0.81081008709219208918D-01, kind = 8 ), &
    real ( 0.53449421441089580702D-01, kind = 8 ), &
    real ( 0.39950321008923244846D-01, kind = 8 ), &
    real ( 0.39330637437584921392D-01, kind = 8 ), &
    real ( 0.37582274342808670750D-01, kind = 8 ), &
    real ( 0.31912486554480390343D-01, kind = 8 ), &
    real ( 0.25506146883504738403D-01, kind = 8 ), &
    real ( 0.21244480317825292412D-01, kind = 8 ), &
    real ( 0.15925498348551684335D-01, kind = 8 ), &
    real ( 0.12737506927242585015D-01, kind = 8 ), &
    real ( 0.84897750814784916847D-02, kind = 8 ), &
    real ( 0.63668349178454469153D-02, kind = 8 ), &
    real ( 0.50932843163122551114D-02, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0156250000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  12.0000000000D+00, kind = 8 ), &
    real (  16.0000000000D+00, kind = 8 ), &
    real (  16.2500000000D+00, kind = 8 ), &
    real (  17.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  25.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  40.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ), &
    real (  75.0000000000D+00, kind = 8 ), &
    real ( 100.0000000000D+00, kind = 8 ), &
    real ( 125.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function i1ml1 ( xvalue )

!*******************************************************************************
!
!! I1ML1 calculates the difference between the Bessel I1 and Struve L1 functions.
!
!  Discussion:
!
!    The function is defined by:
!
!      I1ML1(x) = I1(x) - L1(x)
!
!    I1(x) is the modified Bessel function of the first kind of order 1,
!    L1(x) is the modified Struve function of order 1.
!
!    The code uses Chebyshev expansions with the coefficients
!    given to an accuracy of 20D.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    29 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!    0 <= XVALUE is required.
!
!    Output, real ( kind = 8 ) I1ML1, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ) i1ml1
  integer, parameter :: nterm1 = 20
  integer, parameter :: nterm2 = 22
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ), parameter :: six = real ( 6.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: two = 2.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) ai1l1(0:23),ai1l1a(0:25),atehun, &
       forty,sixten,t,twobpi,two88, &
       xhigh,xlow,xsq
  data sixten,forty/ 16.0d0 , 40.0d0 /
  data two88,atehun/ 288.0d0 , 800.0d0 /
  data twobpi/0.63661977236758134308d0/
  data ai1l1(0)/  0.67536369062350576137d0/
  data ai1l1(1)/ -0.38134971097266559040d0/
  data ai1l1(2)/  0.17452170775133943559d0/
  data ai1l1(3)/ -0.7062105887235025061d-1/
  data ai1l1(4)/  0.2517341413558803702d-1/
  data ai1l1(5)/ -0.787098561606423321d-2/
  data ai1l1(6)/  0.214814368651922006d-2/
  data ai1l1(7)/ -0.50862199717906236d-3/
  data ai1l1(8)/  0.10362608280442330d-3/
  data ai1l1(9)/ -0.1795447212057247d-4/
  data ai1l1(10)/ 0.259788274515414d-5/
  data ai1l1(11)/-0.30442406324667d-6/
  data ai1l1(12)/ 0.2720239894766d-7/
  data ai1l1(13)/-0.158126144190d-8/
  data ai1l1(14)/ 0.1816209172d-10/
  data ai1l1(15)/ 0.647967659d-11/
  data ai1l1(16)/-0.54113290d-12/
  data ai1l1(17)/-0.308311d-14/
  data ai1l1(18)/ 0.305638d-14/
  data ai1l1(19)/-0.9717d-16/
  data ai1l1(20)/-0.1422d-16/
  data ai1l1(21)/ 0.84d-18/
  data ai1l1(22)/ 0.7d-19/
  data ai1l1(23)/-0.1d-19/
  data ai1l1a(0)/  1.99679361896789136501d0/
  data ai1l1a(1)/ -0.190663261409686132d-2/
  data ai1l1a(2)/ -0.36094622410174481d-3/
  data ai1l1a(3)/ -0.6841847304599820d-4/
  data ai1l1a(4)/ -0.1299008228509426d-4/
  data ai1l1a(5)/ -0.247152188705765d-5/
  data ai1l1a(6)/ -0.47147839691972d-6/
  data ai1l1a(7)/ -0.9020819982592d-7/
  data ai1l1a(8)/ -0.1730458637504d-7/
  data ai1l1a(9)/ -0.332323670159d-8/
  data ai1l1a(10)/-0.63736421735d-9/
  data ai1l1a(11)/-0.12180239756d-9/
  data ai1l1a(12)/-0.2317346832d-10/
  data ai1l1a(13)/-0.439068833d-11/
  data ai1l1a(14)/-0.82847110d-12/
  data ai1l1a(15)/-0.15562249d-12/
  data ai1l1a(16)/-0.2913112d-13/
  data ai1l1a(17)/-0.543965d-14/
  data ai1l1a(18)/-0.101177d-14/
  data ai1l1a(19)/-0.18767d-15/
  data ai1l1a(20)/-0.3484d-16/
  data ai1l1a(21)/-0.643d-17/
  data ai1l1a(22)/-0.118d-17/
  data ai1l1a(23)/-0.22d-18/
  data ai1l1a(24)/-0.4d-19/
  data ai1l1a(25)/-0.1d-19/
!
!   MACHINE-DEPENDENT CONSTANTS (suitable for IEEE machines)
!
  data xlow,xhigh/2.22044605d-16,1.8981253d9/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'I1ML1 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    i1ml1 = zero
  else if ( x < xlow ) then
    i1ml1 = x / two
  else if ( x <= sixten ) then
    t = ( six * x - forty ) / ( x + forty )
    i1ml1 = cheval ( nterm1, ai1l1, t ) * x / two
  else if ( x <= xhigh ) then
    xsq = x * x
    t = ( atehun - xsq ) / ( two88 + xsq )
    i1ml1 = cheval ( nterm2, ai1l1a, t ) * twobpi
  else
    i1ml1 = twobpi
  end if

  return
end
subroutine i1ml1_values ( n_data, x, fx )

!*******************************************************************************
!
!! I1ML1_VALUES returns some values of the I1ML1 function.
!
!  Discussion:
!
!    The function is defined by:
!
!      I1ML1(x) = I1(x) - L1(x)
!
!    I1(x) is the modified Bessel function of the first kind of order 1,
!    L1(x) is the modified Struve function of order 1.
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    30 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.97575346155386267134D-03, kind = 8 ), &
    real ( 0.77609293280609272733D-02, kind = 8 ), &
    real ( 0.59302966404545373770D-01, kind = 8 ), &
    real ( 0.20395212276737365307D+00, kind = 8 ), &
    real ( 0.33839472293667639038D+00, kind = 8 ), &
    real ( 0.48787706726961324579D+00, kind = 8 ), &
    real ( 0.59018734196576517506D+00, kind = 8 ), &
    real ( 0.62604539530312149476D+00, kind = 8 ), &
    real ( 0.63209315274909764698D+00, kind = 8 ), &
    real ( 0.63410179313235359215D+00, kind = 8 ), &
    real ( 0.63417966797578128188D+00, kind = 8 ), &
    real ( 0.63439268632392089434D+00, kind = 8 ), &
    real ( 0.63501579073257770690D+00, kind = 8 ), &
    real ( 0.63559616677359459337D+00, kind = 8 ), &
    real ( 0.63591001826697110312D+00, kind = 8 ), &
    real ( 0.63622113181751073643D+00, kind = 8 ), &
    real ( 0.63636481702133606597D+00, kind = 8 ), &
    real ( 0.63650653499619902120D+00, kind = 8 ), &
    real ( 0.63655609126300261851D+00, kind = 8 ), &
    real ( 0.63657902087183929223D+00, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0156250000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  12.0000000000D+00, kind = 8 ), &
    real (  16.0000000000D+00, kind = 8 ), &
    real (  16.2500000000D+00, kind = 8 ), &
    real (  17.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  25.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  40.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ), &
    real (  75.0000000000D+00, kind = 8 ), &
    real ( 100.0000000000D+00, kind = 8 ), &
    real ( 125.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function lobachevsky ( xvalue )

!*******************************************************************************
!
!! LOBACHEVSKY calculates the Lobachevsky function.
!
!  Discussion:
!
!    The function is defined by:
!
!      LOBACHEVSKY(x) = Integral ( 0 <= t <= x ) -ln ( abs ( cos ( t ) ) dt
!
!    The code uses Chebyshev expansions whose coefficients are given
!    to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) LOBACHEVSKY, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer indpi2
  integer indsgn
  integer npi
  integer, parameter :: nterm1 = 13
  integer, parameter :: nterm2 = 9
  real ( kind = 8 ) lobachevsky
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ), parameter :: six = real ( 6.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: two = 2.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) arlob1(0:15),arlob2(0:10), &
       fval,fval1,lbpb21,lbpb22,lobpia,lobpib, &
       lobpi1,lobpi2,pi,piby2,piby21,piby22,piby4,pi1, &
       pi11,pi12,pi2,t,tcon,xcub,xhigh,xlow1, &
       xlow2,xlow3,xr
  data lobpia,lobpib/ 1115.0d0 , 512.0d0 /
  data lobpi2/-1.48284696397869499311d-4/
  data lbpb22/-7.41423481989347496556d-5/
  data pi11,pi12/ 201.0d0 , 64.0d0 /
  data pi2/9.67653589793238462643d-4/
  data piby22/4.83826794896619231322d-4/
  data tcon/3.24227787655480868620d0/
  data arlob1/0.34464884953481300507d0, &
              0.584198357190277669d-2, &
              0.19175029694600330d-3, &
              0.787251606456769d-5, &
              0.36507477415804d-6, &
              0.1830287272680d-7, &
              0.96890333005d-9, &
              0.5339055444d-10, &
              0.303408025d-11, &
              0.17667875d-12, &
              0.1049393d-13, &
              0.63359d-15, &
              0.3878d-16, &
              0.240d-17, &
              0.15d-18, &
              0.1d-19/
  data arlob2/2.03459418036132851087d0, &
              0.1735185882027407681d-1, &
              0.5516280426090521d-4, &
              0.39781646276598d-6, &
              0.369018028918d-8, &
              0.3880409214d-10, &
              0.44069698d-12, &
              0.527674d-14, &
              0.6568d-16, &
              0.84d-18, &
              0.1d-19/
!
!   Machine-dependent constants (suitable for IEEE machines)
!
  data xlow1,xlow2/5.11091385d-103,4.71216091d-8/
  data xlow3,xhigh/6.32202727d-8,4.5035996d15/
!
  x = abs ( xvalue )
  indsgn = 1
  if ( xvalue < zero ) then
    indsgn = -1
  end if

  if ( xhigh < x ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'LOBACHEVSKY - Fatal error!'
    write ( *, '(a)' ) '  Argument magnitude too large.'
    lobachevsky = zero
    return
  end if
!
!  Reduce argument to [0,pi]
!
  pi1 = pi11 / pi12
  pi = pi1 + pi2
  piby2 = pi / two
  piby21 = pi1 / two
  piby4 = piby2 / two
  npi = int ( x / pi )
  xr = ( x - npi * pi1 ) - npi * pi2
!
!  Reduce argument to [0,pi/2]
!
  indpi2 = 0
  if ( piby2 < xr ) then
    indpi2 = 1
    xr = ( pi1 - xr ) + pi2
  end if
!
!  Code for argument in [0,pi/4]
!
  if ( xr <= piby4 ) then
     if ( xr < xlow1 ) then
        fval = zero
     else
        xcub = xr * xr * xr
        if ( xr < xlow2 ) then
          fval = xcub / six
        else
          t = ( tcon * xr * xr - half ) - half
          fval = xcub * cheval ( nterm1, arlob1, t )
        end if
     end if
  else
!
!  Code for argument in [pi/4,pi/2]
!
     xr = ( piby21 - xr ) + piby22
     if ( xr == zero ) then
        fval1 = zero
     else
        if ( xr < xlow3 ) then
          fval1 = xr * ( one - log ( xr ) )
        else
          t = ( tcon * xr * xr - half ) - half
          fval1 = xr * ( cheval ( nterm2, arlob2, t ) - log ( xr ) )
        end if
     end if
     lbpb21 = lobpia / ( lobpib + lobpib )
     fval = ( lbpb21 - fval1 ) + lbpb22
  end if

  lobpi1 = lobpia / lobpib
!
!  Compute value for argument in [pi/2,pi]
!
  if ( indpi2 == 1 ) then
     fval = ( lobpi1 - fval ) + lobpi2
  end if

  if ( npi <= 0 ) then
    lobachevsky = fval
  else
    lobachevsky = ( fval + npi * lobpi2 ) + npi * lobpi1
  end if

  if ( indsgn == -1 ) then
    lobachevsky = -lobachevsky
  end if

  return
end
subroutine lobachevsky_values ( n_data, x, fx )

!*******************************************************************************
!
!! LOBACHEVSKY_VALUES returns some values of the Lobachevsky function.
!
!  Discussion:
!
!    The function is defined by:
!
!      LOBACHEVSKY(x) = Integral ( 0 <= t <= x ) -ln ( abs ( cos ( t ) ) dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    31 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.12417639065161393857D-08, kind = 8 ), &
    real ( 0.79473344770001088225D-07, kind = 8 ), &
    real ( 0.50867598186208834198D-05, kind = 8 ), &
    real ( 0.32603097901207200319D-03, kind = 8 ), &
    real ( 0.21380536815408214419D-01, kind = 8 ), &
    real ( 0.18753816902083824050D+00, kind = 8 ), &
    real ( 0.83051199971883645115D+00, kind = 8 ), &
    real ( 0.18854362426679034904D+01, kind = 8 ), &
    real ( 0.21315988986516411053D+01, kind = 8 ), &
    real ( 0.21771120185613427221D+01, kind = 8 ), &
    real ( 0.22921027921896650849D+01, kind = 8 ), &
    real ( 0.39137195028784495586D+01, kind = 8 ), &
    real ( 0.43513563983836427904D+01, kind = 8 ), &
    real ( 0.44200644968478185898D+01, kind = 8 ), &
    real ( 0.65656013133623829156D+01, kind = 8 ), &
    real ( 0.10825504661504599479D+02, kind = 8 ), &
    real ( 0.13365512855474227325D+02, kind = 8 ), &
    real ( 0.21131002685639959927D+02, kind = 8 ), &
    real ( 0.34838236589449117389D+02, kind = 8 ), &
    real ( 0.69657062437837394278D+02, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0078125000D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   2.5000000000D+00, kind = 8 ), &
    real (   3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   7.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ), &
    real ( 100.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function stromgen ( xvalue )

!*******************************************************************************
!
!! STROMGEN calculates Stromgen's integral.
!
!  Discussion:
!
!    The function is defined by:
!
!      STROMGEN(X) = Integral ( 0 <= t <= X ) t^7 * exp(2*t) / (exp(t)-1)^3 dt
!
!    The code uses a Chebyshev series, the coefficients of which are
!    given to an accuracy of 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) STROMGEN, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) astrom(0:26)
  real ( kind = 8 ) cheval
  real ( kind = 8 ) epngln
  real ( kind = 8 ) epsln
  real ( kind = 8 ) f15bp4
  real ( kind = 8 ), parameter :: four = 4.0D+00
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer k1
  integer k2
  integer, parameter :: nterms = 23
  integer numexp
  real ( kind = 8 ), parameter :: one = 1.0D+00
  real ( kind = 8 ) one5ln
  real ( kind = 8 ) pi4b3
  real ( kind = 8 ) rk
  real ( kind = 8 ) stromgen
  real ( kind = 8 ), parameter :: two = 2.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) seven,sumexp,sum2,t,valinf,xhigh, &
       xk,xk1,xlow0,xlow1
  data seven/ 7.0d0 /
  data one5ln/ 0.4055d0 /
  data f15bp4/0.38497433455066256959d-1 /
  data pi4b3/1.29878788045336582982d2 /
  data valinf/196.51956920868988261257d0/
  data astrom(0)/  0.56556120872539155290d0/
  data astrom(1)/  0.4555731969101785525d-1/
  data astrom(2)/ -0.4039535875936869170d-1/
  data astrom(3)/ -0.133390572021486815d-2/
  data astrom(4)/  0.185862506250538030d-2/
  data astrom(5)/ -0.4685555868053659d-4/
  data astrom(6)/ -0.6343475643422949d-4/
  data astrom(7)/  0.572548708143200d-5/
  data astrom(8)/  0.159352812216822d-5/
  data astrom(9)/ -0.28884328431036d-6/
  data astrom(10)/-0.2446633604801d-7/
  data astrom(11)/ 0.1007250382374d-7/
  data astrom(12)/-0.12482986104d-9/
  data astrom(13)/-0.26300625283d-9/
  data astrom(14)/ 0.2490407578d-10/
  data astrom(15)/ 0.485454902d-11/
  data astrom(16)/-0.105378913d-11/
  data astrom(17)/-0.3604417d-13/
  data astrom(18)/ 0.2992078d-13/
  data astrom(19)/-0.163971d-14/
  data astrom(20)/-0.61061d-15/
  data astrom(21)/ 0.9335d-16/
  data astrom(22)/ 0.709d-17/
  data astrom(23)/-0.291d-17/
  data astrom(24)/ 0.8d-19/
  data astrom(25)/ 0.6d-19/
  data astrom(26)/-0.1d-19/
!
!  Machine-dependent constants
!
  data xlow0,xlow1/7.80293d-62,2.22045d-16/
  data epsln,epngln/-36.0436534d0,-36.7368006d0/
  data xhigh/3.1525197d16/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'STROMGEN - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    stromgen = zero
    return
  end if

  if ( x < xlow0 ) then
    stromgen = zero
  else if ( x < xlow1 ) then
    stromgen = x**5 / pi4b3
  else if ( x <= four ) then
    t = ( ( x / two ) - half ) - half
    stromgen = x**5 * cheval ( nterms, astrom, t ) * f15bp4
  else
!
!  Code for x > 4.0
!
    if ( xhigh < x ) then
      sumexp = one
    else
      numexp = int ( epsln / ( one5ln - x ) ) + 1
      if ( 1 < numexp ) then
        t = exp ( -x )
      else
        t = one
      end if
      rk = zero
      do k1 = 1, numexp
        rk = rk + one
      end do
      sumexp = zero
      do k1 = 1, numexp
        sum2 = one
        xk = one / ( rk * x )
        xk1 = one
        do k2 = 1, 7
          sum2 = sum2 * xk1 * xk + one
          xk1 = xk1 + one
        end do
        sum2 = sum2 * ( rk + one ) / two
        sumexp = sumexp * t + sum2
        rk = rk - one
      end do

    end if

    t = seven * log ( x ) - x + log ( sumexp )

    if ( t < epngln ) then
      stromgen = valinf
    else
      stromgen = valinf - exp ( t ) * f15bp4
    end if

  end if

  return
end
subroutine stromgen_values ( n_data, x, fx )

!*******************************************************************************
!
!! STROMGEN_VALUES returns some values of the Stromgen function.
!
!  Discussion:
!
!    The function is defined by:
!
!      STROMGEN(X) = Integral ( 0 <= t <= X ) t^7 * exp(2*t) / (exp(t)-1)^3 dt
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    31 August 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.21901065985698662316D-15, kind = 8 ), &
    real ( 0.22481399438625244761D-12, kind = 8 ), &
    real ( 0.23245019579558857124D-09, kind = 8 ), &
    real ( 0.24719561475975007037D-06, kind = 8 ), &
    real ( 0.28992610989833245669D-03, kind = 8 ), &
    real ( 0.10698146390809715091D-01, kind = 8 ), &
    real ( 0.89707650964424730705D-01, kind = 8 ), &
    real ( 0.40049605719592888440D+00, kind = 8 ), &
    real ( 0.30504104398079096598D+01, kind = 8 ), &
    real ( 0.11367704858439426431D+02, kind = 8 ), &
    real ( 0.12960679405324786954D+02, kind = 8 ), &
    real ( 0.18548713944748505675D+02, kind = 8 ), &
    real ( 0.27866273821903121400D+02, kind = 8 ), &
    real ( 0.51963334071699323351D+02, kind = 8 ), &
    real ( 0.10861016747891228129D+03, kind = 8 ), &
    real ( 0.15378903316556621624D+03, kind = 8 ), &
    real ( 0.19302665532558721516D+03, kind = 8 ), &
    real ( 0.19636850166006541482D+03, kind = 8 ), &
    real ( 0.19651946766008214217D+03, kind = 8 ), &
    real ( 0.19651956920868316152D+03, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0078125000D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.1250000000D+00, kind = 8 ), &
    real (   4.5000000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function struve_h0 ( xvalue )

!*******************************************************************************
!
!! STRUVE_H0 calculates the Struve function of order 0.
!
!  Discussion:
!
!    The function is defined by:
!
!      HO(x) = (2/pi) Integral ( 0 <= t <= pi/2 ) sin ( x * cos ( t ) ) dt
!
!    H0 also satisfies the second-order equation
!
!      x*D(Df) + Df + x * f = 2 * x / pi
!
!    The code uses Chebyshev expansions whose coefficients are
!    given to 20D.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) STRUVE_H0, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) arrh0(0:19)
  real ( kind = 8 ) arrh0a(0:20)
  real ( kind = 8 ) ay0asp(0:12)
  real ( kind = 8 ) ay0asq(0:13)
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: eight = real ( 8.0, kind = 8 )
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer indsgn
  integer, parameter :: nterm1 = 18
  integer, parameter :: nterm2 = 18
  integer, parameter :: nterm3 = 11
  integer, parameter :: nterm4 = 11
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ) struve_h0
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) eleven,h0as, &
       piby4,rt2bpi,sixtp5,t,thr2p5,twenty, &
       twobpi,two62,xhigh,xlow,xmp4,xsq, &
       y0p,y0q,y0val
  data eleven/ 11.0d0/
  data twenty /20.0d0 /
  data sixtp5,two62,thr2p5/60.5d0, 262.0d0, 302.5d0/
  data piby4/0.78539816339744830962d0/
  data rt2bpi/0.79788456080286535588d0/
  data twobpi/0.63661977236758134308d0/
  data arrh0(0)/  0.28696487399013225740d0/
  data arrh0(1)/ -0.25405332681618352305d0/
  data arrh0(2)/  0.20774026739323894439d0/
  data arrh0(3)/ -0.20364029560386585140d0/
  data arrh0(4)/  0.12888469086866186016d0/
  data arrh0(5)/ -0.4825632815622261202d-1/
  data arrh0(6)/  0.1168629347569001242d-1/
  data arrh0(7)/ -0.198118135642418416d-2/
  data arrh0(8)/  0.24899138512421286d-3/
  data arrh0(9)/ -0.2418827913785950d-4/
  data arrh0(10)/ 0.187437547993431d-5/
  data arrh0(11)/-0.11873346074362d-6/
  data arrh0(12)/ 0.626984943346d-8/
  data arrh0(13)/-0.28045546793d-9/
  data arrh0(14)/ 0.1076941205d-10/
  data arrh0(15)/-0.35904793d-12/
  data arrh0(16)/ 0.1049447d-13/
  data arrh0(17)/-0.27119d-15/
  data arrh0(18)/ 0.624d-17/
  data arrh0(19)/-0.13d-18/
  data arrh0a(0)/  1.99291885751992305515d0/
  data arrh0a(1)/ -0.384232668701456887d-2/
  data arrh0a(2)/ -0.32871993712353050d-3/
  data arrh0a(3)/ -0.2941181203703409d-4/
  data arrh0a(4)/ -0.267315351987066d-5/
  data arrh0a(5)/ -0.24681031075013d-6/
  data arrh0a(6)/ -0.2295014861143d-7/
  data arrh0a(7)/ -0.215682231833d-8/
  data arrh0a(8)/ -0.20303506483d-9/
  data arrh0a(9)/ -0.1934575509d-10/
  data arrh0a(10)/-0.182773144d-11/
  data arrh0a(11)/-0.17768424d-12/
  data arrh0a(12)/-0.1643296d-13/
  data arrh0a(13)/-0.171569d-14/
  data arrh0a(14)/-0.13368d-15/
  data arrh0a(15)/-0.2077d-16/
  data arrh0a(16)/ 0.2d-19/
  data arrh0a(17)/-0.55d-18/
  data arrh0a(18)/ 0.10d-18/
  data arrh0a(19)/-0.4d-19/
  data arrh0a(20)/ 0.1d-19/
  data ay0asp/1.99944639402398271568d0, &
             -0.28650778647031958d-3, &
             -0.1005072797437620d-4, &
             -0.35835941002463d-6, &
             -0.1287965120531d-7, &
             -0.46609486636d-9, &
             -0.1693769454d-10, &
             -0.61852269d-12, &
             -0.2261841d-13, &
             -0.83268d-15, &
             -0.3042d-16, &
             -0.115d-17, &
             -0.4d-19/
  data ay0asq/1.99542681386828604092d0, &
             -0.236013192867514472d-2, &
             -0.7601538908502966d-4, &
             -0.256108871456343d-5, &
             -0.8750292185106d-7, &
             -0.304304212159d-8, &
             -0.10621428314d-9, &
             -0.377371479d-11, &
             -0.13213687d-12, &
             -0.488621d-14, &
             -0.15809d-15, &
             -0.762d-17, &
             -0.3d-19, &
             -0.3d-19/
!
!   MACHINE-DEPENDENT CONSTANTS (Suitable for IEEE-arithmetic machines)
!
  data xlow,xhigh/3.1610136d-8,4.50359963d15/
!
  x = xvalue
  indsgn = 1

  if ( x < zero ) then
    x = -x
    indsgn = -1
  end if

  if ( x < xlow ) then
    struve_h0 = twobpi * x
  else if ( x <= eleven ) then
    t = ( ( x * x ) / sixtp5 - half ) - half
    struve_h0 = twobpi * x * cheval ( nterm1, arrh0, t )
  else if ( x <= xhigh ) then
    xsq = x * x
    t = ( two62 - xsq ) / ( twenty + xsq )
    y0p = cheval ( nterm3, ay0asp, t )
    y0q = cheval ( nterm4, ay0asq, t ) / ( eight * x )
    xmp4 = x - piby4
    y0val = y0p * sin ( xmp4 ) - y0q * cos ( xmp4 )
    y0val = y0val * rt2bpi / sqrt ( x )
    t = ( thr2p5 - xsq ) / ( sixtp5 + xsq )
    h0as = twobpi * cheval ( nterm2, arrh0a, t ) / x
    struve_h0 = y0val + h0as
  else
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'STRUVE_H0 - Fatal error!'
    write ( *, '(a)' ) '  Argument magnitude too large.'
    struve_h0 = zero
  end if

  if ( indsgn == -1 ) then
    struve_h0 = -struve_h0
  end if

  return
end
subroutine struve_h0_values ( n_data, x, fx )

!*******************************************************************************
!
!! STRUVE_H0_VALUES returns some values of the Struve H0 function.
!
!  Discussion:
!
!    The function is defined by:
!
!      HO(x) = (2/pi) * Integral ( 0 <= t <= pi/2 ) sin ( x * cos ( t ) ) dt
!
!    In Mathematica, the function can be evaluated by:
!
!      StruveH[0,x]
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    01 September 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!    Stephen Wolfram,
!    The Mathematica Book,
!    Fourth Edition,
!    Wolfram Media / Cambridge University Press, 1999.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real (  0.12433974658847434366d-02, kind = 8 ), &
    real ( -0.49735582423748415045d-02, kind = 8 ), &
    real (  0.39771469054536941564d-01, kind = 8 ), &
    real ( -0.15805246001653314198d+00, kind = 8 ), &
    real (  0.56865662704828795099d+00, kind = 8 ), &
    real (  0.66598399314899916605d+00, kind = 8 ), &
    real (  0.79085884950809589255d+00, kind = 8 ), &
    real ( -0.13501457342248639716d+00, kind = 8 ), &
    real (  0.20086479668164503137d+00, kind = 8 ), &
    real ( -0.11142097800261991552d+00, kind = 8 ), &
    real ( -0.17026804865989885869d+00, kind = 8 ), &
    real ( -0.13544931808186467594d+00, kind = 8 ), &
    real (  0.94393698081323450897d-01, kind = 8 ), &
    real ( -0.10182482016001510271d+00, kind = 8 ), &
    real (  0.96098421554162110012d-01, kind = 8 ), &
    real ( -0.85337674826118998952d-01, kind = 8 ), &
    real ( -0.76882290637052720045d-01, kind = 8 ), &
    real (  0.47663833591418256339d-01, kind = 8 ), &
    real ( -0.70878751689647343204d-01, kind = 8 ), &
    real (  0.65752908073352785368d-01, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (    0.0019531250D+00, kind = 8 ), &
    real (   -0.0078125000D+00, kind = 8 ), &
    real (    0.0625000000D+00, kind = 8 ), &
    real (   -0.2500000000D+00, kind = 8 ), &
    real (    1.0000000000D+00, kind = 8 ), &
    real (    1.2500000000D+00, kind = 8 ), &
    real (    2.0000000000D+00, kind = 8 ), &
    real (   -4.0000000000D+00, kind = 8 ), &
    real (    7.5000000000D+00, kind = 8 ), &
    real (   11.0000000000D+00, kind = 8 ), &
    real (   11.5000000000D+00, kind = 8 ), &
    real (  -16.0000000000D+00, kind = 8 ), &
    real (   20.0000000000D+00, kind = 8 ), &
    real (   25.0000000000D+00, kind = 8 ), &
    real (  -30.0000000000D+00, kind = 8 ), &
    real (   50.0000000000D+00, kind = 8 ), &
    real (   75.0000000000D+00, kind = 8 ), &
    real (  -80.0000000000D+00, kind = 8 ), &
    real (  100.0000000000D+00, kind = 8 ), &
    real ( -125.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function struve_h1 ( xvalue )

!*******************************************************************************
!
!! STRUVE_H1 calculates the Struve function of order 1.
!
!  Discussion:
!
!    The function is defined by:
!
!      H1(x) = 2*x/pi * Integral ( 0 <= t <= pi/2 )
!        sin ( x * cos ( t ) )^2 * sin ( t ) dt
!
!    H1 also satisfies the second-order differential equation
!
!      x^2 * D^2 f  +  x * Df  +  (x^2 - 1)f  =  2x^2 / pi
!
!    The code uses Chebyshev expansions with the coefficients
!    given to 20D.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) STRUVE_H1, the value of the function.
!
  implicit none

  real ( kind = 8 ) arrh1(0:17)
  real ( kind = 8 ) arrh1a(0:21)
  real ( kind = 8 ) ay1asp(0:14)
  real ( kind = 8 ) ay1asq(0:15)
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: eight = real ( 8.0, kind = 8 )
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer, parameter :: nterm1 = 15
  integer, parameter :: nterm2 = 17
  integer, parameter :: nterm3 = 12
  integer, parameter :: nterm4 = 13
  real ( kind = 8 ) struve_h1
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) fortp5, &
       h1as,nine,one82,rt2bpi,t,thpby4, &
       twenty,twobpi,tw02p5,xhigh,xlow1,xlow2, &
       xm3p4,xsq,y1p,y1q,y1val
  data nine / 9.0d0 /
  data twenty / 20.0d0 /
  data fortp5,one82,tw02p5/40.5d0, 182.0d0 , 202.5d0/
  data rt2bpi/0.79788456080286535588d0/
  data thpby4/2.35619449019234492885d0/
  data twobpi/0.63661977236758134308d0/
  data arrh1/0.17319061083675439319d0, &
            -0.12606917591352672005d0, &
             0.7908576160495357500d-1, &
            -0.3196493222321870820d-1, &
             0.808040581404918834d-2, &
            -0.136000820693074148d-2, &
             0.16227148619889471d-3, &
            -0.1442352451485929d-4, &
             0.99219525734072d-6, &
            -0.5441628049180d-7, &
             0.243631662563d-8, &
            -0.9077071338d-10, &
             0.285926585d-11, &
            -0.7716975d-13, &
             0.180489d-14, &
            -0.3694d-16, &
             0.67d-18, &
            -0.1d-19/
  data arrh1a(0)/  2.01083504951473379407d0/
  data arrh1a(1)/  0.592218610036099903d-2/
  data arrh1a(2)/  0.55274322698414130d-3/
  data arrh1a(3)/  0.5269873856311036d-4/
  data arrh1a(4)/  0.506374522140969d-5/
  data arrh1a(5)/  0.49028736420678d-6/
  data arrh1a(6)/  0.4763540023525d-7/
  data arrh1a(7)/  0.465258652283d-8/
  data arrh1a(8)/  0.45465166081d-9/
  data arrh1a(9)/  0.4472462193d-10/
  data arrh1a(10)/ 0.437308292d-11/
  data arrh1a(11)/ 0.43568368d-12/
  data arrh1a(12)/ 0.4182190d-13/
  data arrh1a(13)/ 0.441044d-14/
  data arrh1a(14)/ 0.36391d-15/
  data arrh1a(15)/ 0.5558d-16/
  data arrh1a(16)/-0.4d-19/
  data arrh1a(17)/ 0.163d-17/
  data arrh1a(18)/-0.34d-18/
  data arrh1a(19)/ 0.13d-18/
  data arrh1a(20)/-0.4d-19/
  data arrh1a(21)/ 0.1d-19/
  data ay1asp/2.00135240045889396402d0, &
              0.71104241596461938d-3, &
              0.3665977028232449d-4, &
              0.191301568657728d-5, &
              0.10046911389777d-6, &
              0.530401742538d-8, &
              0.28100886176d-9, &
              0.1493886051d-10, &
              0.79578420d-12, &
              0.4252363d-13, &
              0.227195d-14, &
              0.12216d-15, &
              0.650d-17, &
              0.36d-18, &
              0.2d-19/
  data ay1asq/5.99065109477888189116d0, &
             -0.489593262336579635d-2, &
             -0.23238321307070626d-3, &
             -0.1144734723857679d-4, &
             -0.57169926189106d-6, &
             -0.2895516716917d-7, &
             -0.147513345636d-8, &
             -0.7596537378d-10, &
             -0.390658184d-11, &
             -0.20464654d-12, &
             -0.1042636d-13, &
             -0.57702d-15, &
             -0.2550d-16, &
             -0.210d-17, &
              0.2d-19, &
             -0.2d-19/
!
!   MACHINE-DEPENDENT CONSTANTS (Suitable for IEEE-arithmetic machines)
!
  data xlow1,xlow2/2.23750222d-154,4.08085106d-8/
  data xhigh/4.50359963d15/
!
  x = abs ( xvalue )

  if ( x < xlow1 ) then
    struve_h1 = zero
  else if ( x < xlow2 ) then
    xsq = x * x
    struve_h1 = twobpi * xsq
  else if ( x <= nine ) then
    xsq = x * x
    t = ( xsq / fortp5 - half ) - half
    struve_h1 = twobpi * xsq * cheval ( nterm1, arrh1, t )
  else if ( x <= xhigh ) then
    xsq = x * x
    t = ( one82 - xsq ) / ( twenty + xsq )
    y1p = cheval ( nterm3, ay1asp, t )
    y1q = cheval ( nterm4, ay1asq, t ) / ( eight * x)
    xm3p4 = x - thpby4
    y1val = y1p * sin ( xm3p4 ) + y1q * cos ( xm3p4 )
    y1val = y1val * rt2bpi / sqrt ( x )
    t = ( tw02p5 - xsq ) / ( fortp5 + xsq )
    h1as = twobpi * cheval ( nterm2, arrh1a, t )
    struve_h1 = y1val + h1as
  else
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'STRUVE_H1 - Fatal error!'
    write ( *, '(a)' ) '  Argument magnitude too large.'
    struve_h1 = zero
  end if

  return
end
subroutine struve_h1_values ( n_data, x, fx )

!*******************************************************************************
!
!! STRUVE_H1_VALUES returns some values of the Struve H1 function.
!
!  Discussion:
!
!    The function is defined by:
!
!      H1(x) = 2*x/pi * Integral ( 0 <= t <= pi/2 )
!        sin ( x * cos ( t ) )^2 * sin ( t ) dt
!
!    In Mathematica, the function can be evaluated by:
!
!      StruveH[1,x]
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    02 September 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!    Stephen Wolfram,
!    The Mathematica Book,
!    Fourth Edition,
!    Wolfram Media / Cambridge University Press, 1999.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.80950369576367526071D-06, kind = 8 ), &
    real ( 0.12952009724113229165D-04, kind = 8 ), &
    real ( 0.82871615165407083021D-03, kind = 8 ), &
    real ( 0.13207748375849572564D-01, kind = 8 ), &
    real ( 0.19845733620194439894D+00, kind = 8 ), &
    real ( 0.29853823231804706294D+00, kind = 8 ), &
    real ( 0.64676372828356211712D+00, kind = 8 ), &
    real ( 0.10697266613089193593D+01, kind = 8 ), &
    real ( 0.38831308000420560970D+00, kind = 8 ), &
    real ( 0.74854243745107710333D+00, kind = 8 ), &
    real ( 0.84664854642567359993D+00, kind = 8 ), &
    real ( 0.58385732464244384564D+00, kind = 8 ), &
    real ( 0.80600584524215772824D+00, kind = 8 ), &
    real ( 0.53880362132692947616D+00, kind = 8 ), &
    real ( 0.72175037834698998506D+00, kind = 8 ), &
    real ( 0.58007844794544189900D+00, kind = 8 ), &
    real ( 0.60151910385440804463D+00, kind = 8 ), &
    real ( 0.70611511147286827018D+00, kind = 8 ), &
    real ( 0.61631110327201338454D+00, kind = 8 ), &
    real ( 0.62778480765443656489D+00, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (    0.0019531250D+00, kind = 8 ), &
    real (   -0.0078125000D+00, kind = 8 ), &
    real (    0.0625000000D+00, kind = 8 ), &
    real (   -0.2500000000D+00, kind = 8 ), &
    real (    1.0000000000D+00, kind = 8 ), &
    real (    1.2500000000D+00, kind = 8 ), &
    real (    2.0000000000D+00, kind = 8 ), &
    real (   -4.0000000000D+00, kind = 8 ), &
    real (    7.5000000000D+00, kind = 8 ), &
    real (   11.0000000000D+00, kind = 8 ), &
    real (   11.5000000000D+00, kind = 8 ), &
    real (  -16.0000000000D+00, kind = 8 ), &
    real (   20.0000000000D+00, kind = 8 ), &
    real (   25.0000000000D+00, kind = 8 ), &
    real (  -30.0000000000D+00, kind = 8 ), &
    real (   50.0000000000D+00, kind = 8 ), &
    real (   75.0000000000D+00, kind = 8 ), &
    real (  -80.0000000000D+00, kind = 8 ), &
    real (  100.0000000000D+00, kind = 8 ), &
    real ( -125.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function struve_l0 ( xvalue )

!*******************************************************************************
!
!! STRUVE_L0 calculates the modified Struve function of order 0.
!
!  Discussion:
!
!    This function calculates the modified Struve function of
!    order 0, denoted L0(x), defined as the solution of the
!    second-order equation
!
!      x*D(Df) + Df - x*f  =  2x/pi
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) STRUVE_L0, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  integer indsgn
  integer, parameter :: nterm1 = 25
  integer, parameter :: nterm2 = 14
  integer, parameter :: nterm3 = 21
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ) struve_l0
  real ( kind = 8 ), parameter :: two = 2.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) arl0(0:27),arl0as(0:15),ai0ml0(0:23), &
       atehun,ch1,ch2,lnr2pi, &
       sixten,t,test,twent4,twent8,twobpi,two88, &
       xhigh1,xhigh2,xlow,xmax,xsq
  data sixten/16.0d0/
  data twent4,twent8/24.0d0 , 28.0d0 /
  data two88,atehun/288.0d0 , 800.0d0/
  data lnr2pi/0.91893853320467274178d0/
  data twobpi/0.63661977236758134308d0/
  data arl0(0)/  0.42127458349979924863d0/
  data arl0(1)/ -0.33859536391220612188d0/
  data arl0(2)/  0.21898994812710716064d0/
  data arl0(3)/ -0.12349482820713185712d0/
  data arl0(4)/  0.6214209793866958440d-1/
  data arl0(5)/ -0.2817806028109547545d-1/
  data arl0(6)/  0.1157419676638091209d-1/
  data arl0(7)/ -0.431658574306921179d-2/
  data arl0(8)/  0.146142349907298329d-2/
  data arl0(9)/ -0.44794211805461478d-3/
  data arl0(10)/ 0.12364746105943761d-3/
  data arl0(11)/-0.3049028334797044d-4/
  data arl0(12)/ 0.663941401521146d-5/
  data arl0(13)/-0.125538357703889d-5/
  data arl0(14)/ 0.20073446451228d-6/
  data arl0(15)/-0.2588260170637d-7/
  data arl0(16)/ 0.241143742758d-8/
  data arl0(17)/-0.10159674352d-9/
  data arl0(18)/-0.1202430736d-10/
  data arl0(19)/ 0.262906137d-11/
  data arl0(20)/-0.15313190d-12/
  data arl0(21)/-0.1574760d-13/
  data arl0(22)/ 0.315635d-14/
  data arl0(23)/-0.4096d-16/
  data arl0(24)/-0.3620d-16/
  data arl0(25)/ 0.239d-17/
  data arl0(26)/ 0.36d-18/
  data arl0(27)/-0.4d-19/
  data arl0as(0)/  2.00861308235605888600d0/
  data arl0as(1)/  0.403737966500438470d-2/
  data arl0as(2)/ -0.25199480286580267d-3/
  data arl0as(3)/  0.1605736682811176d-4/
  data arl0as(4)/ -0.103692182473444d-5/
  data arl0as(5)/  0.6765578876305d-7/
  data arl0as(6)/ -0.444999906756d-8/
  data arl0as(7)/  0.29468889228d-9/
  data arl0as(8)/ -0.1962180522d-10/
  data arl0as(9)/  0.131330306d-11/
  data arl0as(10)/-0.8819190d-13/
  data arl0as(11)/ 0.595376d-14/
  data arl0as(12)/-0.40389d-15/
  data arl0as(13)/ 0.2651d-16/
  data arl0as(14)/-0.208d-17/
  data arl0as(15)/ 0.11d-18/
  data ai0ml0(0)/ 2.00326510241160643125d0/
  data ai0ml0(1)/ 0.195206851576492081d-2/
  data ai0ml0(2)/ 0.38239523569908328d-3/
  data ai0ml0(3)/ 0.7534280817054436d-4/
  data ai0ml0(4)/ 0.1495957655897078d-4/
  data ai0ml0(5)/ 0.299940531210557d-5/
  data ai0ml0(6)/ 0.60769604822459d-6/
  data ai0ml0(7)/ 0.12399495544506d-6/
  data ai0ml0(8)/ 0.2523262552649d-7/
  data ai0ml0(9)/ 0.504634857332d-8/
  data ai0ml0(10)/0.97913236230d-9/
  data ai0ml0(11)/0.18389115241d-9/
  data ai0ml0(12)/0.3376309278d-10/
  data ai0ml0(13)/0.611179703d-11/
  data ai0ml0(14)/0.108472972d-11/
  data ai0ml0(15)/0.18861271d-12/
  data ai0ml0(16)/0.3280345d-13/
  data ai0ml0(17)/0.565647d-14/
  data ai0ml0(18)/0.93300d-15/
  data ai0ml0(19)/0.15881d-15/
  data ai0ml0(20)/0.2791d-16/
  data ai0ml0(21)/0.389d-17/
  data ai0ml0(22)/0.70d-18/
  data ai0ml0(23)/0.16d-18/
!
!   MACHINE-DEPENDENT VALUES (Suitable for IEEE-arithmetic machines)
!
  data xlow,xmax/4.4703484d-8,1.797693d308/
  data xhigh1,xhigh2/5.1982303d8,2.5220158d17/
!
  x = xvalue
  indsgn = 1
  if ( x < zero ) then
    x = -x
    indsgn = -1
  end if

  if ( x < xlow ) then
    struve_l0 = twobpi * x
  else if ( x <= sixten ) then
    t = ( four * x - twent4 ) / ( x + twent4 )
    struve_l0 = twobpi * x * cheval ( nterm1, arl0, t ) * exp ( x )
  else
!
!   Code for |xvalue| > 16
!
     if ( xhigh2 < x ) then
        ch1 = one
     else
        t = ( x - twent8 ) / ( four - x )
        ch1 = cheval ( nterm2, arl0as, t )
     end if

     if ( xhigh1 < x ) then
        ch2 = one
     else
        xsq = x * x
        t = ( atehun - xsq ) / ( two88 + xsq )
        ch2 = cheval ( nterm3, ai0ml0, t )
     end if

     test = log ( ch1 ) - lnr2pi - log ( x ) / two + x

     if ( log ( xmax ) < test ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'STRUVE_L0 - Fatal error!'
        write ( *, '(a)' ) '  Argument would cause overflow.'
        struve_l0 = xmax
     else
        struve_l0 = exp ( test ) - twobpi * ch2 / x
     end if

  end if

  if ( indsgn == -1 ) then
    struve_l0 = -struve_l0
  end if

  return
end
subroutine struve_l0_values ( n_data, x, fx )

!*******************************************************************************
!
!! STRUVE_L0_VALUES returns some values of the Struve L0 function.
!
!  Discussion:
!
!    In Mathematica, the function can be evaluated by:
!
!      StruveL[0,x]
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    03 September 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!    Stephen Wolfram,
!    The Mathematica Book,
!    Fourth Edition,
!    Wolfram Media / Cambridge University Press, 1999.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real (  0.12433985199262820188D-02, kind = 8 ), &
    real ( -0.19896526647882937004D-01, kind = 8 ), &
    real (  0.79715713253115014945D-01, kind = 8 ), &
    real ( -0.32724069939418078025D+00, kind = 8 ), &
    real (  0.71024318593789088874D+00, kind = 8 ), &
    real (  0.19374337579914456612D+01, kind = 8 ), &
    real ( -0.11131050203248583431D+02, kind = 8 ), &
    real (  0.16850062034703267148D+03, kind = 8 ), &
    real ( -0.28156522493745948555D+04, kind = 8 ), &
    real (  0.89344618796978400815D+06, kind = 8 ), &
    real (  0.11382025002851451057D+07, kind = 8 ), &
    real ( -0.23549701855860190304D+07, kind = 8 ), &
    real (  0.43558282527641046718D+08, kind = 8 ), &
    real (  0.49993516476037957165D+09, kind = 8 ), &
    real ( -0.57745606064408041689D+10, kind = 8 ), &
    real (  0.78167229782395624524D+12, kind = 8 ), &
    real ( -0.14894774793419899908D+17, kind = 8 ), &
    real (  0.29325537838493363267D+21, kind = 8 ), &
    real (  0.58940770556098011683D+25, kind = 8 ), &
    real ( -0.12015889579125463605D+30, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (  -0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (  -0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (  -4.0000000000D+00, kind = 8 ), &
    real (   7.0000000000D+00, kind = 8 ), &
    real ( -10.0000000000D+00, kind = 8 ), &
    real (  16.0000000000D+00, kind = 8 ), &
    real (  16.2500000000D+00, kind = 8 ), &
    real ( -17.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  22.5000000000D+00, kind = 8 ), &
    real ( -25.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real ( -40.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ), &
    real (  60.0000000000D+00, kind = 8 ), &
    real ( -70.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function struve_l1 ( xvalue )

!*******************************************************************************
!
!! STRUVE_L1 calculates the modified Struve function of order 1.
!
!  Discussion:
!
!    This function calculates the modified Struve function of
!    order 1, denoted L1(x), defined as the solution of
!
!      x*x*D(Df) + x*Df - (x*x+1)f = 2 * x * x / pi
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) STRUVE_L1, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: four = real ( 4.0, kind = 8 )
  integer, parameter :: nterm1 = 24
  integer, parameter :: nterm2 = 13
  integer, parameter :: nterm3 = 22
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ), parameter :: sixten = real ( 16.0, kind = 8 )
  real ( kind = 8 ) struve_l1
  real ( kind = 8 ), parameter :: two = 2.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) arl1(0:26),arl1as(0:16),ai1ml1(0:25), &
       atehun,ch1,ch2,lnr2pi, &
       pi3by2,t,test,thirty,twent4, &
       twobpi,two88,xhigh1,xhigh2,xlow1,xlow2, &
       xmax,xsq
  data twent4,thirty/24.0d0, 30.0d0/
  data two88,atehun/288.0d0, 800.0d0/
  data lnr2pi/0.91893853320467274178d0/
  data pi3by2/4.71238898038468985769d0/
  data twobpi/0.63661977236758134308d0/
  data arl1(0)/  0.38996027351229538208d0/
  data arl1(1)/ -0.33658096101975749366d0/
  data arl1(2)/  0.23012467912501645616d0/
  data arl1(3)/ -0.13121594007960832327d0/
  data arl1(4)/  0.6425922289912846518d-1/
  data arl1(5)/ -0.2750032950616635833d-1/
  data arl1(6)/  0.1040234148637208871d-1/
  data arl1(7)/ -0.350532294936388080d-2/
  data arl1(8)/  0.105748498421439717d-2/
  data arl1(9)/ -0.28609426403666558d-3/
  data arl1(10)/ 0.6925708785942208d-4/
  data arl1(11)/-0.1489693951122717d-4/
  data arl1(12)/ 0.281035582597128d-5/
  data arl1(13)/-0.45503879297776d-6/
  data arl1(14)/ 0.6090171561770d-7/
  data arl1(15)/-0.623543724808d-8/
  data arl1(16)/ 0.38430012067d-9/
  data arl1(17)/ 0.790543916d-11/
  data arl1(18)/-0.489824083d-11/
  data arl1(19)/ 0.46356884d-12/
  data arl1(20)/ 0.684205d-14/
  data arl1(21)/-0.569748d-14/
  data arl1(22)/ 0.35324d-15/
  data arl1(23)/ 0.4244d-16/
  data arl1(24)/-0.644d-17/
  data arl1(25)/-0.21d-18/
  data arl1(26)/ 0.9d-19/
  data arl1as(0)/  1.97540378441652356868d0/
  data arl1as(1)/ -0.1195130555088294181d-1/
  data arl1as(2)/  0.33639485269196046d-3/
  data arl1as(3)/ -0.1009115655481549d-4/
  data arl1as(4)/  0.30638951321998d-6/
  data arl1as(5)/ -0.953704370396d-8/
  data arl1as(6)/  0.29524735558d-9/
  data arl1as(7)/ -0.951078318d-11/
  data arl1as(8)/  0.28203667d-12/
  data arl1as(9)/ -0.1134175d-13/
  data arl1as(10)/ 0.147d-17/
  data arl1as(11)/-0.6232d-16/
  data arl1as(12)/-0.751d-17/
  data arl1as(13)/-0.17d-18/
  data arl1as(14)/ 0.51d-18/
  data arl1as(15)/ 0.23d-18/
  data arl1as(16)/ 0.5d-19/
  data ai1ml1(0)/  1.99679361896789136501d0/
  data ai1ml1(1)/ -0.190663261409686132d-2/
  data ai1ml1(2)/ -0.36094622410174481d-3/
  data ai1ml1(3)/ -0.6841847304599820d-4/
  data ai1ml1(4)/ -0.1299008228509426d-4/
  data ai1ml1(5)/ -0.247152188705765d-5/
  data ai1ml1(6)/ -0.47147839691972d-6/
  data ai1ml1(7)/ -0.9020819982592d-7/
  data ai1ml1(8)/ -0.1730458637504d-7/
  data ai1ml1(9)/ -0.332323670159d-8/
  data ai1ml1(10)/-0.63736421735d-9/
  data ai1ml1(11)/-0.12180239756d-9/
  data ai1ml1(12)/-0.2317346832d-10/
  data ai1ml1(13)/-0.439068833d-11/
  data ai1ml1(14)/-0.82847110d-12/
  data ai1ml1(15)/-0.15562249d-12/
  data ai1ml1(16)/-0.2913112d-13/
  data ai1ml1(17)/-0.543965d-14/
  data ai1ml1(18)/-0.101177d-14/
  data ai1ml1(19)/-0.18767d-15/
  data ai1ml1(20)/-0.3484d-16/
  data ai1ml1(21)/-0.643d-17/
  data ai1ml1(22)/-0.118d-17/
  data ai1ml1(23)/-0.22d-18/
  data ai1ml1(24)/-0.4d-19/
  data ai1ml1(25)/-0.1d-19/
!
!   MACHINE-DEPENDENT VALUES (Suitable for IEEE-arithmetic machines)
!
  data xlow1,xlow2,xmax/5.7711949d-8,3.3354714d-154,1.797693d308/
  data xhigh1,xhigh2/5.19823025d8,2.7021597d17/
!
  x = abs ( xvalue )

  if ( x <= xlow2 ) then
    struve_l1 = zero
  else if ( x < xlow1 ) then
    xsq = x * x
    struve_l1 = xsq / pi3by2
  else if ( x <= sixten ) then
    xsq = x * x
    t = ( four * x - twent4 ) / ( x + twent4 )
    struve_l1 = xsq * cheval ( nterm1, arl1, t ) * exp ( x ) / pi3by2
  else

    if ( xhigh2 < x ) then
      ch1 = one
    else
      t = ( x - thirty ) / ( two - x )
      ch1 = cheval ( nterm2, arl1as, t )
    end if

    if ( xhigh1 < x ) then
      ch2 = one
    else
      xsq = x * x
      t = ( atehun - xsq ) / ( two88 + xsq )
      ch2 = cheval ( nterm3, ai1ml1, t )
    end if

    test = log ( ch1 ) - lnr2pi - log ( x ) / two + x

    if ( log ( xmax ) < test ) then
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'STRUVE_L1 - Fatal error!'
      write ( *, '(a)' ) '  Argument would cause overflow.'
      struve_l1 = xmax
    else
      struve_l1 = exp ( test ) - twobpi * ch2
    end if

  end if

  return
end
subroutine struve_l1_values ( n_data, x, fx )

!*******************************************************************************
!
!! STRUVE_L1_VALUES returns some values of the Struve L1 function.
!
!  Discussion:
!
!    In Mathematica, the function can be evaluated by:
!
!      StruveL[1,x]
!
!    The data was reported by McLeod.
!
!  Modified:
!
!    06 September 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!    Stephen Wolfram,
!    The Mathematica Book,
!    Fourth Edition,
!    Wolfram Media / Cambridge University Press, 1999.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.80950410749865126939d-06, kind = 8 ), &
    real ( 0.20724649092571514607d-03, kind = 8 ), &
    real ( 0.33191834066894516744d-02, kind = 8 ), &
    real ( 0.53942182623522663292d-01, kind = 8 ), &
    real ( 0.22676438105580863683d+00, kind = 8 ), &
    real ( 0.11027597873677158176d+01, kind = 8 ), &
    real ( 0.91692778117386847344d+01, kind = 8 ), &
    real ( 0.15541656652426660966d+03, kind = 8 ), &
    real ( 0.26703582852084829694d+04, kind = 8 ), &
    real ( 0.86505880175304633906d+06, kind = 8 ), &
    real ( 0.11026046613094942620d+07, kind = 8 ), &
    real ( 0.22846209494153934787d+07, kind = 8 ), &
    real ( 0.42454972750111979449d+08, kind = 8 ), &
    real ( 0.48869614587997695539d+09, kind = 8 ), &
    real ( 0.56578651292431051863d+10, kind = 8 ), &
    real ( 0.76853203893832108948d+12, kind = 8 ), &
    real ( 0.14707396163259352103d+17, kind = 8 ), &
    real ( 0.29030785901035567967d+21, kind = 8 ), &
    real ( 0.58447515883904682813d+25, kind = 8 ), &
    real ( 0.11929750788892311875d+30, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (  -0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (  -0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (  -4.0000000000D+00, kind = 8 ), &
    real (   7.0000000000D+00, kind = 8 ), &
    real ( -10.0000000000D+00, kind = 8 ), &
    real (  16.0000000000D+00, kind = 8 ), &
    real (  16.2500000000D+00, kind = 8 ), &
    real ( -17.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  22.5000000000D+00, kind = 8 ), &
    real ( -25.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real ( -40.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ), &
    real (  60.0000000000D+00, kind = 8 ), &
    real ( -70.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function synch1 ( xvalue )

!*******************************************************************************
!
!! SYNCH1 calculates the synchrotron radiation function.
!
!  Discussion:
!
!    The function is defined by:
!
!      SYNCH1(x) = x * Integral ( x <= t < infinity ) K(5/3)(t) dt
!
!    where K(5/3) is a modified Bessel function of order 5/3.
!
!    The code uses Chebyshev expansions, the coefficients of which
!    are given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 September 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) SYNCH1, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: eight = real ( 8.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: half = real ( 0.5D+00, kind = 8 )
  integer, parameter :: nterm1 = 12
  integer, parameter :: nterm2 = 10
  integer, parameter :: nterm3 = 21
  real ( kind = 8 ), parameter :: one = real ( 1.0D+00, kind = 8 )
  real ( kind = 8 ) synch1
  real ( kind = 8 ), parameter :: three = real ( 3.0D+00, kind = 8 )
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = real ( 0.0D+00, kind = 8 )

  real ( kind = 8 ) async1(0:13),async2(0:11),asynca(0:24), &
       cheb1,cheb2,conlow, &
       lnrtp2,pibrt3,t,twelve,xhigh1, &
       xhigh2,xlow,xpowth
  data twelve/ 12.0d0 /
  data conlow/2.14952824153447863671d0/
  data pibrt3/1.81379936423421785059d0/
  data lnrtp2/0.22579135264472743236d0/
  data async1/30.36468298250107627340d0, &
              17.07939527740839457449d0, &
               4.56013213354507288887d0, &
               0.54928124673041997963d0, &
               0.3729760750693011724d-1, &
               0.161362430201041242d-2, &
               0.4819167721203707d-4, &
               0.105124252889384d-5, &
               0.1746385046697d-7, &
               0.22815486544d-9, &
               0.240443082d-11, &
               0.2086588d-13, &
               0.15167d-15, &
               0.94d-18/
  data async2/0.44907216235326608443d0, &
              0.8983536779941872179d-1, &
              0.810445737721512894d-2, &
              0.42617169910891619d-3, &
              0.1476096312707460d-4, &
              0.36286336153998d-6, &
              0.666348074984d-8, &
              0.9490771655d-10, &
              0.107912491d-11, &
              0.1002201d-13, &
              0.7745d-16, &
              0.51d-18/
  data asynca(0)/ 2.13293051613550009848d0/
  data asynca(1)/ 0.7413528649542002401d-1/
  data asynca(2)/ 0.869680999099641978d-2/
  data asynca(3)/ 0.117038262487756921d-2/
  data asynca(4)/ 0.16451057986191915d-3/
  data asynca(5)/ 0.2402010214206403d-4/
  data asynca(6)/ 0.358277563893885d-5/
  data asynca(7)/ 0.54477476269837d-6/
  data asynca(8)/ 0.8388028561957d-7/
  data asynca(9)/ 0.1306988268416d-7/
  data asynca(10)/0.205309907144d-8/
  data asynca(11)/0.32518753688d-9/
  data asynca(12)/0.5179140412d-10/
  data asynca(13)/0.830029881d-11/
  data asynca(14)/0.133527277d-11/
  data asynca(15)/0.21591498d-12/
  data asynca(16)/0.3499673d-13/
  data asynca(17)/0.569942d-14/
  data asynca(18)/0.92906d-15/
  data asynca(19)/0.15222d-15/
  data asynca(20)/0.2491d-16/
  data asynca(21)/0.411d-17/
  data asynca(22)/0.67d-18/
  data asynca(23)/0.11d-18/
  data asynca(24)/0.2d-19/
!
!   Machine-dependent constants (suitable for IEEE machines)
!
  data xlow/2.98023224d-8/
  data xhigh1,xhigh2/809.595907d0,-708.396418d0/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'SYNCH1 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    synch1 = zero
  else if ( x < xlow ) then
    xpowth = x ** ( one / three )
    synch1 = conlow * xpowth
  else if ( x <= four ) then
    xpowth = x ** ( one / three )
    t = ( x * x / eight - half ) - half
    cheb1 = cheval ( nterm1, async1, t )
    cheb2 = cheval ( nterm2, async2, t )
    t = xpowth * cheb1 - xpowth**11 * cheb2
    synch1 = t - pibrt3 * x
  else if ( x <= xhigh1 ) then
    t = ( twelve - x ) / ( x + four )
    cheb1 = cheval ( nterm3, asynca, t )
    t = lnrtp2 - x + log ( sqrt ( x ) * cheb1 )
    if ( t < xhigh2 ) then
      synch1 = zero
    else
      synch1 = exp ( t )
    end if
  else
    synch1 = zero
  end if

  return
end
subroutine synch1_values ( n_data, x, fx )

!*******************************************************************************
!
!! SYNCH1_VALUES returns some values of the synchrotron radiation function.
!
!  Discussion:
!
!    The function is defined by:
!
!      SYNCH1(x) = x * Integral ( x <= t < infinity ) K(5/3)(t) dt
!
!    where K(5/3) is a modified Bessel function of order 5/3.
!
!  Modified:
!
!    05 September 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!    Stephen Wolfram,
!    The Mathematica Book,
!    Fourth Edition,
!    Wolfram Media / Cambridge University Press, 1999.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real (   0.26514864547487397044D+00, kind = 8 ), &
    real (   0.62050129979079045645D+00, kind = 8 ), &
    real (   0.85112572132368011206D+00, kind = 8 ), &
    real (   0.87081914687546885094D+00, kind = 8 ), &
    real (   0.65142281535536396975D+00, kind = 8 ), &
    real (   0.45064040920322354579D+00, kind = 8 ), &
    real (   0.30163590285073940285D+00, kind = 8 ), &
    real (   0.19814490804441305867D+00, kind = 8 ), &
    real (   0.12856571000906381300D+00, kind = 8 ), &
    real (   0.52827396697866818297D-01, kind = 8 ), &
    real (   0.42139298471720305542D-01, kind = 8 ), &
    real (   0.21248129774981984268D-01, kind = 8 ), &
    real (   0.13400258907505536491D-01, kind = 8 ), &
    real (   0.84260797314108699935D-02, kind = 8 ), &
    real (   0.12884516186754671469D-02, kind = 8 ), &
    real (   0.19223826430086897418D-03, kind = 8 ), &
    real (   0.28221070834007689394D-04, kind = 8 ), &
    real (   0.15548757973038189372D-05, kind = 8 ), &
    real (   0.11968634456097453636D-07, kind = 8 ), &
    real (   0.89564246772237127742D-10, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   2.5000000000D+00, kind = 8 ), &
    real (   3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.2500000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   5.5000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  12.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  25.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function synch2 ( xvalue )

!*******************************************************************************
!
!! SYNCH2 calculates the synchrotron radiation function.
!
!  Discussion:
!
!    The function is defined by:
!
!      SYNCH2(x) = x * K(2/3)(x)
!
!    where K(2/3) is a modified Bessel function of order 2/3.
!
!    The code uses Chebyshev expansions, the coefficients of which
!    are given to 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) SYNCH2, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: eight = real ( 8.0, kind = 8 )
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer, parameter :: nterm1 = 13
  integer, parameter :: nterm2 = 12
  integer, parameter :: nterm3 = 16
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ) synch2
  real ( kind = 8 ), parameter :: three = real ( 3.0, kind = 8 )
  real ( kind = 8 ), parameter :: two = 2.0D+00
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) asyn21(0:14),asyn22(0:13),asyn2a(0:18), &
       cheb1,cheb2,conlow, &
       lnrtp2,t,ten,xhigh1, &
       xhigh2,xlow,xpowth
  data ten/ 10.0d0 /
  data conlow/1.07476412076723931836d0/
  data lnrtp2/0.22579135264472743236d0/
  data asyn21/38.61783992384308548014d0, &
              23.03771559496373459697d0, &
               5.38024998683357059676d0, &
               0.61567938069957107760d0, &
               0.4066880046688955843d-1, &
               0.172962745526484141d-2, &
               0.5106125883657699d-4, &
               0.110459595022012d-5, &
               0.1823553020649d-7, &
               0.23707698034d-9, &
               0.248872963d-11, &
               0.2152868d-13, &
               0.15607d-15, &
               0.96d-18, &
               0.1d-19/
  data asyn22/7.90631482706608042875d0, &
              3.13534636128534256841d0, &
              0.48548794774537145380d0, &
              0.3948166758272372337d-1, &
              0.196616223348088022d-2, &
              0.6590789322930420d-4, &
              0.158575613498559d-5, &
              0.2868653011233d-7, &
              0.40412023595d-9, &
              0.455684443d-11, &
              0.4204590d-13, &
              0.32326d-15, &
              0.210d-17, &
              0.1d-19/
  data asyn2a/2.02033709417071360032d0, &
              0.1095623712180740443d-1, &
              0.85423847301146755d-3, &
              0.7234302421328222d-4, &
              0.631244279626992d-5, &
              0.56481931411744d-6, &
              0.5128324801375d-7, &
              0.471965329145d-8, &
              0.43807442143d-9, &
              0.4102681493d-10, &
              0.386230721d-11, &
              0.36613228d-12, &
              0.3480232d-13, &
              0.333010d-14, &
              0.31856d-15, &
              0.3074d-16, &
              0.295d-17, &
              0.29d-18, &
              0.3d-19/
!
!   Machine-dependent constants (suitable for IEEE machines)
!
  data xlow/2.98023224d-8/
  data xhigh1,xhigh2/809.595907d0,-708.396418d0/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'SYNCH2 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    synch2 = zero
  else if ( x < xlow ) then
    xpowth = x ** ( one / three )
    synch2 = conlow * xpowth
  else if ( x <= four ) then
    xpowth = x ** ( one / three )
    t = ( x * x / eight - half ) - half
    cheb1 = cheval ( nterm1, asyn21, t )
    cheb2 = cheval ( nterm2, asyn22, t )
    synch2 = xpowth * cheb1 - xpowth**5 * cheb2
  else if ( x <= xhigh1 ) then
    t = ( ten - x ) / ( x + two )
    cheb1 = cheval ( nterm3, asyn2a, t )
    t = lnrtp2 - x + log ( sqrt ( x ) * cheb1 )
    if ( t < xhigh2 ) then
      synch2 = zero
    else
      synch2 = exp ( t )
    end if
  else
    synch2 = zero
  end if

  return
end
subroutine synch2_values ( n_data, x, fx )

!*******************************************************************************
!
!! SYNCH2_VALUES returns some values of the synchrotron radiation function.
!
!  Discussion:
!
!    The function is defined by:
!
!      SYNCH2(x) = x * K(2/3)(x)
!
!    where K(2/3) is a modified Bessel function of order 2/3.
!
!  Modified:
!
!    05 September 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!    Stephen Wolfram,
!    The Mathematica Book,
!    Fourth Edition,
!    Wolfram Media / Cambridge University Press, 1999.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.13430727275667378338D+00, kind = 8 ), &
    real ( 0.33485265272424176976D+00, kind = 8 ), &
    real ( 0.50404224110911078651D+00, kind = 8 ), &
    real ( 0.60296523236016785113D+00, kind = 8 ), &
    real ( 0.49447506210420826699D+00, kind = 8 ), &
    real ( 0.36036067860473360389D+00, kind = 8 ), &
    real ( 0.24967785497625662113D+00, kind = 8 ), &
    real ( 0.16813830542905833533D+00, kind = 8 ), &
    real ( 0.11117122348556549832D+00, kind = 8 ), &
    real ( 0.46923205826101330711D-01, kind = 8 ), &
    real ( 0.37624545861980001482D-01, kind = 8 ), &
    real ( 0.19222123172484106436D-01, kind = 8 ), &
    real ( 0.12209535343654701398D-01, kind = 8 ), &
    real ( 0.77249644268525771866D-02, kind = 8 ), &
    real ( 0.12029044213679269639D-02, kind = 8 ), &
    real ( 0.18161187569530204281D-03, kind = 8 ), &
    real ( 0.26884338006629353506D-04, kind = 8 ), &
    real ( 0.14942212731345828759D-05, kind = 8 ), &
    real ( 0.11607696854385161390D-07, kind = 8 ), &
    real ( 0.87362343746221526073D-10, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   2.5000000000D+00, kind = 8 ), &
    real (   3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.2500000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   5.5000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  12.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  25.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
subroutine timestamp ( )

!*******************************************************************************
!
!! TIMESTAMP prints the current YMDHMS date as a time stamp.
!
!  Example:
!
!    May 31 2001   9:45:54.872 AM
!
!  Modified:
!
!    15 March 2003
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    None
!
  implicit none
!
  character ( len = 40 ) string
!
  call timestring ( string )

  write ( *, '(a)' ) trim ( string )

  return
end
subroutine timestring ( string )

!*******************************************************************************
!
!! TIMESTRING writes the current YMDHMS date into a string.
!
!  Example:
!
!    STRING = 'May 31 2001   9:45:54.872 AM'
!
!  Modified:
!
!    15 March 2003
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Output, character ( len = * ) STRING, contains the date information.
!    A character length of 40 should always be sufficient.
!
  implicit none
!
  character ( len = 8 ) ampm
  integer d
  character ( len = 8 ) date
  integer h
  integer m
  integer mm
  character ( len = 9 ), parameter, dimension(12) :: month = (/ &
    'January  ', 'February ', 'March    ', 'April    ', &
    'May      ', 'June     ', 'July     ', 'August   ', &
    'September', 'October  ', 'November ', 'December ' /)
  integer n
  integer s
  character ( len = * ) string
  character ( len = 10 ) time
  integer values(8)
  integer y
  character ( len = 5 ) zone
!
  call date_and_time ( date, time, zone, values )

  y = values(1)
  m = values(2)
  d = values(3)
  h = values(5)
  n = values(6)
  s = values(7)
  mm = values(8)

  if ( h < 12 ) then
    ampm = 'AM'
  else if ( h == 12 ) then
    if ( n == 0 .and. s == 0 ) then
      ampm = 'Noon'
    else
      ampm = 'PM'
    end if
  else
    h = h - 12
    if ( h < 12 ) then
      ampm = 'PM'
    else if ( h == 12 ) then
      if ( n == 0 .and. s == 0 ) then
        ampm = 'Midnight'
      else
        ampm = 'AM'
      end if
    end if
  end if

  write ( string, '(a,1x,i2,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) &
    trim ( month(m) ), d, y, h, ':', n, ':', s, '.', mm, trim ( ampm )

  return
end
function tran02 ( xvalue )

!*******************************************************************************
!
!! TRAN02 calculates the transport integral of order 2.
!
!  Discussion:
!
!    The function is defined by:
!
!      TRAN02(x) = Integral ( 0 <= t <= x ) t^2 exp(t) / ( exp(t) - 1 )^2 dt
!
!    The program uses a Chebyshev series, the coefficients of which are
!    given to an accuracy of 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) TRAN02, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: eight = real ( 8.0, kind = 8 )
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer k1
  integer k2
  integer, parameter :: nterms = 17
  integer numexp
  integer, parameter :: numjn = 2
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ) tran02
  real ( kind = 8 ), parameter :: valinf &
    = real ( 0.32898681336964528729D+01, kind = 8 )
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) atran(0:19),rk, &
       rnumjn,sumexp,sum2,t,xhigh1,xhigh2, &
       xhigh3,xk,xk1,xlow1
  data rnumjn/ 2.0d0 /

  data atran/1.67176044643453850301d0, &
            -0.14773535994679448986d0, &
             0.1482138199469363384d-1, &
            -0.141953303263056126d-2, &
             0.13065413244157083d-3, &
            -0.1171557958675790d-4, &
             0.103334984457557d-5, &
            -0.9019113042227d-7, &
             0.781771698331d-8, &
            -0.67445656840d-9, &
             0.5799463945d-10, &
            -0.497476185d-11, &
             0.42596097d-12, &
            -0.3642189d-13, &
             0.311086d-14, &
            -0.26547d-15, &
             0.2264d-16, &
            -0.193d-17, &
             0.16d-18, &
            -0.1d-19/
!
!  Machine-dependent constants
!
  data xlow1/2.98023224d-8/
  data xhigh1,xhigh3/36.04365668d0,-36.73680056d0/
  data xhigh2/9.00719925d15/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'TRAN02 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    tran02 = zero
  else if ( x < xlow1 ) then
    tran02 =  ( x ** ( numjn - 1 ) ) / ( rnumjn - one )
  else if ( x <= four ) then
    t = ( ( ( x * x ) / eight ) - half ) - half
    tran02 = ( x ** ( numjn - 1 ) ) * cheval ( nterms, atran, t )
  else

     if ( xhigh2 < x ) then
        sumexp = one
     else
        if ( x <= xhigh1 ) then
           numexp = int ( xhigh1 / x ) + 1
           t = exp ( -x )
        else
           numexp = 1
           t = one
        end if
        rk = zero
        do k1 = 1, numexp
           rk = rk + one
        end do
        sumexp = zero
        do k1 = 1, numexp
           sum2 = one
           xk = one / ( rk * x )
           xk1 = one
           do k2 = 1, numjn
              sum2 = sum2 * xk1 * xk + one
              xk1 = xk1 + one
           end do
           sumexp = sumexp * t + sum2
           rk = rk - one
        end do
     end if

     t = rnumjn * log ( x ) - x + log ( sumexp )
     if ( t < xhigh3 ) then
        tran02 = valinf
     else
        tran02 = valinf - exp ( t )
     end if

  end if

  return
end
subroutine tran02_values ( n_data, x, fx )

!*******************************************************************************
!
!! TRAN02_VALUES returns some values of the order 2 transportation function.
!
!  Discussion:
!
!    The function is defined by:
!
!      TRAN02(x) = Integral ( 0 <= t <= x ) t^2 exp(t) / ( exp(t) - 1 )^2 dt
!
!  Modified:
!
!    06 September 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!    Stephen Wolfram,
!    The Mathematica Book,
!    Fourth Edition,
!    Wolfram Media / Cambridge University Press, 1999.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.19531247930394515480D-02, kind = 8 ), &
    real ( 0.31249152314331109004D-01, kind = 8 ), &
    real ( 0.12494577194783451032D+00, kind = 8 ), &
    real ( 0.49655363615640595865D+00, kind = 8 ), &
    real ( 0.97303256135517012845D+00, kind = 8 ), &
    real ( 0.14121978695932525805D+01, kind = 8 ), &
    real ( 0.18017185674405776809D+01, kind = 8 ), &
    real ( 0.21350385339277043015D+01, kind = 8 ), &
    real ( 0.24110500490169534620D+01, kind = 8 ), &
    real ( 0.28066664045631179931D+01, kind = 8 ), &
    real ( 0.28777421863296234131D+01, kind = 8 ), &
    real ( 0.30391706043438554330D+01, kind = 8 ), &
    real ( 0.31125074928667355940D+01, kind = 8 ), &
    real ( 0.31656687817738577185D+01, kind = 8 ), &
    real ( 0.32623520367816009184D+01, kind = 8 ), &
    real ( 0.32843291144979517358D+01, kind = 8 ), &
    real ( 0.32897895167775788137D+01, kind = 8 ), &
    real ( 0.32898672226665499687D+01, kind = 8 ), &
    real ( 0.32898681336064325400D+01, kind = 8 ), &
    real ( 0.32898681336964528724D+01, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   2.5000000000D+00, kind = 8 ), &
    real (   3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.2500000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   5.5000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function tran03 ( xvalue )

!*******************************************************************************
!
!! TRAN03 calculates the transport integral of order 3.
!
!  Discussion:
!
!    The function is defined by:
!
!      TRAN03(x) = Integral ( 0 <= t <= x ) t^3 * exp(t) / ( exp(t) - 1 )^2 dt
!
!    The program uses a Chebyshev series, the coefficients of which are
!    given to an accuracy of 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) TRAN03, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) atran(0:19)
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: eight = real ( 8.0, kind = 8 )
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer k1
  integer k2
  integer, parameter :: nterms = 17
  integer numexp
  integer numjn
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ) tran03
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) rk, &
       rnumjn,sumexp,sum2,t,valinf,xhigh1,xhigh2, &
       xhigh3,xk,xk1,xlow1,xlow2
  data numjn,rnumjn/ 3 , 3.0d0 /
  data valinf/0.72123414189575657124d1/
  data atran/0.76201254324387200657d0, &
            -0.10567438770505853250d0, &
             0.1197780848196578097d-1, &
            -0.121440152036983073d-2, &
             0.11550997693928547d-3, &
            -0.1058159921244229d-4, &
             0.94746633853018d-6, &
            -0.8362212128581d-7, &
             0.731090992775d-8, &
            -0.63505947788d-9, &
             0.5491182819d-10, &
            -0.473213954d-11, &
             0.40676948d-12, &
            -0.3489706d-13, &
             0.298923d-14, &
            -0.25574d-15, &
             0.2186d-16, &
            -0.187d-17, &
             0.16d-18, &
            -0.1d-19/
!
!  Machine-dependent constants
!
  data xlow1,xlow2/2.98023224d-8,2.10953733d-154/
  data xhigh1,xhigh3/36.04365668d0,-36.73680056d0/
  data xhigh2/1.35107988d16/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'TRAN03 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    tran03 = zero
  else if ( x < xlow2 ) then
    tran03 = zero
  else if ( x < xlow1 ) then
    tran03 = ( x**( numjn - 1 ) ) / ( rnumjn - one )
  else if ( x <= four ) then
    t = ( ( ( x*x ) / eight ) - half ) - half
    tran03 = ( x**( numjn - 1 ) ) * cheval ( nterms, atran, t )
  else

     if ( xhigh2 < x ) then
        sumexp = one
     else
        if ( x <= xhigh1 ) then
           numexp = int ( xhigh1 / x ) + 1
           t = exp ( -x )
        else
           numexp = 1
           t = one
        end if
        rk = zero
        do k1 = 1, numexp
           rk = rk + one
        end do
        sumexp = zero
        do k1 = 1, numexp
           sum2 = one
           xk = one / ( rk * x )
           xk1 = one
           do k2 = 1, numjn
              sum2 = sum2 * xk1 * xk + one
              xk1 = xk1 + one
           end do
           sumexp = sumexp * t + sum2
           rk = rk - one
        end do
     end if

     t = rnumjn * log ( x ) - x + log ( sumexp )

     if ( t < xhigh3 ) then
        tran03 = valinf
     else
        tran03 = valinf - exp ( t )
     end if

  end if

  return
end
subroutine tran03_values ( n_data, x, fx )

!*******************************************************************************
!
!! TRAN03_VALUES returns some values of the order 3 transportation function.
!
!  Discussion:
!
!    The function is defined by:
!
!      TRAN03(x) = Integral ( 0 <= t <= x ) t^3 * exp(t) / ( exp(t) - 1 )^2 dt
!
!  Modified:
!
!    06 September 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!    Stephen Wolfram,
!    The Mathematica Book,
!    Fourth Edition,
!    Wolfram Media / Cambridge University Press, 1999.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.19073483296476379584D-05, kind = 8 ), &
    real ( 0.48826138243180786081D-03, kind = 8 ), &
    real ( 0.78074163848431205820D-02, kind = 8 ), &
    real ( 0.12370868718812031049D+00, kind = 8 ), &
    real ( 0.47984100657241749994D+00, kind = 8 ), &
    real ( 0.10269431622039754738D+01, kind = 8 ), &
    real ( 0.17063547219458658863D+01, kind = 8 ), &
    real ( 0.24539217444475937661D+01, kind = 8 ), &
    real ( 0.32106046629422467723D+01, kind = 8 ), &
    real ( 0.45792174372291563703D+01, kind = 8 ), &
    real ( 0.48722022832940370805D+01, kind = 8 ), &
    real ( 0.56143866138422732286D+01, kind = 8 ), &
    real ( 0.59984455864575470009D+01, kind = 8 ), &
    real ( 0.63033953673480961120D+01, kind = 8 ), &
    real ( 0.69579908688361166266D+01, kind = 8 ), &
    real ( 0.71503227120085929750D+01, kind = 8 ), &
    real ( 0.72110731475871876393D+01, kind = 8 ), &
    real ( 0.72123221966388461839D+01, kind = 8 ), &
    real ( 0.72123414161609465119D+01, kind = 8 ), &
    real ( 0.72123414189575656868D+01, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   2.5000000000D+00, kind = 8 ), &
    real (   3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.2500000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   5.5000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function tran04 ( xvalue )

!*******************************************************************************
!
!! TRAN04 calculates the transport integral of order 4.
!
!  Discussion:
!
!    The function is defined by:
!
!      TRAN04(x) = Integral ( 0 <= t <= x ) t^4 * exp(t) / ( exp(t) - 1 )^2 dt
!
!    The program uses a Chebyshev series, the coefficients of which are
!    given to an accuracy of 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) TRAN04, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: eight = real ( 8.0, kind = 8 )
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer k1
  integer k2
  integer, parameter :: nterms = 17
  integer numexp
  integer numjn
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ) tran04
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) atran(0:19),rk, &
       rnumjn,sumexp,sum2,t,valinf,xhigh1,xhigh2, &
       xhigh3,xk,xk1,xlow1,xlow2
  data numjn,rnumjn/ 4 , 4.0d0 /
  data valinf/0.25975757609067316596d2/
  data atran/0.48075709946151105786d0, &
            -0.8175378810321083956d-1, &
             0.1002700665975162973d-1, &
            -0.105993393598201507d-2, &
             0.10345062450304053d-3, &
            -0.964427054858991d-5, &
             0.87455444085147d-6, &
            -0.7793212079811d-7, &
             0.686498861410d-8, &
            -0.59995710764d-9, &
             0.5213662413d-10, &
            -0.451183819d-11, &
             0.38921592d-12, &
            -0.3349360d-13, &
             0.287667d-14, &
            -0.24668d-15, &
             0.2113d-16, &
            -0.181d-17, &
             0.15d-18, &
            -0.1d-19/
!
!  Machine-dependent constants
!
  data xlow1,xlow2/2.98023224d-8,4.05653502d-103/
  data xhigh1,xhigh3/36.04365668d0,-36.73680056d0/
  data xhigh2/1.80143985d16/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'TRAN04 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    tran04 = zero
    return
  end if
!
!   Code for x < =  4.0
!
  if ( x <= four ) then
     if ( x < xlow2 ) then
        tran04 = zero
     else
        if ( x < xlow1 ) then
           tran04 =  ( x ** ( numjn-1 ) ) / ( rnumjn - one )
        else
           t = ( ( ( x * x ) / eight ) - half ) - half
           tran04 = ( x ** ( numjn-1 ) ) * cheval ( nterms, atran, t )
        end if
     end if
  else
!
!  Code for x > 4.0
!
     if ( xhigh2 < x ) then
        sumexp = one
     else
        if ( x <= xhigh1 ) then
           numexp = int ( xhigh1 / x ) + 1
           t = exp ( -x )
        else
           numexp = 1
           t = one
        end if
        rk = zero
        do k1 = 1, numexp
           rk = rk + one
        end do
        sumexp = zero
        do k1 = 1, numexp
           sum2 = one
           xk = one / ( rk * x )
           xk1 = one
           do k2 = 1, numjn
              sum2 = sum2 * xk1 * xk + one
              xk1 = xk1 + one
           end do
           sumexp = sumexp * t + sum2
           rk = rk - one
        end do
     end if

     t = rnumjn * log ( x ) - x + log ( sumexp )

     if ( t < xhigh3 ) then
        tran04 = valinf
     else
        tran04 = valinf - exp ( t )
     end if

  end if

  return
end
subroutine tran04_values ( n_data, x, fx )

!*******************************************************************************
!
!! TRAN04_VALUES returns some values of the order 4 transportation function.
!
!  Discussion:
!
!    The function is defined by:
!
!      TRAN04(x) = Integral ( 0 <= t <= x ) t^4 * exp(t) / ( exp(t) - 1 )^2 dt
!
!  Modified:
!
!    06 September 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!    Stephen Wolfram,
!    The Mathematica Book,
!    Fourth Edition,
!    Wolfram Media / Cambridge University Press, 1999.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.24835263919461834041D-08, kind = 8 ), &
    real ( 0.10172029353616724881D-04, kind = 8 ), &
    real ( 0.65053332405940765479D-03, kind = 8 ), &
    real ( 0.41150448004155727767D-01, kind = 8 ), &
    real ( 0.31724404523442648241D+00, kind = 8 ), &
    real ( 0.10079442901142373591D+01, kind = 8 ), &
    real ( 0.22010881024333408363D+01, kind = 8 ), &
    real ( 0.38846508619156545210D+01, kind = 8 ), &
    real ( 0.59648223973714765245D+01, kind = 8 ), &
    real ( 0.10731932392998622219D+02, kind = 8 ), &
    real ( 0.11940028876819364777D+02, kind = 8 ), &
    real ( 0.15359784316882182982D+02, kind = 8 ), &
    real ( 0.17372587633093742893D+02, kind = 8 ), &
    real ( 0.19122976016053166969D+02, kind = 8 ), &
    real ( 0.23583979156921941515D+02, kind = 8 ), &
    real ( 0.25273667677030441733D+02, kind = 8 ), &
    real ( 0.25955198214572256372D+02, kind = 8 ), &
    real ( 0.25975350935212241910D+02, kind = 8 ), &
    real ( 0.25975757522084093747D+02, kind = 8 ), &
    real ( 0.25975757609067315288D+02, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   2.5000000000D+00, kind = 8 ), &
    real (   3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.2500000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   5.5000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function tran05 ( xvalue )

!*******************************************************************************
!
!! TRAN05 calculates the transport integral of order 5.
!
!  Discussion:
!
!    The function is defined by:
!
!      TRAN05(x) = Integral ( 0 <= t <= x ) t^5 * exp(t) / ( exp(t) - 1 )^2 dt
!
!    The program uses a Chebyshev series, the coefficients of which are
!    given to an accuracy of 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) TRAN05, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: eight = real ( 8.0, kind = 8 )
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer k1
  integer k2
  integer, parameter :: nterms = 17
  integer numexp
  integer numjn
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ) tran05
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) atran(0:19),rk, &
       rnumjn,sumexp,sum2,t,valinf,xhigh1,xhigh2, &
       xhigh3,xk,xk1,xlow1,xlow2
  data numjn,rnumjn/ 5 , 5.0d0 /
  data valinf/0.12443133061720439116d3/
  data atran/0.34777777713391078928d0, &
            -0.6645698897605042801d-1, &
             0.861107265688330882d-2, &
            -0.93966822237555384d-3, &
             0.9363248060815134d-4, &
            -0.885713193408328d-5, &
             0.81191498914503d-6, &
            -0.7295765423277d-7, &
             0.646971455045d-8, &
            -0.56849028255d-9, &
             0.4962559787d-10, &
            -0.431093996d-11, &
             0.37310094d-12, &
            -0.3219769d-13, &
             0.277220d-14, &
            -0.23824d-15, &
             0.2044d-16, &
            -0.175d-17, &
             0.15d-18, &
            -0.1d-19/
!
!  Machine-dependent constants
!
  data xlow1,xlow2/2.98023224d-8,1.72723372d-77/
  data xhigh1,xhigh3/36.04365668d0,-36.73680056d0/
  data xhigh2/2.25179981d16/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'TRAN05 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    tran05 = zero
    return
  end if
!
!   Code for x < =  4.0
!
  if ( x <= four ) then
     if ( x < xlow2 ) then
        tran05 = zero
     else
        if ( x < xlow1 ) then
           tran05 =  ( x ** ( numjn - 1 ) ) / ( rnumjn - one )
        else
           t = ( ( ( x * x ) / eight ) - half ) - half
           tran05 = ( x ** ( numjn-1 ) ) * cheval ( nterms, atran, t )
        end if
     end if
  else
!
!  Code for x > 4.0
!
     if ( xhigh2 < x ) then
        sumexp = one
     else
        if ( x <= xhigh1 ) then
           numexp = int ( xhigh1 / x )  + 1
           t = exp ( -x )
        else
           numexp = 1
           t = one
        end if
        rk = zero
        do k1 = 1, numexp
           rk = rk + one
        end do
        sumexp = zero
        do k1 = 1, numexp
           sum2 = one
           xk = one / ( rk * x )
           xk1 = one
           do k2 = 1, numjn
              sum2 = sum2 * xk1 * xk + one
              xk1 = xk1 + one
           end do
           sumexp = sumexp * t + sum2
           rk = rk - one
        end do
     end if
     t = rnumjn * log ( x ) - x + log ( sumexp )
     if ( t < xhigh3 ) then
        tran05 = valinf
     else
        tran05 = valinf - exp ( t )
     end if
  end if

  return
end
subroutine tran05_values ( n_data, x, fx )

!*******************************************************************************
!
!! TRAN05_VALUES returns some values of the order 5 transportation function.
!
!  Discussion:
!
!    The function is defined by:
!
!      TRAN05(x) = Integral ( 0 <= t <= x ) t^5 * exp(t) / ( exp(t) - 1 )^2 dt
!
!  Modified:
!
!    06 September 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!    Stephen Wolfram,
!    The Mathematica Book,
!    Fourth Edition,
!    Wolfram Media / Cambridge University Press, 1999.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.36379780361036116971D-11, kind = 8 ), &
    real ( 0.23840564453948442379D-06, kind = 8 ), &
    real ( 0.60982205372226969189D-04, kind = 8 ), &
    real ( 0.15410004586376649337D-01, kind = 8 ), &
    real ( 0.23661587923909478926D+00, kind = 8 ), &
    real ( 0.11198756851307629651D+01, kind = 8 ), &
    real ( 0.32292901663684049171D+01, kind = 8 ), &
    real ( 0.70362973105160654056D+01, kind = 8 ), &
    real ( 0.12770557691044159511D+02, kind = 8 ), &
    real ( 0.29488339015245845447D+02, kind = 8 ), &
    real ( 0.34471340540362254586D+02, kind = 8 ), &
    real ( 0.50263092218175187785D+02, kind = 8 ), &
    real ( 0.60819909101127165207D+02, kind = 8 ), &
    real ( 0.70873334429213460498D+02, kind = 8 ), &
    real ( 0.10147781242977788097D+03, kind = 8 ), &
    real ( 0.11638074540242071077D+03, kind = 8 ), &
    real ( 0.12409623901262967878D+03, kind = 8 ), &
    real ( 0.12442270155632550228D+03, kind = 8 ), &
    real ( 0.12443132790838589548D+03, kind = 8 ), &
    real ( 0.12443133061720432435D+03, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   2.5000000000D+00, kind = 8 ), &
    real (   3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.2500000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   5.5000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function tran06 ( xvalue )

!*******************************************************************************
!
!! TRAN06 calculates the transport integral of order 6.
!
!  Discussion:
!
!    The function is defined by:
!
!      TRAN06(x) = Integral ( 0 <= t <= x ) t^6 * exp(t) / ( exp(t) - 1 )^2 dt
!
!    The program uses a Chebyshev series, the coefficients of which are
!    given to an accuracy of 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) TRAN06, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: eight = real ( 8.0, kind = 8 )
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer k1
  integer k2
  integer, parameter :: nterms = 17
  integer numexp
  integer numjn
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ) tran06
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) atran(0:19),rk, &
       rnumjn,sumexp,sum2,t,valinf,xhigh1,xhigh2, &
       xhigh3,xk,xk1,xlow1,xlow2
  data numjn,rnumjn/ 6 , 6.0d0 /
  data valinf/0.73248700462880338059d3/
  data atran/0.27127335397840008227d0, &
            -0.5588610553191453393d-1, &
             0.753919513290083056d-2, &
            -0.84351138579211219d-3, &
             0.8549098079676702d-4, &
            -0.818715493293098d-5, &
             0.75754240427986d-6, &
            -0.6857306541831d-7, &
             0.611700376031d-8, &
            -0.54012707024d-9, &
             0.4734306435d-10, &
            -0.412701055d-11, &
             0.35825603d-12, &
            -0.3099752d-13, &
             0.267501d-14, &
            -0.23036d-15, &
             0.1980d-16, &
            -0.170d-17, &
             0.15d-18, &
            -0.1d-19/
!
!  Machine-dependent constants
!
  data xlow1,xlow2/2.98023224d-8,4.06689432d-62/
  data xhigh1,xhigh3/36.04365668d0,-36.73680056d0/
  data xhigh2/2.70215977d16/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'TRAN06 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    tran06 = zero
    return
  end if
!
!   Code for x < =  4 .0
!
  if ( x <= four ) then
     if ( x < xlow2 ) then
        tran06 = zero
     else
        if ( x < xlow1 ) then
           tran06 =  ( x ** ( numjn-1 ) ) / ( rnumjn - one )
        else
           t =  ( ( ( x * x ) / eight ) - half ) - half
           tran06 = ( x ** ( numjn-1 )  ) * cheval ( nterms, atran, t )
        end if
     end if
  else
!
!  Code for x > 4 .0
!
     if ( xhigh2 < x ) then
        sumexp = one
     else
        if ( x <= xhigh1 ) then
           numexp = int ( xhigh1 / x ) + 1
           t = exp ( - x )
        else
           numexp = 1
           t = one
        end if
        rk = zero
        do k1 = 1, numexp
           rk = rk + one
        end do
        sumexp = zero
        do k1 = 1, numexp
           sum2 = one
           xk = one / ( rk * x )
           xk1 = one
           do k2 = 1, numjn
              sum2 = sum2 * xk1 * xk + one
              xk1 = xk1 + one
           end do
           sumexp = sumexp * t + sum2
           rk = rk - one
        end do
     end if
     t = rnumjn * log ( x ) - x + log ( sumexp )
     if ( t < xhigh3 ) then
        tran06 = valinf
     else
        tran06 = valinf - exp ( t )
     end if
  end if

  return
end
subroutine tran06_values ( n_data, x, fx )

!*******************************************************************************
!
!! TRAN06_VALUES returns some values of the order 6 transportation function.
!
!  Discussion:
!
!    The function is defined by:
!
!      TRAN06(x) = Integral ( 0 <= t <= x ) t^6 * exp(t) / ( exp(t) - 1 )^2 dt
!
!  Modified:
!
!    06 September 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!    Stephen Wolfram,
!    The Mathematica Book,
!    Fourth Edition,
!    Wolfram Media / Cambridge University Press, 1999.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.56843405953641209574D-14, kind = 8 ), &
    real ( 0.59601180165247401484D-08, kind = 8 ), &
    real ( 0.60978424397580572815D-05, kind = 8 ), &
    real ( 0.61578909866319494394D-02, kind = 8 ), &
    real ( 0.18854360275680840514D+00, kind = 8 ), &
    real ( 0.13319251347921659134D+01, kind = 8 ), &
    real ( 0.50857202271697616755D+01, kind = 8 ), &
    real ( 0.13729222365466557122D+02, kind = 8 ), &
    real ( 0.29579592481641441292D+02, kind = 8 ), &
    real ( 0.88600835706899853768D+02, kind = 8 ), &
    real ( 0.10916037113373004909D+03, kind = 8 ), &
    real ( 0.18224323749575359518D+03, kind = 8 ), &
    real ( 0.23765383125586756031D+03, kind = 8 ), &
    real ( 0.29543246745959381136D+03, kind = 8 ), &
    real ( 0.50681244381280455592D+03, kind = 8 ), &
    real ( 0.63878231134946125623D+03, kind = 8 ), &
    real ( 0.72699203556994876111D+03, kind = 8 ), &
    real ( 0.73230331643146851717D+03, kind = 8 ), &
    real ( 0.73248692015882096369D+03, kind = 8 ), &
    real ( 0.73248700462879996604D+03, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   2.5000000000D+00, kind = 8 ), &
    real (   3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.2500000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   5.5000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function tran07 ( xvalue )

!*******************************************************************************
!
!! TRAN07 calculates the transport integral of order 7.
!
!  Discussion:
!
!    The function is defined by:
!
!      TRAN07(x) = Integral ( 0 <= t <= x ) t^7 * exp(t) / ( exp(t) - 1 )^2 dt
!
!    The program uses a Chebyshev series, the coefficients of which are
!    given to an accuracy of 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) TRAN07, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: eight = real ( 8.0, kind = 8 )
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer k1
  integer k2
  integer, parameter :: nterms = 17
  integer numexp
  integer numjn
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ) tran07
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) atran(0:19),rk, &
       rnumjn,sumexp,sum2,t,valinf,xhigh1,xhigh2, &
       xhigh3,xk,xk1,xlow1,xlow2
  data numjn,rnumjn/ 7 , 7.0d0/
  data valinf/0.50820803580048910473d4/
  data atran/0.22189250734010404423d0, &
            -0.4816751061177993694d-1, &
             0.670092448103153629d-2, &
            -0.76495183443082557d-3, &
             0.7863485592348690d-4, &
            -0.761025180887504d-5, &
             0.70991696299917d-6, &
            -0.6468025624903d-7, &
             0.580039233960d-8, &
            -0.51443370149d-9, &
             0.4525944183d-10, &
            -0.395800363d-11, &
             0.34453785d-12, &
            -0.2988292d-13, &
             0.258434d-14, &
            -0.22297d-15, &
             0.1920d-16, &
            -0.165d-17, &
             0.14d-18, &
            -0.1d-19/
!
!  Machine-dependent constants
!
  data xlow1,xlow2/2.98023224d-8,7.14906557d-52/
  data xhigh1,xhigh3/36.04365668d0,-36.73680056d0/
  data xhigh2/3.15251973d16/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'TRAN07 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    tran07 = zero
    return
  end if
!
!   Code for x <= 4.0
!
  if ( x <= four ) then
     if ( x < xlow2 ) then
        tran07 = zero
     else
        if ( x < xlow1 ) then
           tran07 = ( x**(numjn-1) ) / ( rnumjn - one )
        else
           t = ( ( ( x * x ) / eight ) - half ) - half
           tran07 = ( x**(numjn-1) ) * cheval ( nterms, atran, t )
        end if
     end if
  else
!
!  Code for x > 4.0
!
     if ( xhigh2 < x ) then
        sumexp = one
     else
        if ( x <= xhigh1 ) then
           numexp = int ( xhigh1 / x ) + 1
           t = exp ( -x )
        else
           numexp = 1
           t = one
        end if
        rk = zero
        do k1 = 1, numexp
           rk = rk + one
        end do
        sumexp = zero
        do k1 = 1, numexp
           sum2 = one
           xk = one / ( rk * x )
           xk1 = one
           do k2 = 1, numjn
              sum2 = sum2 * xk1 * xk + one
              xk1 = xk1 + one
           end do
           sumexp = sumexp * t + sum2
           rk = rk - one
        end do
     end if

     t = rnumjn * log ( x ) - x + log ( sumexp )

     if ( t < xhigh3 ) then
        tran07 = valinf
     else
        tran07 = valinf - exp ( t )
     end if

  end if

  return
end
subroutine tran07_values ( n_data, x, fx )

!*******************************************************************************
!
!! TRAN07_VALUES returns some values of the order 7 transportation function.
!
!  Discussion:
!
!    The function is defined by:
!
!      TRAN07(x) = Integral ( 0 <= t <= x ) t^7 * exp(t) / ( exp(t) - 1 )^2 dt
!
!  Modified:
!
!    06 September 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!    Stephen Wolfram,
!    The Mathematica Book,
!    Fourth Edition,
!    Wolfram Media / Cambridge University Press, 1999.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.92518563327283409427D-17, kind = 8 ), &
    real ( 0.15521095556949867541D-09, kind = 8 ), &
    real ( 0.63516238373841716290D-06, kind = 8 ), &
    real ( 0.25638801246626135714D-02, kind = 8 ), &
    real ( 0.15665328993811649746D+00, kind = 8 ), &
    real ( 0.16538225039181097423D+01, kind = 8 ), &
    real ( 0.83763085709508211054D+01, kind = 8 ), &
    real ( 0.28078570717830763747D+02, kind = 8 ), &
    real ( 0.72009676046751991365D+02, kind = 8 ), &
    real ( 0.28174905701691911450D+03, kind = 8 ), &
    real ( 0.36660227975327792529D+03, kind = 8 ), &
    real ( 0.70556067982603601123D+03, kind = 8 ), &
    real ( 0.99661927562755629434D+03, kind = 8 ), &
    real ( 0.13288914430417403901D+04, kind = 8 ), &
    real ( 0.27987640273169129925D+04, kind = 8 ), &
    real ( 0.39721376409416504325D+04, kind = 8 ), &
    real ( 0.49913492839319899726D+04, kind = 8 ), &
    real ( 0.50781562639825019000D+04, kind = 8 ), &
    real ( 0.50820777202028708434D+04, kind = 8 ), &
    real ( 0.50820803580047164618D+04, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   2.5000000000D+00, kind = 8 ), &
    real (   3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.2500000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   5.5000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function tran08 ( xvalue )

!*******************************************************************************
!
!! TRAN08 calculates the transport integral of order 8.
!
!  Discussion:
!
!    The function is defined by:
!
!      TRAN08(x) = Integral ( 0 <= t <= x ) t^8 * exp(t) / ( exp(t) - 1 )^2 dt
!
!    The program uses a Chebyshev series, the coefficients of which are
!    given to an accuracy of 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) TRAN08, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: eight = real ( 8.0, kind = 8 )
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer k1
  integer k2
  integer, parameter :: nterms = 17
  integer numexp
  integer numjn
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ) tran08
  real ( kind = 8 ) x
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  real ( kind = 8 ) atran(0:19),rk, &
       rnumjn,sumexp,sum2,t,valinf,xhigh1,xhigh2, &
       xhigh3,xk,xk1,xlow1,xlow2
  data numjn,rnumjn/ 8, 8.0d0 /
  data valinf/0.40484399001901115764d5/
  data atran/0.18750695774043719233d0, &
            -0.4229527646093673337d-1, &
             0.602814856929065592d-2, &
            -0.69961054811814776d-3, &
             0.7278482421298789d-4, &
            -0.710846250050067d-5, &
             0.66786706890115d-6, &
            -0.6120157501844d-7, &
             0.551465264474d-8, &
            -0.49105307052d-9, &
             0.4335000869d-10, &
            -0.380218700d-11, &
             0.33182369d-12, &
            -0.2884512d-13, &
             0.249958d-14, &
            -0.21605d-15, &
             0.1863d-16, &
            -0.160d-17, &
             0.14d-18, &
            -0.1d-19/
!
!  Machine-dependent constants
!
  data xlow1,xlow2/2.98023224d-8,1.48029723d-44/
  data xhigh1,xhigh3/36.04365668d0,-36.73680056d0/
  data xhigh2/3.6028797d16/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'TRAN08 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    tran08 = zero
    return
  end if
!
!   Code for x < =  4.0
!
  if ( x <= four ) then
     if ( x < xlow2 ) then
        tran08 = zero
     else
        if ( x < xlow1 ) then
           tran08 = ( x ** ( numjn - 1 ) ) / ( rnumjn - one )
        else
           t = ( ( ( x * x ) / eight ) - half ) - half
           tran08 = ( x ** ( numjn - 1 ) ) * cheval ( nterms, atran, t )
        end if
     end if
  else
!
!  Code for x > 4.0
!
     if ( xhigh2 < x ) then
        sumexp = one
     else
        if ( x <= xhigh1 ) then
           numexp = int ( xhigh1 / x ) + 1
           t = exp ( - x )
        else
           numexp = 1
           t = one
        end if
        rk = zero
        do k1 = 1, numexp
           rk = rk + one
        end do
        sumexp = zero
        do k1 = 1, numexp
           sum2 = one
           xk = one / ( rk * x )
           xk1 = one
           do k2 = 1, numjn
              sum2 = sum2 * xk1 * xk + one
              xk1 = xk1 + one
           end do
           sumexp = sumexp * t + sum2
           rk = rk - one
        end do
     end if
     t = rnumjn * log ( x ) - x + log ( sumexp )
     if ( t < xhigh3 ) then
        tran08 = valinf
     else
        tran08 = valinf - exp ( t )
     end if
  end if

  return
end
subroutine tran08_values ( n_data, x, fx )

!*******************************************************************************
!
!! TRAN08_VALUES returns some values of the order 8 transportation function.
!
!  Discussion:
!
!    The function is defined by:
!
!      TRAN08(x) = Integral ( 0 <= t <= x ) t^8 * exp(t) / ( exp(t) - 1 )^2 dt
!
!  Modified:
!
!    06 September 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!    Stephen Wolfram,
!    The Mathematica Book,
!    Fourth Edition,
!    Wolfram Media / Cambridge University Press, 1999.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.15488598634539359463D-19, kind = 8 ), &
    real ( 0.41574269117845953797D-11, kind = 8 ), &
    real ( 0.68050651245227411689D-07, kind = 8 ), &
    real ( 0.10981703519563009836D-02, kind = 8 ), &
    real ( 0.13396432776187883834D+00, kind = 8 ), &
    real ( 0.21153387806998617182D+01, kind = 8 ), &
    real ( 0.14227877028750735641D+02, kind = 8 ), &
    real ( 0.59312061431647843226D+02, kind = 8 ), &
    real ( 0.18139614577043147745D+03, kind = 8 ), &
    real ( 0.93148001928992220863D+03, kind = 8 ), &
    real ( 0.12817928112604611804D+04, kind = 8 ), &
    real ( 0.28572838386329242218D+04, kind = 8 ), &
    real ( 0.43872971687877730010D+04, kind = 8 ), &
    real ( 0.62993229139406657611D+04, kind = 8 ), &
    real ( 0.16589426277154888511D+05, kind = 8 ), &
    real ( 0.27064780798797398935D+05, kind = 8 ), &
    real ( 0.38974556062543661284D+05, kind = 8 ), &
    real ( 0.40400240716905025786D+05, kind = 8 ), &
    real ( 0.40484316504120655568D+05, kind = 8 ), &
    real ( 0.40484399001892184901D+05, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   2.5000000000D+00, kind = 8 ), &
    real (   3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.2500000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   5.5000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end
function tran09 ( xvalue )

!*******************************************************************************
!
!! TRAN09 calculates the transport integral of order 9.
!
!  Discussion:
!
!    The function is defined by:
!
!      TRAN09(x) = Integral ( 0 <= t <= x ) t^9 * exp(t) / ( exp(t) - 1 )^2 dt
!
!    The program uses a Chebyshev series, the coefficients of which are
!    given to an accuracy of 20 decimal places.
!
!    This subroutine is set up to work on IEEE machines.
!
!  Modified:
!
!    07 August 2004
!
!  Author:
!
!    Allan McLeod,
!    Department of Mathematics and Statistics,
!    Paisley University, High Street, Paisley, Scotland, PA12BE
!    macl_ms0@paisley.ac.uk
!
!  Reference:
!
!    Allan Mcleod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!  Parameters:
!
!    Input, real ( kind = 8 ) XVALUE, the argument of the function.
!
!    Output, real ( kind = 8 ) TRAN09, the value of the function.
!
  implicit none
!
  real ( kind = 8 ) atran(0:19)
  real ( kind = 8 ) cheval
  real ( kind = 8 ), parameter :: eight = real ( 8.0, kind = 8 )
  real ( kind = 8 ), parameter :: four = real ( 4.0D+00, kind = 8 )
  real ( kind = 8 ), parameter :: half = 0.5D+00
  integer k1
  integer k2
  integer, parameter :: nterms = 17
  integer numexp
  integer, parameter :: numjn = 9
  real ( kind = 8 ), parameter :: one = real ( 1.0, kind = 8 )
  real ( kind = 8 ) rk
  real ( kind = 8 ), parameter :: rnumjn = 9.0d0
  real ( kind = 8 ) sumexp
  real ( kind = 8 ) sum2
  real ( kind = 8 ) t
  real ( kind = 8 ) tran09
  real ( kind = 8 ), parameter :: valinf = 0.36360880558872871397d6
  real ( kind = 8 ) x
  real ( kind = 8 ) xhigh1
  real ( kind = 8 ) xhigh2
  real ( kind = 8 ) xhigh3
  real ( kind = 8 ) xk
  real ( kind = 8 ) xk1
  real ( kind = 8 ) xlow1
  real ( kind = 8 ) xlow2
  real ( kind = 8 ) xvalue
  real ( kind = 8 ), parameter :: zero = 0.0D+00

  data atran/0.16224049991949846835d0, &
            -0.3768351452195937773d-1, &
             0.547669715917719770d-2, &
            -0.64443945009449521d-3, &
             0.6773645285280983d-4, &
            -0.666813497582042d-5, &
             0.63047560019047d-6, &
            -0.5807478663611d-7, &
             0.525551305123d-8, &
            -0.46968861761d-9, &
             0.4159395065d-10, &
            -0.365808491d-11, &
             0.32000794d-12, &
            -0.2787651d-13, &
             0.242017d-14, &
            -0.20953d-15, &
             0.1810d-16, &
            -0.156d-17, &
             0.13d-18, &
            -0.1d-19/
!
!  Machine-dependent constants (for IEEE machines)
!
  data xlow1,xlow2/2.98023224d-8,4.5321503d-39/
  data xhigh1,xhigh3/36.04365668d0,-36.73680056d0/
  data xhigh2/4.05323966d16/
!
  x = xvalue

  if ( x < zero ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'TRAN09 - Fatal error!'
    write ( *, '(a)' ) '  Argument X < 0.'
    tran09 = zero
    return
  end if
!
!   Code for x < =  4.0
!
  if ( x <= four ) then
     if ( x < xlow2 ) then
        tran09 = zero
     else
        if ( x < xlow1 ) then
           tran09 = ( x ** ( numjn - 1 ) ) / ( rnumjn - one )
        else
           t = ( ( ( x * x ) / eight ) - half ) - half
           tran09 = ( x ** ( numjn - 1 ) ) * cheval ( nterms, atran, t )
        end if
     end if
  else
!
!  Code for x > 4.0
!
     if ( xhigh2 < x ) then
        sumexp = one
     else
        if ( x <= xhigh1 ) then
           numexp = int ( xhigh1 / x ) + 1
           t = exp ( -x )
        else
           numexp = 1
           t = one
        end if
        rk = zero
        do k1 = 1, numexp
           rk = rk + one
        end do
        sumexp = zero
        do k1 = 1, numexp
           sum2 = one
           xk = one / ( rk * x )
           xk1 = one
           do k2 = 1, numjn
              sum2 = sum2 * xk1 * xk + one
              xk1 = xk1 + one
           end do
           sumexp = sumexp * t + sum2
           rk = rk - one
        end do
     end if

     t = rnumjn * log ( x ) - x + log ( sumexp )

     if ( t < xhigh3 ) then
        tran09 = valinf
     else
        tran09 = valinf - exp ( t )
     end if

  end if

  return
end
subroutine tran09_values ( n_data, x, fx )

!*******************************************************************************
!
!! TRAN09_VALUES returns some values of the order 9 transportation function.
!
!  Discussion:
!
!    The function is defined by:
!
!      TRAN09(x) = Integral ( 0 <= t <= x ) t^9 * exp(t) / ( exp(t) - 1 )^2 dt
!
!  Modified:
!
!    06 September 2004
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    Milton Abramowitz and Irene Stegun,
!    Handbook of Mathematical Functions,
!    US Department of Commerce, 1964.
!
!    Allan McLeod,
!    Algorithm 757, MISCFUN: A software package to compute uncommon
!      special functions,
!    ACM Transactions on Mathematical Software,
!    Volume 22, Number 3, September 1996, pages 288-301.
!
!    Stephen Wolfram,
!    The Mathematica Book,
!    Fourth Edition,
!    Wolfram Media / Cambridge University Press, 1999.
!
!  Parameters:
!
!    Input/output, integer N_DATA.  The user sets N_DATA to 0 before the
!    first call.  On each call, the routine increments N_DATA by 1, and
!    returns the corresponding data; when there is no more data, the
!    output value of N_DATA will be 0 again.
!
!    Output, real ( kind = 8 ) X, the argument of the function.
!
!    Output, real ( kind = 8 ) FX, the value of the function.
!
  implicit none
!
  integer, parameter :: n_max = 20
!
  real ( kind = 8 ) fx
  real ( kind = 8 ), save, dimension ( n_max ) :: fx_vec = (/ &
    real ( 0.26469772870084897671D-22, kind = 8 ), &
    real ( 0.11367943653594246210D-12, kind = 8 ), &
    real ( 0.74428246255329800255D-08, kind = 8 ), &
    real ( 0.48022728485415366194D-03, kind = 8 ), &
    real ( 0.11700243014358676725D+00, kind = 8 ), &
    real ( 0.27648973910899914391D+01, kind = 8 ), &
    real ( 0.24716631405829192997D+02, kind = 8 ), &
    real ( 0.12827119828849828583D+03, kind = 8 ), &
    real ( 0.46842894800662208986D+03, kind = 8 ), &
    real ( 0.31673967371627895718D+04, kind = 8 ), &
    real ( 0.46140886546630195390D+04, kind = 8 ), &
    real ( 0.11952718545392302185D+05, kind = 8 ), &
    real ( 0.20001612666477027728D+05, kind = 8 ), &
    real ( 0.31011073271851366554D+05, kind = 8 ), &
    real ( 0.10352949905541130133D+06, kind = 8 ), &
    real ( 0.19743173017140591390D+06, kind = 8 ), &
    real ( 0.33826030414658460679D+06, kind = 8 ), &
    real ( 0.36179607036750755227D+06, kind = 8 ), &
    real ( 0.36360622124777561525D+06, kind = 8 ), &
    real ( 0.36360880558827162725D+06, kind = 8 ) /)
  integer n_data
  real ( kind = 8 ) x
  real ( kind = 8 ), save, dimension ( n_max ) :: x_vec = (/ &
    real (   0.0019531250D+00, kind = 8 ), &
    real (   0.0312500000D+00, kind = 8 ), &
    real (   0.1250000000D+00, kind = 8 ), &
    real (   0.5000000000D+00, kind = 8 ), &
    real (   1.0000000000D+00, kind = 8 ), &
    real (   1.5000000000D+00, kind = 8 ), &
    real (   2.0000000000D+00, kind = 8 ), &
    real (   2.5000000000D+00, kind = 8 ), &
    real (   3.0000000000D+00, kind = 8 ), &
    real (   4.0000000000D+00, kind = 8 ), &
    real (   4.2500000000D+00, kind = 8 ), &
    real (   5.0000000000D+00, kind = 8 ), &
    real (   5.5000000000D+00, kind = 8 ), &
    real (   6.0000000000D+00, kind = 8 ), &
    real (   8.0000000000D+00, kind = 8 ), &
    real (  10.0000000000D+00, kind = 8 ), &
    real (  15.0000000000D+00, kind = 8 ), &
    real (  20.0000000000D+00, kind = 8 ), &
    real (  30.0000000000D+00, kind = 8 ), &
    real (  50.0000000000D+00, kind = 8 ) /)
!
  if ( n_data < 0 ) then
    n_data = 0
  end if

  n_data = n_data + 1

  if ( n_max < n_data ) then
    n_data = 0
    x = 0.0D+00
    fx = 0.0D+00
  else
    x  = x_vec(n_data)
    fx = fx_vec(n_data)
  end if

  return
end