MINICERN/mathlib/gen/e/dspkn2.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 DSPKN2(KX,KY,MX,MY,AX,BX,AY,BY,TX,TY,NERR)
  11
  12 #include "gen/imp64.inc"
  13       DIMENSION TX(*),TY(*)
  14       CHARACTER NAME*(*)
  15       CHARACTER*80 ERRTXT
  16       PARAMETER (NAME = 'DSPKN2')
  17
  18 ************************************************************************
  19 *   NORBAS, VERSION: 15.03.1993
  20 ************************************************************************
  21 *
  22 *   DSPKN2 COMPUTES TWO SETS OF MX (MX >= 2*KX+2) AND MY (MY >= 2*KY+2)
  23 *   SPLINE-KNOTS IN THE INTERVAL  AX <= X <= BX  AND  AY <= Y <= BY
  24 *   AS KNOTS FOR NORMALIZED B-SPLINES OF DEGREE  KX  (0 <= KX <= 25) AND
  25 *   KY  (0 <= KY <= 25), RESPECTIVELY.
  26 *   THE FIRST (KX+1) KNOTS OF TX ARE EQUAL TO AX, THE LAST (KX+1) KNOTS
  27 *   OF TX ARE EQUAL TO BX, AND THE OTHER KNOTS OF TX ARE EQUIDISTANT.
  28 *   A CORRESPONDING CHARACTERISTIC HOLDS FOR SET OF KNOTS TY IN
  29 *   Y-DIRECTION.
  30 *
  31 *   PARAMETERS:
  32 *
  33 *   KX   (INTEGER) DEGREE OF B-SPLINES IN X-DIRECTION.
  34 *   KY   (INTEGER) DEGREE OF B-SPLINES IN Y-DIRECTION.
  35 *   MX   (INTEGER) NUMBER OF KNOTS IN THE INTERVAL  AX <= X <= BX.
  36 *   MY   (INTEGER) NUMBER OF KNOTS IN THE INTERVAL  AY <= Y <= BY.
  37 *   AX   (DOUBLE PRECISION) LEFT  ENDPOINT OF X-INTERVAL
  38 *   BX   (DOUBLE PRECISION) RIGHT ENDPOINT OF X-INTERVAL
  39 *   AY   (DOUBLE PRECISION) LEFT  ENDPOINT OF Y-INTERVAL
  40 *   BY   (DOUBLE PRECISION) RIGHT ENDPOINT OF Y-INTERVAL
  41 *   TX   (DOUBLE RECISION) ARRAY OF AT LEAST ORDER MX CONTAINING THE
  42 *         KNOTS OVER THE X-INTERVAL, ON EXIT.
  43 *   TY   (DOUBLE RECISION) ARRAY OF AT LEAST ORDER MY CONTAINING THE
  44 *         KNOTS OVER THE Y-INTERVAL, ON EXIT.
  45 *   NERR (INTEGER) ERROR INDICATOR. ON EXIT:
  46 *        = 0: NO ERROR DETECTED
  47 *        = 1: AT LEAST ONE OF THE CONSTANTS  KX, KY, MX, MY  IS ILLEGAL
  48 *
  49 *   USAGE:
  50 *
  51 *       THE USER HAS TO PROVIDE KX, KY, MX, MY, AX, BX, AY, BY.
  52 *       ON RETURN THE ARRAYS  TX  AND  TY  CONTAIN THE DESIRED KNOTS IN
  53 *       ASCENDING ORDER.
  54 *
  55 *   ERROR MESSAGES:
  56 *
  57 *   IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT-
  58 *   PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED:
  59 *     KX < 0       OR   KX > 25      OR   KY < 0    OR    KY > 25  OR
  60 *     MX < 2*KX+2  OR   MY < 2*KY+2  OR
  61 *     BX <= AX     OR   BY <= AY .
  62 *
  63 *   ********************************************************************
  64
  65       NERR=1
  66       IF(KX .LT. 0 .OR. KX .GT. 25) THEN
  67        WRITE(ERRTXT,101) 'KX',KX
  68        CALL MTLPRT(NAME,'E210.1',ERRTXT)
  69       ELSEIF(KY .LT. 0 .OR. KY .GT. 25) THEN
  70        WRITE(ERRTXT,101) 'KY',KY
  71        CALL MTLPRT(NAME,'E210.1',ERRTXT)
  72       ELSEIF(MX .LT. 2*KX+2) THEN
  73        WRITE(ERRTXT,101) 'MX',MX
  74        CALL MTLPRT(NAME,'E210.2',ERRTXT)
  75       ELSEIF(MY .LT. 2*KY+2) THEN
  76        WRITE(ERRTXT,101) 'MY',MY
  77        CALL MTLPRT(NAME,'E210.2',ERRTXT)
  78       ELSEIF(BX .LE. AX) THEN
  79        WRITE(ERRTXT,103) 'AX',AX,'BX',BX
  80        CALL MTLPRT(NAME,'E210.7',ERRTXT)
  81       ELSEIF(BY .LE. AY) THEN
  82        WRITE(ERRTXT,103) 'AY',AY,'BY',BY
  83        CALL MTLPRT(NAME,'E210.7',ERRTXT)
  84       ELSE
  85        NERR=0
  86        DX=(BX-AX)/(MX-2*KX-1)
  87        DY=(BY-AY)/(MY-2*KY-1)
  88
  89        CALL DVSET(KX+1,AX,TX(1),TX(2))
  90        CALL DVSET(KX+1,BX,TX(MX-KX),TX(MX-KX+1))
  91        DO 10 I = KX+2,MX-KX-1
  92    10  TX(I)=AX+DX*(I-KX-1)
  93
  94        CALL DVSET(KY+1,AY,TY(1),TY(2))
  95        CALL DVSET(KY+1,BY,TY(MY-KY),TY(MY-KY+1))
  96        DO 20 I = KY+2,MY-KY-1
  97    20  TY(I)=AY+DY*(I-KY-1)
  98       ENDIF
  99
 100       RETURN
 101
 102   101 FORMAT(1X,A5,' =',I6,'   NOT IN RANGE')
 103   103 FORMAT(1X,A5,' =',1PD15.8,A7,' =',1PD15.8,'   INCONSISTENT')
 104       END
 105
 106