subroutine mth_init
  call message(6,1,'MTH_INIT','Using NAG library')
end subroutine mth_init
!
subroutine mth_fitspl (name, nd, nk8, x, y, w, ks,   &
    wk1, wk2, cs, ss, error)
  character(len=*) :: name          !
  integer :: nd                     !
  integer :: nk8                    !
  real*8 :: x(nd)                   !
  real*8 :: y(nd)                   !
  real*8 :: w(nd)                   !
  real*8 :: ks(nk8)                 !
  real*8 :: wk1(nd)                 !
  real*8 :: wk2(4,nk8)              !
  real*8 :: cs(nk8)                 !
  real*8 :: ss                      !
  logical :: error                  !
  ! Local
  integer :: ifail, i
  character(len=60) :: chain
  !
  ! Fit splines
  ifail = 1
  error = .false.
  call e02baf(nd, nk8, x, y, w, ks, wk1, wk2, cs,   &
    ss, ifail)
  if (ifail.eq.5) then
    error = .true.
    call message(8,4,name,'Too many breaks')
    write(chain,*) 'Using ',nk8, ' breaks :'
    call message(4,1,name,chain)
    do i=1, nk8
      write(chain,*) i,' at ',ks(i+4)
      call message(4,1,name,chain)
    enddo
    error = .true.
  elseif (ifail.ne.0) then
    call mth_fail (name,'MTH_FITSPL',ifail,error)
  endif
end subroutine mth_fitspl
!
subroutine mth_fitpol(name,nd,ipol,m_pol,xxx,yyy,www,   &
    wk1,wk3,apol,spol,error)
  character(len=*) :: name          !
  integer :: nd                     !
  integer :: ipol                   !
  integer :: m_pol                  !
  real*8 :: xxx(nd)                 !
  real*8 :: yyy(nd)                 !
  real*8 :: www(nd)                 !
  real*8 :: wk1(3*nd)               !
  real*8 :: wk3(2*ipol)             !
  real*8 :: apol(m_pol,ipol)        !
  real*8 :: spol(ipol)              !
  logical :: error                  !
  ! Local
  integer :: ifail
  !
  call e02adf(nd,ipol,m_pol,xxx,yyy,www,wk1,wk3,   &
    apol,spol,ifail)
  call mth_fail (name,'MTH_FITPOL',ifail,error)
end subroutine mth_fitpol
!
subroutine mth_getspl(name,nk8, ks, cs, xx, yy, error)
  character(len=*) :: name          !
  integer :: nk8                    !
  real*8 :: ks(nk8)                 !
  real*8 :: cs(nk8)                 !
  real*8 :: xx                      !
  real*8 :: yy                      !
  logical :: error                  !
  ! Local
  integer :: ifail
  !
  call e02bbf(nk8, ks, cs, xx, yy, ifail)
  call nag_fail (name,'MTH_GETSPL',ifail,error)
end subroutine mth_getspl
!
subroutine mth_getspd(name,nk8, ks, cs, xx, left, yy, error)
  character(len=*) :: name          !
  integer :: nk8                    !
  real*8 :: ks(nk8)                 !
  real*8 :: cs(nk8)                 !
  real*8 :: xx                      !
  integer :: left                   !
  real*8 :: yy(4)                   !
  logical :: error                  !
  ! Local
  integer :: ifail
  !
  call e02bcf(nk8, ks, cs, xx, left, yy, ifail)
  call nag_fail (name,'MTH_GETSPD',ifail,error)
end subroutine mth_getspd
!
subroutine mth_getpol(name,ipol,aa,xx,yy,error)
  character(len=*) :: name          !
  integer :: ipol                   !
  real*8 :: aa(ipol)                !
  real*8 :: xx                      !
  real*8 :: yy                      !
  logical :: error                  !
  ! Local
  integer :: ifail
  !
  call e02aef(ipol,aa,xx,yy,ifail)
  call mth_fail (name,'MTH_GETPOL',ifail,error)
end subroutine mth_getpol
!
subroutine mth_fail (fac,prog,ifail,error)
  character(len=*) :: fac           !
  character(len=*) :: prog          !
  integer :: ifail                  !
  logical :: error                  !
  ! Local
  character(len=60) :: chain
  !
  if (ifail.eq.0) then
    error = .false.
  else
    write(chain,'(A,A,A,I4)')   &
      'ERROR in ',prog,', ifail = ',ifail
    call message(8,4,fac,chain)
    error = .true.
  endif
