1c-----------------------------------------------------------------------
2c
3c  R : A Computer Language for Statistical Data Analysis
4c  Copyright (C) 1998-2016 The R Core Team
5c
6c  This program is free software; you can redistribute it and/or modify
7c  it under the terms of the GNU General Public License as published by
8c  the Free Software Foundation; either version 2 of the License, or
9c  (at your option) any later version.
10c
11c  This program is distributed in the hope that it will be useful,
12c  but WITHOUT ANY WARRANTY; without even the implied warranty of
13c  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14c  GNU General Public License for more details.
15c
16c  You should have received a copy of the GNU General Public License
17c  along with this program; if not, a copy is available at
18c  https://www.R-project.org/Licenses/
19c
20c-----------------------------------------------------------------------
21
22C Called from R's smooth.spline in ../R/smspline.R  as .Fortran(C, ..)
23C    and from C's
24
25C An interface to sbart() --- fewer arguments BUT unspecified scrtch() dimension
26C
27C NB: this routine alters ws [and isetup].
28C renamed for safety
29C
30      subroutine rbart(penalt,dofoff,xs,ys,ws,ssw,n,knot,nk,
31     &     coef,sz,lev,
32     &     crit,iparms,spar,parms,
33     &     scrtch, ld4,ldnk,ier)
34c Args:
35      integer n,nk, iparms(4), ld4,ldnk,ier
36      double precision penalt,dofoff, xs(n),ys(n),ws(n), ssw,
37     &     knot(nk+4), coef(nk), sz(n), lev(n),
38     &     crit, spar, parms(5),
39     &     scrtch(*)
40C          ^^^^^^^^ dimension (9+2*ld4+ldnk)*nk = (17 + 1)*nk [last nk never accessed]
41c Vars:
42      integer isetup
43
44      if(iparms(4) .eq. 1) then ! spar is lambda
45         isetup = 2
46      else
47         isetup = 0
48      endif
49      call sbart(penalt,dofoff,xs,ys,ws,ssw,n,knot,nk,
50     &     coef,sz,lev, crit,
51     &     iparms(1),spar,iparms(2),iparms(3),
52c          = icrit   spar   ispar    iter
53     &     parms(1),parms(2),parms(3),parms(4),parms(5),
54c          = lspar   uspar    tol      eps      ratio
55     &     isetup, scrtch(1),
56c          = 0|2    xwy  == X'W y
57     &     scrtch(  nk+1),scrtch(2*nk+1),scrtch(3*nk+1),scrtch(4*nk+1),
58c          =   hs0	      hs1	     hs2	    hs3		==> X'W X
59     &     scrtch(5*nk+1),scrtch(6*nk+1),scrtch(7*nk+1),scrtch(8*nk+1),
60c          =   sg0	      sg1	     sg2	    sg3		==> SIGMA
61     &     scrtch(9*nk+1),
62c          =   abd [ld4 x nk]						==> R
63     &     scrtch(9*nk+ ld4*nk+1), scrtch(9*nk+2*ld4*nk+1),
64c          =   p1ip[ld4 x nk]          p2ip [ldnk x nk]
65     &     ld4,ldnk,ier)
66
67      return
68      end
69