subroutine newton_coef_1d ( nd, xd, yd, cd ) !*****************************************************************************80 ! !! NEWTON_COEF_1D computes coefficients of a Newton 1D interpolant. ! ! Licensing: ! ! This code is distributed under the GNU LGPL license. ! ! Modified: ! ! 05 July 2015 ! ! Author: ! ! John Burkardt ! ! Reference: ! ! Carl deBoor, ! A Practical Guide to Splines, ! Springer, 2001, ! ISBN: 0387953663, ! LC: QA1.A647.v27. ! ! Parameters: ! ! Input, integer ( kind = 4 ) ND, the number of data points. ! ! Input, real ( kind = 8 ) XD(ND), the X values at which data was taken. ! ! Input, real ( kind = 8 ) YD(ND), the corresponding Y values. ! ! Output, real ( kind = 8 ) CD(ND), the divided difference coefficients. ! implicit none integer ( kind = 4 ) nd real ( kind = 8 ) cd(nd) integer ( kind = 4 ) i integer ( kind = 4 ) j real ( kind = 8 ) xd(nd) real ( kind = 8 ) yd(nd) ! ! Copy the data values. ! cd(1:nd) = yd(1:nd) ! ! Compute the divided differences. ! do i = 2, nd do j = nd, i, -1 cd(j) = ( cd(j) - cd(j-1) ) / ( xd(j) - xd(j+1-i) ) end do end do return end subroutine newton_value_1d ( nd, xd, cd, ni, xi, yi ) !*****************************************************************************80 ! !! NEWTON_VALUE_1D evaluates a Newton 1D interpolant. ! ! Licensing: ! ! This code is distributed under the GNU LGPL license. ! ! Modified: ! ! 05 July 2015 ! ! Author: ! ! John Burkardt ! ! Reference: ! ! Carl deBoor, ! A Practical Guide to Splines, ! Springer, 2001, ! ISBN: 0387953663, ! LC: QA1.A647.v27. ! ! Parameters: ! ! Input, integer ( kind = 4 ) ND, the order of the difference table. ! ! Input, real ( kind = 8 ) XD(ND), the X values of the difference table. ! ! Input, real ( kind = 8 ) CD(ND), the divided differences. ! ! Input, integer ( kind = 4 ) NI, the number of interpolation points. ! ! Input, real ( kind = 8 ) XI(NI), the interpolation points. ! ! Output, real ( kind = 8 ) YI(NI), the interpolation values. ! implicit none integer ( kind = 4 ) nd integer ( kind = 4 ) ni real ( kind = 8 ) cd(nd) integer ( kind = 4 ) i real ( kind = 8 ) xd(nd) real ( kind = 8 ) xi(ni) real ( kind = 8 ) yi(ni) yi(1:ni) = cd(nd) do i = nd - 1, 1, -1 yi(1:ni) = cd(i) + ( xi(1:ni) - xd(i) ) * yi(1:ni) end do return end subroutine r8vec_print ( n, a, title ) !*****************************************************************************80 ! !! R8VEC_PRINT prints an R8VEC. ! ! Discussion: ! ! An R8VEC is a vector of R8's. ! ! Licensing: ! ! This code is distributed under the GNU LGPL license. ! ! Modified: ! ! 22 August 2000 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, integer ( kind = 4 ) N, the number of components of the vector. ! ! Input, real ( kind = 8 ) A(N), the vector to be printed. ! ! Input, character ( len = * ) TITLE, a title. ! implicit none integer ( kind = 4 ) n real ( kind = 8 ) a(n) integer ( kind = 4 ) i character ( len = * ) title write ( *, '(a)' ) ' ' write ( *, '(a)' ) trim ( title ) write ( *, '(a)' ) ' ' do i = 1, n write ( *, '(2x,i8,a,1x,g16.8)' ) i, ':', a(i) end do return end subroutine r8vec2_print ( n, a1, a2, title ) !*****************************************************************************80 ! !! R8VEC2_PRINT prints an R8VEC2. ! ! Discussion: ! ! An R8VEC2 is a dataset consisting of N pairs of R8's, stored ! as two separate vectors A1 and A2. ! ! Licensing: ! ! This code is distributed under the GNU LGPL license. ! ! Modified: ! ! 13 December 2004 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, integer ( kind = 4 ) N, the number of components of the vector. ! ! Input, real ( kind = 8 ) A1(N), A2(N), the vectors to be printed. ! ! Input, character ( len = * ) TITLE, a title. ! implicit none integer ( kind = 4 ) n real ( kind = 8 ) a1(n) real ( kind = 8 ) a2(n) integer ( kind = 4 ) i character ( len = * ) title write ( *, '(a)' ) ' ' write ( *, '(a)' ) trim ( title ) write ( *, '(a)' ) ' ' do i = 1, n write ( *, '(2x,i4,2x,g14.6,2x,g14.6)' ) i, a1(i), a2(i) end do 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 GNU LGPL license. ! ! Modified: ! ! 18 May 2013 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! None ! implicit none character ( len = 8 ) ampm integer ( kind = 4 ) d integer ( kind = 4 ) h integer ( kind = 4 ) m integer ( kind = 4 ) mm character ( len = 9 ), parameter, dimension(12) :: month = (/ & 'January ', 'February ', 'March ', 'April ', & 'May ', 'June ', 'July ', 'August ', & 'September', 'October ', 'November ', 'December ' /) integer ( kind = 4 ) n integer ( kind = 4 ) s integer ( kind = 4 ) values(8) integer ( kind = 4 ) 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,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