dfc.f 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412
  1. *DECK DFC
  2. SUBROUTINE DFC (NDATA, XDATA, YDATA, SDDATA, NORD, NBKPT, BKPT,
  3. + NCONST, XCONST, YCONST, NDERIV, MODE, COEFF, W, IW)
  4. C***BEGIN PROLOGUE DFC
  5. C***PURPOSE Fit a piecewise polynomial curve to discrete data.
  6. C The piecewise polynomials are represented as B-splines.
  7. C The fitting is done in a weighted least squares sense.
  8. C Equality and inequality constraints can be imposed on the
  9. C fitted curve.
  10. C***LIBRARY SLATEC
  11. C***CATEGORY K1A1A1, K1A2A, L8A3
  12. C***TYPE DOUBLE PRECISION (FC-S, DFC-D)
  13. C***KEYWORDS B-SPLINE, CONSTRAINED LEAST SQUARES, CURVE FITTING,
  14. C WEIGHTED LEAST SQUARES
  15. C***AUTHOR Hanson, R. J., (SNLA)
  16. C***DESCRIPTION
  17. C
  18. C This subprogram fits a piecewise polynomial curve
  19. C to discrete data. The piecewise polynomials are
  20. C represented as B-splines.
  21. C The fitting is done in a weighted least squares sense.
  22. C Equality and inequality constraints can be imposed on the
  23. C fitted curve.
  24. C
  25. C For a description of the B-splines and usage instructions to
  26. C evaluate them, see
  27. C
  28. C C. W. de Boor, Package for Calculating with B-Splines.
  29. C SIAM J. Numer. Anal., p. 441, (June, 1977).
  30. C
  31. C For further documentation and discussion of constrained
  32. C curve fitting using B-splines, see
  33. C
  34. C R. J. Hanson, Constrained Least Squares Curve Fitting
  35. C to Discrete Data Using B-Splines, a User's
  36. C Guide. Sandia Labs. Tech. Rept. SAND-78-1291,
  37. C December, (1978).
  38. C
  39. C Input.. All TYPE REAL variables are DOUBLE PRECISION
  40. C NDATA,XDATA(*),
  41. C YDATA(*),
  42. C SDDATA(*)
  43. C The NDATA discrete (X,Y) pairs and the Y value
  44. C standard deviation or uncertainty, SD, are in
  45. C the respective arrays XDATA(*), YDATA(*), and
  46. C SDDATA(*). No sorting of XDATA(*) is
  47. C required. Any non-negative value of NDATA is
  48. C allowed. A negative value of NDATA is an
  49. C error. A zero value for any entry of
  50. C SDDATA(*) will weight that data point as 1.
  51. C Otherwise the weight of that data point is
  52. C the reciprocal of this entry.
  53. C
  54. C NORD,NBKPT,
  55. C BKPT(*)
  56. C The NBKPT knots of the B-spline of order NORD
  57. C are in the array BKPT(*). Normally the
  58. C problem data interval will be included between
  59. C the limits BKPT(NORD) and BKPT(NBKPT-NORD+1).
  60. C The additional end knots BKPT(I),I=1,...,
  61. C NORD-1 and I=NBKPT-NORD+2,...,NBKPT, are
  62. C required to compute the functions used to fit
  63. C the data. No sorting of BKPT(*) is required.
  64. C Internal to DFC( ) the extreme end knots may
  65. C be reduced and increased respectively to
  66. C accommodate any data values that are exterior
  67. C to the given knot values. The contents of
  68. C BKPT(*) is not changed.
  69. C
  70. C NORD must be in the range 1 .LE. NORD .LE. 20.
  71. C The value of NBKPT must satisfy the condition
  72. C NBKPT .GE. 2*NORD.
  73. C Other values are considered errors.
  74. C
  75. C (The order of the spline is one more than the
  76. C degree of the piecewise polynomial defined on
  77. C each interval. This is consistent with the
  78. C B-spline package convention. For example,
  79. C NORD=4 when we are using piecewise cubics.)
  80. C
  81. C NCONST,XCONST(*),
  82. C YCONST(*),NDERIV(*)
  83. C The number of conditions that constrain the
  84. C B-spline is NCONST. A constraint is specified
  85. C by an (X,Y) pair in the arrays XCONST(*) and
  86. C YCONST(*), and by the type of constraint and
  87. C derivative value encoded in the array
  88. C NDERIV(*). No sorting of XCONST(*) is
  89. C required. The value of NDERIV(*) is
  90. C determined as follows. Suppose the I-th
  91. C constraint applies to the J-th derivative
  92. C of the B-spline. (Any non-negative value of
  93. C J < NORD is permitted. In particular the
  94. C value J=0 refers to the B-spline itself.)
  95. C For this I-th constraint, set
  96. C XCONST(I)=X,
  97. C YCONST(I)=Y, and
  98. C NDERIV(I)=ITYPE+4*J, where
  99. C
  100. C ITYPE = 0, if (J-th deriv. at X) .LE. Y.
  101. C = 1, if (J-th deriv. at X) .GE. Y.
  102. C = 2, if (J-th deriv. at X) .EQ. Y.
  103. C = 3, if (J-th deriv. at X) .EQ.
  104. C (J-th deriv. at Y).
  105. C (A value of NDERIV(I)=-1 will cause this
  106. C constraint to be ignored. This subprogram
  107. C feature is often useful when temporarily
  108. C suppressing a constraint while still
  109. C retaining the source code of the calling
  110. C program.)
  111. C
  112. C MODE
  113. C An input flag that directs the least squares
  114. C solution method used by DFC( ).
  115. C
  116. C The variance function, referred to below,
  117. C defines the square of the probable error of
  118. C the fitted curve at any point, XVAL.
  119. C This feature of DFC( ) allows one to use the
  120. C square root of this variance function to
  121. C determine a probable error band around the
  122. C fitted curve.
  123. C
  124. C =1 a new problem. No variance function.
  125. C
  126. C =2 a new problem. Want variance function.
  127. C
  128. C =3 an old problem. No variance function.
  129. C
  130. C =4 an old problem. Want variance function.
  131. C
  132. C Any value of MODE other than 1-4 is an error.
  133. C
  134. C The user with a new problem can skip directly
  135. C to the description of the input parameters
  136. C IW(1), IW(2).
  137. C
  138. C If the user correctly specifies the new or old
  139. C problem status, the subprogram DFC( ) will
  140. C perform more efficiently.
  141. C By an old problem it is meant that subprogram
  142. C DFC( ) was last called with this same set of
  143. C knots, data points and weights.
  144. C
  145. C Another often useful deployment of this old
  146. C problem designation can occur when one has
  147. C previously obtained a Q-R orthogonal
  148. C decomposition of the matrix resulting from
  149. C B-spline fitting of data (without constraints)
  150. C at the breakpoints BKPT(I), I=1,...,NBKPT.
  151. C For example, this matrix could be the result
  152. C of sequential accumulation of the least
  153. C squares equations for a very large data set.
  154. C The user writes this code in a manner
  155. C convenient for the application. For the
  156. C discussion here let
  157. C
  158. C N=NBKPT-NORD, and K=N+3
  159. C
  160. C Let us assume that an equivalent least squares
  161. C system
  162. C
  163. C RC=D
  164. C
  165. C has been obtained. Here R is an N+1 by N
  166. C matrix and D is a vector with N+1 components.
  167. C The last row of R is zero. The matrix R is
  168. C upper triangular and banded. At most NORD of
  169. C the diagonals are nonzero.
  170. C The contents of R and D can be copied to the
  171. C working array W(*) as follows.
  172. C
  173. C The I-th diagonal of R, which has N-I+1
  174. C elements, is copied to W(*) starting at
  175. C
  176. C W((I-1)*K+1),
  177. C
  178. C for I=1,...,NORD.
  179. C The vector D is copied to W(*) starting at
  180. C
  181. C W(NORD*K+1)
  182. C
  183. C The input value used for NDATA is arbitrary
  184. C when an old problem is designated. Because
  185. C of the feature of DFC( ) that checks the
  186. C working storage array lengths, a value not
  187. C exceeding NBKPT should be used. For example,
  188. C use NDATA=0.
  189. C
  190. C (The constraints or variance function request
  191. C can change in each call to DFC( ).) A new
  192. C problem is anything other than an old problem.
  193. C
  194. C IW(1),IW(2)
  195. C The amounts of working storage actually
  196. C allocated for the working arrays W(*) and
  197. C IW(*). These quantities are compared with the
  198. C actual amounts of storage needed in DFC( ).
  199. C Insufficient storage allocated for either
  200. C W(*) or IW(*) is an error. This feature was
  201. C included in DFC( ) because misreading the
  202. C storage formulas for W(*) and IW(*) might very
  203. C well lead to subtle and hard-to-find
  204. C programming bugs.
  205. C
  206. C The length of W(*) must be at least
  207. C
  208. C NB=(NBKPT-NORD+3)*(NORD+1)+
  209. C 2*MAX(NDATA,NBKPT)+NBKPT+NORD**2
  210. C
  211. C Whenever possible the code uses banded matrix
  212. C processors DBNDAC( ) and DBNDSL( ). These
  213. C are utilized if there are no constraints,
  214. C no variance function is required, and there
  215. C is sufficient data to uniquely determine the
  216. C B-spline coefficients. If the band processors
  217. C cannot be used to determine the solution,
  218. C then the constrained least squares code DLSEI
  219. C is used. In this case the subprogram requires
  220. C an additional block of storage in W(*). For
  221. C the discussion here define the integers NEQCON
  222. C and NINCON respectively as the number of
  223. C equality (ITYPE=2,3) and inequality
  224. C (ITYPE=0,1) constraints imposed on the fitted
  225. C curve. Define
  226. C
  227. C L=NBKPT-NORD+1
  228. C
  229. C and note that
  230. C
  231. C NCONST=NEQCON+NINCON.
  232. C
  233. C When the subprogram DFC( ) uses DLSEI( ) the
  234. C length of the working array W(*) must be at
  235. C least
  236. C
  237. C LW=NB+(L+NCONST)*L+
  238. C 2*(NEQCON+L)+(NINCON+L)+(NINCON+2)*(L+6)
  239. C
  240. C The length of the array IW(*) must be at least
  241. C
  242. C IW1=NINCON+2*L
  243. C
  244. C in any case.
  245. C
  246. C Output.. All TYPE REAL variables are DOUBLE PRECISION
  247. C MODE
  248. C An output flag that indicates the status
  249. C of the constrained curve fit.
  250. C
  251. C =-1 a usage error of DFC( ) occurred. The
  252. C offending condition is noted with the
  253. C SLATEC library error processor, XERMSG.
  254. C In case the working arrays W(*) or IW(*)
  255. C are not long enough, the minimal
  256. C acceptable length is printed.
  257. C
  258. C = 0 successful constrained curve fit.
  259. C
  260. C = 1 the requested equality constraints
  261. C are contradictory.
  262. C
  263. C = 2 the requested inequality constraints
  264. C are contradictory.
  265. C
  266. C = 3 both equality and inequality constraints
  267. C are contradictory.
  268. C
  269. C COEFF(*)
  270. C If the output value of MODE=0 or 1, this array
  271. C contains the unknowns obtained from the least
  272. C squares fitting process. These N=NBKPT-NORD
  273. C parameters are the B-spline coefficients.
  274. C For MODE=1, the equality constraints are
  275. C contradictory. To make the fitting process
  276. C more robust, the equality constraints are
  277. C satisfied in a least squares sense. In this
  278. C case the array COEFF(*) contains B-spline
  279. C coefficients for this extended concept of a
  280. C solution. If MODE=-1,2 or 3 on output, the
  281. C array COEFF(*) is undefined.
  282. C
  283. C Working Arrays.. All Type REAL variables are DOUBLE PRECISION
  284. C W(*),IW(*)
  285. C These arrays are respectively typed DOUBLE
  286. C PRECISION and INTEGER.
  287. C Their required lengths are specified as input
  288. C parameters in IW(1), IW(2) noted above. The
  289. C contents of W(*) must not be modified by the
  290. C user if the variance function is desired.
  291. C
  292. C Evaluating the
  293. C Variance Function..
  294. C To evaluate the variance function (assuming
  295. C that the uncertainties of the Y values were
  296. C provided to DFC( ) and an input value of
  297. C MODE=2 or 4 was used), use the function
  298. C subprogram DCV( )
  299. C
  300. C VAR=DCV(XVAL,NDATA,NCONST,NORD,NBKPT,
  301. C BKPT,W)
  302. C
  303. C Here XVAL is the point where the variance is
  304. C desired. The other arguments have the same
  305. C meaning as in the usage of DFC( ).
  306. C
  307. C For those users employing the old problem
  308. C designation, let MDATA be the number of data
  309. C points in the problem. (This may be different
  310. C from NDATA if the old problem designation
  311. C feature was used.) The value, VAR, should be
  312. C multiplied by the quantity
  313. C
  314. C DBLE(MAX(NDATA-N,1))/DBLE(MAX(MDATA-N,1))
  315. C
  316. C The output of this subprogram is not defined
  317. C if an input value of MODE=1 or 3 was used in
  318. C FC( ) or if an output value of MODE=-1, 2, or
  319. C 3 was obtained. The variance function, except
  320. C for the scaling factor noted above, is given
  321. C by
  322. C
  323. C VAR=(transpose of B(XVAL))*C*B(XVAL)
  324. C
  325. C The vector B(XVAL) is the B-spline basis
  326. C function values at X=XVAL.
  327. C The covariance matrix, C, of the solution
  328. C coefficients accounts only for the least
  329. C squares equations and the explicitly stated
  330. C equality constraints. This fact must be
  331. C considered when interpreting the variance
  332. C function from a data fitting problem that has
  333. C inequality constraints on the fitted curve.
  334. C
  335. C Evaluating the
  336. C Fitted Curve..
  337. C To evaluate derivative number IDER at XVAL,
  338. C use the function subprogram DBVALU( )
  339. C
  340. C F = DBVALU(BKPT,COEFF,NBKPT-NORD,NORD,IDER,
  341. C XVAL,INBV,WORKB)
  342. C
  343. C The output of this subprogram will not be
  344. C defined unless an output value of MODE=0 or 1
  345. C was obtained from DFC( ), XVAL is in the data
  346. C interval, and IDER is nonnegative and .LT.
  347. C NORD.
  348. C
  349. C The first time DBVALU( ) is called, INBV=1
  350. C must be specified. This value of INBV is the
  351. C overwritten by DBVALU( ). The array WORKB(*)
  352. C must be of length at least 3*NORD, and must
  353. C not be the same as the W(*) array used in
  354. C the call to DFC( ).
  355. C
  356. C DBVALU( ) expects the breakpoint array BKPT(*)
  357. C to be sorted.
  358. C
  359. C***REFERENCES R. J. Hanson, Constrained least squares curve fitting
  360. C to discrete data using B-splines, a users guide,
  361. C Report SAND78-1291, Sandia Laboratories, December
  362. C 1978.
  363. C***ROUTINES CALLED DFCMN
  364. C***REVISION HISTORY (YYMMDD)
  365. C 780801 DATE WRITTEN
  366. C 890531 Changed all specific intrinsics to generic. (WRB)
  367. C 891006 Cosmetic changes to prologue. (WRB)
  368. C 891006 REVISION DATE from Version 3.2
  369. C 891214 Prologue converted to Version 4.0 format. (BAB)
  370. C 900510 Convert references to XERRWV to references to XERMSG. (RWC)
  371. C 900607 Editorial changes to Prologue to make Prologues for EFC,
  372. C DEFC, FC, and DFC look as much the same as possible. (RWC)
  373. C 920501 Reformatted the REFERENCES section. (WRB)
  374. C***END PROLOGUE DFC
  375. DOUBLE PRECISION BKPT(*), COEFF(*), SDDATA(*), W(*), XCONST(*),
  376. * XDATA(*), YCONST(*), YDATA(*)
  377. INTEGER IW(*), MODE, NBKPT, NCONST, NDATA, NDERIV(*), NORD
  378. C
  379. EXTERNAL DFCMN
  380. C
  381. INTEGER I1, I2, I3, I4, I5, I6, I7, MDG, MDW
  382. C
  383. C***FIRST EXECUTABLE STATEMENT DFC
  384. MDG = NBKPT - NORD + 3
  385. MDW = NBKPT - NORD + 1 + NCONST
  386. C USAGE IN DFCMN( ) OF W(*)..
  387. C I1,...,I2-1 G(*,*)
  388. C
  389. C I2,...,I3-1 XTEMP(*)
  390. C
  391. C I3,...,I4-1 PTEMP(*)
  392. C
  393. C I4,...,I5-1 BKPT(*) (LOCAL TO DFCMN( ))
  394. C
  395. C I5,...,I6-1 BF(*,*)
  396. C
  397. C I6,...,I7-1 W(*,*)
  398. C
  399. C I7,... WORK(*) FOR DLSEI( )
  400. C
  401. I1 = 1
  402. I2 = I1 + MDG*(NORD+1)
  403. I3 = I2 + MAX(NDATA,NBKPT)
  404. I4 = I3 + MAX(NDATA,NBKPT)
  405. I5 = I4 + NBKPT
  406. I6 = I5 + NORD*NORD
  407. I7 = I6 + MDW*(NBKPT-NORD+1)
  408. CALL DFCMN(NDATA, XDATA, YDATA, SDDATA, NORD, NBKPT, BKPT, NCONST,
  409. 1 XCONST, YCONST, NDERIV, MODE, COEFF, W(I5), W(I2), W(I3),
  410. 2 W(I4), W(I1), MDG, W(I6), MDW, W(I7), IW)
  411. RETURN
  412. END