MINICERN/mathlib/gen/e/dspcd1.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:25  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE DSPCD1(K,M,NDER,T,C,D,NERR)
  11
  12 #include "gen/imp64.inc"
  13       DIMENSION T(*),C(*),D(*)
  14       CHARACTER NAME*(*)
  15       CHARACTER*80 ERRTXT
  16       PARAMETER (NAME = 'DSPCD1')
  17
  18 ************************************************************************
  19 *   NORBAS, VERSION: 15.03.1993
  20 ************************************************************************
  21 *
  22 *   DSPCD1 COMPUTES FROM GIVEN COEFFICIENTS  C(1),...,C(M-K-1)  OF A
  23 *   POLYNOMIAL SPLINE  S(X)  IN B-SPLINE REPRESENTATION
  24 *
  25 *          S(X) =  SUMME(I=1,...,M-K-1)  C(I) * B(I,K)(X)
  26 *
  27 *   THE CORRESPONDING COEFFICIENTS  D(1),...,D(M-K-NDER-1)  OF THE
  28 *   NDER-TH DERIVATIVE OF S(X).
  29 *
  30 *   THE FUNCTIONS  B(I,K)(X)  ARE NORMALIZED B-SPLINES OF DEGREE  K
  31 *   (0<= K <= 25)  WITH INDEX  I  (1 <= I <= M-K-1) OVER A SET OF
  32 *   SPLINE-KNOTS
  33 *              T(1),T(2), ... ,T(M)    ( M >= 2*K+2 )
  34 *   (KNOTS IN ASCENDING ORDER, WITH MULTIPLICITIES NOT GREATER
  35 *   THAN  K+1).
  36 *   THE FUNCTION VALUE OF THE NORMALIZED B-SPLINE  B(I,K)(X)  IS
  37 *   IDENTICALLY ZERO OUTSIDE THE INTERVAL  T(I) <= X < T(I+K+1).
  38 *   THE NORMALIZATION OF  N(X) = B(I,K)(X)  IS SUCH THAT THE INTGRAL OF
  39 *   N(X)  OVER THE WHOLE X-RANGE EQUALS
  40 *                  ( T(I+K+1) - T(I) ) / (K+1)  .
  41 *
  42 *   PARAMETERS:
  43 *
  44 *   K     (INTEGER) DEGREE (= ORDER - 1) OF B-SPLINES.
  45 *   M     (INTEGER) NUMBER OF KNOTS FOR THE B-SPLINES.
  46 *   NDER  (INTEGER) ORDER OF DERIVATIVE
  47 *   T     (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER M CONTAINING THE
  48 *         KNOTS, ON ENTRY.
  49 *   C     (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER  M-K-1. ON ENTRY
  50 *         C(1),...,C(M-K-1)  MUST CONTAIN THE COEFFICIENTS OF THE
  51 *         POLYNOMIAL SPLINE  S(X)  IN B-SPLINE REPRESENTATION.
  52 *   D     (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER  M-K-1.
  53 *         ON EXIT  D(1),...,D(M-K-NDER-1)  CONTAIN THE COEFFICIENTS
  54 *         OF THE NDER-TH DERIVATIVE OF  S(X) IN B-SPLINE REPRESENTATION.
  55 *         (THE REMAINING ARRAY ELEMENTS D(M-K-NDER),...,D(M-K-1) ARE
  56 *         USED AS WORKING SPACE).
  57 *   NERR  (INTEGER) ERROR INDICATOR. ON EXIT:
  58 *         = 0: NO ERROR DETECTED
  59 *         = 1: AT LEAST ONE OF THE CONSTANTS  K , M , NDER  IS ILLEGAL
  60 *
  61 *   ERROR MESSAGES:
  62 *
  63 *   IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT-
  64 *   PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED:
  65 *     K < 0      OR    K > 25    OR
  66 *     M < 2*K+2  OR
  67 *     NDER < 1   OR    NDER > K .
  68 *
  69 ************************************************************************
  70
  71       PARAMETER (Z0 = 0)
  72
  73       NERR=1
  74       IF(K .LT. 0 .OR. K .GT. 25) THEN
  75        WRITE(ERRTXT,101) 'K',K
  76        CALL MTLPRT(NAME,'E210.1',ERRTXT)
  77       ELSEIF(M .LT. 2*K+2) THEN
  78        WRITE(ERRTXT,101) 'M',M
  79        CALL MTLPRT(NAME,'E210.2',ERRTXT)
  80       ELSEIF(NDER .LT. 1 .OR. NDER .GT. K) THEN
  81        WRITE(ERRTXT,101) 'NDER',NDER
  82        CALL MTLPRT(NAME,'E210.5',ERRTXT)
  83       ELSE
  84        NERR=0
  85        CALL DVCPY(M-K-1,C(1),C(2),D(1),D(2))
  86        DO 10 J = 1,NDER
  87        A=K-J+1
  88        DO 10 I = 1,M-K-1-J
  89        DIF=T(I+K+1)-T(I+J)
  90        D0=Z0
  91        IF(DIF .NE. 0) D0=A*(D(I+1)-D(I))/DIF
  92    10  D(I)=D0
  93       ENDIF
  94
  95       RETURN
  96
  97   101 FORMAT(1X,A5,' =',I6,'   NOT IN RANGE')
  98       END
  99
 100
 101