MINICERN/mathlib/gen/e/splan1.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:26  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE SPLAN1(B1,X,X2,X3,X4,ND)
  11 #include "gen/imp64.inc"
  12       DIMENSION B1(3)
  13
  14 ************************************************************************
  15 *   NORBAS, VERSION: 15.03.1993
  16 ************************************************************************
  17 *
  18 *   TEST-ROUTINE  SPLAN1
  19 *   FOR COMPUTING  1-DIMENSIONAL  B-SPLINES OF DEGREE  K = 1
  20 *   BY MEANS OF ANALYTIC FORMULAE
  21 *
  22 ************************************************************************
  23
  24       DO 1 I = 1,3
  25     1 B1(I)=0
  26       IF(IABS(ND) .GT. 1) RETURN
  27       IF(X .LT. X2 .OR. X .GT. X4) RETURN
  28       IF(ND .EQ. 0) THEN
  29        IF(X .LT. X3) THEN
  30         B1(1)=(-X+X3)/X3
  31         B1(2)=X/X3
  32         B1(3)=0
  33        ELSE
  34         B1(1)=0
  35         B1(2)=(X-1)/(X3-1)
  36         B1(3)=(-X+X3)/(X3-1)
  37        END IF
  38       ELSE IF(ND .EQ. 1) THEN
  39        IF(X .LT. X3) THEN
  40         B1(1)=-1/X3
  41         B1(2)=1/X3
  42         B1(3)=0
  43        ELSE
  44         B1(1)=0
  45         B1(2)=1/(X3-1)
  46         B1(3)=-1/(X3-1)
  47        END IF
  48       ELSE IF(ND .EQ. -1) THEN
  49        IF(X .LT. X3) THEN
  50         B1(1)=-(X/2-X3)*X/X3
  51         B1(2)=X**2/(2*X3)
  52         B1(3)=0
  53        ELSE
  54         B1(1)=X3/2
  55         B1(2)=(X**2-2*X+X3)/(2*(X3-1))
  56         B1(3)=-(X-X3)**2/(2*(X3-1))
  57        END IF
  58       END IF
  59       RETURN
  60       END
  61
  62
  63