pchkt.f 2.4 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495
  1. *DECK PCHKT
  2. SUBROUTINE PCHKT (N, X, KNOTYP, T)
  3. C***BEGIN PROLOGUE PCHKT
  4. C***SUBSIDIARY
  5. C***PURPOSE Compute B-spline knot sequence for PCHBS.
  6. C***LIBRARY SLATEC (PCHIP)
  7. C***CATEGORY E3
  8. C***TYPE SINGLE PRECISION (PCHKT-S, DPCHKT-D)
  9. C***AUTHOR Fritsch, F. N., (LLNL)
  10. C***DESCRIPTION
  11. C
  12. C Set a knot sequence for the B-spline representation of a PCH
  13. C function with breakpoints X. All knots will be at least double.
  14. C Endknots are set as:
  15. C (1) quadruple knots at endpoints if KNOTYP=0;
  16. C (2) extrapolate the length of end interval if KNOTYP=1;
  17. C (3) periodic if KNOTYP=2.
  18. C
  19. C Input arguments: N, X, KNOTYP.
  20. C Output arguments: T.
  21. C
  22. C Restrictions/assumptions:
  23. C 1. N.GE.2 . (not checked)
  24. C 2. X(i).LT.X(i+1), i=1,...,N . (not checked)
  25. C 3. 0.LE.KNOTYP.LE.2 . (Acts like KNOTYP=0 for any other value.)
  26. C
  27. C***SEE ALSO PCHBS
  28. C***ROUTINES CALLED (NONE)
  29. C***REVISION HISTORY (YYMMDD)
  30. C 870701 DATE WRITTEN
  31. C 900405 Converted Fortran to upper case.
  32. C 900410 Converted prologue to SLATEC 4.0 format.
  33. C 900410 Minor cosmetic changes.
  34. C 930514 Changed NKNOTS from an output to an input variable. (FNF)
  35. C 930604 Removed unused variable NKNOTS from argument list. (FNF)
  36. C***END PROLOGUE PCHKT
  37. C
  38. C*Internal Notes:
  39. C
  40. C Since this is subsidiary to PCHBS, which validates its input before
  41. C calling, it is unnecessary for such validation to be done here.
  42. C
  43. C**End
  44. C
  45. C Declare arguments.
  46. C
  47. INTEGER N, KNOTYP
  48. REAL X(*), T(*)
  49. C
  50. C Declare local variables.
  51. C
  52. INTEGER J, K, NDIM
  53. REAL HBEG, HEND
  54. C***FIRST EXECUTABLE STATEMENT PCHKT
  55. C
  56. C Initialize.
  57. C
  58. NDIM = 2*N
  59. C
  60. C Set interior knots.
  61. C
  62. J = 1
  63. DO 20 K = 1, N
  64. J = J + 2
  65. T(J) = X(K)
  66. T(J+1) = T(J)
  67. 20 CONTINUE
  68. C Assertion: At this point T(3),...,T(NDIM+2) have been set and
  69. C J=NDIM+1.
  70. C
  71. C Set end knots according to KNOTYP.
  72. C
  73. HBEG = X(2) - X(1)
  74. HEND = X(N) - X(N-1)
  75. IF (KNOTYP.EQ.1 ) THEN
  76. C Extrapolate.
  77. T(2) = X(1) - HBEG
  78. T(NDIM+3) = X(N) + HEND
  79. ELSE IF ( KNOTYP.EQ.2 ) THEN
  80. C Periodic.
  81. T(2) = X(1) - HEND
  82. T(NDIM+3) = X(N) + HBEG
  83. ELSE
  84. C Quadruple end knots.
  85. T(2) = X(1)
  86. T(NDIM+3) = X(N)
  87. ENDIF
  88. T(1) = T(2)
  89. T(NDIM+4) = T(NDIM+3)
  90. C
  91. C Terminate.
  92. C
  93. RETURN
  94. C------------- LAST LINE OF PCHKT FOLLOWS ------------------------------
  95. END