program main !*****************************************************************************80 ! !! patterson_rule() writes a Gauss-Patterson quadrature rule to a file. ! ! Usage: ! ! patterson_rule order a b filename ! ! where ! ! * ORDER is the number of points in the rule, and must be ! 1, 3, 7, 15, 31, 63, 127, 255 or 511; ! * A is the left endpoint; ! * B is the right endpoint; ! * FILENAME is the "root name" of the output files. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 21 February 2010 ! ! Author: ! ! John Burkardt ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) real ( kind = rk ) a integer arg_num real ( kind = rk ) b character ( len = 255 ) filename integer iarg integer iargc integer ierror integer last integer order logical order_check real ( kind = rk ) r(2) character ( len = 255 ) string real ( kind = rk ), allocatable, dimension ( : ) :: w real ( kind = rk ), allocatable, dimension ( : ) :: x call timestamp ( ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'PATTERSON_RULE():' write ( *, '(a)' ) ' FORTRAN90 version' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Look up a Gauss-Patterson rule for approximating' write ( *, '(a)' ) ' Integral ( A <= x <= B ) f(x) dx' write ( *, '(a)' ) ' of order ORDER.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' The user specifies ORDER, A, B, and FILENAME.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' ORDER is 1, 3, 7, 15, 31, 63, 127, 255 or 511.' write ( *, '(a)' ) ' A is the left endpoint.' write ( *, '(a)' ) ' B is the right endpoint.' write ( *, '(a)' ) ' FILENAME is used to generate 3 files:' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' filename_w.txt - the weight file' write ( *, '(a)' ) ' filename_x.txt - the abscissa file.' write ( *, '(a)' ) ' filename_r.txt - the region file.' ! ! Get the number of command line arguments. ! arg_num = iargc ( ) ! ! Get ORDER. ! if ( 1 <= arg_num ) then iarg = 1 call getarg ( iarg, string ) call s_to_i4 ( string, order, ierror, last ) else write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Enter the rule order ORDER:' read ( *, * ) order end if if ( .not. order_check ( order ) ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' The value of ORDER was not acceptable.' write ( *, '(a)' ) & ' Acceptable values are 1, 3, 7, 15, 31, 63, 127, 255 and 511.' stop 1 end if ! ! Get A. ! if ( 2 <= arg_num ) then iarg = 2 call getarg ( iarg, string ) call s_to_r8 ( string, a, ierror, last ) else write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Enter the left endpoint A:' read ( *, * ) a end if ! ! Get B. ! if ( 3 <= arg_num ) then iarg = 3 call getarg ( iarg, string ) call s_to_r8 ( string, b, ierror, last ) else write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Enter the right endpoint B:' read ( *, * ) b end if ! ! Get FILENAME. ! if ( 4 <= arg_num ) then iarg = 4 call getarg ( iarg, filename ) else write ( *, '(a)' ) ' ' write ( *, '(a)' ) & ' Enter FILENAME, the "root name" of the quadrature files).' read ( *, '(a)' ) filename end if ! ! Input summary. ! write ( *, '(a)' ) ' ' write ( *, '(a,i8)' ) ' ORDER = ', order write ( *, '(a,g14.6)' ) ' A = ', a write ( *, '(a,g14.6)' ) ' B = ', b write ( *, '(a)' ) ' FILENAME = "' // trim ( filename ) // '".' ! ! Construct the rule. ! r(1) = a r(2) = b allocate ( w(order) ) allocate ( x(order) ) call patterson_set ( order, x, w ) ! ! Rescale the rule. ! call rescale ( a, b, order, x, w ) ! ! Write the rule. ! call rule_write ( order, x, w, r, filename ) ! ! Free memory. ! deallocate ( w ) deallocate ( x ) ! ! Terminate. ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'PATTERSON_RULE:' write ( *, '(a)' ) ' Normal end of execution.' write ( *, '(a)' ) ' ' call timestamp ( ) stop end subroutine ch_cap ( c ) !*****************************************************************************80 ! !! CH_CAP capitalizes a single character. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 15 January 2008 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input/output, character C, the character to capitalize. ! implicit none character c integer itemp itemp = ichar ( c ) if ( 97 <= itemp .and. itemp <= 122 ) then c = char ( itemp - 32 ) end if return end function ch_eqi ( c1, c2 ) !*****************************************************************************80 ! !! CH_EQI is a case insensitive comparison of two characters for equality. ! ! Example: ! ! CH_EQI ( 'A', 'a' ) is .TRUE. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 15 January 2008 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character C1, C2, the characters to compare. ! ! Output, logical CH_EQI, the result of the comparison. ! implicit none logical ch_eqi character c1 character c1_cap character c2 character c2_cap c1_cap = c1 c2_cap = c2 call ch_cap ( c1_cap ) call ch_cap ( c2_cap ) if ( c1_cap == c2_cap ) then ch_eqi = .true. else ch_eqi = .false. end if return end subroutine ch_to_digit ( c, digit ) !*****************************************************************************80 ! !! CH_TO_DIGIT returns the integer value of a base 10 digit. ! ! Example: ! ! C DIGIT ! --- ----- ! '0' 0 ! '1' 1 ! ... ... ! '9' 9 ! ' ' 0 ! 'X' -1 ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 15 January 2008 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character C, the decimal digit, '0' through '9' or blank ! are legal. ! ! Output, integer DIGIT, the corresponding integer value. ! If C was 'illegal', then DIGIT is -1. ! implicit none character c integer digit if ( lge ( c, '0' ) .and. lle ( c, '9' ) ) then digit = ichar ( c ) - 48 else if ( c == ' ' ) then digit = 0 else digit = -1 end if return end subroutine get_unit ( iunit ) !*****************************************************************************80 ! !! GET_UNIT returns a free FORTRAN unit number. ! ! Discussion: ! ! A "free" FORTRAN unit number is an integer between 1 and 99 which ! is not currently associated with an I/O device. A free FORTRAN unit ! number is needed in order to open a file with the OPEN command. ! ! If IUNIT = 0, then no free FORTRAN unit could be found, although ! all 99 units were checked (except for units 5, 6 and 9, which ! are commonly reserved for console I/O). ! ! Otherwise, IUNIT is an integer between 1 and 99, representing a ! free FORTRAN unit. Note that GET_UNIT assumes that units 5 and 6 ! are special, and will never return those values. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 15 January 2008 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Output, integer IUNIT, the free unit number. ! implicit none integer i integer ios integer iunit logical lopen iunit = 0 do i = 1, 99 if ( i /= 5 .and. i /= 6 .and. i /= 9 ) then inquire ( unit = i, opened = lopen, iostat = ios ) if ( ios == 0 ) then if ( .not. lopen ) then iunit = i return end if end if end if end do return end function order_check ( order ) !*****************************************************************************80 ! !! ORDER_CHECK checks the value of ORDER. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 17 December 2009 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, integer ORDER, the requested order. ! ! Output, logical ORDER_CHECK, is TRUE if the requested order is acceptable. ! implicit none integer order logical order_check order_check = ( order == 1 ) .or. & ( order == 3 ) .or. & ( order == 7 ) .or. & ( order == 15 ) .or. & ( order == 31 ) .or. & ( order == 63 ) .or. & ( order == 127 ) .or. & ( order == 255 ) .or. & ( order == 511 ) return end subroutine patterson_set ( n, x, w ) !*****************************************************************************80 ! !! PATTERSON_SET sets abscissas and weights for Gauss-Patterson quadrature. ! ! Discussion: ! ! The integration interval is [ -1, 1 ]. ! ! The weight function is w(x) = 1.0. ! ! The integral to approximate: ! ! Integral ( -1 <= X <= 1 ) F(X) dX ! ! The quadrature rule: ! ! Sum ( 1 <= I <= N ) W(I) * F ( X(I) ) ! ! The zeroth rule, of order 1, is the standard Gauss-Legendre rule. ! ! The first rule, of order 3, is the standard Gauss-Legendre rule. ! ! The second rule, of order 7, includes the abscissas of the previous ! rule. ! ! Each subsequent rule is nested in a similar way. Rules are available ! of orders 1, 3, 7, 15, 31, 63, 127, 255 and 511. ! ! The data for N = 511 was supplied by Dirk Laurie. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 14 September 2011 ! ! Author: ! ! John Burkardt ! ! Reference: ! ! Prem Kythe, Michael Schaeferkotter, ! Handbook of Computational Methods for Integration, ! Chapman and Hall, 2004, ! ISBN: 1-58488-428-2, ! LC: QA299.3.K98. ! ! Thomas Patterson, ! The Optimal Addition of Points to Quadrature Formulae, ! Mathematics of Computation, ! Volume 22, Number 104, October 1968, pages 847-856. ! ! Parameters: ! ! Input, integer N, the order of the rule. ! N must be 1, 3, 7, 15, 31, 63, 127, 255 or 511. ! ! Output, real ( kind = rk ) X(N), the abscissas. ! ! Output, real ( kind = rk ) W(N), the weights. ! The weights are positive, symmetric and should sum to 2. ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer n real ( kind = rk ) x(n) real ( kind = rk ) w(n) if ( n == 1 ) then x(1) = 0.0D+00 w(1) = 2.0D+00 else if ( n == 3 ) then x(1) = -0.77459666924148337704D+00 x(2) = 0.0D+00 x(3) = 0.77459666924148337704D+00 w(1) = 0.555555555555555555556D+00 w(2) = 0.888888888888888888889D+00 w(3) = 0.555555555555555555556D+00 else if ( n == 7 ) then x(1) = -0.96049126870802028342D+00 x(2) = -0.77459666924148337704D+00 x(3) = -0.43424374934680255800D+00 x(4) = 0.0D+00 x(5) = 0.43424374934680255800D+00 x(6) = 0.77459666924148337704D+00 x(7) = 0.96049126870802028342D+00 w(1) = 0.104656226026467265194D+00 w(2) = 0.268488089868333440729D+00 w(3) = 0.401397414775962222905D+00 w(4) = 0.450916538658474142345D+00 w(5) = 0.401397414775962222905D+00 w(6) = 0.268488089868333440729D+00 w(7) = 0.104656226026467265194D+00 else if ( n == 15 ) then x( 1) = -0.99383196321275502221D+00 x( 2) = -0.96049126870802028342D+00 x( 3) = -0.88845923287225699889D+00 x( 4) = -0.77459666924148337704D+00 x( 5) = -0.62110294673722640294D+00 x( 6) = -0.43424374934680255800D+00 x( 7) = -0.22338668642896688163D+00 x( 8) = 0.0D+00 x( 9) = 0.22338668642896688163D+00 x(10) = 0.43424374934680255800D+00 x(11) = 0.62110294673722640294D+00 x(12) = 0.77459666924148337704D+00 x(13) = 0.88845923287225699889D+00 x(14) = 0.96049126870802028342D+00 x(15) = 0.99383196321275502221D+00 w( 1) = 0.0170017196299402603390D+00 w( 2) = 0.0516032829970797396969D+00 w( 3) = 0.0929271953151245376859D+00 w( 4) = 0.134415255243784220360D+00 w( 5) = 0.171511909136391380787D+00 w( 6) = 0.200628529376989021034D+00 w( 7) = 0.219156858401587496404D+00 w( 8) = 0.225510499798206687386D+00 w( 9) = 0.219156858401587496404D+00 w(10) = 0.200628529376989021034D+00 w(11) = 0.171511909136391380787D+00 w(12) = 0.134415255243784220360D+00 w(13) = 0.0929271953151245376859D+00 w(14) = 0.0516032829970797396969D+00 w(15) = 0.0170017196299402603390D+00 else if ( n == 31 ) then x( 1) = -0.99909812496766759766D+00 x( 2) = -0.99383196321275502221D+00 x( 3) = -0.98153114955374010687D+00 x( 4) = -0.96049126870802028342D+00 x( 5) = -0.92965485742974005667D+00 x( 6) = -0.88845923287225699889D+00 x( 7) = -0.83672593816886873550D+00 x( 8) = -0.77459666924148337704D+00 x( 9) = -0.70249620649152707861D+00 x(10) = -0.62110294673722640294D+00 x(11) = -0.53131974364437562397D+00 x(12) = -0.43424374934680255800D+00 x(13) = -0.33113539325797683309D+00 x(14) = -0.22338668642896688163D+00 x(15) = -0.11248894313318662575D+00 x(16) = 0.0D+00 x(17) = 0.11248894313318662575D+00 x(18) = 0.22338668642896688163D+00 x(19) = 0.33113539325797683309D+00 x(20) = 0.43424374934680255800D+00 x(21) = 0.53131974364437562397D+00 x(22) = 0.62110294673722640294D+00 x(23) = 0.70249620649152707861D+00 x(24) = 0.77459666924148337704D+00 x(25) = 0.83672593816886873550D+00 x(26) = 0.88845923287225699889D+00 x(27) = 0.92965485742974005667D+00 x(28) = 0.96049126870802028342D+00 x(29) = 0.98153114955374010687D+00 x(30) = 0.99383196321275502221D+00 x(31) = 0.99909812496766759766D+00 w( 1) = 0.00254478079156187441540D+00 w( 2) = 0.00843456573932110624631D+00 w( 3) = 0.0164460498543878109338D+00 w( 4) = 0.0258075980961766535646D+00 w( 5) = 0.0359571033071293220968D+00 w( 6) = 0.0464628932617579865414D+00 w( 7) = 0.0569795094941233574122D+00 w( 8) = 0.0672077542959907035404D+00 w( 9) = 0.0768796204990035310427D+00 w(10) = 0.0857559200499903511542D+00 w(11) = 0.0936271099812644736167D+00 w(12) = 0.100314278611795578771D+00 w(13) = 0.105669893580234809744D+00 w(14) = 0.109578421055924638237D+00 w(15) = 0.111956873020953456880D+00 w(16) = 0.112755256720768691607D+00 w(17) = 0.111956873020953456880D+00 w(18) = 0.109578421055924638237D+00 w(19) = 0.105669893580234809744D+00 w(20) = 0.100314278611795578771D+00 w(21) = 0.0936271099812644736167D+00 w(22) = 0.0857559200499903511542D+00 w(23) = 0.0768796204990035310427D+00 w(24) = 0.0672077542959907035404D+00 w(25) = 0.0569795094941233574122D+00 w(26) = 0.0464628932617579865414D+00 w(27) = 0.0359571033071293220968D+00 w(28) = 0.0258075980961766535646D+00 w(29) = 0.0164460498543878109338D+00 w(30) = 0.00843456573932110624631D+00 w(31) = 0.00254478079156187441540D+00 else if ( n == 63 ) then x( 1) = -0.99987288812035761194D+00 x( 2) = -0.99909812496766759766D+00 x( 3) = -0.99720625937222195908D+00 x( 4) = -0.99383196321275502221D+00 x( 5) = -0.98868475754742947994D+00 x( 6) = -0.98153114955374010687D+00 x( 7) = -0.97218287474858179658D+00 x( 8) = -0.96049126870802028342D+00 x( 9) = -0.94634285837340290515D+00 x(10) = -0.92965485742974005667D+00 x(11) = -0.91037115695700429250D+00 x(12) = -0.88845923287225699889D+00 x(13) = -0.86390793819369047715D+00 x(14) = -0.83672593816886873550D+00 x(15) = -0.80694053195021761186D+00 x(16) = -0.77459666924148337704D+00 x(17) = -0.73975604435269475868D+00 x(18) = -0.70249620649152707861D+00 x(19) = -0.66290966002478059546D+00 x(20) = -0.62110294673722640294D+00 x(21) = -0.57719571005204581484D+00 x(22) = -0.53131974364437562397D+00 x(23) = -0.48361802694584102756D+00 x(24) = -0.43424374934680255800D+00 x(25) = -0.38335932419873034692D+00 x(26) = -0.33113539325797683309D+00 x(27) = -0.27774982202182431507D+00 x(28) = -0.22338668642896688163D+00 x(29) = -0.16823525155220746498D+00 x(30) = -0.11248894313318662575D+00 x(31) = -0.056344313046592789972D+00 x(32) = 0.0D+00 x(33) = 0.056344313046592789972D+00 x(34) = 0.11248894313318662575D+00 x(35) = 0.16823525155220746498D+00 x(36) = 0.22338668642896688163D+00 x(37) = 0.27774982202182431507D+00 x(38) = 0.33113539325797683309D+00 x(39) = 0.38335932419873034692D+00 x(40) = 0.43424374934680255800D+00 x(41) = 0.48361802694584102756D+00 x(42) = 0.53131974364437562397D+00 x(43) = 0.57719571005204581484D+00 x(44) = 0.62110294673722640294D+00 x(45) = 0.66290966002478059546D+00 x(46) = 0.70249620649152707861D+00 x(47) = 0.73975604435269475868D+00 x(48) = 0.77459666924148337704D+00 x(49) = 0.80694053195021761186D+00 x(50) = 0.83672593816886873550D+00 x(51) = 0.86390793819369047715D+00 x(52) = 0.88845923287225699889D+00 x(53) = 0.91037115695700429250D+00 x(54) = 0.92965485742974005667D+00 x(55) = 0.94634285837340290515D+00 x(56) = 0.96049126870802028342D+00 x(57) = 0.97218287474858179658D+00 x(58) = 0.98153114955374010687D+00 x(59) = 0.98868475754742947994D+00 x(60) = 0.99383196321275502221D+00 x(61) = 0.99720625937222195908D+00 x(62) = 0.99909812496766759766D+00 x(63) = 0.99987288812035761194D+00 w( 1) = 0.000363221481845530659694D+00 w( 2) = 0.00126515655623006801137D+00 w( 3) = 0.00257904979468568827243D+00 w( 4) = 0.00421763044155885483908D+00 w( 5) = 0.00611550682211724633968D+00 w( 6) = 0.00822300795723592966926D+00 w( 7) = 0.0104982469096213218983D+00 w( 8) = 0.0129038001003512656260D+00 w( 9) = 0.0154067504665594978021D+00 w(10) = 0.0179785515681282703329D+00 w(11) = 0.0205942339159127111492D+00 w(12) = 0.0232314466399102694433D+00 w(13) = 0.0258696793272147469108D+00 w(14) = 0.0284897547458335486125D+00 w(15) = 0.0310735511116879648799D+00 w(16) = 0.0336038771482077305417D+00 w(17) = 0.0360644327807825726401D+00 w(18) = 0.0384398102494555320386D+00 w(19) = 0.0407155101169443189339D+00 w(20) = 0.0428779600250077344929D+00 w(21) = 0.0449145316536321974143D+00 w(22) = 0.0468135549906280124026D+00 w(23) = 0.0485643304066731987159D+00 w(24) = 0.0501571393058995374137D+00 w(25) = 0.0515832539520484587768D+00 w(26) = 0.0528349467901165198621D+00 w(27) = 0.0539054993352660639269D+00 w(28) = 0.0547892105279628650322D+00 w(29) = 0.0554814043565593639878D+00 w(30) = 0.0559784365104763194076D+00 w(31) = 0.0562776998312543012726D+00 w(32) = 0.0563776283603847173877D+00 w(33) = 0.0562776998312543012726D+00 w(34) = 0.0559784365104763194076D+00 w(35) = 0.0554814043565593639878D+00 w(36) = 0.0547892105279628650322D+00 w(37) = 0.0539054993352660639269D+00 w(38) = 0.0528349467901165198621D+00 w(39) = 0.0515832539520484587768D+00 w(40) = 0.0501571393058995374137D+00 w(41) = 0.0485643304066731987159D+00 w(42) = 0.0468135549906280124026D+00 w(43) = 0.0449145316536321974143D+00 w(44) = 0.0428779600250077344929D+00 w(45) = 0.0407155101169443189339D+00 w(46) = 0.0384398102494555320386D+00 w(47) = 0.0360644327807825726401D+00 w(48) = 0.0336038771482077305417D+00 w(49) = 0.0310735511116879648799D+00 w(50) = 0.0284897547458335486125D+00 w(51) = 0.0258696793272147469108D+00 w(52) = 0.0232314466399102694433D+00 w(53) = 0.0205942339159127111492D+00 w(54) = 0.0179785515681282703329D+00 w(55) = 0.0154067504665594978021D+00 w(56) = 0.0129038001003512656260D+00 w(57) = 0.0104982469096213218983D+00 w(58) = 0.00822300795723592966926D+00 w(59) = 0.00611550682211724633968D+00 w(60) = 0.00421763044155885483908D+00 w(61) = 0.00257904979468568827243D+00 w(62) = 0.00126515655623006801137D+00 w(63) = 0.000363221481845530659694D+00 else if ( n == 127 ) then x( 1) = -0.99998243035489159858D+00 x( 2) = -0.99987288812035761194D+00 x( 3) = -0.99959879967191068325D+00 x( 4) = -0.99909812496766759766D+00 x( 5) = -0.99831663531840739253D+00 x( 6) = -0.99720625937222195908D+00 x( 7) = -0.99572410469840718851D+00 x( 8) = -0.99383196321275502221D+00 x( 9) = -0.99149572117810613240D+00 x( 10) = -0.98868475754742947994D+00 x( 11) = -0.98537149959852037111D+00 x( 12) = -0.98153114955374010687D+00 x( 13) = -0.97714151463970571416D+00 x( 14) = -0.97218287474858179658D+00 x( 15) = -0.96663785155841656709D+00 x( 16) = -0.96049126870802028342D+00 x( 17) = -0.95373000642576113641D+00 x( 18) = -0.94634285837340290515D+00 x( 19) = -0.93832039777959288365D+00 x( 20) = -0.92965485742974005667D+00 x( 21) = -0.92034002547001242073D+00 x( 22) = -0.91037115695700429250D+00 x( 23) = -0.89974489977694003664D+00 x( 24) = -0.88845923287225699889D+00 x( 25) = -0.87651341448470526974D+00 x( 26) = -0.86390793819369047715D+00 x( 27) = -0.85064449476835027976D+00 x( 28) = -0.83672593816886873550D+00 x( 29) = -0.82215625436498040737D+00 x( 30) = -0.80694053195021761186D+00 x( 31) = -0.79108493379984836143D+00 x( 32) = -0.77459666924148337704D+00 x( 33) = -0.75748396638051363793D+00 x( 34) = -0.73975604435269475868D+00 x( 35) = -0.72142308537009891548D+00 x( 36) = -0.70249620649152707861D+00 x( 37) = -0.68298743109107922809D+00 x( 38) = -0.66290966002478059546D+00 x( 39) = -0.64227664250975951377D+00 x( 40) = -0.62110294673722640294D+00 x( 41) = -0.59940393024224289297D+00 x( 42) = -0.57719571005204581484D+00 x( 43) = -0.55449513263193254887D+00 x( 44) = -0.53131974364437562397D+00 x( 45) = -0.50768775753371660215D+00 x( 46) = -0.48361802694584102756D+00 x( 47) = -0.45913001198983233287D+00 x( 48) = -0.43424374934680255800D+00 x( 49) = -0.40897982122988867241D+00 x( 50) = -0.38335932419873034692D+00 x( 51) = -0.35740383783153215238D+00 x( 52) = -0.33113539325797683309D+00 x( 53) = -0.30457644155671404334D+00 x( 54) = -0.27774982202182431507D+00 x( 55) = -0.25067873030348317661D+00 x( 56) = -0.22338668642896688163D+00 x( 57) = -0.19589750271110015392D+00 x( 58) = -0.16823525155220746498D+00 x( 59) = -0.14042423315256017459D+00 x( 60) = -0.11248894313318662575D+00 x( 61) = -0.084454040083710883710D+00 x( 62) = -0.056344313046592789972D+00 x( 63) = -0.028184648949745694339D+00 x( 64) = 0.0D+00 x( 65) = 0.028184648949745694339D+00 x( 66) = 0.056344313046592789972D+00 x( 67) = 0.084454040083710883710D+00 x( 68) = 0.11248894313318662575D+00 x( 69) = 0.14042423315256017459D+00 x( 70) = 0.16823525155220746498D+00 x( 71) = 0.19589750271110015392D+00 x( 72) = 0.22338668642896688163D+00 x( 73) = 0.25067873030348317661D+00 x( 74) = 0.27774982202182431507D+00 x( 75) = 0.30457644155671404334D+00 x( 76) = 0.33113539325797683309D+00 x( 77) = 0.35740383783153215238D+00 x( 78) = 0.38335932419873034692D+00 x( 79) = 0.40897982122988867241D+00 x( 80) = 0.43424374934680255800D+00 x( 81) = 0.45913001198983233287D+00 x( 82) = 0.48361802694584102756D+00 x( 83) = 0.50768775753371660215D+00 x( 84) = 0.53131974364437562397D+00 x( 85) = 0.55449513263193254887D+00 x( 86) = 0.57719571005204581484D+00 x( 87) = 0.59940393024224289297D+00 x( 88) = 0.62110294673722640294D+00 x( 89) = 0.64227664250975951377D+00 x( 90) = 0.66290966002478059546D+00 x( 91) = 0.68298743109107922809D+00 x( 92) = 0.70249620649152707861D+00 x( 93) = 0.72142308537009891548D+00 x( 94) = 0.73975604435269475868D+00 x( 95) = 0.75748396638051363793D+00 x( 96) = 0.77459666924148337704D+00 x( 97) = 0.79108493379984836143D+00 x( 98) = 0.80694053195021761186D+00 x( 99) = 0.82215625436498040737D+00 x(100) = 0.83672593816886873550D+00 x(101) = 0.85064449476835027976D+00 x(102) = 0.86390793819369047715D+00 x(103) = 0.87651341448470526974D+00 x(104) = 0.88845923287225699889D+00 x(105) = 0.89974489977694003664D+00 x(106) = 0.91037115695700429250D+00 x(107) = 0.92034002547001242073D+00 x(108) = 0.92965485742974005667D+00 x(109) = 0.93832039777959288365D+00 x(110) = 0.94634285837340290515D+00 x(111) = 0.95373000642576113641D+00 x(112) = 0.96049126870802028342D+00 x(113) = 0.96663785155841656709D+00 x(114) = 0.97218287474858179658D+00 x(115) = 0.97714151463970571416D+00 x(116) = 0.98153114955374010687D+00 x(117) = 0.98537149959852037111D+00 x(118) = 0.98868475754742947994D+00 x(119) = 0.99149572117810613240D+00 x(120) = 0.99383196321275502221D+00 x(121) = 0.99572410469840718851D+00 x(122) = 0.99720625937222195908D+00 x(123) = 0.99831663531840739253D+00 x(124) = 0.99909812496766759766D+00 x(125) = 0.99959879967191068325D+00 x(126) = 0.99987288812035761194D+00 x(127) = 0.99998243035489159858D+00 w( 1) = 0.0000505360952078625176247D+00 w( 2) = 0.000180739564445388357820D+00 w( 3) = 0.000377746646326984660274D+00 w( 4) = 0.000632607319362633544219D+00 w( 5) = 0.000938369848542381500794D+00 w( 6) = 0.00128952408261041739210D+00 w( 7) = 0.00168114286542146990631D+00 w( 8) = 0.00210881524572663287933D+00 w( 9) = 0.00256876494379402037313D+00 w( 10) = 0.00305775341017553113613D+00 w( 11) = 0.00357289278351729964938D+00 w( 12) = 0.00411150397865469304717D+00 w( 13) = 0.00467105037211432174741D+00 w( 14) = 0.00524912345480885912513D+00 w( 15) = 0.00584344987583563950756D+00 w( 16) = 0.00645190005017573692280D+00 w( 17) = 0.00707248999543355546805D+00 w( 18) = 0.00770337523327974184817D+00 w( 19) = 0.00834283875396815770558D+00 w( 20) = 0.00898927578406413572328D+00 w( 21) = 0.00964117772970253669530D+00 w( 22) = 0.0102971169579563555237D+00 w( 23) = 0.0109557333878379016480D+00 w( 24) = 0.0116157233199551347270D+00 w( 25) = 0.0122758305600827700870D+00 w( 26) = 0.0129348396636073734547D+00 w( 27) = 0.0135915710097655467896D+00 w( 28) = 0.0142448773729167743063D+00 w( 29) = 0.0148936416648151820348D+00 w( 30) = 0.0155367755558439824399D+00 w( 31) = 0.0161732187295777199419D+00 w( 32) = 0.0168019385741038652709D+00 w( 33) = 0.0174219301594641737472D+00 w( 34) = 0.0180322163903912863201D+00 w( 35) = 0.0186318482561387901863D+00 w( 36) = 0.0192199051247277660193D+00 w( 37) = 0.0197954950480974994880D+00 w( 38) = 0.0203577550584721594669D+00 w( 39) = 0.0209058514458120238522D+00 w( 40) = 0.0214389800125038672465D+00 w( 41) = 0.0219563663053178249393D+00 w( 42) = 0.0224572658268160987071D+00 w( 43) = 0.0229409642293877487608D+00 w( 44) = 0.0234067774953140062013D+00 w( 45) = 0.0238540521060385400804D+00 w( 46) = 0.0242821652033365993580D+00 w( 47) = 0.0246905247444876769091D+00 w( 48) = 0.0250785696529497687068D+00 w( 49) = 0.0254457699654647658126D+00 w( 50) = 0.0257916269760242293884D+00 w( 51) = 0.0261156733767060976805D+00 w( 52) = 0.0264174733950582599310D+00 w( 53) = 0.0266966229274503599062D+00 w( 54) = 0.0269527496676330319634D+00 w( 55) = 0.0271855132296247918192D+00 w( 56) = 0.0273946052639814325161D+00 w( 57) = 0.0275797495664818730349D+00 w( 58) = 0.0277407021782796819939D+00 w( 59) = 0.0278772514766137016085D+00 w( 60) = 0.0279892182552381597038D+00 w( 61) = 0.0280764557938172466068D+00 w( 62) = 0.0281388499156271506363D+00 w( 63) = 0.0281763190330166021307D+00 w( 64) = 0.0281888141801923586938D+00 w( 65) = 0.0281763190330166021307D+00 w( 66) = 0.0281388499156271506363D+00 w( 67) = 0.0280764557938172466068D+00 w( 68) = 0.0279892182552381597038D+00 w( 69) = 0.0278772514766137016085D+00 w( 70) = 0.0277407021782796819939D+00 w( 71) = 0.0275797495664818730349D+00 w( 72) = 0.0273946052639814325161D+00 w( 73) = 0.0271855132296247918192D+00 w( 74) = 0.0269527496676330319634D+00 w( 75) = 0.0266966229274503599062D+00 w( 76) = 0.0264174733950582599310D+00 w( 77) = 0.0261156733767060976805D+00 w( 78) = 0.0257916269760242293884D+00 w( 79) = 0.0254457699654647658126D+00 w( 80) = 0.0250785696529497687068D+00 w( 81) = 0.0246905247444876769091D+00 w( 82) = 0.0242821652033365993580D+00 w( 83) = 0.0238540521060385400804D+00 w( 84) = 0.0234067774953140062013D+00 w( 85) = 0.0229409642293877487608D+00 w( 86) = 0.0224572658268160987071D+00 w( 87) = 0.0219563663053178249393D+00 w( 88) = 0.0214389800125038672465D+00 w( 89) = 0.0209058514458120238522D+00 w( 90) = 0.0203577550584721594669D+00 w( 91) = 0.0197954950480974994880D+00 w( 92) = 0.0192199051247277660193D+00 w( 93) = 0.0186318482561387901863D+00 w( 94) = 0.0180322163903912863201D+00 w( 95) = 0.0174219301594641737472D+00 w( 96) = 0.0168019385741038652709D+00 w( 97) = 0.0161732187295777199419D+00 w( 98) = 0.0155367755558439824399D+00 w( 99) = 0.0148936416648151820348D+00 w(100) = 0.0142448773729167743063D+00 w(101) = 0.0135915710097655467896D+00 w(102) = 0.0129348396636073734547D+00 w(103) = 0.0122758305600827700870D+00 w(104) = 0.0116157233199551347270D+00 w(105) = 0.0109557333878379016480D+00 w(106) = 0.0102971169579563555237D+00 w(107) = 0.00964117772970253669530D+00 w(108) = 0.00898927578406413572328D+00 w(109) = 0.00834283875396815770558D+00 w(110) = 0.00770337523327974184817D+00 w(111) = 0.00707248999543355546805D+00 w(112) = 0.00645190005017573692280D+00 w(113) = 0.00584344987583563950756D+00 w(114) = 0.00524912345480885912513D+00 w(115) = 0.00467105037211432174741D+00 w(116) = 0.00411150397865469304717D+00 w(117) = 0.00357289278351729964938D+00 w(118) = 0.00305775341017553113613D+00 w(119) = 0.00256876494379402037313D+00 w(120) = 0.00210881524572663287933D+00 w(121) = 0.00168114286542146990631D+00 w(122) = 0.00128952408261041739210D+00 w(123) = 0.000938369848542381500794D+00 w(124) = 0.000632607319362633544219D+00 w(125) = 0.000377746646326984660274D+00 w(126) = 0.000180739564445388357820D+00 w(127) = 0.0000505360952078625176247D+00 else if ( n == 255 ) then x( 1) = -0.99999759637974846462D+00 x( 2) = -0.99998243035489159858D+00 x( 3) = -0.99994399620705437576D+00 x( 4) = -0.99987288812035761194D+00 x( 5) = -0.99976049092443204733D+00 x( 6) = -0.99959879967191068325D+00 x( 7) = -0.99938033802502358193D+00 x( 8) = -0.99909812496766759766D+00 x( 9) = -0.99874561446809511470D+00 x( 10) = -0.99831663531840739253D+00 x( 11) = -0.99780535449595727456D+00 x( 12) = -0.99720625937222195908D+00 x( 13) = -0.99651414591489027385D+00 x( 14) = -0.99572410469840718851D+00 x( 15) = -0.99483150280062100052D+00 x( 16) = -0.99383196321275502221D+00 x( 17) = -0.99272134428278861533D+00 x( 18) = -0.99149572117810613240D+00 x( 19) = -0.99015137040077015918D+00 x( 20) = -0.98868475754742947994D+00 x( 21) = -0.98709252795403406719D+00 x( 22) = -0.98537149959852037111D+00 x( 23) = -0.98351865757863272876D+00 x( 24) = -0.98153114955374010687D+00 x( 25) = -0.97940628167086268381D+00 x( 26) = -0.97714151463970571416D+00 x( 27) = -0.97473445975240266776D+00 x( 28) = -0.97218287474858179658D+00 x( 29) = -0.96948465950245923177D+00 x( 30) = -0.96663785155841656709D+00 x( 31) = -0.96364062156981213252D+00 x( 32) = -0.96049126870802028342D+00 x( 33) = -0.95718821610986096274D+00 x( 34) = -0.95373000642576113641D+00 x( 35) = -0.95011529752129487656D+00 x( 36) = -0.94634285837340290515D+00 x( 37) = -0.94241156519108305981D+00 x( 38) = -0.93832039777959288365D+00 x( 39) = -0.93406843615772578800D+00 x( 40) = -0.92965485742974005667D+00 x( 41) = -0.92507893290707565236D+00 x( 42) = -0.92034002547001242073D+00 x( 43) = -0.91543758715576504064D+00 x( 44) = -0.91037115695700429250D+00 x( 45) = -0.90514035881326159519D+00 x( 46) = -0.89974489977694003664D+00 x( 47) = -0.89418456833555902286D+00 x( 48) = -0.88845923287225699889D+00 x( 49) = -0.88256884024734190684D+00 x( 50) = -0.87651341448470526974D+00 x( 51) = -0.87029305554811390585D+00 x( 52) = -0.86390793819369047715D+00 x( 53) = -0.85735831088623215653D+00 x( 54) = -0.85064449476835027976D+00 x( 55) = -0.84376688267270860104D+00 x( 56) = -0.83672593816886873550D+00 x( 57) = -0.82952219463740140018D+00 x( 58) = -0.82215625436498040737D+00 x( 59) = -0.81462878765513741344D+00 x( 60) = -0.80694053195021761186D+00 x( 61) = -0.79909229096084140180D+00 x( 62) = -0.79108493379984836143D+00 x( 63) = -0.78291939411828301639D+00 x( 64) = -0.77459666924148337704D+00 x( 65) = -0.76611781930376009072D+00 x( 66) = -0.75748396638051363793D+00 x( 67) = -0.74869629361693660282D+00 x( 68) = -0.73975604435269475868D+00 x( 69) = -0.73066452124218126133D+00 x( 70) = -0.72142308537009891548D+00 x( 71) = -0.71203315536225203459D+00 x( 72) = -0.70249620649152707861D+00 x( 73) = -0.69281376977911470289D+00 x( 74) = -0.68298743109107922809D+00 x( 75) = -0.67301883023041847920D+00 x( 76) = -0.66290966002478059546D+00 x( 77) = -0.65266166541001749610D+00 x( 78) = -0.64227664250975951377D+00 x( 79) = -0.63175643771119423041D+00 x( 80) = -0.62110294673722640294D+00 x( 81) = -0.61031811371518640016D+00 x( 82) = -0.59940393024224289297D+00 x( 83) = -0.58836243444766254143D+00 x( 84) = -0.57719571005204581484D+00 x( 85) = -0.56590588542365442262D+00 x( 86) = -0.55449513263193254887D+00 x( 87) = -0.54296566649831149049D+00 x( 88) = -0.53131974364437562397D+00 x( 89) = -0.51955966153745702199D+00 x( 90) = -0.50768775753371660215D+00 x( 91) = -0.49570640791876146017D+00 x( 92) = -0.48361802694584102756D+00 x( 93) = -0.47142506587165887693D+00 x( 94) = -0.45913001198983233287D+00 x( 95) = -0.44673538766202847374D+00 x( 96) = -0.43424374934680255800D+00 x( 97) = -0.42165768662616330006D+00 x( 98) = -0.40897982122988867241D+00 x( 99) = -0.39621280605761593918D+00 x(100) = -0.38335932419873034692D+00 x(101) = -0.37042208795007823014D+00 x(102) = -0.35740383783153215238D+00 x(103) = -0.34430734159943802278D+00 x(104) = -0.33113539325797683309D+00 x(105) = -0.31789081206847668318D+00 x(106) = -0.30457644155671404334D+00 x(107) = -0.29119514851824668196D+00 x(108) = -0.27774982202182431507D+00 x(109) = -0.26424337241092676194D+00 x(110) = -0.25067873030348317661D+00 x(111) = -0.23705884558982972721D+00 x(112) = -0.22338668642896688163D+00 x(113) = -0.20966523824318119477D+00 x(114) = -0.19589750271110015392D+00 x(115) = -0.18208649675925219825D+00 x(116) = -0.16823525155220746498D+00 x(117) = -0.15434681148137810869D+00 x(118) = -0.14042423315256017459D+00 x(119) = -0.12647058437230196685D+00 x(120) = -0.11248894313318662575D+00 x(121) = -0.098482396598119202090D+00 x(122) = -0.084454040083710883710D+00 x(123) = -0.070406976042855179063D+00 x(124) = -0.056344313046592789972D+00 x(125) = -0.042269164765363603212D+00 x(126) = -0.028184648949745694339D+00 x(127) = -0.014093886410782462614D+00 x(128) = 0.0D+00 x(129) = 0.014093886410782462614D+00 x(130) = 0.028184648949745694339D+00 x(131) = 0.042269164765363603212D+00 x(132) = 0.056344313046592789972D+00 x(133) = 0.070406976042855179063D+00 x(134) = 0.084454040083710883710D+00 x(135) = 0.098482396598119202090D+00 x(136) = 0.11248894313318662575D+00 x(137) = 0.12647058437230196685D+00 x(138) = 0.14042423315256017459D+00 x(139) = 0.15434681148137810869D+00 x(140) = 0.16823525155220746498D+00 x(141) = 0.18208649675925219825D+00 x(142) = 0.19589750271110015392D+00 x(143) = 0.20966523824318119477D+00 x(144) = 0.22338668642896688163D+00 x(145) = 0.23705884558982972721D+00 x(146) = 0.25067873030348317661D+00 x(147) = 0.26424337241092676194D+00 x(148) = 0.27774982202182431507D+00 x(149) = 0.29119514851824668196D+00 x(150) = 0.30457644155671404334D+00 x(151) = 0.31789081206847668318D+00 x(152) = 0.33113539325797683309D+00 x(153) = 0.34430734159943802278D+00 x(154) = 0.35740383783153215238D+00 x(155) = 0.37042208795007823014D+00 x(156) = 0.38335932419873034692D+00 x(157) = 0.39621280605761593918D+00 x(158) = 0.40897982122988867241D+00 x(159) = 0.42165768662616330006D+00 x(160) = 0.43424374934680255800D+00 x(161) = 0.44673538766202847374D+00 x(162) = 0.45913001198983233287D+00 x(163) = 0.47142506587165887693D+00 x(164) = 0.48361802694584102756D+00 x(165) = 0.49570640791876146017D+00 x(166) = 0.50768775753371660215D+00 x(167) = 0.51955966153745702199D+00 x(168) = 0.53131974364437562397D+00 x(169) = 0.54296566649831149049D+00 x(170) = 0.55449513263193254887D+00 x(171) = 0.56590588542365442262D+00 x(172) = 0.57719571005204581484D+00 x(173) = 0.58836243444766254143D+00 x(174) = 0.59940393024224289297D+00 x(175) = 0.61031811371518640016D+00 x(176) = 0.62110294673722640294D+00 x(177) = 0.63175643771119423041D+00 x(178) = 0.64227664250975951377D+00 x(179) = 0.65266166541001749610D+00 x(180) = 0.66290966002478059546D+00 x(181) = 0.67301883023041847920D+00 x(182) = 0.68298743109107922809D+00 x(183) = 0.69281376977911470289D+00 x(184) = 0.70249620649152707861D+00 x(185) = 0.71203315536225203459D+00 x(186) = 0.72142308537009891548D+00 x(187) = 0.73066452124218126133D+00 x(188) = 0.73975604435269475868D+00 x(189) = 0.74869629361693660282D+00 x(190) = 0.75748396638051363793D+00 x(191) = 0.76611781930376009072D+00 x(192) = 0.77459666924148337704D+00 x(193) = 0.78291939411828301639D+00 x(194) = 0.79108493379984836143D+00 x(195) = 0.79909229096084140180D+00 x(196) = 0.80694053195021761186D+00 x(197) = 0.81462878765513741344D+00 x(198) = 0.82215625436498040737D+00 x(199) = 0.82952219463740140018D+00 x(200) = 0.83672593816886873550D+00 x(201) = 0.84376688267270860104D+00 x(202) = 0.85064449476835027976D+00 x(203) = 0.85735831088623215653D+00 x(204) = 0.86390793819369047715D+00 x(205) = 0.87029305554811390585D+00 x(206) = 0.87651341448470526974D+00 x(207) = 0.88256884024734190684D+00 x(208) = 0.88845923287225699889D+00 x(209) = 0.89418456833555902286D+00 x(210) = 0.89974489977694003664D+00 x(211) = 0.90514035881326159519D+00 x(212) = 0.91037115695700429250D+00 x(213) = 0.91543758715576504064D+00 x(214) = 0.92034002547001242073D+00 x(215) = 0.92507893290707565236D+00 x(216) = 0.92965485742974005667D+00 x(217) = 0.93406843615772578800D+00 x(218) = 0.93832039777959288365D+00 x(219) = 0.94241156519108305981D+00 x(220) = 0.94634285837340290515D+00 x(221) = 0.95011529752129487656D+00 x(222) = 0.95373000642576113641D+00 x(223) = 0.95718821610986096274D+00 x(224) = 0.96049126870802028342D+00 x(225) = 0.96364062156981213252D+00 x(226) = 0.96663785155841656709D+00 x(227) = 0.96948465950245923177D+00 x(228) = 0.97218287474858179658D+00 x(229) = 0.97473445975240266776D+00 x(230) = 0.97714151463970571416D+00 x(231) = 0.97940628167086268381D+00 x(232) = 0.98153114955374010687D+00 x(233) = 0.98351865757863272876D+00 x(234) = 0.98537149959852037111D+00 x(235) = 0.98709252795403406719D+00 x(236) = 0.98868475754742947994D+00 x(237) = 0.99015137040077015918D+00 x(238) = 0.99149572117810613240D+00 x(239) = 0.99272134428278861533D+00 x(240) = 0.99383196321275502221D+00 x(241) = 0.99483150280062100052D+00 x(242) = 0.99572410469840718851D+00 x(243) = 0.99651414591489027385D+00 x(244) = 0.99720625937222195908D+00 x(245) = 0.99780535449595727456D+00 x(246) = 0.99831663531840739253D+00 x(247) = 0.99874561446809511470D+00 x(248) = 0.99909812496766759766D+00 x(249) = 0.99938033802502358193D+00 x(250) = 0.99959879967191068325D+00 x(251) = 0.99976049092443204733D+00 x(252) = 0.99987288812035761194D+00 x(253) = 0.99994399620705437576D+00 x(254) = 0.99998243035489159858D+00 x(255) = 0.99999759637974846462D+00 w( 1) = 0.69379364324108267170D-05 w( 2) = 0.25157870384280661489D-04 w( 3) = 0.53275293669780613125D-04 w( 4) = 0.90372734658751149261D-04 w( 5) = 0.13575491094922871973D-03 w( 6) = 0.18887326450650491366D-03 w( 7) = 0.24921240048299729402D-03 w( 8) = 0.31630366082226447689D-03 w( 9) = 0.38974528447328229322D-03 w( 10) = 0.46918492424785040975D-03 w( 11) = 0.55429531493037471492D-03 w( 12) = 0.64476204130572477933D-03 w( 13) = 0.74028280424450333046D-03 w( 14) = 0.84057143271072246365D-03 w( 15) = 0.94536151685852538246D-03 w( 16) = 0.10544076228633167722D-02 w( 17) = 0.11674841174299594077D-02 w( 18) = 0.12843824718970101768D-02 w( 19) = 0.14049079956551446427D-02 w( 20) = 0.15288767050877655684D-02 w( 21) = 0.16561127281544526052D-02 w( 22) = 0.17864463917586498247D-02 w( 23) = 0.19197129710138724125D-02 w( 24) = 0.20557519893273465236D-02 w( 25) = 0.21944069253638388388D-02 w( 26) = 0.23355251860571608737D-02 w( 27) = 0.24789582266575679307D-02 w( 28) = 0.26245617274044295626D-02 w( 29) = 0.27721957645934509940D-02 w( 30) = 0.29217249379178197538D-02 w( 31) = 0.30730184347025783234D-02 w( 32) = 0.32259500250878684614D-02 w( 33) = 0.33803979910869203823D-02 w( 34) = 0.35362449977167777340D-02 w( 35) = 0.36933779170256508183D-02 w( 36) = 0.38516876166398709241D-02 w( 37) = 0.40110687240750233989D-02 w( 38) = 0.41714193769840788528D-02 w( 39) = 0.43326409680929828545D-02 w( 40) = 0.44946378920320678616D-02 w( 41) = 0.46573172997568547773D-02 w( 42) = 0.48205888648512683476D-02 w( 43) = 0.49843645647655386012D-02 w( 44) = 0.51485584789781777618D-02 w( 45) = 0.53130866051870565663D-02 w( 46) = 0.54778666939189508240D-02 w( 47) = 0.56428181013844441585D-02 w( 48) = 0.58078616599775673635D-02 w( 49) = 0.59729195655081658049D-02 w( 50) = 0.61379152800413850435D-02 w( 51) = 0.63027734490857587172D-02 w( 52) = 0.64674198318036867274D-02 w( 53) = 0.66317812429018878941D-02 w( 54) = 0.67957855048827733948D-02 w( 55) = 0.69593614093904229394D-02 w( 56) = 0.71224386864583871532D-02 w( 57) = 0.72849479805538070639D-02 w( 58) = 0.74468208324075910174D-02 w( 59) = 0.76079896657190565832D-02 w( 60) = 0.77683877779219912200D-02 w( 61) = 0.79279493342948491103D-02 w( 62) = 0.80866093647888599710D-02 w( 63) = 0.82443037630328680306D-02 w( 64) = 0.84009692870519326354D-02 w( 65) = 0.85565435613076896192D-02 w( 66) = 0.87109650797320868736D-02 w( 67) = 0.88641732094824942641D-02 w( 68) = 0.90161081951956431600D-02 w( 69) = 0.91667111635607884067D-02 w( 70) = 0.93159241280693950932D-02 w( 71) = 0.94636899938300652943D-02 w( 72) = 0.96099525623638830097D-02 w( 73) = 0.97546565363174114611D-02 w( 74) = 0.98977475240487497440D-02 w( 75) = 0.10039172044056840798D-01 w( 76) = 0.10178877529236079733D-01 w( 77) = 0.10316812330947621682D-01 w( 78) = 0.10452925722906011926D-01 w( 79) = 0.10587167904885197931D-01 w( 80) = 0.10719490006251933623D-01 w( 81) = 0.10849844089337314099D-01 w( 82) = 0.10978183152658912470D-01 w( 83) = 0.11104461134006926537D-01 w( 84) = 0.11228632913408049354D-01 w( 85) = 0.11350654315980596602D-01 w( 86) = 0.11470482114693874380D-01 w( 87) = 0.11588074033043952568D-01 w( 88) = 0.11703388747657003101D-01 w( 89) = 0.11816385890830235763D-01 w( 90) = 0.11927026053019270040D-01 w( 91) = 0.12035270785279562630D-01 w( 92) = 0.12141082601668299679D-01 w( 93) = 0.12244424981611985899D-01 w( 94) = 0.12345262372243838455D-01 w( 95) = 0.12443560190714035263D-01 w( 96) = 0.12539284826474884353D-01 w( 97) = 0.12632403643542078765D-01 w( 98) = 0.12722884982732382906D-01 w( 99) = 0.12810698163877361967D-01 w(100) = 0.12895813488012114694D-01 w(101) = 0.12978202239537399286D-01 w(102) = 0.13057836688353048840D-01 w(103) = 0.13134690091960152836D-01 w(104) = 0.13208736697529129966D-01 w(105) = 0.13279951743930530650D-01 w(106) = 0.13348311463725179953D-01 w(107) = 0.13413793085110098513D-01 w(108) = 0.13476374833816515982D-01 w(109) = 0.13536035934956213614D-01 w(110) = 0.13592756614812395910D-01 w(111) = 0.13646518102571291428D-01 w(112) = 0.13697302631990716258D-01 w(113) = 0.13745093443001896632D-01 w(114) = 0.13789874783240936517D-01 w(115) = 0.13831631909506428676D-01 w(116) = 0.13870351089139840997D-01 w(117) = 0.13906019601325461264D-01 w(118) = 0.13938625738306850804D-01 w(119) = 0.13968158806516938516D-01 w(120) = 0.13994609127619079852D-01 w(121) = 0.14017968039456608810D-01 w(122) = 0.14038227896908623303D-01 w(123) = 0.14055382072649964277D-01 w(124) = 0.14069424957813575318D-01 w(125) = 0.14080351962553661325D-01 w(126) = 0.14088159516508301065D-01 w(127) = 0.14092845069160408355D-01 w(128) = 0.14094407090096179347D-01 w(129) = 0.14092845069160408355D-01 w(130) = 0.14088159516508301065D-01 w(131) = 0.14080351962553661325D-01 w(132) = 0.14069424957813575318D-01 w(133) = 0.14055382072649964277D-01 w(134) = 0.14038227896908623303D-01 w(135) = 0.14017968039456608810D-01 w(136) = 0.13994609127619079852D-01 w(137) = 0.13968158806516938516D-01 w(138) = 0.13938625738306850804D-01 w(139) = 0.13906019601325461264D-01 w(140) = 0.13870351089139840997D-01 w(141) = 0.13831631909506428676D-01 w(142) = 0.13789874783240936517D-01 w(143) = 0.13745093443001896632D-01 w(144) = 0.13697302631990716258D-01 w(145) = 0.13646518102571291428D-01 w(146) = 0.13592756614812395910D-01 w(147) = 0.13536035934956213614D-01 w(148) = 0.13476374833816515982D-01 w(149) = 0.13413793085110098513D-01 w(150) = 0.13348311463725179953D-01 w(151) = 0.13279951743930530650D-01 w(152) = 0.13208736697529129966D-01 w(153) = 0.13134690091960152836D-01 w(154) = 0.13057836688353048840D-01 w(155) = 0.12978202239537399286D-01 w(156) = 0.12895813488012114694D-01 w(157) = 0.12810698163877361967D-01 w(158) = 0.12722884982732382906D-01 w(159) = 0.12632403643542078765D-01 w(160) = 0.12539284826474884353D-01 w(161) = 0.12443560190714035263D-01 w(162) = 0.12345262372243838455D-01 w(163) = 0.12244424981611985899D-01 w(164) = 0.12141082601668299679D-01 w(165) = 0.12035270785279562630D-01 w(166) = 0.11927026053019270040D-01 w(167) = 0.11816385890830235763D-01 w(168) = 0.11703388747657003101D-01 w(169) = 0.11588074033043952568D-01 w(170) = 0.11470482114693874380D-01 w(171) = 0.11350654315980596602D-01 w(172) = 0.11228632913408049354D-01 w(173) = 0.11104461134006926537D-01 w(174) = 0.10978183152658912470D-01 w(175) = 0.10849844089337314099D-01 w(176) = 0.10719490006251933623D-01 w(177) = 0.10587167904885197931D-01 w(178) = 0.10452925722906011926D-01 w(179) = 0.10316812330947621682D-01 w(180) = 0.10178877529236079733D-01 w(181) = 0.10039172044056840798D-01 w(182) = 0.98977475240487497440D-02 w(183) = 0.97546565363174114611D-02 w(184) = 0.96099525623638830097D-02 w(185) = 0.94636899938300652943D-02 w(186) = 0.93159241280693950932D-02 w(187) = 0.91667111635607884067D-02 w(188) = 0.90161081951956431600D-02 w(189) = 0.88641732094824942641D-02 w(190) = 0.87109650797320868736D-02 w(191) = 0.85565435613076896192D-02 w(192) = 0.84009692870519326354D-02 w(193) = 0.82443037630328680306D-02 w(194) = 0.80866093647888599710D-02 w(195) = 0.79279493342948491103D-02 w(196) = 0.77683877779219912200D-02 w(197) = 0.76079896657190565832D-02 w(198) = 0.74468208324075910174D-02 w(199) = 0.72849479805538070639D-02 w(200) = 0.71224386864583871532D-02 w(201) = 0.69593614093904229394D-02 w(202) = 0.67957855048827733948D-02 w(203) = 0.66317812429018878941D-02 w(204) = 0.64674198318036867274D-02 w(205) = 0.63027734490857587172D-02 w(206) = 0.61379152800413850435D-02 w(207) = 0.59729195655081658049D-02 w(208) = 0.58078616599775673635D-02 w(209) = 0.56428181013844441585D-02 w(210) = 0.54778666939189508240D-02 w(211) = 0.53130866051870565663D-02 w(212) = 0.51485584789781777618D-02 w(213) = 0.49843645647655386012D-02 w(214) = 0.48205888648512683476D-02 w(215) = 0.46573172997568547773D-02 w(216) = 0.44946378920320678616D-02 w(217) = 0.43326409680929828545D-02 w(218) = 0.41714193769840788528D-02 w(219) = 0.40110687240750233989D-02 w(220) = 0.38516876166398709241D-02 w(221) = 0.36933779170256508183D-02 w(222) = 0.35362449977167777340D-02 w(223) = 0.33803979910869203823D-02 w(224) = 0.32259500250878684614D-02 w(225) = 0.30730184347025783234D-02 w(226) = 0.29217249379178197538D-02 w(227) = 0.27721957645934509940D-02 w(228) = 0.26245617274044295626D-02 w(229) = 0.24789582266575679307D-02 w(230) = 0.23355251860571608737D-02 w(231) = 0.21944069253638388388D-02 w(232) = 0.20557519893273465236D-02 w(233) = 0.19197129710138724125D-02 w(234) = 0.17864463917586498247D-02 w(235) = 0.16561127281544526052D-02 w(236) = 0.15288767050877655684D-02 w(237) = 0.14049079956551446427D-02 w(238) = 0.12843824718970101768D-02 w(239) = 0.11674841174299594077D-02 w(240) = 0.10544076228633167722D-02 w(241) = 0.94536151685852538246D-03 w(242) = 0.84057143271072246365D-03 w(243) = 0.74028280424450333046D-03 w(244) = 0.64476204130572477933D-03 w(245) = 0.55429531493037471492D-03 w(246) = 0.46918492424785040975D-03 w(247) = 0.38974528447328229322D-03 w(248) = 0.31630366082226447689D-03 w(249) = 0.24921240048299729402D-03 w(250) = 0.18887326450650491366D-03 w(251) = 0.13575491094922871973D-03 w(252) = 0.90372734658751149261D-04 w(253) = 0.53275293669780613125D-04 w(254) = 0.25157870384280661489D-04 w(255) = 0.69379364324108267170D-05 else if ( n == 511 ) then x( 1) = -0.999999672956734384381D+00 x( 2) = -0.999997596379748464620D+00 x( 3) = -0.999992298136257588028D+00 x( 4) = -0.999982430354891598580D+00 x( 5) = -0.999966730098486276883D+00 x( 6) = -0.999943996207054375764D+00 x( 7) = -0.999913081144678282800D+00 x( 8) = -0.999872888120357611938D+00 x( 9) = -0.999822363679787739196D+00 x( 10) = -0.999760490924432047330D+00 x( 11) = -0.999686286448317731776D+00 x( 12) = -0.999598799671910683252D+00 x( 13) = -0.999497112467187190535D+00 x( 14) = -0.999380338025023581928D+00 x( 15) = -0.999247618943342473599D+00 x( 16) = -0.999098124967667597662D+00 x( 17) = -0.998931050830810562236D+00 x( 18) = -0.998745614468095114704D+00 x( 19) = -0.998541055697167906027D+00 x( 20) = -0.998316635318407392531D+00 x( 21) = -0.998071634524930323302D+00 x( 22) = -0.997805354495957274562D+00 x( 23) = -0.997517116063472399965D+00 x( 24) = -0.997206259372221959076D+00 x( 25) = -0.996872143485260161299D+00 x( 26) = -0.996514145914890273849D+00 x( 27) = -0.996131662079315037786D+00 x( 28) = -0.995724104698407188509D+00 x( 29) = -0.995290903148810302261D+00 x( 30) = -0.994831502800621000519D+00 x( 31) = -0.994345364356723405931D+00 x( 32) = -0.993831963212755022209D+00 x( 33) = -0.993290788851684966211D+00 x( 34) = -0.992721344282788615328D+00 x( 35) = -0.992123145530863117683D+00 x( 36) = -0.991495721178106132399D+00 x( 37) = -0.990838611958294243677D+00 x( 38) = -0.990151370400770159181D+00 x( 39) = -0.989433560520240838716D+00 x( 40) = -0.988684757547429479939D+00 x( 41) = -0.987904547695124280467D+00 x( 42) = -0.987092527954034067190D+00 x( 43) = -0.986248305913007552681D+00 x( 44) = -0.985371499598520371114D+00 x( 45) = -0.984461737328814534596D+00 x( 46) = -0.983518657578632728762D+00 x( 47) = -0.982541908851080604251D+00 x( 48) = -0.981531149553740106867D+00 x( 49) = -0.980486047876721339416D+00 x( 50) = -0.979406281670862683806D+00 x( 51) = -0.978291538324758539526D+00 x( 52) = -0.977141514639705714156D+00 x( 53) = -0.975955916702011753129D+00 x( 54) = -0.974734459752402667761D+00 x( 55) = -0.973476868052506926773D+00 x( 56) = -0.972182874748581796578D+00 x( 57) = -0.970852221732792443256D+00 x( 58) = -0.969484659502459231771D+00 x( 59) = -0.968079947017759947964D+00 x( 60) = -0.966637851558416567092D+00 x( 61) = -0.965158148579915665979D+00 x( 62) = -0.963640621569812132521D+00 x( 63) = -0.962085061904651475741D+00 x( 64) = -0.960491268708020283423D+00 x( 65) = -0.958859048710200221356D+00 x( 66) = -0.957188216109860962736D+00 x( 67) = -0.955478592438183697574D+00 x( 68) = -0.953730006425761136415D+00 x( 69) = -0.951942293872573589498D+00 x( 70) = -0.950115297521294876558D+00 x( 71) = -0.948248866934137357063D+00 x( 72) = -0.946342858373402905148D+00 x( 73) = -0.944397134685866648591D+00 x( 74) = -0.942411565191083059813D+00 x( 75) = -0.940386025573669721370D+00 x( 76) = -0.938320397779592883655D+00 x( 77) = -0.936214569916450806625D+00 x( 78) = -0.934068436157725787999D+00 x( 79) = -0.931881896650953639345D+00 x( 80) = -0.929654857429740056670D+00 x( 81) = -0.927387230329536696843D+00 x( 82) = -0.925078932907075652364D+00 x( 83) = -0.922729888363349241523D+00 x( 84) = -0.920340025470012420730D+00 x( 85) = -0.917909278499077501636D+00 x( 86) = -0.915437587155765040644D+00 x( 87) = -0.912924896514370590080D+00 x( 88) = -0.910371156957004292498D+00 x( 89) = -0.907776324115058903624D+00 x( 90) = -0.905140358813261595189D+00 x( 91) = -0.902463227016165675048D+00 x( 92) = -0.899744899776940036639D+00 x( 93) = -0.896985353188316590376D+00 x( 94) = -0.894184568335559022859D+00 x( 95) = -0.891342531251319871666D+00 x( 96) = -0.888459232872256998890D+00 x( 97) = -0.885534668997285008926D+00 x( 98) = -0.882568840247341906842D+00 x( 99) = -0.879561752026556262568D+00 x(100) = -0.876513414484705269742D+00 x(101) = -0.873423842480859310192D+00 x(102) = -0.870293055548113905851D+00 x(103) = -0.867121077859315215614D+00 x(104) = -0.863907938193690477146D+00 x(105) = -0.860653669904299969802D+00 x(106) = -0.857358310886232156525D+00 x(107) = -0.854021903545468625813D+00 x(108) = -0.850644494768350279758D+00 x(109) = -0.847226135891580884381D+00 x(110) = -0.843766882672708601038D+00 x(111) = -0.840266795261030442350D+00 x(112) = -0.836725938168868735503D+00 x(113) = -0.833144380243172624728D+00 x(114) = -0.829522194637401400178D+00 x(115) = -0.825859458783650001088D+00 x(116) = -0.822156254364980407373D+00 x(117) = -0.818412667287925807395D+00 x(118) = -0.814628787655137413436D+00 x(119) = -0.810804709738146594361D+00 x(120) = -0.806940531950217611856D+00 x(121) = -0.803036356819268687782D+00 x(122) = -0.799092290960841401800D+00 x(123) = -0.795108445051100526780D+00 x(124) = -0.791084933799848361435D+00 x(125) = -0.787021875923539422170D+00 x(126) = -0.782919394118283016385D+00 x(127) = -0.778777615032822744702D+00 x(128) = -0.774596669241483377036D+00 x(129) = -0.770376691217076824278D+00 x(130) = -0.766117819303760090717D+00 x(131) = -0.761820195689839149173D+00 x(132) = -0.757483966380513637926D+00 x(133) = -0.753109281170558142523D+00 x(134) = -0.748696293616936602823D+00 x(135) = -0.744245161011347082309D+00 x(136) = -0.739756044352694758677D+00 x(137) = -0.735229108319491547663D+00 x(138) = -0.730664521242181261329D+00 x(139) = -0.726062455075389632685D+00 x(140) = -0.721423085370098915485D+00 x(141) = -0.716746591245747095767D+00 x(142) = -0.712033155362252034587D+00 x(143) = -0.707282963891961103412D+00 x(144) = -0.702496206491527078610D+00 x(145) = -0.697673076273711232906D+00 x(146) = -0.692813769779114702895D+00 x(147) = -0.687918486947839325756D+00 x(148) = -0.682987431091079228087D+00 x(149) = -0.678020808862644517838D+00 x(150) = -0.673018830230418479199D+00 x(151) = -0.667981708447749702165D+00 x(152) = -0.662909660024780595461D+00 x(153) = -0.657802904699713735422D+00 x(154) = -0.652661665410017496101D+00 x(155) = -0.647486168263572388782D+00 x(156) = -0.642276642509759513774D+00 x(157) = -0.637033320510492495071D+00 x(158) = -0.631756437711194230414D+00 x(159) = -0.626446232611719746542D+00 x(160) = -0.621102946737226402941D+00 x(161) = -0.615726824608992638014D+00 x(162) = -0.610318113715186400156D+00 x(163) = -0.604877064481584353319D+00 x(164) = -0.599403930242242892974D+00 x(165) = -0.593898967210121954393D+00 x(166) = -0.588362434447662541434D+00 x(167) = -0.582794593837318850840D+00 x(168) = -0.577195710052045814844D+00 x(169) = -0.571566050525742833992D+00 x(170) = -0.565905885423654422623D+00 x(171) = -0.560215487612728441818D+00 x(172) = -0.554495132631932548866D+00 x(173) = -0.548745098662529448608D+00 x(174) = -0.542965666498311490492D+00 x(175) = -0.537157119515795115982D+00 x(176) = -0.531319743644375623972D+00 x(177) = -0.525453827336442687395D+00 x(178) = -0.519559661537457021993D+00 x(179) = -0.513637539655988578507D+00 x(180) = -0.507687757533716602155D+00 x(181) = -0.501710613415391878251D+00 x(182) = -0.495706407918761460170D+00 x(183) = -0.489675444004456155436D+00 x(184) = -0.483618026945841027562D+00 x(185) = -0.477534464298829155284D+00 x(186) = -0.471425065871658876934D+00 x(187) = -0.465290143694634735858D+00 x(188) = -0.459130011989832332874D+00 x(189) = -0.452944987140767283784D+00 x(190) = -0.446735387662028473742D+00 x(191) = -0.440501534168875795783D+00 x(192) = -0.434243749346802558002D+00 x(193) = -0.427962357921062742583D+00 x(194) = -0.421657686626163300056D+00 x(195) = -0.415330064175321663764D+00 x(196) = -0.408979821229888672409D+00 x(197) = -0.402607290368737092671D+00 x(198) = -0.396212806057615939183D+00 x(199) = -0.389796704618470795479D+00 x(200) = -0.383359324198730346916D+00 x(201) = -0.376901004740559344802D+00 x(202) = -0.370422087950078230138D+00 x(203) = -0.363922917266549655269D+00 x(204) = -0.357403837831532152376D+00 x(205) = -0.350865196458001209011D+00 x(206) = -0.344307341599438022777D+00 x(207) = -0.337730623318886219621D+00 x(208) = -0.331135393257976833093D+00 x(209) = -0.324522004605921855207D+00 x(210) = -0.317890812068476683182D+00 x(211) = -0.311242171836871800300D+00 x(212) = -0.304576441556714043335D+00 x(213) = -0.297893980296857823437D+00 x(214) = -0.291195148518246681964D+00 x(215) = -0.284480308042725577496D+00 x(216) = -0.277749822021824315065D+00 x(217) = -0.271004054905512543536D+00 x(218) = -0.264243372410926761945D+00 x(219) = -0.257468141491069790481D+00 x(220) = -0.250678730303483176613D+00 x(221) = -0.243875508178893021593D+00 x(222) = -0.237058845589829727213D+00 x(223) = -0.230229114119222177156D+00 x(224) = -0.223386686428966881628D+00 x(225) = -0.216531936228472628081D+00 x(226) = -0.209665238243181194766D+00 x(227) = -0.202786968183064697557D+00 x(228) = -0.195897502711100153915D+00 x(229) = -0.188997219411721861059D+00 x(230) = -0.182086496759252198246D+00 x(231) = -0.175165714086311475707D+00 x(232) = -0.168235251552207464982D+00 x(233) = -0.161295490111305257361D+00 x(234) = -0.154346811481378108692D+00 x(235) = -0.147389598111939940054D+00 x(236) = -0.140424233152560174594D+00 x(237) = -0.133451100421161601344D+00 x(238) = -0.126470584372301966851D+00 x(239) = -0.119483070065440005133D+00 x(240) = -0.112488943133186625746D+00 x(241) = -0.105488589749541988533D+00 x(242) = -0.984823965981192020903D-01 x(243) = -0.914707508403553909095D-01 x(244) = -0.844540400837108837102D-01 x(245) = -0.774326523498572825675D-01 x(246) = -0.704069760428551790633D-01 x(247) = -0.633773999173222898797D-01 x(248) = -0.563443130465927899720D-01 x(249) = -0.493081047908686267156D-01 x(250) = -0.422691647653636032124D-01 x(251) = -0.352278828084410232603D-01 x(252) = -0.281846489497456943394D-01 x(253) = -0.211398533783310883350D-01 x(254) = -0.140938864107824626142D-01 x(255) = -0.704713845933674648514D-02 x(256) = +0.000000000000000000000D+00 x(257) = +0.704713845933674648514D-02 x(258) = +0.140938864107824626142D-01 x(259) = +0.211398533783310883350D-01 x(260) = +0.281846489497456943394D-01 x(261) = +0.352278828084410232603D-01 x(262) = +0.422691647653636032124D-01 x(263) = +0.493081047908686267156D-01 x(264) = +0.563443130465927899720D-01 x(265) = +0.633773999173222898797D-01 x(266) = +0.704069760428551790633D-01 x(267) = +0.774326523498572825675D-01 x(268) = +0.844540400837108837102D-01 x(269) = +0.914707508403553909095D-01 x(270) = +0.984823965981192020903D-01 x(271) = +0.105488589749541988533D+00 x(272) = +0.112488943133186625746D+00 x(273) = +0.119483070065440005133D+00 x(274) = +0.126470584372301966851D+00 x(275) = +0.133451100421161601344D+00 x(276) = +0.140424233152560174594D+00 x(277) = +0.147389598111939940054D+00 x(278) = +0.154346811481378108692D+00 x(279) = +0.161295490111305257361D+00 x(280) = +0.168235251552207464982D+00 x(281) = +0.175165714086311475707D+00 x(282) = +0.182086496759252198246D+00 x(283) = +0.188997219411721861059D+00 x(284) = +0.195897502711100153915D+00 x(285) = +0.202786968183064697557D+00 x(286) = +0.209665238243181194766D+00 x(287) = +0.216531936228472628081D+00 x(288) = +0.223386686428966881628D+00 x(289) = +0.230229114119222177156D+00 x(290) = +0.237058845589829727213D+00 x(291) = +0.243875508178893021593D+00 x(292) = +0.250678730303483176613D+00 x(293) = +0.257468141491069790481D+00 x(294) = +0.264243372410926761945D+00 x(295) = +0.271004054905512543536D+00 x(296) = +0.277749822021824315065D+00 x(297) = +0.284480308042725577496D+00 x(298) = +0.291195148518246681964D+00 x(299) = +0.297893980296857823437D+00 x(300) = +0.304576441556714043335D+00 x(301) = +0.311242171836871800300D+00 x(302) = +0.317890812068476683182D+00 x(303) = +0.324522004605921855207D+00 x(304) = +0.331135393257976833093D+00 x(305) = +0.337730623318886219621D+00 x(306) = +0.344307341599438022777D+00 x(307) = +0.350865196458001209011D+00 x(308) = +0.357403837831532152376D+00 x(309) = +0.363922917266549655269D+00 x(310) = +0.370422087950078230138D+00 x(311) = +0.376901004740559344802D+00 x(312) = +0.383359324198730346916D+00 x(313) = +0.389796704618470795479D+00 x(314) = +0.396212806057615939183D+00 x(315) = +0.402607290368737092671D+00 x(316) = +0.408979821229888672409D+00 x(317) = +0.415330064175321663764D+00 x(318) = +0.421657686626163300056D+00 x(319) = +0.427962357921062742583D+00 x(320) = +0.434243749346802558002D+00 x(321) = +0.440501534168875795783D+00 x(322) = +0.446735387662028473742D+00 x(323) = +0.452944987140767283784D+00 x(324) = +0.459130011989832332874D+00 x(325) = +0.465290143694634735858D+00 x(326) = +0.471425065871658876934D+00 x(327) = +0.477534464298829155284D+00 x(328) = +0.483618026945841027562D+00 x(329) = +0.489675444004456155436D+00 x(330) = +0.495706407918761460170D+00 x(331) = +0.501710613415391878251D+00 x(332) = +0.507687757533716602155D+00 x(333) = +0.513637539655988578507D+00 x(334) = +0.519559661537457021993D+00 x(335) = +0.525453827336442687395D+00 x(336) = +0.531319743644375623972D+00 x(337) = +0.537157119515795115982D+00 x(338) = +0.542965666498311490492D+00 x(339) = +0.548745098662529448608D+00 x(340) = +0.554495132631932548866D+00 x(341) = +0.560215487612728441818D+00 x(342) = +0.565905885423654422623D+00 x(343) = +0.571566050525742833992D+00 x(344) = +0.577195710052045814844D+00 x(345) = +0.582794593837318850840D+00 x(346) = +0.588362434447662541434D+00 x(347) = +0.593898967210121954393D+00 x(348) = +0.599403930242242892974D+00 x(349) = +0.604877064481584353319D+00 x(350) = +0.610318113715186400156D+00 x(351) = +0.615726824608992638014D+00 x(352) = +0.621102946737226402941D+00 x(353) = +0.626446232611719746542D+00 x(354) = +0.631756437711194230414D+00 x(355) = +0.637033320510492495071D+00 x(356) = +0.642276642509759513774D+00 x(357) = +0.647486168263572388782D+00 x(358) = +0.652661665410017496101D+00 x(359) = +0.657802904699713735422D+00 x(360) = +0.662909660024780595461D+00 x(361) = +0.667981708447749702165D+00 x(362) = +0.673018830230418479199D+00 x(363) = +0.678020808862644517838D+00 x(364) = +0.682987431091079228087D+00 x(365) = +0.687918486947839325756D+00 x(366) = +0.692813769779114702895D+00 x(367) = +0.697673076273711232906D+00 x(368) = +0.702496206491527078610D+00 x(369) = +0.707282963891961103412D+00 x(370) = +0.712033155362252034587D+00 x(371) = +0.716746591245747095767D+00 x(372) = +0.721423085370098915485D+00 x(373) = +0.726062455075389632685D+00 x(374) = +0.730664521242181261329D+00 x(375) = +0.735229108319491547663D+00 x(376) = +0.739756044352694758677D+00 x(377) = +0.744245161011347082309D+00 x(378) = +0.748696293616936602823D+00 x(379) = +0.753109281170558142523D+00 x(380) = +0.757483966380513637926D+00 x(381) = +0.761820195689839149173D+00 x(382) = +0.766117819303760090717D+00 x(383) = +0.770376691217076824278D+00 x(384) = +0.774596669241483377036D+00 x(385) = +0.778777615032822744702D+00 x(386) = +0.782919394118283016385D+00 x(387) = +0.787021875923539422170D+00 x(388) = +0.791084933799848361435D+00 x(389) = +0.795108445051100526780D+00 x(390) = +0.799092290960841401800D+00 x(391) = +0.803036356819268687782D+00 x(392) = +0.806940531950217611856D+00 x(393) = +0.810804709738146594361D+00 x(394) = +0.814628787655137413436D+00 x(395) = +0.818412667287925807395D+00 x(396) = +0.822156254364980407373D+00 x(397) = +0.825859458783650001088D+00 x(398) = +0.829522194637401400178D+00 x(399) = +0.833144380243172624728D+00 x(400) = +0.836725938168868735503D+00 x(401) = +0.840266795261030442350D+00 x(402) = +0.843766882672708601038D+00 x(403) = +0.847226135891580884381D+00 x(404) = +0.850644494768350279758D+00 x(405) = +0.854021903545468625813D+00 x(406) = +0.857358310886232156525D+00 x(407) = +0.860653669904299969802D+00 x(408) = +0.863907938193690477146D+00 x(409) = +0.867121077859315215614D+00 x(410) = +0.870293055548113905851D+00 x(411) = +0.873423842480859310192D+00 x(412) = +0.876513414484705269742D+00 x(413) = +0.879561752026556262568D+00 x(414) = +0.882568840247341906842D+00 x(415) = +0.885534668997285008926D+00 x(416) = +0.888459232872256998890D+00 x(417) = +0.891342531251319871666D+00 x(418) = +0.894184568335559022859D+00 x(419) = +0.896985353188316590376D+00 x(420) = +0.899744899776940036639D+00 x(421) = +0.902463227016165675048D+00 x(422) = +0.905140358813261595189D+00 x(423) = +0.907776324115058903624D+00 x(424) = +0.910371156957004292498D+00 x(425) = +0.912924896514370590080D+00 x(426) = +0.915437587155765040644D+00 x(427) = +0.917909278499077501636D+00 x(428) = +0.920340025470012420730D+00 x(429) = +0.922729888363349241523D+00 x(430) = +0.925078932907075652364D+00 x(431) = +0.927387230329536696843D+00 x(432) = +0.929654857429740056670D+00 x(433) = +0.931881896650953639345D+00 x(434) = +0.934068436157725787999D+00 x(435) = +0.936214569916450806625D+00 x(436) = +0.938320397779592883655D+00 x(437) = +0.940386025573669721370D+00 x(438) = +0.942411565191083059813D+00 x(439) = +0.944397134685866648591D+00 x(440) = +0.946342858373402905148D+00 x(441) = +0.948248866934137357063D+00 x(442) = +0.950115297521294876558D+00 x(443) = +0.951942293872573589498D+00 x(444) = +0.953730006425761136415D+00 x(445) = +0.955478592438183697574D+00 x(446) = +0.957188216109860962736D+00 x(447) = +0.958859048710200221356D+00 x(448) = +0.960491268708020283423D+00 x(449) = +0.962085061904651475741D+00 x(450) = +0.963640621569812132521D+00 x(451) = +0.965158148579915665979D+00 x(452) = +0.966637851558416567092D+00 x(453) = +0.968079947017759947964D+00 x(454) = +0.969484659502459231771D+00 x(455) = +0.970852221732792443256D+00 x(456) = +0.972182874748581796578D+00 x(457) = +0.973476868052506926773D+00 x(458) = +0.974734459752402667761D+00 x(459) = +0.975955916702011753129D+00 x(460) = +0.977141514639705714156D+00 x(461) = +0.978291538324758539526D+00 x(462) = +0.979406281670862683806D+00 x(463) = +0.980486047876721339416D+00 x(464) = +0.981531149553740106867D+00 x(465) = +0.982541908851080604251D+00 x(466) = +0.983518657578632728762D+00 x(467) = +0.984461737328814534596D+00 x(468) = +0.985371499598520371114D+00 x(469) = +0.986248305913007552681D+00 x(470) = +0.987092527954034067190D+00 x(471) = +0.987904547695124280467D+00 x(472) = +0.988684757547429479939D+00 x(473) = +0.989433560520240838716D+00 x(474) = +0.990151370400770159181D+00 x(475) = +0.990838611958294243677D+00 x(476) = +0.991495721178106132399D+00 x(477) = +0.992123145530863117683D+00 x(478) = +0.992721344282788615328D+00 x(479) = +0.993290788851684966211D+00 x(480) = +0.993831963212755022209D+00 x(481) = +0.994345364356723405931D+00 x(482) = +0.994831502800621000519D+00 x(483) = +0.995290903148810302261D+00 x(484) = +0.995724104698407188509D+00 x(485) = +0.996131662079315037786D+00 x(486) = +0.996514145914890273849D+00 x(487) = +0.996872143485260161299D+00 x(488) = +0.997206259372221959076D+00 x(489) = +0.997517116063472399965D+00 x(490) = +0.997805354495957274562D+00 x(491) = +0.998071634524930323302D+00 x(492) = +0.998316635318407392531D+00 x(493) = +0.998541055697167906027D+00 x(494) = +0.998745614468095114704D+00 x(495) = +0.998931050830810562236D+00 x(496) = +0.999098124967667597662D+00 x(497) = +0.999247618943342473599D+00 x(498) = +0.999380338025023581928D+00 x(499) = +0.999497112467187190535D+00 x(500) = +0.999598799671910683252D+00 x(501) = +0.999686286448317731776D+00 x(502) = +0.999760490924432047330D+00 x(503) = +0.999822363679787739196D+00 x(504) = +0.999872888120357611938D+00 x(505) = +0.999913081144678282800D+00 x(506) = +0.999943996207054375764D+00 x(507) = +0.999966730098486276883D+00 x(508) = +0.999982430354891598580D+00 x(509) = +0.999992298136257588028D+00 x(510) = +0.999997596379748464620D+00 x(511) = +0.999999672956734384381D+00 w( 1) = 0.945715933950007048827D-06 w( 2) = 0.345456507169149134898D-05 w( 3) = 0.736624069102321668857D-05 w( 4) = 0.125792781889592743525D-04 w( 5) = 0.190213681905875816679D-04 w( 6) = 0.266376412339000901358D-04 w( 7) = 0.353751372055189588628D-04 w( 8) = 0.451863674126296143105D-04 w( 9) = 0.560319507856164252140D-04 w( 10) = 0.678774554733972416227D-04 w( 11) = 0.806899228014035293851D-04 w( 12) = 0.944366322532705527066D-04 w( 13) = 0.109085545645741522051D-03 w( 14) = 0.124606200241498368482D-03 w( 15) = 0.140970302204104791413D-03 w( 16) = 0.158151830411132242924D-03 w( 17) = 0.176126765545083195474D-03 w( 18) = 0.194872642236641146532D-03 w( 19) = 0.214368090034216937149D-03 w( 20) = 0.234592462123925204879D-03 w( 21) = 0.255525589595236862014D-03 w( 22) = 0.277147657465187357459D-03 w( 23) = 0.299439176850911730874D-03 w( 24) = 0.322381020652862389664D-03 w( 25) = 0.345954492129903871350D-03 w( 26) = 0.370141402122251665232D-03 w( 27) = 0.394924138246873704434D-03 w( 28) = 0.420285716355361231823D-03 w( 29) = 0.446209810101403247488D-03 w( 30) = 0.472680758429262691232D-03 w( 31) = 0.499683553312800484519D-03 w( 32) = 0.527203811431658386125D-03 w( 33) = 0.555227733977307579715D-03 w( 34) = 0.583742058714979703847D-03 w( 35) = 0.612734008012225209294D-03 w( 36) = 0.642191235948505088403D-03 w( 37) = 0.672101776960108194646D-03 w( 38) = 0.702453997827572321358D-03 w( 39) = 0.733236554224767912055D-03 w( 40) = 0.764438352543882784191D-03 w( 41) = 0.796048517297550871506D-03 w( 42) = 0.828056364077226302608D-03 w( 43) = 0.860451377808527848128D-03 w( 44) = 0.893223195879324912340D-03 w( 45) = 0.926361595613111283368D-03 w( 46) = 0.959856485506936206261D-03 w( 47) = 0.993697899638760857945D-03 w( 48) = 0.102787599466367326179D-02 w( 49) = 0.106238104885340071375D-02 w( 50) = 0.109720346268191941940D-02 w( 51) = 0.113233376051597664917D-02 w( 52) = 0.116776259302858043685D-02 w( 53) = 0.120348074001265964881D-02 w( 54) = 0.123947911332878396534D-02 w( 55) = 0.127574875977346947345D-02 w( 56) = 0.131228086370221478128D-02 w( 57) = 0.134906674928353113127D-02 w( 58) = 0.138609788229672549700D-02 w( 59) = 0.142336587141720519900D-02 w( 60) = 0.146086246895890987689D-02 w( 61) = 0.149857957106456636214D-02 w( 62) = 0.153650921735128916170D-02 w( 63) = 0.157464359003212166189D-02 w( 64) = 0.161297501254393423070D-02 w( 65) = 0.165149594771914570655D-02 w( 66) = 0.169019899554346019117D-02 w( 67) = 0.172907689054461607168D-02 w( 68) = 0.176812249885838886701D-02 w( 69) = 0.180732881501808930079D-02 w( 70) = 0.184668895851282540913D-02 w( 71) = 0.188619617015808475394D-02 w( 72) = 0.192584380831993546204D-02 w( 73) = 0.196562534503150547732D-02 w( 74) = 0.200553436203751169944D-02 w( 75) = 0.204556454679958293446D-02 w( 76) = 0.208570968849203942640D-02 w( 77) = 0.212596367401472533045D-02 w( 78) = 0.216632048404649142727D-02 w( 79) = 0.220677418916003329194D-02 w( 80) = 0.224731894601603393082D-02 w( 81) = 0.228794899365195972378D-02 w( 82) = 0.232865864987842738864D-02 w( 83) = 0.236944230779380495146D-02 w( 84) = 0.241029443242563417382D-02 w( 85) = 0.245120955750556483923D-02 w( 86) = 0.249218228238276930060D-02 w( 87) = 0.253320726907925325750D-02 w( 88) = 0.257427923948908888092D-02 w( 89) = 0.261539297272236109225D-02 w( 90) = 0.265654330259352828314D-02 w( 91) = 0.269772511525294586667D-02 w( 92) = 0.273893334695947541201D-02 w( 93) = 0.278016298199139435045D-02 w( 94) = 0.282140905069222207923D-02 w( 95) = 0.286266662764757868253D-02 w( 96) = 0.290393082998878368175D-02 w( 97) = 0.294519681581857582284D-02 w( 98) = 0.298645978275408290247D-02 w( 99) = 0.302771496658198544480D-02 w(100) = 0.306895764002069252174D-02 w(101) = 0.311018311158427546158D-02 w(102) = 0.315138672454287935858D-02 w(103) = 0.319256385597434736790D-02 w(104) = 0.323370991590184336368D-02 w(105) = 0.327482034651233969564D-02 w(106) = 0.331589062145094394706D-02 w(107) = 0.335691624518616761342D-02 w(108) = 0.339789275244138669739D-02 w(109) = 0.343881570768790591876D-02 w(110) = 0.347968070469521146972D-02 w(111) = 0.352048336613417922682D-02 w(112) = 0.356121934322919357659D-02 w(113) = 0.360188431545532431869D-02 w(114) = 0.364247399027690353194D-02 w(115) = 0.368298410292403911967D-02 w(116) = 0.372341041620379550870D-02 w(117) = 0.376374872034296338241D-02 w(118) = 0.380399483285952829161D-02 w(119) = 0.384414459846013158917D-02 w(120) = 0.388419388896099560998D-02 w(121) = 0.392413860322995774660D-02 w(122) = 0.396397466714742455513D-02 w(123) = 0.400369803358421688562D-02 w(124) = 0.404330468239442998549D-02 w(125) = 0.408279062042157838350D-02 w(126) = 0.412215188151643401528D-02 w(127) = 0.416138452656509745764D-02 w(128) = 0.420048464352596631772D-02 w(129) = 0.423944834747438184434D-02 w(130) = 0.427827178065384480959D-02 w(131) = 0.431695111253279479928D-02 w(132) = 0.435548253986604343679D-02 w(133) = 0.439386228676004195260D-02 w(134) = 0.443208660474124713206D-02 w(135) = 0.447015177282692726900D-02 w(136) = 0.450805409759782158001D-02 w(137) = 0.454578991327213285488D-02 w(138) = 0.458335558178039420335D-02 w(139) = 0.462074749284080687482D-02 w(140) = 0.465796206403469754658D-02 w(141) = 0.469499574088179046532D-02 w(142) = 0.473184499691503264714D-02 w(143) = 0.476850633375474925263D-02 w(144) = 0.480497628118194150483D-02 w(145) = 0.484125139721057135214D-02 w(146) = 0.487732826815870573054D-02 w(147) = 0.491320350871841897367D-02 w(148) = 0.494887376202437487201D-02 w(149) = 0.498433569972103029914D-02 w(150) = 0.501958602202842039909D-02 w(151) = 0.505462145780650125058D-02 w(152) = 0.508943876461803986674D-02 w(153) = 0.512403472879005351831D-02 w(154) = 0.515840616547381084096D-02 w(155) = 0.519254991870341614863D-02 w(156) = 0.522646286145300596306D-02 w(157) = 0.526014189569259311205D-02 w(158) = 0.529358395244259896547D-02 w(159) = 0.532678599182711857974D-02 w(160) = 0.535974500312596681161D-02 w(161) = 0.539245800482555593606D-02 w(162) = 0.542492204466865704951D-02 w(163) = 0.545713419970309863995D-02 w(164) = 0.548909157632945623482D-02 w(165) = 0.552079131034778706457D-02 w(166) = 0.555223056700346326850D-02 w(167) = 0.558340654103215637610D-02 w(168) = 0.561431645670402467678D-02 w(169) = 0.564495756786715368885D-02 w(170) = 0.567532715799029830087D-02 w(171) = 0.570542254020497332312D-02 w(172) = 0.573524105734693719020D-02 w(173) = 0.576478008199711142954D-02 w(174) = 0.579403701652197628421D-02 w(175) = 0.582300929311348057702D-02 w(176) = 0.585169437382850155033D-02 w(177) = 0.588008975062788803205D-02 w(178) = 0.590819294541511788161D-02 w(179) = 0.593600151007459827614D-02 w(180) = 0.596351302650963502011D-02 w(181) = 0.599072510668009471472D-02 w(182) = 0.601763539263978131522D-02 w(183) = 0.604424155657354634589D-02 w(184) = 0.607054130083414983949D-02 w(185) = 0.609653235797888692923D-02 w(186) = 0.612221249080599294931D-02 w(187) = 0.614757949239083790214D-02 w(188) = 0.617263118612191922727D-02 w(189) = 0.619736542573665996342D-02 w(190) = 0.622178009535701763157D-02 w(191) = 0.624587310952490748541D-02 w(192) = 0.626964241323744217671D-02 w(193) = 0.629308598198198836688D-02 w(194) = 0.631620182177103938227D-02 w(195) = 0.633898796917690165912D-02 w(196) = 0.636144249136619145314D-02 w(197) = 0.638356348613413709795D-02 w(198) = 0.640534908193868098342D-02 w(199) = 0.642679743793437438922D-02 w(200) = 0.644790674400605734710D-02 w(201) = 0.646867522080231481688D-02 w(202) = 0.648910111976869964292D-02 w(203) = 0.650918272318071200827D-02 w(204) = 0.652891834417652442012D-02 w(205) = 0.654830632678944064054D-02 w(206) = 0.656734504598007641819D-02 w(207) = 0.658603290766824937794D-02 w(208) = 0.660436834876456498276D-02 w(209) = 0.662234983720168509457D-02 w(210) = 0.663997587196526532519D-02 w(211) = 0.665724498312454708217D-02 w(212) = 0.667415573186258997654D-02 w(213) = 0.669070671050613006584D-02 w(214) = 0.670689654255504925648D-02 w(215) = 0.672272388271144108036D-02 w(216) = 0.673818741690825799086D-02 w(217) = 0.675328586233752529078D-02 w(218) = 0.676801796747810680683D-02 w(219) = 0.678238251212300746082D-02 w(220) = 0.679637830740619795480D-02 w(221) = 0.681000419582894688374D-02 w(222) = 0.682325905128564571420D-02 w(223) = 0.683614177908911221841D-02 w(224) = 0.684865131599535812903D-02 w(225) = 0.686078663022780697951D-02 w(226) = 0.687254672150094831613D-02 w(227) = 0.688393062104341470995D-02 w(228) = 0.689493739162046825872D-02 w(229) = 0.690556612755588354803D-02 w(230) = 0.691581595475321433825D-02 w(231) = 0.692568603071643155621D-02 w(232) = 0.693517554456992049848D-02 w(233) = 0.694428371707782549438D-02 w(234) = 0.695300980066273063177D-02 w(235) = 0.696135307942366551493D-02 w(236) = 0.696931286915342540213D-02 w(237) = 0.697688851735519545845D-02 w(238) = 0.698407940325846925786D-02 w(239) = 0.699088493783425207545D-02 w(240) = 0.699730456380953992594D-02 w(241) = 0.700333775568106572820D-02 w(242) = 0.700898401972830440494D-02 w(243) = 0.701424289402572916425D-02 w(244) = 0.701911394845431165171D-02 w(245) = 0.702359678471225911031D-02 w(246) = 0.702769103632498213858D-02 w(247) = 0.703139636865428709508D-02 w(248) = 0.703471247890678765907D-02 w(249) = 0.703763909614153052319D-02 w(250) = 0.704017598127683066242D-02 w(251) = 0.704232292709631209597D-02 w(252) = 0.704407975825415053266D-02 w(253) = 0.704544633127951476780D-02 w(254) = 0.704642253458020417748D-02 w(255) = 0.704700828844548013730D-02 w(256) = 0.704720354504808967346D-02 w(257) = 0.704700828844548013730D-02 w(258) = 0.704642253458020417748D-02 w(259) = 0.704544633127951476780D-02 w(260) = 0.704407975825415053266D-02 w(261) = 0.704232292709631209597D-02 w(262) = 0.704017598127683066242D-02 w(263) = 0.703763909614153052319D-02 w(264) = 0.703471247890678765907D-02 w(265) = 0.703139636865428709508D-02 w(266) = 0.702769103632498213858D-02 w(267) = 0.702359678471225911031D-02 w(268) = 0.701911394845431165171D-02 w(269) = 0.701424289402572916425D-02 w(270) = 0.700898401972830440494D-02 w(271) = 0.700333775568106572820D-02 w(272) = 0.699730456380953992594D-02 w(273) = 0.699088493783425207545D-02 w(274) = 0.698407940325846925786D-02 w(275) = 0.697688851735519545845D-02 w(276) = 0.696931286915342540213D-02 w(277) = 0.696135307942366551493D-02 w(278) = 0.695300980066273063177D-02 w(279) = 0.694428371707782549438D-02 w(280) = 0.693517554456992049848D-02 w(281) = 0.692568603071643155621D-02 w(282) = 0.691581595475321433825D-02 w(283) = 0.690556612755588354803D-02 w(284) = 0.689493739162046825872D-02 w(285) = 0.688393062104341470995D-02 w(286) = 0.687254672150094831613D-02 w(287) = 0.686078663022780697951D-02 w(288) = 0.684865131599535812903D-02 w(289) = 0.683614177908911221841D-02 w(290) = 0.682325905128564571420D-02 w(291) = 0.681000419582894688374D-02 w(292) = 0.679637830740619795480D-02 w(293) = 0.678238251212300746082D-02 w(294) = 0.676801796747810680683D-02 w(295) = 0.675328586233752529078D-02 w(296) = 0.673818741690825799086D-02 w(297) = 0.672272388271144108036D-02 w(298) = 0.670689654255504925648D-02 w(299) = 0.669070671050613006584D-02 w(300) = 0.667415573186258997654D-02 w(301) = 0.665724498312454708217D-02 w(302) = 0.663997587196526532519D-02 w(303) = 0.662234983720168509457D-02 w(304) = 0.660436834876456498276D-02 w(305) = 0.658603290766824937794D-02 w(306) = 0.656734504598007641819D-02 w(307) = 0.654830632678944064054D-02 w(308) = 0.652891834417652442012D-02 w(309) = 0.650918272318071200827D-02 w(310) = 0.648910111976869964292D-02 w(311) = 0.646867522080231481688D-02 w(312) = 0.644790674400605734710D-02 w(313) = 0.642679743793437438922D-02 w(314) = 0.640534908193868098342D-02 w(315) = 0.638356348613413709795D-02 w(316) = 0.636144249136619145314D-02 w(317) = 0.633898796917690165912D-02 w(318) = 0.631620182177103938227D-02 w(319) = 0.629308598198198836688D-02 w(320) = 0.626964241323744217671D-02 w(321) = 0.624587310952490748541D-02 w(322) = 0.622178009535701763157D-02 w(323) = 0.619736542573665996342D-02 w(324) = 0.617263118612191922727D-02 w(325) = 0.614757949239083790214D-02 w(326) = 0.612221249080599294931D-02 w(327) = 0.609653235797888692923D-02 w(328) = 0.607054130083414983949D-02 w(329) = 0.604424155657354634589D-02 w(330) = 0.601763539263978131522D-02 w(331) = 0.599072510668009471472D-02 w(332) = 0.596351302650963502011D-02 w(333) = 0.593600151007459827614D-02 w(334) = 0.590819294541511788161D-02 w(335) = 0.588008975062788803205D-02 w(336) = 0.585169437382850155033D-02 w(337) = 0.582300929311348057702D-02 w(338) = 0.579403701652197628421D-02 w(339) = 0.576478008199711142954D-02 w(340) = 0.573524105734693719020D-02 w(341) = 0.570542254020497332312D-02 w(342) = 0.567532715799029830087D-02 w(343) = 0.564495756786715368885D-02 w(344) = 0.561431645670402467678D-02 w(345) = 0.558340654103215637610D-02 w(346) = 0.555223056700346326850D-02 w(347) = 0.552079131034778706457D-02 w(348) = 0.548909157632945623482D-02 w(349) = 0.545713419970309863995D-02 w(350) = 0.542492204466865704951D-02 w(351) = 0.539245800482555593606D-02 w(352) = 0.535974500312596681161D-02 w(353) = 0.532678599182711857974D-02 w(354) = 0.529358395244259896547D-02 w(355) = 0.526014189569259311205D-02 w(356) = 0.522646286145300596306D-02 w(357) = 0.519254991870341614863D-02 w(358) = 0.515840616547381084096D-02 w(359) = 0.512403472879005351831D-02 w(360) = 0.508943876461803986674D-02 w(361) = 0.505462145780650125058D-02 w(362) = 0.501958602202842039909D-02 w(363) = 0.498433569972103029914D-02 w(364) = 0.494887376202437487201D-02 w(365) = 0.491320350871841897367D-02 w(366) = 0.487732826815870573054D-02 w(367) = 0.484125139721057135214D-02 w(368) = 0.480497628118194150483D-02 w(369) = 0.476850633375474925263D-02 w(370) = 0.473184499691503264714D-02 w(371) = 0.469499574088179046532D-02 w(372) = 0.465796206403469754658D-02 w(373) = 0.462074749284080687482D-02 w(374) = 0.458335558178039420335D-02 w(375) = 0.454578991327213285488D-02 w(376) = 0.450805409759782158001D-02 w(377) = 0.447015177282692726900D-02 w(378) = 0.443208660474124713206D-02 w(379) = 0.439386228676004195260D-02 w(380) = 0.435548253986604343679D-02 w(381) = 0.431695111253279479928D-02 w(382) = 0.427827178065384480959D-02 w(383) = 0.423944834747438184434D-02 w(384) = 0.420048464352596631772D-02 w(385) = 0.416138452656509745764D-02 w(386) = 0.412215188151643401528D-02 w(387) = 0.408279062042157838350D-02 w(388) = 0.404330468239442998549D-02 w(389) = 0.400369803358421688562D-02 w(390) = 0.396397466714742455513D-02 w(391) = 0.392413860322995774660D-02 w(392) = 0.388419388896099560998D-02 w(393) = 0.384414459846013158917D-02 w(394) = 0.380399483285952829161D-02 w(395) = 0.376374872034296338241D-02 w(396) = 0.372341041620379550870D-02 w(397) = 0.368298410292403911967D-02 w(398) = 0.364247399027690353194D-02 w(399) = 0.360188431545532431869D-02 w(400) = 0.356121934322919357659D-02 w(401) = 0.352048336613417922682D-02 w(402) = 0.347968070469521146972D-02 w(403) = 0.343881570768790591876D-02 w(404) = 0.339789275244138669739D-02 w(405) = 0.335691624518616761342D-02 w(406) = 0.331589062145094394706D-02 w(407) = 0.327482034651233969564D-02 w(408) = 0.323370991590184336368D-02 w(409) = 0.319256385597434736790D-02 w(410) = 0.315138672454287935858D-02 w(411) = 0.311018311158427546158D-02 w(412) = 0.306895764002069252174D-02 w(413) = 0.302771496658198544480D-02 w(414) = 0.298645978275408290247D-02 w(415) = 0.294519681581857582284D-02 w(416) = 0.290393082998878368175D-02 w(417) = 0.286266662764757868253D-02 w(418) = 0.282140905069222207923D-02 w(419) = 0.278016298199139435045D-02 w(420) = 0.273893334695947541201D-02 w(421) = 0.269772511525294586667D-02 w(422) = 0.265654330259352828314D-02 w(423) = 0.261539297272236109225D-02 w(424) = 0.257427923948908888092D-02 w(425) = 0.253320726907925325750D-02 w(426) = 0.249218228238276930060D-02 w(427) = 0.245120955750556483923D-02 w(428) = 0.241029443242563417382D-02 w(429) = 0.236944230779380495146D-02 w(430) = 0.232865864987842738864D-02 w(431) = 0.228794899365195972378D-02 w(432) = 0.224731894601603393082D-02 w(433) = 0.220677418916003329194D-02 w(434) = 0.216632048404649142727D-02 w(435) = 0.212596367401472533045D-02 w(436) = 0.208570968849203942640D-02 w(437) = 0.204556454679958293446D-02 w(438) = 0.200553436203751169944D-02 w(439) = 0.196562534503150547732D-02 w(440) = 0.192584380831993546204D-02 w(441) = 0.188619617015808475394D-02 w(442) = 0.184668895851282540913D-02 w(443) = 0.180732881501808930079D-02 w(444) = 0.176812249885838886701D-02 w(445) = 0.172907689054461607168D-02 w(446) = 0.169019899554346019117D-02 w(447) = 0.165149594771914570655D-02 w(448) = 0.161297501254393423070D-02 w(449) = 0.157464359003212166189D-02 w(450) = 0.153650921735128916170D-02 w(451) = 0.149857957106456636214D-02 w(452) = 0.146086246895890987689D-02 w(453) = 0.142336587141720519900D-02 w(454) = 0.138609788229672549700D-02 w(455) = 0.134906674928353113127D-02 w(456) = 0.131228086370221478128D-02 w(457) = 0.127574875977346947345D-02 w(458) = 0.123947911332878396534D-02 w(459) = 0.120348074001265964881D-02 w(460) = 0.116776259302858043685D-02 w(461) = 0.113233376051597664917D-02 w(462) = 0.109720346268191941940D-02 w(463) = 0.106238104885340071375D-02 w(464) = 0.102787599466367326179D-02 w(465) = 0.993697899638760857945D-03 w(466) = 0.959856485506936206261D-03 w(467) = 0.926361595613111283368D-03 w(468) = 0.893223195879324912340D-03 w(469) = 0.860451377808527848128D-03 w(470) = 0.828056364077226302608D-03 w(471) = 0.796048517297550871506D-03 w(472) = 0.764438352543882784191D-03 w(473) = 0.733236554224767912055D-03 w(474) = 0.702453997827572321358D-03 w(475) = 0.672101776960108194646D-03 w(476) = 0.642191235948505088403D-03 w(477) = 0.612734008012225209294D-03 w(478) = 0.583742058714979703847D-03 w(479) = 0.555227733977307579715D-03 w(480) = 0.527203811431658386125D-03 w(481) = 0.499683553312800484519D-03 w(482) = 0.472680758429262691232D-03 w(483) = 0.446209810101403247488D-03 w(484) = 0.420285716355361231823D-03 w(485) = 0.394924138246873704434D-03 w(486) = 0.370141402122251665232D-03 w(487) = 0.345954492129903871350D-03 w(488) = 0.322381020652862389664D-03 w(489) = 0.299439176850911730874D-03 w(490) = 0.277147657465187357459D-03 w(491) = 0.255525589595236862014D-03 w(492) = 0.234592462123925204879D-03 w(493) = 0.214368090034216937149D-03 w(494) = 0.194872642236641146532D-03 w(495) = 0.176126765545083195474D-03 w(496) = 0.158151830411132242924D-03 w(497) = 0.140970302204104791413D-03 w(498) = 0.124606200241498368482D-03 w(499) = 0.109085545645741522051D-03 w(500) = 0.944366322532705527066D-04 w(501) = 0.806899228014035293851D-04 w(502) = 0.678774554733972416227D-04 w(503) = 0.560319507856164252140D-04 w(504) = 0.451863674126296143105D-04 w(505) = 0.353751372055189588628D-04 w(506) = 0.266376412339000901358D-04 w(507) = 0.190213681905875816679D-04 w(508) = 0.125792781889592743525D-04 w(509) = 0.736624069102321668857D-05 w(510) = 0.345456507169149134898D-05 w(511) = 0.945715933950007048827D-06 else write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'PATTERSON_SET - Fatal error!' write ( *, '(a)' ) ' Illegal input value of ORDER.' write ( *, '(a)' ) ' Order must be 1, 3, 7, 15, 31, 63, 127, 255 or 511.' stop 1 end if return end subroutine r8mat_write ( output_filename, m, n, table ) !*****************************************************************************80 ! !! R8MAT_WRITE writes an R8MAT file. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 31 May 2009 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character ( len = * ) OUTPUT_FILENAME, the output file name. ! ! Input, integer M, the spatial dimension. ! ! Input, integer N, the number of points. ! ! Input, real ( kind = rk ) TABLE(M,N), the table data. ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer m integer n integer j character ( len = * ) output_filename integer output_status integer output_unit character ( len = 30 ) string real ( kind = rk ) table(m,n) ! ! Open the file. ! call get_unit ( output_unit ) open ( unit = output_unit, file = output_filename, & status = 'replace', iostat = output_status ) if ( output_status /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'R8MAT_WRITE - Fatal error!' write ( *, '(a,i8)' ) ' Could not open the output file "' // & trim ( output_filename ) // '" on unit ', output_unit output_unit = -1 stop 1 end if ! ! Create a format string. ! ! For less precision in the output file, try: ! ! '(', m, 'g', 14, '.', 6, ')' ! if ( 0 < m .and. 0 < n ) then write ( string, '(a1,i8,a1,i8,a1,i8,a1)' ) '(', m, 'g', 24, '.', 16, ')' ! ! Write the data. ! do j = 1, n write ( output_unit, string ) table(1:m,j) end do end if ! ! Close the file. ! close ( unit = output_unit ) return end subroutine rescale ( a, b, n, x, w ) !*****************************************************************************80 ! !! RESCALE rescales a Legendre quadrature rule from [-1,+1] to [A,B]. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 18 October 2009 ! ! Author: ! ! John Burkardt. ! ! Reference: ! ! Andreas Glaser, Xiangtao Liu, Vladimir Rokhlin, ! A fast algorithm for the calculation of the roots of special functions, ! SIAM Journal on Scientific Computing, ! Volume 29, Number 4, pages 1420-1438, 2007. ! ! Parameters: ! ! Input, real ( kind = rk ) A, B, the endpoints of the new interval. ! ! Input, integer N, the order. ! ! Input/output, real ( kind = rk ) X(N), on input, the abscissas for [-1,+1]. ! On output, the abscissas for [A,B]. ! ! Input/output, real ( kind = rk ) W(N), on input, the weights for [-1,+1]. ! On output, the weights for [A,B]. ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer n real ( kind = rk ) a real ( kind = rk ) b real ( kind = rk ) w(n) real ( kind = rk ) x(n) x(1:n) = ( ( a + b ) + ( b - a ) * x(1:n) ) / 2.0D+00 w(1:n) = ( b - a ) * w(1:n) / 2.0D+00 return end subroutine rule_write ( order, x, w, r, filename ) !*****************************************************************************80 ! !! RULE_WRITE writes a quadrature rule to a file. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 18 February 2010 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, integer ORDER, the order of the rule. ! ! Input, real ( kind = rk ) X(ORDER), the abscissas. ! ! Input, real ( kind = rk ) W(ORDER), the weights. ! ! Input, real ( kind = rk ) R(2), defines the region. ! ! Input, character ( len = * ) FILENAME, specifies the output. ! 'filename_w.txt', 'filename_x.txt', 'filename_r.txt' defining weights, ! abscissas, and region. ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer order character ( len = * ) filename character ( len = 255 ) filename_r character ( len = 255 ) filename_w character ( len = 255 ) filename_x real ( kind = rk ) r(2) real ( kind = rk ) w(order) real ( kind = rk ) x(order) filename_w = trim ( filename ) // '_w.txt' filename_x = trim ( filename ) // '_x.txt' filename_r = trim ( filename ) // '_r.txt' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Creating quadrature files.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' "Root" file name is "' // trim ( filename ) // '".' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Weight file will be "' // trim ( filename_w ) // '".' write ( *, '(a)' ) ' Abscissa file will be "' // trim ( filename_x ) // '".' write ( *, '(a)' ) ' Region file will be "' // trim ( filename_r ) // '".' call r8mat_write ( filename_w, 1, order, w ) call r8mat_write ( filename_x, 1, order, x ) call r8mat_write ( filename_r, 1, 2, r ) return end subroutine s_to_i4 ( s, ival, ierror, length ) !*****************************************************************************80 ! !! S_TO_I4 reads an I4 from a string. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 15 January 2008 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character ( len = * ) S, a string to be examined. ! ! Output, integer IVAL, the integer value read from the string. ! If the string is blank, then IVAL will be returned 0. ! ! Output, integer IERROR, an error flag. ! 0, no error. ! 1, an error occurred. ! ! Output, integer LENGTH, the number of characters of S ! used to make IVAL. ! implicit none character c integer i integer ierror integer isgn integer istate integer ival integer length character ( len = * ) s ierror = 0 istate = 0 isgn = 1 ival = 0 do i = 1, len_trim ( s ) c = s(i:i) ! ! Haven't read anything. ! if ( istate == 0 ) then if ( c == ' ' ) then else if ( c == '-' ) then istate = 1 isgn = -1 else if ( c == '+' ) then istate = 1 isgn = + 1 else if ( lle ( '0', c ) .and. lle ( c, '9' ) ) then istate = 2 ival = ichar ( c ) - ichar ( '0' ) else ierror = 1 return end if ! ! Have read the sign, expecting digits. ! else if ( istate == 1 ) then if ( c == ' ' ) then else if ( lle ( '0', c ) .and. lle ( c, '9' ) ) then istate = 2 ival = ichar ( c ) - ichar ( '0' ) else ierror = 1 return end if ! ! Have read at least one digit, expecting more. ! else if ( istate == 2 ) then if ( lle ( '0', c ) .and. lle ( c, '9' ) ) then ival = 10 * ival + ichar ( c ) - ichar ( '0' ) else ival = isgn * ival length = i - 1 return end if end if end do ! ! If we read all the characters in the string, see if we're OK. ! if ( istate == 2 ) then ival = isgn * ival length = len_trim ( s ) else ierror = 1 length = 0 end if return end subroutine s_to_r8 ( s, dval, ierror, length ) !*****************************************************************************80 ! !! S_TO_R8 reads an R8 value from a string. ! ! Discussion: ! ! An "R8" value is simply a real number to be stored as a ! variable of type "real ( kind = rk )". ! ! The routine will read as many characters as possible until it reaches ! the end of the string, or encounters a character which cannot be ! part of the number. ! ! Legal input is: ! ! 1 blanks, ! 2 '+' or '-' sign, ! 2.5 blanks ! 3 integer part, ! 4 decimal point, ! 5 fraction part, ! 6 'E' or 'e' or 'D' or 'd', exponent marker, ! 7 exponent sign, ! 8 exponent integer part, ! 9 exponent decimal point, ! 10 exponent fraction part, ! 11 blanks, ! 12 final comma or semicolon, ! ! with most quantities optional. ! ! Example: ! ! S DVAL ! ! '1' 1.0 ! ' 1 ' 1.0 ! '1A' 1.0 ! '12,34,56' 12.0 ! ' 34 7' 34.0 ! '-1E2ABCD' -100.0 ! '-1X2ABCD' -1.0 ! ' 2E-1' 0.2 ! '23.45' 23.45 ! '-4.2E+2' -420.0 ! '17d2' 1700.0 ! '-14e-2' -0.14 ! 'e2' 100.0 ! '-12.73e-9.23' -12.73 * 10.0^(-9.23) ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 12 January 2009 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, character ( len = * ) S, the string containing the ! data to be read. Reading will begin at position 1 and ! terminate at the end of the string, or when no more ! characters can be read to form a legal real. Blanks, ! commas, or other nonnumeric data will, in particular, ! cause the conversion to halt. ! ! Output, real ( kind = rk ) DVAL, the value read from the string. ! ! Output, integer IERROR, error flag. ! 0, no errors occurred. ! 1, 2, 6 or 7, the input number was garbled. The ! value of IERROR is the last type of input successfully ! read. For instance, 1 means initial blanks, 2 means ! a plus or minus sign, and so on. ! ! Output, integer LENGTH, the number of characters read ! to form the number, including any terminating ! characters such as a trailing comma or blanks. ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) character c logical ch_eqi real ( kind = rk ) dval integer ierror integer ihave integer isgn integer iterm integer jbot integer jsgn integer jtop integer length integer ndig real ( kind = rk ) rbot real ( kind = rk ) rexp real ( kind = rk ) rtop character ( len = * ) s integer s_length character :: TAB = achar ( 9 ) s_length = len_trim ( s ) ierror = 0 dval = 0.0D+00 length = -1 isgn = 1 rtop = 0 rbot = 1 jsgn = 1 jtop = 0 jbot = 1 ihave = 1 iterm = 0 do length = length + 1 if ( s_length < length+1 ) then exit end if c = s(length+1:length+1) ! ! Blank character. ! if ( c == ' ' .or. c == TAB ) then if ( ihave == 2 ) then else if ( ihave == 6 .or. ihave == 7 ) then iterm = 1 else if ( 1 < ihave ) then ihave = 11 end if ! ! Comma. ! else if ( c == ',' .or. c == ';' ) then if ( ihave /= 1 ) then iterm = 1 ihave = 12 length = length + 1 end if ! ! Minus sign. ! else if ( c == '-' ) then if ( ihave == 1 ) then ihave = 2 isgn = -1 else if ( ihave == 6 ) then ihave = 7 jsgn = -1 else iterm = 1 end if ! ! Plus sign. ! else if ( c == '+' ) then if ( ihave == 1 ) then ihave = 2 else if ( ihave == 6 ) then ihave = 7 else iterm = 1 end if ! ! Decimal point. ! else if ( c == '.' ) then if ( ihave < 4 ) then ihave = 4 else if ( 6 <= ihave .and. ihave <= 8 ) then ihave = 9 else iterm = 1 end if ! ! Scientific notation exponent marker. ! else if ( ch_eqi ( c, 'E' ) .or. ch_eqi ( c, 'D' ) ) then if ( ihave < 6 ) then ihave = 6 else iterm = 1 end if ! ! Digit. ! else if ( ihave < 11 .and. lle ( '0', c ) .and. lle ( c, '9' ) ) then if ( ihave <= 2 ) then ihave = 3 else if ( ihave == 4 ) then ihave = 5 else if ( ihave == 6 .or. ihave == 7 ) then ihave = 8 else if ( ihave == 9 ) then ihave = 10 end if call ch_to_digit ( c, ndig ) if ( ihave == 3 ) then rtop = 10.0D+00 * rtop + real ( ndig, kind = rk ) else if ( ihave == 5 ) then rtop = 10.0D+00 * rtop + real ( ndig, kind = rk ) rbot = 10.0D+00 * rbot else if ( ihave == 8 ) then jtop = 10 * jtop + ndig else if ( ihave == 10 ) then jtop = 10 * jtop + ndig jbot = 10 * jbot end if ! ! Anything else is regarded as a terminator. ! else iterm = 1 end if ! ! If we haven't seen a terminator, and we haven't examined the ! entire string, go get the next character. ! if ( iterm == 1 ) then exit end if end do ! ! If we haven't seen a terminator, and we have examined the ! entire string, then we're done, and LENGTH is equal to S_LENGTH. ! if ( iterm /= 1 .and. length+1 == s_length ) then length = s_length end if ! ! Number seems to have terminated. Have we got a legal number? ! Not if we terminated in states 1, 2, 6 or 7! ! if ( ihave == 1 .or. ihave == 2 .or. ihave == 6 .or. ihave == 7 ) then ierror = ihave write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'S_TO_R8 - Serious error!' write ( *, '(a)' ) ' Illegal or nonnumeric input:' write ( *, '(a)' ) ' ' // trim ( s ) stop 1 end if ! ! Number seems OK. Form it. ! if ( jtop == 0 ) then rexp = 1.0D+00 else if ( jbot == 1 ) then rexp = 10.0D+00 ** ( jsgn * jtop ) else rexp = 10.0D+00 ** ( real ( jsgn * jtop, kind = rk ) & / real ( jbot, kind = rk ) ) end if end if dval = real ( isgn, kind = rk ) * rexp * rtop / rbot return end subroutine timestamp ( ) !*****************************************************************************80 ! !! TIMESTAMP prints the current YMDHMS date as a time stamp. ! ! Example: ! ! 31 May 2001 9:45:54.872 AM ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 18 May 2013 ! ! Author: ! ! John Burkardt ! implicit none character ( len = 8 ) ampm integer d 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 integer values(8) integer y call date_and_time ( values = 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 ( *, '(i2.2,1x,a,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) & d, trim ( month(m) ), y, h, ':', n, ':', s, '.', mm, trim ( ampm ) return end