1 /*
2 * Copyright (C) 1998, 2000-2007, 2010, 2011, 2012, 2013 SINTEF ICT,
3 * Applied Mathematics, Norway.
4 *
5 * Contact information: E-mail: tor.dokken@sintef.no
6 * SINTEF ICT, Department of Applied Mathematics,
7 * P.O. Box 124 Blindern,
8 * 0314 Oslo, Norway.
9 *
10 * This file is part of SISL.
11 *
12 * SISL is free software: you can redistribute it and/or modify
13 * it under the terms of the GNU Affero General Public License as
14 * published by the Free Software Foundation, either version 3 of the
15 * License, or (at your option) any later version.
16 *
17 * SISL is distributed in the hope that it will be useful,
18 * but WITHOUT ANY WARRANTY; without even the implied warranty of
19 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 * GNU Affero General Public License for more details.
21 *
22 * You should have received a copy of the GNU Affero General Public
23 * License along with SISL. If not, see
24 * <http://www.gnu.org/licenses/>.
25 *
26 * In accordance with Section 7(b) of the GNU Affero General Public
27 * License, a covered work must retain the producer line in every data
28 * file that is created or manipulated using SISL.
29 *
30 * Other Usage
31 * You can be released from the requirements of the license by purchasing
32 * a commercial license. Buying such a license is mandatory as soon as you
33 * develop commercial activities involving the SISL library without
34 * disclosing the source code of your own applications.
35 *
36 * This file may be used in accordance with the terms contained in a
37 * written agreement between you and SINTEF ICT.
38 */
39
40 #include "sisl-copyright.h"
41
42 /*
43 *
44 * $Id: s1934.c,v 1.1 1994-04-21 12:10:42 boh Exp $
45 *
46 */
47
48
49 #define S1934
50
51 #include "sislP.h"
52
53
54 #if defined(SISLNEEDPROTOTYPES)
55 void
s1934(double * et,int in,int ik,double start,double end,int * jstat)56 s1934 (double *et, int in, int ik, double start, double end, int *jstat)
57 #else
58 void
59 s1934 (et, in, ik, start, end, jstat)
60 double *et;
61 int in;
62 int ik;
63 double start;
64 double end;
65 int *jstat;
66
67 #endif
68 /*
69 *********************************************************************
70 *
71 *********************************************************************
72 *
73 * PURPOSE : To map the support of a knot vector into a specified
74 * interval.
75 *
76 *
77 * INPUT : et - The original knot vector
78 * in - The number of degrees of freedom in the
79 * B-basis given by the knot vector.
80 * ik - The order of the basis.
81 * start - Start of the interval into which the knot
82 * vector is to be mapped.
83 * end - End of the interval into which the knot
84 * vector is to be mapped.
85 *
86 *
87 * OUTPUT : et - The changed knot vector.
88 * jstat - Output status:
89 * < 0: Error.
90 * = 0: Ok.
91 * > 0: Warning.
92 *
93 * METHOD :
94 *
95 * REFERENCES : Fortran version:
96 * T.Dokken, SI, 1981-10
97 *
98 * CALLS : s6err.
99 *
100 *
101 * WRITTEN BY : Christophe R. Birkeland
102 * REWISED BY : Vibeke Skytt, SI, 92-10. The output knot vector will
103 * have k-tupple knots in the ends.
104 *
105 *********************************************************************
106 */
107 {
108 int ii, stop; /* Loop control parameters */
109 int kpos = 0; /* Error position indicator */
110 double store1; /* Parameters used to decrease execution
111 * time */
112 double fac; /* Factor used in computation of new
113 * knot vector */
114
115 *jstat = 0;
116
117
118 /* Test if legal input */
119
120 if ((ik < 1) || (in <ik))
121 goto err112;
122
123 if (start == end)
124 goto err124;
125
126
127 /* Perform normalization */
128
129 store1 = et[ik - 1];
130 fac = (end - start) / (et[in] -store1);
131 stop = in +ik;
132
133 for (ii=0; ii<ik; ii++) et[ii] = start;
134
135 for (ii = ik; ii < in; ii++)
136 et[ii] = fac * (et[ii] - store1) + start;
137
138 for (ii = in; ii < stop; ii++) et[ii] = end;
139
140
141 /* Normalization performed */
142
143 goto out;
144
145
146 /* Error in description of B-spline */
147
148 err112:
149 *jstat = -112;
150 s6err ("s1934", *jstat, kpos);
151 goto out;
152
153 /* The parameter interval is of zero length */
154
155 err124:
156 *jstat = -124;
157 s6err ("s1934", *jstat, kpos);
158 goto out;
159
160 out:
161 return;
162 }
163