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