c program DRSSFIT c>> 1996-07-03 DRSSFIT Krogh Special code for C conversion. c>> 1996-06-19 DRSSFIT Krogh Changes in formats for C conversion. c>> 1996-05-28 DRSSFIT Krogh Added external & removed Fortran 90 syntax c>> 1994-10-19 DRSSFIT Krogh Changes to use M77CON c>> 1992-11-18 DRSSFIT CLL Changed order of arguments in SSFIT. c>> 1992-10-29 C. L. Lawson, JPL c Demonstration driver for SSFIT, SSVAL, SSQUAD, SSTOP, SPVAL, SPQUAD c ------------------------------------------------------------------ c--S replaces "?": DR?SFIT, ?SFIT, ?SVAL, ?SQUAD, ?STOP, ?PVAL, ?PQUAD c--& ?PRPL c ------------------------------------------------------------------ c++ Code for .C. is inactive c%% long int k; c++ End integer I, IERR, NXY, KORDER, MPC, NCOEF, NDERIV, NPC, NT, LDW parameter(NXY = 12, NCOEF=8, KORDER=4, NT = NCOEF+KORDER,LDW = 10) parameter(MPC = NCOEF-KORDER+1) external SSVAL, SSQUAD, SPVAL, SPQUAD real BDIF(NCOEF*KORDER), SSVAL, SSQUAD, SPVAL, SPQUAD real BCOEF(NCOEF), PCOEF(MPC*KORDER) real SD(1), SIGFAC, TKNOTS(NT), W(LDW,KORDER+1) real X(NXY), XI(MPC+1), Y(NXY), YFIT, Z character IMAGE*31 data X / 2.E0, 4.E0, 6.E0, 8.E0,10.E0,12.E0, * 14.E0,16.E0,18.E0,20.E0,22.E0,24.E0/ data Y /2.2E0,4.0E0,5.0E0,4.6E0,2.8E0,2.7E0, * 3.8E0,5.1E0,6.1E0,6.3E0,5.0E0,2.0E0/ data TKNOTS / 4*2.0E0, 6.4E0, 10.8E0, 15.2E0, 19.6E0, 4*24.0E0 / data NDERIV / 0 / data SD(1) / -1.0E0 / c ------------------------------------------------------------------ print'('' DRSSFIT''/ '' Demo driver for SSFIT, SSVAL, SSQUAD,'', * '' SSTOP, SPVAL, SPQUAD'')' print'(/'' KORDER ='',i3,'', NCOEF ='',i3)', KORDER, NCOEF c++ Code for ~.C. is active print'('' TKNOTS() = '',4f10.5/(14x,4f10.5))', * (TKNOTS(I), I = 1, NT) c++ Code for .C. is inactive c%% printf( "\n TKNOTS() = "); c%% for (i = 1; i <= NT+3; i+=4){ c%% for (k = i; k <= min( i+3, NT ); k++) c%% printf( "%10.5f", Tknots[k] ); c%% if (i + 3 < NT) printf( "\n ");} c++ End call SSFIT(X, Y, SD, NXY, KORDER, NCOEF, TKNOTS, BCOEF, * SIGFAC,IERR, LDW, W) c++ Code for ~.C. is active print'(/'' After call to SSFIT:''/'' IERR ='',i5, * '', SIGFAC ='', f10.5 //'' BCOEF() = '', * 4f10.5/(13x,4f10.5))', IERR, SIGFAC, (BCOEF(I),I=1,NCOEF) c++ Code for .C. is inactive c%% printf( "\n After call to SSFIT:\n IERR =%5ld, SIGFAC =" c%% "%10.5f\n\n BCOEF() = ", ierr, sigfac); c%% for (i = 1; i <= NCOEF+3; i+=4){ c%% for (k = i; k <= min( i+3, NCOEF ); k++) c%% printf( "%10.5f", Bcoef[k] ); c%% if (i + 3 < NCOEF) printf( "\n ");} c++ End print'(/'' Evaluating fitted spline function using SSVAL:'')' print'(/ * '' I X Y YFIT R=Y-YFIT YFIT''/)' do 20 I=1,NXY YFIT= SSVAL(KORDER, NCOEF, TKNOTS, BCOEF, X(I), NDERIV) call SPRPL(YFIT, '*', IMAGE, 31, 1.9e0, 6.3e0, .true.) print'(3x,i2,f6.0,2f9.3,f10.3,3x,a31)', * I, X(I), Y(I), YFIT, Y(I)-YFIT, IMAGE 20 continue Z = SSQUAD(KORDER, NCOEF, TKNOTS, BCOEF, 5.0e0, 20.0e0) print'(/'' Integral from 5.0 to 20.0 using SSQUAD:'',f12.5)',Z call SSTOP(KORDER, NCOEF, TKNOTS, BCOEF, BDIF, NPC, XI, PCOEF) print'(/ * '' Using SSTOP to convert from B-spline basis to power basis.'')' print'('' NPC ='',i3)',NPC c++ Code for ~.C. is active print'('' XI() = '',4f10.5/(14x,4f10.5))',(XI(I),I=1,NPC+1) print'('' PCOEF() = '',4f10.5/(14x,4f10.5))', * (PCOEF(I),I=1,NPC*KORDER) c++ Code for .C. is inactive c%% printf( " XI() = "); c%% for (i = 1; i <= (npc + 1); i+=4){ c%% for (k = i; k <= min( i+3, npc+1 ); k++) c%% printf( "%10.5f", Xi[k] ); c%% if (i <= npc) printf( "\n ");} c%% printf( "\n PCOEF() = "); c%% for (i = 1; i <= (npc*KORDER); i+=4){ c%% for (k = i; k <= min( i+3, npc*KORDER ); k++) c%% printf( "%10.5f", Pcoef[k] ); c%% if (i < npc*KORDER) printf( "\n ");} c++ End print'(/'' Evaluating fitted spline function using SPVAL:'')' print'(/ * '' I X Y YFIT R=Y-YFIT YFIT''/)' do 40 I=1,NXY YFIT= SPVAL(KORDER, NPC, XI, PCOEF, X(I), NDERIV) call SPRPL(YFIT, '*', IMAGE, 31, 1.9e0, 6.3e0, .true.) print'(3x,i2,f6.0,2f9.3,f10.3,3x,a31)', * I, X(I), Y(I), YFIT, Y(I)-YFIT, IMAGE 40 continue Z = SPQUAD(KORDER, NPC, XI, PCOEF, 5.0e0, 20.0e0) print'(/'' Integral from 5.0 to 20.0 using SPQUAD:'',f12.5)',Z end