]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 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 DSPCD2(KX,KY,MX,MY,NDERX,NDERY,TX,TY,C,NDIMC,D,NERR) | |
11 | ||
12 | #include "gen/imp64.inc" | |
13 | DIMENSION TX(*),TY(*),C(NDIMC,*),D(NDIMC,*) | |
14 | CHARACTER NAME*(*) | |
15 | CHARACTER*80 ERRTXT | |
16 | PARAMETER (NAME = 'DSPCD2') | |
17 | ||
18 | ************************************************************************ | |
19 | * NORBAS, VERSION: 15.03.1993 | |
20 | ************************************************************************ | |
21 | * | |
22 | * DSPCD2 COMPUTES FROM GIVEN COEFFICIENTS | |
23 | * C(I,J) (I=1,...,MX-KX-1 , J=1,...,MY-KY-1) | |
24 | * OF A TWO-DIMENSIONAL POLYNOMIAL SPLINE S(X,Y) IN REPRESENTATION OF | |
25 | * NORMALIZED TWO-DIMENSIONAL B-SPLINES B(I,J)(X,Y) | |
26 | * | |
27 | * S(X,Y) = SUMME(I=1,...,MX-KX-1) | |
28 | * SUMME(J=1,...,MY-KY-1) C(I,J) * B(I,J)(X,Y) | |
29 | * | |
30 | * THE CORRESPONDING COEFFICIENTS | |
31 | * D(I,J) (I=1,...,MX-KX-NDERX-1 , J=1,...,MY-KY-NDERY-1) | |
32 | * OF THE NDERX-TH , NDERY-TH PARTIAL DERIVATIVE OF S(X,Y). | |
33 | * | |
34 | * THE TWO-DIMENSIONAL B-SPLINES B(I,J)(X,Y) ARE THE PRODUCT OF TWO | |
35 | * ONE-DIMENSIONAL B-SPLINES BX , BY | |
36 | * B(I,J)(X,Y) = BX(I,KX)(X) * BY(J,KY)(Y) | |
37 | * OF DEGREE KX AND KY ( 0 <= KX , KY <= 25 ) WITH INDICES I , J | |
38 | * ( 1 <= I <= MX-KX-1 , 1 <= J <= MY-KY-1 ) OVER TWO SETS OF SPLINE- | |
39 | * KNOTS | |
40 | * TX(1),TX(2),...,TX(MX) ( MX >= 2*KX+2 ) | |
41 | * TY(1),TY(2),...,TY(MY) ( MY >= 2*KY+2 ) , | |
42 | * RESPECTIVELY. | |
43 | * FOR FURTHER DETAILS TO THE ONE-DIMENSIONAL NORMALIZED B-SPLINES SEE | |
44 | * THE COMMENTS TO DSPNB1. | |
45 | * | |
46 | * PARAMETERS: | |
47 | * | |
48 | * KX (INTEGER) DEGREE OF ONE-DIMENSIONAL B-SPLINES IN X-DIRECTION | |
49 | * OVER THE SET OF KNOTS TX. | |
50 | * KY (INTEGER) DEGREE OF ONE-DIMENSIONAL B-SPLINES IN Y-DIRECTION | |
51 | * OVER THE SET OF KNOTS TY. | |
52 | * MX (INTEGER) NUMBER OF KNOTS FOR THE B-SPLINES IN X-DIRECTION. | |
53 | * MY (INTEGER) NUMBER OF KNOTS FOR THE B-SPLINES IN Y-DIRECTION. | |
54 | * NDERX (INTEGER) ORDER OF PARTIAL DERIVATIVE IN X-DIRECTION. | |
55 | * NDERY (INTEGER) ORDER OF PARTIAL DERIVATIVE IN Y-DIRECTION. | |
56 | * NDIMC (INTEGER) DECLARED FIRST DIMENSION OF ARRAYS C AND D IN THE | |
57 | * CALLING PROGRAM, WITH NDIMC >= MX-KX-1 . | |
58 | * TX (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER MX CONTAINING THE | |
59 | * KNOTS IN X-DIRECTION, ON ENTRY. | |
60 | * TY (DOUBLE PRECISION) ARRAY OF AT LEAST ORDER MY CONTAINING THE | |
61 | * KNOTS IN Y-DIRECTION, ON ENTRY. | |
62 | * C (DOUBLE PRECISION) ARRAY OF ORDER (NDIMC, >= MY-KY-1). | |
63 | * ON ENTRY C(I,J) MUST CONTAIN THE (I,J)-TH COEFFICIENT OF THE | |
64 | * TWO-DIMENSIONAL B-SPLINE REPRESENTATION OF S(X,Y) . | |
65 | * D (DOUBLE PRECISION) ARRAY OF ORDER (NDIMD, >= MY-KY-1). | |
66 | * ON EXIT D(I,J) CONTAINS THE (I,J)-TH COEFFICIENT OF THE | |
67 | * TWO-DIMENSIONAL B-SPLINE REPRESENTATION OF THE NDERX-TH, | |
68 | * NDERY-TH PARTIAL DERIVATIVE OF S(X,Y). | |
69 | * NERR (INTEGER) ERROR INDICATOR. ON EXIT: | |
70 | * = 0: NO ERROR DETECTED | |
71 | * = 1: AT LEAST ONE OF THE CONSTANTS KX , KY , MX , MY , NDERX , | |
72 | * NDERY IS ILLEGAL | |
73 | * | |
74 | * ERROR MESSAGES: | |
75 | * | |
76 | * IF ONE OF THE FOLLOWING RELATION IS SATISFIED BY THE CHOSEN INPUT- | |
77 | * PARAMETERS THE PROGRAM RETURNS, AND AN ERROR MESSAGE IS PRINTED: | |
78 | * KX < 0 OR KX > 25 OR KY < 0 OR KY > 25 OR | |
79 | * MX < 2*KX+2 OR MY < 2*KY+2 OR | |
80 | * NDERX < 0 OR NDERY < 0 OR | |
81 | * NDERX < 1 AND NDERY < 1 OR | |
82 | * NDERX > KX OR NDERY > KY . | |
83 | * | |
84 | ************************************************************************ | |
85 | ||
86 | PARAMETER (Z0 = 0) | |
87 | ||
88 | NERR=1 | |
89 | IF(KX .LT. 0 .OR. KX .GT. 25) THEN | |
90 | WRITE(ERRTXT,101) 'KX',KX | |
91 | CALL MTLPRT(NAME,'E210.1',ERRTXT) | |
92 | ELSEIF(KY .LT. 0 .OR. KY .GT. 25) THEN | |
93 | WRITE(ERRTXT,101) 'KY',KY | |
94 | CALL MTLPRT(NAME,'E210.1',ERRTXT) | |
95 | ELSEIF(MX .LT. 2*KX+2) THEN | |
96 | WRITE(ERRTXT,101) 'MX',MX | |
97 | CALL MTLPRT(NAME,'E210.2',ERRTXT) | |
98 | ELSEIF(MY .LT. 2*KY+2) THEN | |
99 | WRITE(ERRTXT,101) 'MY',MY | |
100 | CALL MTLPRT(NAME,'E210.2',ERRTXT) | |
101 | ELSEIF(NDERX .LT. 0 .OR. NDERX .GT. KX) THEN | |
102 | WRITE(ERRTXT,101) 'NDERX',NDERX | |
103 | CALL MTLPRT(NAME,'E210.5',ERRTXT) | |
104 | ELSEIF(NDERY .LT. 0 .OR. NDERY .GT. KY) THEN | |
105 | WRITE(ERRTXT,101) 'NDERY',NDERY | |
106 | CALL MTLPRT(NAME,'E210.5',ERRTXT) | |
107 | ELSEIF(NDERX .LT. 1 .AND. NDERY .LT. 1)THEN | |
108 | WRITE(ERRTXT,102) 'NDERX',NDERX,'NDERY',NDERY | |
109 | CALL MTLPRT(NAME,'E210.6',ERRTXT) | |
110 | ELSE | |
111 | ||
112 | NERR=0 | |
113 | CALL DMCPY(MX-KX-1,MY-KY-1,C(1,1),C(1,2),C(2,1), | |
114 | + D(1,1),D(1,2),D(2,1)) | |
115 | IF(NDERX .GT. 0) THEN | |
116 | DO 10 J = 1,MY-KY-1 | |
117 | DO 10 L = 1,NDERX | |
118 | A=KX-L+1 | |
119 | DO 10 I = 1,MX-KX-1-L | |
120 | DIF=TX(I+KX+1)-TX(I+L) | |
121 | D0=Z0 | |
122 | IF(DIF .NE. Z0) D0=A*(D(I+1,J)-D(I,J))/DIF | |
123 | 10 D(I,J)=D0 | |
124 | ENDIF | |
125 | ||
126 | IF(NDERY .GT. 0) THEN | |
127 | DO 20 I = 1,MX-KX-1 | |
128 | DO 20 L = 1,NDERY | |
129 | A=KY-L+1 | |
130 | DO 20 J = 1,MY-KY-1-L | |
131 | DIF=TY(J+KY+1)-TY(J+L) | |
132 | D0=Z0 | |
133 | IF(DIF .NE. Z0) D0=A*(D(I,J+1)-D(I,J))/DIF | |
134 | 20 D(I,J)=D0 | |
135 | ENDIF | |
136 | ENDIF | |
137 | ||
138 | RETURN | |
139 | ||
140 | 101 FORMAT(1X,A5,' =',I6,' NOT IN RANGE') | |
141 | 102 FORMAT(1X,A5,' =',I6,A7,' =',I6,' INCONSISTENT') | |
142 | END | |
143 | ||
144 |