l2err Subroutine

subroutine l2err ( iprfun, ftau, error )

  !*****************************************************************************80
  !
  !! L2ERR computes the errors of an L2 approximation.
  !
  !  Discussion:
  !
  !    This routine computes various errors of the current L2 approximation, 
  !    whose piecewise polynomial representation is contained in common 
  !    block APPROX, to the given data contained in common block DATA.  
  !
  !    It prints out the average error ERRL1, the L2 error ERRL2, and the
  !    maximum error ERRMAX.
  !
  !  Modified:
  !
  !    16 February 2007
  !
  !  Author:
  !
  !    Carl DeBoor
  !
  !  Reference:
  !
  !    Carl DeBoor,
  !    A Practical Guide to Splines,
  !    Springer, 2001,
  !    ISBN: 0387953663,
  !    LC: QA1.A647.v27.
  !
  !  Parameters: 
  !
  !    Input, integer ( kind = 4 ) IPRFUN.  If IPRFUN = 1, the routine prints out
  !    the value of the approximation as well as its error at
  !    every data point.
  !
  !    Output, real ( kind = 8 ) FTAU(NTAU), contains the value of the computed
  !    approximation at each value TAU(1:NTAU).
  !
  !    Output, real ( kind = 8 ) ERROR(NTAU), with 
  !      ERROR(I) = SCALE * ( G - F )(TAU(I)).  Here, SCALE equals 1
  !    in case IPRFUN /= 1, or the absolute error is greater than 100 
  !    somewhere.  Otherwise, SCALE is such that the maximum of the
  !    absolute value of ERROR(1:NTAU) lies between 10 and 100.  This
  !    makes the printed output more illustrative.
  !
  implicit none

  integer ( kind = 4 ), parameter :: lpkmax = 100
  integer ( kind = 4 ), parameter :: ntmax = 200
  integer ( kind = 4 ), parameter :: ltkmax = 2000

  integer ( kind = 4 ) ntau

  real ( kind = 8 ) break
  real ( kind = 8 ) coef
  real ( kind = 8 ) err
  real ( kind = 8 ) errl1
  real ( kind = 8 ) errl2
  real ( kind = 8 ) errmax
  real ( kind = 8 ) error(ntau)
  real ( kind = 8 ) ftau(ntau)
  real ( kind = 8 ) gtau
  integer ( kind = 4 ) ie
  integer ( kind = 4 ) iprfun
  integer ( kind = 4 ) k
  integer ( kind = 4 ) l
  integer ( kind = 4 ) ll
  real ( kind = 8 ) ppvalu
  real ( kind = 8 ) scale
  real ( kind = 8 ) tau
  real ( kind = 8 ) totalw
  real ( kind = 8 ) weight

  save / approx /
  save / i4data /
  save / r8data /

  common / approx / break(lpkmax), coef(ltkmax), l, k
  common / i4data / ntau
  common / r8data / tau(ntmax), gtau(ntmax), weight(ntmax), totalw

  errl1 = 0.0D+00
  errl2 = 0.0D+00
  errmax = 0.0D+00

  do ll = 1, ntau

     ftau(ll) = ppvalu ( break, coef, l, k, tau(ll), 0 )

     error(ll) = gtau(ll) - ftau(ll)
     err = abs(error(ll))

     if ( errmax < err ) then
        errmax = err
     end if

     errl1 = errl1 + err * weight(ll)
     errl2 = errl2 + err**2 * weight(ll)

  end do

  errl1 = errl1 / totalw
  errl2 = sqrt ( errl2 / totalw )

  write ( *, '(a)' ) ' '
  write ( *, '(a,g14.6)' ) '  Least square error = ', errl2
  write ( *, '(a,g14.6)' ) '  Average error      = ', errl1
  write ( *, '(a,g14.6)' ) '  Maximum error      = ', errmax
  write ( *, '(a)' ) ' '

  if ( iprfun /= 1 ) then
     return
  end if
  !
  !  Scale error curve and print.
  !
  ie = 0
  scale = 1.0D+00

  if ( errmax < 10.0D+00 ) then

     do ie = 1, 9
        scale = scale * 10.0D+00
        if ( 10.0D+00 <= errmax * scale ) then
           exit
        end if
     end do

  end if

  error(1:ntau) = error(1:ntau) * scale

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Approximation and scaled error curve'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i1)' ) &
       '       Data point       Approximation   Deviation x 10**', ie
  write ( *, '(a)' ) ' '
  write ( *, '(i4,f16.8,f16.8,f17.6)' ) &
       ( ll, tau(ll), ftau(ll), error(ll), ll = 1, ntau )

  return
end subroutine l2err