end subroutine mth_fail
!
subroutine mth_fitlin (name,ndd,nvar,a,b,nd,sigma)
  character(len=*) :: name          !
  integer :: ndd                    !
  integer :: nvar                   !
  integer :: nd                     !
  real*8 :: a(nd,nvar)              !
  real*8 :: b(nd)                   !
  real*8 :: sigma                   !
  ! Local
  logical :: error
  !
  integer :: mvar
  parameter (mvar=10)          ! 7 is required for baseline fit.
  integer :: ifail, irank, lwork
  parameter (lwork = 4*mvar)
  real*8 :: work(lwork), work2(mvar)
  !
  ifail = 1
  call f04jaf(ndd,nvar,a,nd,b,1d-5,sigma,irank,work,lwork,   &
    ifail)
  call mth_fail(name,'MTH_FILIN (fit)',ifail,error)
  ifail = 1
  call f04yaf(-1,nvar,sigma,a,nd,.true.,irank,work,work2,work2,   &
    ifail)
  call mth_fail(name,'MTH_FILIN (fit)',ifail,error)
end subroutine mth_fitlin
!
subroutine mth_dpotrf (name, uplo, n, a, lda, error)
  character(len=*) :: name           !
  character(len=*) :: uplo           !
  integer :: n                       !
  integer :: lda                     !
  real*8 :: a(lda,*)                 !
  logical :: error                   !
  ! Local
  integer :: info
  !
  ! Call NAG routine
  call f07fdf (uplo, n, a, lda, info )
  call mth_fail(name,'MTH_DPOTRF',info,error)
end subroutine mth_dpotrf
!
subroutine mth_dpotrs (name,   &
    uplo, n, nrhs, a, lda, b, ldb, info )
  character(len=*) :: name           !
  character(len=*) :: uplo           !
  integer :: n                       !
  integer :: nrhs                    !
  integer :: lda                     !
  real*8 :: a(lda,*)                 !
  integer :: ldb                     !
  real*8 :: b(ldb,*)                 !
  ! Local
  integer :: info
  logical :: error
  !
  ! Call NAG routine
  call f07fef( uplo, n, nrhs, a, lda, b, ldb, info )
  call mth_fail(name,'MTH_DPOTRF',info,error)
end subroutine mth_dpotrs
!
subroutine mth_dpbtrf (name, uplo, n, kd, ab, ldab, error)
  character(len=*) :: name             !
  character(len=*) :: uplo             !
  integer :: n                         !
  integer :: kd                        !
  integer :: ldab                      !
  real*8 :: ab(ldab,*)                 !
  logical :: error                     !
  ! Local
  integer :: info
  !
  ! Call NAG
  call f07hdf( uplo, n, kd, ab, ldab, info )
  call mth_fail(name,'MTH_DPBTRF',info,error)
end subroutine mth_dpbtrf
!
subroutine mth_dpbtrs (name,   &
    uplo, n, kd, nrhs, ab, ldab, b, ldb, error)
  character(len=*) :: name             !
  character(len=*) :: uplo             !
  integer :: n                         !
  integer :: kd                        !
  integer :: nrhs                      !
  integer :: ldab                      !
  real*8 :: ab(ldab,*)                 !
  integer :: ldb                       !
  real*8 :: b(ldb,*)                   !
  logical :: error                     !
  ! Local
  integer :: info
  !
  ! Call LAPACK
  call f07hef( uplo, n, kd, nrhs, ab, ldab, b, ldb, info )
  call mth_fail(name,'MTH_DPBTRS',info,error)
end subroutine mth_dpbtrs
!
function mth_bessj0 (x)
  !---------------------------------------------------------------------
  ! Compute Bessel function J0
  !---------------------------------------------------------------------
  real*8 :: mth_bessj0              !
  real*8 :: x                       !
  ! Local
  real*8 :: s17aef
  integer :: ifail
  !
  ifail = 0
  mth_bessj0 = s17aef(x,ifail)
end function mth_bessj0
!
function mth_bessj1 (x)
  !---------------------------------------------------------------------
  ! Compute Bessel function J1
  !---------------------------------------------------------------------
  real*8 :: mth_bessj1              !
  real*8 :: x                       !
  ! Local
  real*8 :: s17aff
  integer :: ifail
  !
  ifail = 0
  mth_bessj1 = s17aff(x,ifail)
end function mth_bessj1
!
subroutine mth_bessjn (x,j,n)
  !---------------------------------------------------------------------
  ! Compute Bessels functions from J1 to Jn
  !---------------------------------------------------------------------
  real*8 :: x                       !
  integer :: n                      !
  real*8 :: j(n)                    !
  ! Local
  integer :: i
  !
  ! Unefficient implementation, if you don't care
  !      REAL*8 MTH_BESSJ1,MTH_BESSJ
  !      J(1) = MTH_BESSJ1(X)
  !      DO I=2,N
  !         J(I) = MTH_BESSJ(I,X)
  !      ENDDO
  !      RETURN
  !
  ! NAG version
  integer m
  parameter (m=16)
  complex*16 z,jj(m)
  integer ifail
  !
  if (n.gt.m) then
    ifail = 6
  else
    z = cmplx(x,0d0)
    ifail = 0
    call s17def(1.d0,z,2,'U',jj,2,ifail)
    do i=1,n
      !            J(I) = REAL(JJ(I))
      j(i) = dble(jj(i))
    enddo
  endif
end subroutine mth_bessjn
