MINICERN/mathlib/gen/e/splan2.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 SPLAN2(B2,X,X3,X4,X5,X6,ND)
  11 #include "gen/imp64.inc"
  12       DIMENSION B2(5)
  13
  14 ************************************************************************
  15 *   NORBAS, VERSION: 15.03.1993
  16 ************************************************************************
  17 *
  18 *   TEST-ROUTINE  SPLAN2
  19 *   FOR COMPUTING  1-DIMENSIONAL  B-SPLINES OF DEGREE  K = 2
  20 *   BY MEANS OF ANALYTIC FORMULAE
  21 *
  22 ************************************************************************
  23
  24       DO 1 I = 1,5
  25     1 B2(I)=0
  26       IF(ND .LT. -1 .OR. ND .GT. 2) RETURN
  27       IF(X .LT. X3 .OR. X .GT. X6) RETURN
  28       IF(ND .EQ. 0) THEN
  29        IF(X3 .LT. X4 .AND. X4 .LT. X5 .AND. X5 .LT. X6) THEN
  30         IF(X .LT. X4) THEN
  31          B2(1)=((X-X4)/X4)**2
  32          B2(2)=X*(-X*(X4+X5)+2*X4*X5)/(X4**2*X5)
  33          B2(3)=X**2/(X4*X5)
  34          B2(4)=0
  35          B2(5)=0
  36         ELSE IF(X4 .LE. X .AND. X .LT. X5) THEN
  37          B2(1)=0
  38          B2(2)=-(X-X5)**2/(X5*(X4-X5))
  39          B2(3)=(X**2*(X4-X5-1)+2*X*X5-X4*X5)/(X5*(X4-1)*(X4-X5))
  40          B2(4)=(X-X4)**2/((X4-1)*(X4-X5))
  41          B2(5)=0
  42         ELSE
  43          B2(1)=0
  44          B2(2)=0
  45          B2(3)=(X-1)**2/((X4-1)*(X5-1))
  46          B2(4)=(X-1)*(X*(2-X4-X5)+2*X4*X5-X4-X5)/((X4-1)*(X5-1)**2)
  47          B2(5)=((X-X5)/(X5-1))**2
  48         END IF
  49        ELSE IF(X3 .LT. X4 .AND. X4 .EQ. X5 .AND. X5 .LT. X6) THEN
  50         IF(X .LT. X4) THEN
  51          B2(1)=((X-X4)/X4)**2
  52          B2(2)=-2*(X-X4)*X/X4**2
  53          B2(3)=(X/X4)**2
  54          B2(4)=0
  55          B2(5)=0
  56         ELSE
  57          B2(1)=0
  58          B2(2)=0
  59          B2(3)=((X-1)/(X4-1))**2
  60          B2(4)=-2*(X-X4)*(X-1)/(X4-1)**2
  61          B2(5)=((X-X4)/(X4-1))**2
  62         END IF
  63        END IF
  64       ELSE IF(ND .EQ. 1) THEN
  65        IF(X3 .LT. X4 .AND. X4 .LT. X5 .AND. X5 .LT. X6) THEN
  66         IF(X .LT. X4) THEN
  67          B2(1)=2*(X-X4)/X4**2
  68          B2(2)=-2*(X*(X4+X5)-X4*X5)/(X4**2*X5)
  69          B2(3)=2*X/(X4*X5)
  70          B2(4)=0
  71          B2(5)=0
  72         ELSE IF(X4 .LE. X .AND. X .LT. X5) THEN
  73          B2(1)=0
  74          B2(2)=-2*(X-X5)/((X4-X5)*X5)
  75          B2(3)=2*(X*(X4-X5-1)+X5)/((X4-X5)*(X4-1)*X5)
  76          B2(4)=2*(X-X4)/((X4-X5)*(X4-1))
  77          B2(5)=0
  78         ELSE
  79          B2(1)=0
  80          B2(2)=0
  81          B2(3)=2*(X-1)/((X4-1)*(X5-1))
  82          B2(4)=-2*(X*(X4+X5-2)-X4*X5+1)/((X4-1)*(X5-1)**2)
  83          B2(5)=2*(X-X5)/(X5-1)**2
  84         END IF
  85        ELSE IF(X3 .LT. X4 .AND. X4 .EQ. X5 .AND. X5 .LT. X6) THEN
  86         IF(X .LT. X4) THEN
  87          B2(1)=2*(X-X4)/X4**2
  88          B2(2)=-2*(2*X-X4)/X4**2
  89          B2(3)=2*X/X4**2
  90          B2(4)=0
  91          B2(5)=0
  92         ELSE
  93          B2(1)=0
  94          B2(2)=0
  95          B2(3)=2*(X-1)/(X4-1)**2
  96          B2(4)=-2*((X-X4)+(X-1))/(X4-1)**2
  97          B2(5)=2*(X-X4)/(X4-1)**2
  98         END IF
  99        END IF
 100       ELSE IF(ND .EQ. 2) THEN
 101        IF(X3 .LT. X4 .AND. X4 .LT. X5 .AND. X5 .LT. X6) THEN
 102         IF(X .LT. X4) THEN
 103          B2(1)=2/X4**2
 104          B2(2)=-2*(X4+X5)/(X4**2*X5)
 105          B2(3)=2/(X4*X5)
 106          B2(4)=0
 107          B2(5)=0
 108         ELSE IF(X4 .LE. X .AND. X .LT. X5) THEN
 109          B2(1)=0
 110          B2(2)=-2/((X4-X5)*X5)
 111          B2(3)=2*(X4-X5-1)/((X4-X5)*(X4-1)*X5)
 112          B2(4)=2/((X4-X5)*(X4-1))
 113          B2(5)=0
 114         ELSE
 115          B2(1)=0
 116          B2(2)=0
 117          B2(3)=2/((X4-1)*(X5-1))
 118          B2(4)=-2*(X4+X5-2)/((X4-1)*(X5-1)**2)
 119          B2(5)=2/(X5-1)**2
 120         END IF
 121        ELSE IF(X3 .LT. X4 .AND. X4 .EQ. X5 .AND. X5 .LT. X6) THEN
 122         IF(X .LT. X4) THEN
 123          B2(1)=2/X4**2
 124          B2(2)=-4/X4**2
 125          B2(3)=2/X4**2
 126          B2(4)=0
 127          B2(5)=0
 128         ELSE
 129          B2(1)=0
 130          B2(2)=0
 131          B2(3)=2/(X4-1)**2
 132          B2(4)=-4/(X4-1)**2
 133          B2(5)=2/(X4-1)**2
 134         END IF
 135        END IF
 136       ELSE IF(ND .EQ. -1) THEN
 137        IF(X3 .LT. X4 .AND. X4 .LT. X5 .AND. X5 .LT. X6) THEN
 138         IF(X .LT. X4) THEN
 139          B2(1)=(X**2/3-X*X4+X4**2)*X/X4**2
 140          B2(2)=-((X4+X5)*X-3*X4*X5)*X**2/(3*X4**2*X5)
 141          B2(3)=X**3/(3*X4*X5)
 142          B2(4)=0
 143          B2(5)=0
 144         ELSE IF(X4 .LE. X .AND. X .LT. X5) THEN
 145          B2(1)=X4/3
 146          B2(2)=-(X**3-3*X**2*X5+3*X*X5**2-X4*X5**2)/(3*(X4-X5)*X5)
 147          B2(3)=(X**3*(X4-X5-1)+3*X**2*X5-3*X*X4*X5+X4**2*X5)/
 148      1         (3*(X4-X5)*(X4-1)*X5)
 149          B2(4)=(X-X4)**3/(3*(X4-X5)*(X4-1))
 150          B2(5)=0
 151         ELSE
 152          B2(1)=X4/3
 153          B2(2)=X5/3
 154          B2(3)=(X**3-3*X**2+3*X+X4*X5-X4-X5)/(3*(X4-1)*(X5-1))
 155          B2(4)=(X**3*(-X4-X5+2)+3*X**2*(X4*X5-1)+3*X*(-2*X4*
 156      1         X5+X4+X5)-X4**2*X5**2+2*X4**2*X5-X4**2+2*X4*X5**2-
 157      2         X4*X5-X5**2)/(3*(X4-1)*(X5-1)**2)
 158          B2(5)=(X-X5)**3/(3*(X5-1)**2)
 159         END IF
 160        ELSE IF(X3 .LT. X4 .AND. X4 .EQ. X5 .AND. X5 .LT. X6) THEN
 161         IF(X .LT. X4) THEN
 162          B2(1)=(X**2/3-X*X4+X4**2)*X/X4**2
 163          B2(2)=-(2*X-3*X4)*X**2/(3*X4**2)
 164          B2(3)=X**3/(3*X4**2)
 165          B2(4)=0
 166          B2(5)=0
 167         ELSE
 168          B2(1)=X4/3
 169          B2(2)=X4/3
 170          B2(3)=(X**3-3*X**2+3*X+X4**2-2*X4)/(3*(X4-1)**2)
 171          B2(4)=-(2*X+X4-3)*(X-X4)**2/(3*(X4-1)**2)
 172          B2(5)=(X-X4)**3/(3*(X4-1)**2)
 173         END IF
 174        END IF
 175       END IF
 176       RETURN
 177       END
 178
 179
 180