子程序fpclos（iopt，idim，m，u，mx，x，w，k，s，nest，tol，maxit，k1，k2，*n、t、nc、c、fp、fpint、z、a1、a2、b、g1、g2、q、nrdata、ier）c。。c。。标量参数。。实数s、tol、fp整数iopt，idim，m，mx，k，nest，maxit，k1，k2，n，nc，ierc。。数组参数。。实u（m）、x（mx）、w（m），t（嵌套）、c（nc）、fpint（嵌套），z（nc），a1（嵌套，k1），*a2（巢，k），b（巢，k2），g1（巢，k2），g2（巢，k1），q（m，k1）整数nrdata（嵌套）c。。局部标量。。实际acc，cos，d1，fac，fpart，fpms，fpold，fp0，f1，f2，f3，p，per，pinv，piv，*p1、p2、p3、sin、store、term、ui、wi、rn、one、con1、con4、con9、half整数i，ich1，ich3，ij，ik，it，iter，i1，i2，i3，j，jj，jk，jper，j1，j2，kk，*kk1，k3，l，l0，l1，l5，mm，m1，新，nk1，nk2，nmax，nmin，nplus，npl1，*nrint、n10、n11、n7、n8c。。本地阵列。。实h（6）、h1（7）、h2（6）和xi（10）c。。函数引用。。真正的abs，fprati整数max0，min0c。。子程序引用。。c fpbacp、fpbspl、fpgivs、fpdisc、fpknot、fprotac。。c设置常数一个=0.1e+01con1=0.1e0con9=0.9e0con4=0.4e-01一半=0.5e0ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc第1部分：节数及其位置的测定cc******************************c给定一组节点，我们计算最小二乘闭合曲线c sinf（u）。如果和f（p=inf）<=s，我们接受节点的选择。c（c）c如果iopt=-1 sinf（u）是请求的曲线c如果iopt=0或iopt=1，我们检查是否可以接受结：c如果fp<=s，我们将继续使用当前的一组节点。c（c）如果fp>s，我们将增加节数并计算cc相应的最小二乘曲线，直到最终fp<=s.cc节的初始选择取决于s和iopt的值。c（c）c如果s=0，我们有样条插值；在这种情况下，c的数量c节等于nmax=m+2*k。c如果s>0和c我们首先计算c的最小二乘多项式曲线c度k；n=nmin=2*k+2。因为s（u）必须是周期wecc发现s（u）减少到一个不动点。c（c）c iopt=1我们从最后c处发现的结集开始c调用例程，但s>fp0的情况除外；然后是c我们直接计算最小二乘多项式曲线。c（c）ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccm1=m-1kk=kkk1=k1k3=3*k+1nmin=2*k1c确定花键周期的长度。每=u（m）-u（1）如果（iopt.lt.0）转到50c计算acc，f（p）的根的绝对公差=s。acc=公差*sc确定nmax，周期样条插值的节点数nmax=米+2*k如果（s.gt.0。或。nmax.eq.nmin）转到30c如果s=0，s（u）是插值曲线。n=nmax（最大值）c测试所需存储空间是否超过可用存储空间。如果（n.gt.nest）转至620c在插值的情况下找到内部节点的位置。5如果（（k/2）*2.eq.k）转到20做10 i=2，m1j=i+kt（j）=u（i）10继续如果（s＞0.）转到50kk=k-1kk1=k如果（kk.gt.0）转到50t（1）=t（m）-每t（2）=u（1）t（m+1）=u（m）t（m+2）=t（3）+每jj=0做15 i=1，m1j=ido 12 j1=1，idimjj=jj+1c（j）=x（jj）j=j+n12继续15继续jj=1j=米do 17 j1=1，idimc（j）=c（jj）j=j+njj=jj+n17继续fp=0。fpint（n）=fp0fpint（n-1）=0。nrdata（n）=0转到63020乘以25 i=2，m1j=i+kt（j）=（u（i）+u（i-1））*一半25继续转到50如果s>0，我们的初始选择取决于iopt的值。如果iopt=0或iopt=1且s>=fp0，我们开始计算最小二乘c多项式曲线。（即恒定点）。c如果iopt＝1并且fp0＞s，我们开始计算最小平方闭合c曲线根据上次调用时发现的节点集c例程。30如果（iopt.eq.0）转到35如果（n.eq.nmin）转到35fp0=fpint（n）fpold=fpint（n-1）nplus=nrdata（n）如果（fp0.gt.s）转到50c分别处理s（u）是不动点的情况。c fp0表示相应的残差平方和。35 fp0=0。d1=0。做37 j=1，idimz（j）=0。37继续jj=0做45=1，m1wi=w（it）调用fpgivs（wi，d1，cos，sin）do 40 j=1，idimjj=jj+1fac=wi*x（jj）调用fprota（cos，sin，fac，z（j））fp0=fp0+fac**240继续45继续do 47 j=1，idimz（j）=z（j）/d147继续c测试这个不动点是否能解决我们的问题。fpms=fp0-s如果（fpms.lt.acc.或.nmax.eq.nmin），则转到640fpold=fp0c测试所需存储空间是否超过可用存储空间。如果（n.ge.nest）转到620c用一开始计算最小二乘闭合曲线c内部结。nplus=1n=nmin+1毫米=（m+1）/2t（k2）=u（毫米）nrdata（1）=毫米-2nrdata（2）=m1-mmc不同节组的主回路。m是一个save鞋面c限制了试验次数。50 do 340 iter=1，mc找到nrint，即节间距的数量。nrint=n-nmin+1c找到所需的附加结的位置c s（u）的b样条表示。如果我们接受c t（k+1）=u（1），t（n-k）=u（m）c t（k+1-j）=t（n-k-j）-每，j=1,2，。。。k个c t（n-k+j）=t（k+1+j）+per，j=1,2，。。。k个c则s（u）将是一条光滑的闭合曲线，如果b样条c系数满足以下条件c c（（i-1）*n+n7+j）=c（（i-1）*n+j），j=1，。。。k、 i=1,2，。。。，idim（**）c，其中n7=n-2*k-1。t（k1）=u（1）nk1=n-k1nk2=nk1+1t（nk2）=u（m）做60 j=1，ki1=nk2+ji2=nk2-jj1=k1+jj2=k1-jt（i1）=t（j1）+每t（j2）=t（i2）-每60继续计算最小二乘闭合曲线的b样条系数c sinf（u）。观察矩阵a是逐行建立的，而c考虑到条件（**），并简化为三角形c形式通过givens变换。c同时计算fp=f（p=inf）。c n7 x n7三角形上矩阵a的形式为c！a1'！c a=！'a2！c！0 ' !c具有a2an7xk矩阵和a1an10xn10上三角c带矩阵k+1（n10=n7-k）。c初始化。do 65 i=1，ncz（i）＝0。65续做70 i=1，nk1做70 j=1，kk1a1（i，j）=0。70继续n7=nk1-kn10=n7-kkjper=0fp=0。l=k1jj=0做290=1，m1c获取当前数据点u（it），x（it）ui=u（it）wi=w（it）做75 j=1，idimjj=jj+1xi（j）=x（jj）*wi75继续c搜索结间隔t（l）<=ui<t（l+1）。80如果（ui.lt.t（l+1））转到85l=l+1转到80c在ui中计算（k+1）非零b样条并将其存储在q中。85调用fpbspl（t，n，k，ui，l，h）做90 i=1，k1q（it，i）=h（i）h（i）=h（i90继续l5=l-k1c测试b样条是否为nj，k+1（u），j=1+n7，。。。在ui中nk1都为零如果（l5.lt.n10）转到285如果（jper.ne.0）转到160c初始化矩阵a2。做95 i=1，n7do 95 j=1，kka2（i，j）＝0。95继续jk=n10+1做110 i=1，kkik=jkdo 100 j=1，kk1如果（例如le.0），则转到105a2（ik，i）=a1（ik、j）ik=ik-1100继续105焦耳=焦耳+1110继续jper=1c如果b样条之一nj，k+1（u），j=n7+1，。。。ui中nk1不为零c我们考虑了设置新行的条件（**）观测矩阵a的c。此行存储在数组h1中c（相对于a1的部分）和h2（带有c相对于a2）。160做170 i=1，kkh1（i）=0。h2（i）=0。170继续h1（kk1）＝0。j=l5-n10做210 i=1，kk1j=j+1l0=j180 l1=l0-kk如果（l1.le.0）转到200如果（l1.le.n10）转到190l0=l1-n10转到180190小时1（11）=小时（i）转到210200 h2（l0）=h2（10）+h（i）210继续c将观测矩阵的新行旋转为三角形c通过givens变换。如果（n10.le.0）转到250c与第1、2、…行旋转，。。。矩阵a的n10。做240 j=1，n10piv=h1（1）如果（piv.ne.0），请转至214do 212 i=1，kkh1（i）=h1（i+1）212继续h1（kk1）=0。转到240c计算givens变换的参数。214调用fpgivs（piv，a1（j，1），cos，sin）c转换到右侧。j1=jdo 217 j2=1，idim调用fprota（cos，sin，xi（j2），z（j1））j1=j1+n217续c相对于a2的左侧转换。do 220 i=1，kk调用fprota（cos，sin，h2（i），a2（j，i））220继续如果（j.eq.n10）转到250i2=最小值0（n10-j，kk）c相对于a1到左手边的转换。做230 i=1，i2i1=i+1调用fprota（cos，sin，h1（i1），a1（j，i1））h1（i）=h1（i1）230继续h1（i1）=0。240继续c行旋转n10+1，。。。矩阵a的n7。250做270 j=1，kkij=n10+j如果（ij.le.0）转到270piv=h2（j）如果（piv.eq.0）转至270c计算givens变换的参数。调用fpgivs（piv，a2（ij，j），cos，sin）c转换到右侧。j1=ijdo 255 j2=1，idim调用fprota（cos，sin，xi（j2），z（j1））j1=j1+n255续如果（j.eq.kk）转到280j1=j+1c到左手边的转换。do 260 i=j1，kk调用fprota（cos，sin，h2（i），a2（ij，i））260继续270继续c将此行对残差平方和的贡献相加c右侧。280做282 j2=1，idimfp=fp+xi（j2）**2282续转到290c将观测矩阵的新行旋转为b样条曲线nj，k+1（u），j=n7+1，。。。n-k-1均为零用户界面上的c。285焦耳=15做140 i=1，kk1j=j+1piv=h（i）如果（piv.eq.0）转至140c计算givens变换的参数。调用fpgivs（piv，a1（j，1），cos，sin）c转换到右侧。j1=jdo 125 j2=1，idim调用fprota（cos，sin，xi（j2），z（j1））j1=j1+n125续如果（例如kk1）转到150i2=1i3=i+1c到左手边的转换。做130 i1=i3，kk1i2=i2+1调用fprota（cos，sin，h（i1），a1（j，i2））130继续140继续c将此行的贡献与残差平方和相加c右侧。150 do 155 j2=1，idimfp=fp+xi（j2）**2155续290继续fpint（n）=fp0fpint（n-1）=fpoldnrdata（n）=净现值c向后代换得到b样条系数。j1=1do 292 j2=1，idim调用fpbacp（a1，a2，z（j1），n7，kk，c（j1，kk1，nest）j1=j1+n292续c根据条件（**）计算剩余系数。做297 i=1，kj1=ido 295 j=1，idimj2=j1+n7c（j2）=c（j1）j1=j1+n295续297续如果（iopt.lt.0）转到660c检验近似sinf（u）是否是可接受的解。fpms=fp-s如果（abs（fpms）.lt.acc）转到660c如果f（p=inf）<s接受节的选择。如果（fpms.lt.）转到350c如果n=nmax，sinf（u）是插值曲线。如果（n.eq.nmax）转至630c增加节数。c如果n=嵌套，我们不能增加节数，因为c存储容量限制。如果（n.eq.nest）转至620c决定我们要添加的节点数nplus。npl1=nplus*2rn=净现值如果（fpold-fp.gt.acc）npl1=rn*fpms/（fpold-fp）nplus=最小0（nplus*2，最大0（npl1，nplus/2,1））fpold=fpc计算每个结间隔的平方残差之和c t（j+k）<=ui<=t（j+k+1）并将其存储在fpint（j）中，j=1,2，。。。编号：。fpart=0。i=1l=k1jj=0做320 it=1，m1如果（u（it）.lt.t（l））转到300新=1l=l+1300项=0。l0=l-k2do 310 j2=1，idimfac=0。j1=l0do 305 j=1，k1j1=j1+1fac=fac+c（j1）*q（it，j）305继续jj=jj+1术语=术语+（w（it）*（fac-x（jj）））**2l0=l0+n310继续fpart=fpart+术语如果（new.eq.0）转至320如果（l.gt.k2）转到315fpint（nrint）=术语新=0转到320315商店=学期*半学期fpint（i）=fpart-storei=i+1fpart=存储新=0320继续fpint（nrint）=fpint（n rint）+fpartdo 330 l=1，净现值c添加新结调用fpknot（u，m，t，n，fpint，nrdata，nrint，nest，1）c如果n=nmax，我们将节点定位为插值如果（n.eq.nmax）转至5c测试我们是否不能进一步增加节数。如果（n.eq.nest）转到340330继续c使用新的一组节点重新开始计算。340续ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc第2部分：光滑闭合曲线sp（u）的确定。c（c）c******************************c我们已经确定了节数及其位置。c（c）我们现在计算平滑曲线c的b样条系数c sp（u）。观测矩阵a被矩阵c的行所扩展c b表示sp（u）在c处的k阶导数不连续性c内部节点t（k+2），。。。t（n-k-1）必须为零。corres-cc这些附加行的积水重量设置为1/p。c然后我们必须迭代地确定p的值，这样f（p），cc残差的平方和be＝s。我们已经知道最小cc平方多项式曲线对应于p=0，且最小cc平方周期样条曲线对应于p=无穷大。c这里提出的c迭代过程利用了rational cc插值。因为f（p）是凸的且严格递减的cp的c函数，它可以近似为有理函数cc r（p）=（u*p+v）/（p+w）。p（p1，p2，p3）的三个值与对应的-c使用f（p）（f1=f（p1）-s，f2=f（p2）-s、f3=f（p3）-s）的cing值cc计算p的新值，使r（p）=s。收敛为cc通过取f1>0和f3<0来保证。c（c）ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc计算的k阶导数的不连续跳跃c节点t（l）处的b样条曲线，l=k+2，。。。n-k-1并存储在b中。350呼叫fpdisc（t，n，k2，b，nest）c p的初始值。p1=0。f1=fp0-sp3=-1f3=帧/分钟n11=n10-1n8=n7-1p=0。l=n7做352 i=1，kj=k+1-ip=p+a2（l，j）l=l-1如果（l.eq.0）转至356352续做354 i=1，n10p=p+a1（i，1）354续356转=n7p=转/转ich1=0ich3=0c迭代过程以找到f（p）=s的根。do 595 iter=1，最大值c将矩阵g表示为矩阵a，由矩阵b的行扩展。c将权重为1/p的矩阵b的行旋转为c三角形观测矩阵a。c三角化后，我们的n7 x n7矩阵g采用以下形式c！g1'！c g=！'g2！c！0 ' !c具有g2an7x（k+1）矩阵和g1an11xn11上三角c带宽矩阵k+2。（n11=n7-k-1）pinv=一个/pc将矩阵a存储到g中做358 i=1，ncc（i）=z（i）358续做360 i=1，n7g1（i，k1）=a1（i，k1）g1（i，k2）=0。g2（i，1）=0。做360 j=1，kg1（i，j）=a1（i、j）g2（i，j+1）=a2（i、j）360继续l=n10do 370 j=1，k1如果（l.le.0），则转到375g2（l，1）=a1（l，j）l=l-1370继续375乘以540=1，n8c获取矩阵b的新行并将其存储在数组h1中（该部分c相对于g1）和h2（相对于g2的部分）。do 380 j=1，idimxi（j）=0。380续do 385 i=1，k1h1（i）=0。h2（i）=0。385续h1（k2）=0。如果（it.gt.n11）转到420l=它l0=它做390 j=1，k2如果（l0.eq.n10）转到400h1（j）=b（it，j）*pinvl0=l0+1390继续转到470400 l0=1do 410 l1=j，k2h2（l0）=b（it，l1）*pinvl0=l0+1410继续转到470420升=1i=it-n10do 460 j=1，k2i=i+1l0=i430 l1=l0-k1如果（l1.le.0）转到450如果（l1.le.n11）转到440l0=l1-n11转到430440 h1（l1）=b（it，j）*pinv转到460450 h2（l0）=h2（10）+b（it，j）*pinv460续如果（n11.le.0）转到510c通过givens变换将此行旋转为三角形c旋转行l，l+1，。。。第11页。470乘以500 j=l，n11piv=h1（1）c计算givens变换的参数。调用fpgivs（piv，g1（j，1），cos，sin）c转换到右侧。j1=jdo 475 j2=1，idim调用fprota（cos，sin，xi（j2），c（j1））j1=j1+n475续c相对于g2的左侧转换。do 480 i=1，k1调用fprota（cos，sin，h2（i），g2（j，i））480继续如果（j.eq.n11）转到510i2=最小值0（n11-j，k1）c相对于g1的左侧转换。做490 i=1，i2i1=i+1调用fprota（cos，sin，h1（i1），g1（j，i1））h1（i）=h1（i1）490继续h1（i1）=0。500（续）c行旋转n11+1，。。。第7名510乘以530 j=1，k1ij=n11+j如果（ij.le.0）转到530piv=h2（j）c计算givens变换的参数调用fpgivs（piv，g2（ij，j），cos，sin）c转换到右侧。j1=ijdo 515 j2=1，idim调用fprota（cos，sin，xi（j2），c（j1））j1=j1+n515续如果（j.eq.k1）转到540j1=j+1c转换到左侧。do 520 i=j1，k1调用fprota（cos，sin，h2（i），g2（ij，i））520继续530继续540续c向后代换获得b样条系数j1=1do 542 j2=1，idim调用fpbacp（g1，g2，c（j1），n7，k1，c（j1），k2，嵌套）j1=j1+n542续c根据条件（**）计算剩余的b样条系数。做547 i=1，kj1=ido 545 j=1，idimj2=j1+n7c（j2）=c（j1）j1=j1+n545续547续c计算f（p）。fp=0。l=k1jj=0做570它=1，m1如果（u（it）.lt.t（l））转到550l=l+1550 l0=l-k2术语=0。do 565 j2=1，idimfac=0。j1=l0do 560 j=1，k1j1=j1+1fac=fac+c（j1）*q（it，j）560继续jj=jj+1术语=术语+（fac-x（jj））**2l0=l0+n565续fp=fp+术语*w（it）**2570继续c检验近似值sp（u）是否是可接受的解。fpms=fp-s如果（abs（fpms）.lt.acc）转到660c测试是否达到最大迭代次数。如果（iter.eq.maxit）转到600c执行迭代过程的另一个步骤。p2=pf2=英尺/分钟如果（ich3.ne.0）转到580如果（（f2-f3）.gt.acc）转至575c我们最初选择的p太大了。p3=p2f3=f2p=p*con4如果（p.le.p1）p=p1*con9+p2*con1转到595575如果（f2.lt.）ich3=1580如果（ich1.ne.0）转到590如果（（f1-f2）.gt.acc）转到585c我们最初选择的p太小p1=p2f1=f2p=p/con4如果（p3.lt.0.）转至595如果（p.ge.p3）p=p2*con1+p3*con9转到595585如果（f2.gt.0.）ich1=1c测试迭代过程是否按照理论进行应为c。590如果（f2.ge.f1.或.f2.le.f3）转至610c找到p的新值。p=fprati（p1、f1、p2、f2、p3、f3）595续c错误代码和消息。600 ier=3转到660610 ier=2转到660620 ier=1转到660630 ier=-1转到660640 ier=-2c点（z（1），z（2），。。。，z（idim））是我们问题的解决方案。c一个常数函数是一个k次的样条曲线，具有所有的b样条c系数等于该常数。do 650 i=1，k1rn=k1-it（i）=u（1）-rn*perj=i+k1rn=i-1t（j）=u（m）+rn*每650继续n=分钟j1=0do 658 j=1，idimfac=z（j）j2=j1do 654 i=1，k1j2=j2+1c（j2）=fac654续j1=j1+n658续fp=fp0fpint（n）=fp0fpint（n-1）=0。nrdata（n）=0660返回结束