OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dersbasisfuns.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| dersbasisfuns ../engine/source/elements/ige3d/dersbasisfuns.F
25!||--- called by ------------------------------------------------------
26!|| ige3daire ../engine/source/elements/ige3d/ig3daire.F
27!||====================================================================
28 SUBROUTINE dersbasisfuns(IDXI, PXI, XI, KXI, DERS1, DERS2)
29C--------------------------------------------------------------------------------------------------------
30C
31C This subroutine calculates B-spline functions and derivates of B-spline functions
32C Assembling B spline functions for NURBS is outside this subroutine
33C (Like subroutine Bspline_basis_and_deriv, p.101 ISOGEOMETRIC ANALYSIS)
34C
35C--------------------------------------------------------------------------------------------------------
36C VAR | SIZE | TYP | RW | DEFINITION
37C--------------------------------------------------------------------------------------------------------
38C IDXI | 1 | I | R | ELEMENT INDEX IN KNOT VECTOR IN XI DIRECTION
39C PXI | 1 | I | R | POLYNOMIAL INTERPOLATION DEGREE IN XI DIRECTION
40C XI | 1 | F | R | COUNTER PARAMETER VALUE (WHERE THE FUNCTION AND DERIVATE ARE CALCULATED)
41C--------------------------------------------------------------------------------------------------------
42C KXI | NKXI | F | R | (FULL) KNOT VECTOR IN XI DIRECTION FOR THE CURRENT PATCH (GROUP)
43C--------------------------------------------------------------------------------------------------------
44C DERS1 | PXI+1 | F | W | INTERPOLATION FUNCTION
45C DERS2 | PXI+1 | F | W | DERIVATE OF INTERPOLATION FUNCTION
46C--------------------------------------------------------------------------------------------------------
47C Implicite Types
48C--------------------------------------------------------------------------------------------------------
49#include "implicit_f.inc"
50C--------------------------------------------------------------------------------------------------------
51C Dummy Arguments
52C--------------------------------------------------------------------------------------------------------
53 INTEGER PXI, IDXI
54 my_real, INTENT(IN) :: xi
55 my_real, DIMENSION(*), INTENT(IN) :: kxi
56 my_real, DIMENSION(*), INTENT(OUT) :: ders1, ders2
57C--------------------------------------------------------------------------------------------------------
58C Local variables
59C--------------------------------------------------------------------------------------------------------
60 INTEGER J, K, L, KR, KP, J1, J2, NDERS, LS1, LS2
61 my_real saved, temp, d
62 my_real, DIMENSION(PXI+1) :: aleft, right
63 my_real, DIMENSION(2,PXI+1) :: ders, a
64 my_real, DIMENSION(PXI+1,PXI+1) :: andu
65
66 nders=1
67 andu(1,1)=one
68
69 DO j = 1,pxi
70 aleft(j+1) = xi - kxi(idxi+1-j)
71 right(j+1) = kxi(idxi+j) - xi
72 saved = zero
73 DO l = 0,j-1
74 andu(j+1,l+1) = right(l+2) + aleft(j-l+1)
75 temp = andu(l+1,j)/andu(j+1,l+1)
76 andu(l+1,j+1) = saved + right(l+2)*temp
77 saved = aleft(j-l+1)*temp
78 ENDDO
79 andu(j+1,j+1) = saved
80 ENDDO
81
82C LOAD BASIS FUNCTIONS
83 DO j = 0,pxi
84 ders(1,j+1) = andu(j+1,pxi+1)
85 ENDDO
86
87C COMPUTE DERIVATES
88 DO l = 0,pxi
89 ls1 = 0
90 ls2 = 1
91 a(1,1) = one
92
93 DO k = 1,nders
94 d = zero
95 kr = l-k
96 kp = pxi-k
97 IF (l >= k) THEN
98 a(ls2+1,1) = a(ls1+1,1)/andu(kp+2,kr+1)
99 d = a(ls2+1,1)*andu(kr+1,kp+1)
100 ENDIF
101 IF (kr >= -1) THEN
102 j1 = 1
103 ELSE
104 j1 = -kr
105 ENDIF
106 IF ((l-1) <= kp) THEN
107 j2 = k-1
108 ELSE
109 j2 = pxi-l
110 ENDIF
111 DO j = j1,j2
112 a(ls2+1,j+1) = (a(ls1+1,j+1) - a(ls1+1,j))/andu(kp+2,kr+j+1)
113 d = d + a(ls2+1,j+1)*andu(kr+j+1,kp+1)
114 ENDDO
115 IF (l <= kp) THEN
116 a(ls2+1,k+1) = -a(ls1+1,k)/andu(kp+2,l+1)
117 d = d + a(ls2+1,k+1)*andu(l+1,kp+1)
118 ENDIF
119 ders(k+1,l+1) = d
120 j = ls1
121 ls1 = ls2
122 ls2 = j
123 ENDDO
124 ENDDO
125
126C MULTIPLY THROUGH BY THE CORRECT FACTORS
127
128 l = pxi
129 DO k = 1,nders
130 DO j = 0,pxi
131 ders(k+1,j+1) = ders(k+1,j+1)*l
132 ENDDO
133 l = l*(pxi-k)
134 ENDDO
135
136 DO j = 1,pxi+1
137 ders1(j) = ders(1,j)
138 ders2(j) = ders(2,j)
139 ENDDO
140
141 RETURN
142 END
143C
144!||====================================================================
145!|| basisfuns ../engine/source/elements/ige3d/dersbasisfuns.F
146!||====================================================================
147 SUBROUTINE basisfuns(IDXI, PXI, XI, KXI, DERS1)
148C--------------------------------------------------------------------------------------------------------
149C
150C This subroutine calculates B-spline functions and derivates of B-spline functions
151C Assembling B spline functions for NURBS is outside this subroutine
152C (Like subroutine Bspline_basis_and_deriv, p.101 ISOGEOMETRIC ANALYSIS)
153C
154C--------------------------------------------------------------------------------------------------------
155C VAR | SIZE | TYP | RW | DEFINITION
156C--------------------------------------------------------------------------------------------------------
157C IDXI | 1 | I | R | ELEMENT INDEX IN KNOT VECTOR IN XI DIRECTION
158C PXI | 1 | I | R | POLYNOMIAL INTERPOLATION DEGREE IN XI DIRECTION
159C XI | 1 | F | R | COUNTER PARAMETER VALUE (WHERE THE FUNCTION AND DERIVATE ARE CALCULATED)
160C--------------------------------------------------------------------------------------------------------
161C KXI | NKXI | F | R | (FULL) KNOT VECTOR IN XI DIRECTION FOR THE CURRENT PATCH (GROUP)
162C--------------------------------------------------------------------------------------------------------
163C DERS1 | PXI+1 | F | W | INTERPOLATION FUNCTION
164C--------------------------------------------------------------------------------------------------------
165C Implicite Types
166C--------------------------------------------------------------------------------------------------------
167#include "implicit_f.inc"
168C--------------------------------------------------------------------------------------------------------
169C Dummy Arguments
170C--------------------------------------------------------------------------------------------------------
171 INTEGER PXI, IDXI
172 my_real, INTENT(IN) :: xi
173 my_real, DIMENSION(*), INTENT(IN) :: kxi
174 my_real, DIMENSION(*), INTENT(OUT) :: ders1
175C--------------------------------------------------------------------------------------------------------
176C Local variables
177C--------------------------------------------------------------------------------------------------------
178 INTEGER J, L
179 my_real saved, temp
180 my_real, DIMENSION(PXI+1) :: aleft, right
181 my_real, DIMENSION(PXI+1,PXI+1) :: andu
182
183 andu(1,1)=one
184
185 DO j = 1,pxi
186 aleft(j+1) = xi - kxi(idxi+1-j)
187 right(j+1) = kxi(idxi+j) - xi
188 saved = zero
189 DO l = 0,j-1
190 andu(j+1,l+1) = right(l+2) + aleft(j-l+1)
191 temp = andu(l+1,j)/andu(j+1,l+1)
192 andu(l+1,j+1) = saved + right(l+2)*temp
193 saved = aleft(j-l+1)*temp
194 ENDDO
195 andu(j+1,j+1) = saved
196 ENDDO
197
198C LOAD BASIS FUNCTIONS
199 DO j = 0,pxi
200 ders1(j+1) = andu(j+1,pxi+1)
201 ENDDO
202
203 RETURN
204 END
my_real
#define my_real
Definition cppsort.cpp:32
basisfuns
subroutine basisfuns(idxi, pxi, xi, kxi, ders1)
Definition dersbasisfuns.F:148
dersbasisfuns
subroutine dersbasisfuns(idxi, pxi, xi, kxi, ders1, ders2)
Definition dersbasisfuns.F:29