OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fxbodv.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!|| fxlink ../engine/source/constraints/fxbody/fxbodv.F
25!||--- called by ------------------------------------------------------
26!|| fxbodvp1 ../engine/source/constraints/fxbody/fxbodvp.F
27!||====================================================================
28 SUBROUTINE fxlink(CR , SR, DT1, DT2, FXBRPM,
29 . FXBVIT, NME)
30C-----------------------------------------------
31C I m p l i c i t T y p e s
32C-----------------------------------------------
33#include "implicit_f.inc"
34C-----------------------------------------------
35C D u m m y A r g u m e n t s
36C-----------------------------------------------
37 INTEGER NME
38 my_real
39 . cr(6,*), sr(*), dt1, dt2, fxbrpm(*), fxbvit(*)
40C-----------------------------------------------
41C L o c a l V a r i a b l e s
42C-----------------------------------------------
43 INTEGER I,II
44 my_real
45 . v1(3),v2(3),v3(3),v4(3),v5(3),v6(3)
46 my_real
47 . d1,d2,d3,d4,d5,d6
48C-----------------------------------------------
49C VECTEURS
50C-----------------------------------------------
51 v1(1)=fxbrpm(2)
52 v1(2)=fxbrpm(5)
53 v1(3)=fxbrpm(8)
54 v2(1)=fxbrpm(3)
55 v2(2)=fxbrpm(6)
56 v2(3)=fxbrpm(9)
57 v3(1)=fxbrpm(4)
58 v3(2)=fxbrpm(7)
59 v3(3)=fxbrpm(10)
60 v4(1)=v2(1)-v1(1)
61 v4(2)=v2(2)-v1(2)
62 v4(3)=v2(3)-v1(3)
63 v5(1)=v3(1)-v1(1)
64 v5(2)=v3(2)-v1(2)
65 v5(3)=v3(3)-v1(3)
66 v6(1)=v3(1)-v2(1)
67 v6(2)=v3(2)-v2(2)
68 v6(3)=v3(3)-v2(3)
69C
70 d1=zero
71 d2=zero
72 d3=zero
73 d4=zero
74 d5=zero
75 d6=zero
76 DO i=1,3
77 d1=d1+v1(i)**2
78 d2=d2+v2(i)**2
79 d3=d3+v3(i)**2
80 d4=d4+v4(i)**2
81 d5=d5+v5(i)**2
82 d6=d6+v6(i)**2
83 END DO
84C-----------------------------------------------
85C MATRICE
86C-----------------------------------------------
87 DO i=1,6
88 DO ii=1,nme
89 cr(i,ii)=zero
90 ENDDO
91 ENDDO
92C
93 cr(1,10)=-v1(1)-dt2*(fxbvit(1)-fxbvit(10))
94 cr(1,11)=-v1(2)-dt2*(fxbvit(2)-fxbvit(11))
95 cr(1,12)=-v1(3)-dt2*(fxbvit(3)-fxbvit(12))
96 cr(1,1)=-cr(1,10)
97 cr(1,2)=-cr(1,11)
98 cr(1,3)=-cr(1,12)
99C
100 cr(2,10)=-v2(1)-dt2*(fxbvit(4)-fxbvit(10))
101 cr(2,11)=-v2(2)-dt2*(fxbvit(5)-fxbvit(11))
102 cr(2,12)=-v2(3)-dt2*(fxbvit(6)-fxbvit(12))
103 cr(2,4)=-cr(2,10)
104 cr(2,5)=-cr(2,11)
105 cr(2,6)=-cr(2,12)
106C
107 cr(3,10)=-v3(1)-dt2*(fxbvit(7)-fxbvit(10))
108 cr(3,11)=-v3(2)-dt2*(fxbvit(8)-fxbvit(11))
109 cr(3,12)=-v3(3)-dt2*(fxbvit(9)-fxbvit(12))
110 cr(3,7)=-cr(3,10)
111 cr(3,8)=-cr(3,11)
112 cr(3,9)=-cr(3,12)
113C
114 cr(4,1)=-v4(1)-dt2*(fxbvit(4)-fxbvit(1))
115 cr(4,2)=-v4(2)-dt2*(fxbvit(5)-fxbvit(2))
116 cr(4,3)=-v4(3)-dt2*(fxbvit(6)-fxbvit(3))
117 cr(4,4)=-cr(4,1)
118 cr(4,5)=-cr(4,2)
119 cr(4,6)=-cr(4,3)
120C
121 cr(5,1)=-v5(1)-dt2*(fxbvit(7)-fxbvit(1))
122 cr(5,2)=-v5(2)-dt2*(fxbvit(8)-fxbvit(2))
123 cr(5,3)=-v5(3)-dt2*(fxbvit(9)-fxbvit(3))
124 cr(5,7)=-cr(5,1)
125 cr(5,8)=-cr(5,2)
126 cr(5,9)=-cr(5,3)
127C
128 cr(6,4)=-v6(1)-dt2*(fxbvit(7)-fxbvit(4))
129 cr(6,5)=-v6(2)-dt2*(fxbvit(8)-fxbvit(5))
130 cr(6,6)=-v6(3)-dt2*(fxbvit(9)-fxbvit(6))
131 cr(6,7)=-cr(6,4)
132 cr(6,8)=-cr(6,5)
133 cr(6,9)=-cr(6,6)
134C-----------------------------------------------
135C SECOND MEMBRE
136C-----------------------------------------------
137 DO i=1,6
138 sr(i)=zero
139 ENDDO
140 DO i=1,3
141 sr(1)=sr(1)-one/(dt1+dt2)*(two*v1(i)+
142 . dt2*(fxbvit(i)-fxbvit(9+i)))
143 . *(fxbvit(i)-fxbvit(9+i))
144 sr(2)=sr(2)-one/(dt1+dt2)*(two*v2(i)+
145 . dt2*(fxbvit(3+i)-fxbvit(9+i)))
146 . *(fxbvit(3+i)-fxbvit(9+i))
147 sr(3)=sr(3)-one/(dt1+dt2)*(two*v3(i)+
148 . dt2*(fxbvit(6+i)-fxbvit(9+i)))
149 . *(fxbvit(6+i)-fxbvit(9+i))
150 sr(4)=sr(4)-one/(dt1+dt2)*(two*v4(i)+
151 . dt2*(fxbvit(3+i)-fxbvit(i)))
152 . *(fxbvit(3+i)-fxbvit(i))
153 sr(5)=sr(5)-one/(dt1+dt2)*(two*v5(i)+
154 . dt2*(fxbvit(6+i)-fxbvit(i)))
155 . *(fxbvit(6+i)-fxbvit(i))
156 sr(6)=sr(6)-one/(dt1+dt2)*(two*v6(i)+
157 . dt2*(fxbvit(6+i)-fxbvit(3+i)))
158 . *(fxbvit(6+i)-fxbvit(3+i))
159 END DO
160 sr(1)=sr(1)+one/(dt2*(dt1+dt2))*(one-d1)
161 sr(2)=sr(2)+one/(dt2*(dt1+dt2))*(one-d2)
162 sr(3)=sr(3)+one/(dt2*(dt1+dt2))*(one-d3)
163 sr(4)=sr(4)+one/(dt2*(dt1+dt2))*(two-d4)
164 sr(5)=sr(5)+one/(dt2*(dt1+dt2))*(two-d5)
165 sr(6)=sr(6)+one/(dt2*(dt1+dt2))*(two-d6)
166C
167 RETURN
168 END
169!||====================================================================
170!|| splink ../engine/source/constraints/fxbody/fxbodv.F
171!||--- called by ------------------------------------------------------
172!|| fxbodvp1 ../engine/source/constraints/fxbody/fxbodvp.F
173!||====================================================================
174 SUBROUTINE splink(MT, ST, DT1, FXBRPM, FXBVIT,
175 . DMT)
176C-----------------------------------------------
177C I m p l i c i t T y p e s
178C-----------------------------------------------
179#include "implicit_f.inc"
180C-----------------------------------------------
181C C o m m o n B l o c k s
182C-----------------------------------------------
183#include "com01_c.inc"
184C-----------------------------------------------
185C D u m m y A r g u m e n t s
186C-----------------------------------------------
187 INTEGER DMT
188 my_real
189 . mt(dmt,*), st(*), dt1, fxbrpm(*), fxbvit(*)
190C-----------------------------------------------
191C L o c a l V a r i a b l e s
192C-----------------------------------------------
193 INTEGER I,II
194 my_real
195 . p11,p12,p13,p21,p22,p23,p31,p32,p33,dt05
196C
197 dt05=half*dt1
198C
199 DO i=1,3
200 DO ii=1,dmt
201 mt(21+i,ii)=zero
202 ENDDO
203 DO ii=16,21
204 mt(ii,21+i)=zero
205 ENDDO
206 ENDDO
207C
208 p11=fxbrpm(2)
209 p12=fxbrpm(3)
210 p13=fxbrpm(4)
211 p21=fxbrpm(5)
212 p22=fxbrpm(6)
213 p23=fxbrpm(7)
214 p31=fxbrpm(8)
215 p32=fxbrpm(9)
216 p33=fxbrpm(10)
217C
218 IF (ncycle==0) THEN
219 mt(22,13)=one
220 mt(23,14)=one
221 mt(24,15)=one
222 ELSE
223 mt(22,4)=-p13*p11
224 mt(22,5)=-p13*p21
225 mt(22,6)=-p13*p31
226 mt(22,8)=-p11*p22+p12*p21
227 mt(22,9)=-p11*p32+p12*p31
228 mt(22,10)=p13*p11
229 mt(22,11)=p11*p22-p12*p21+p13*p21
230 mt(22,12)=p11*p32-p12*p31+p13*p31
231 mt(22,13)=-one
232 mt(23,4)=-p23*p11
233 mt(23,5)=-p23*p21
234 mt(23,6)=-p23*p31
235 mt(23,7)=-p21*p12+p22*p11
236 mt(23,9)=-p21*p32+p22*p31
237 mt(23,10)=p21*p12-p22*p11+p23*p11
238 mt(23,11)=p23*p21
239 mt(23,12)=p21*p32-p22*p31+p23*p31
240 mt(23,14)=-one
241 mt(24,4)=-p33*p11
242 mt(24,5)=-p33*p21
243 mt(24,6)=-p33*p31
244 mt(24,7)=-p31*p12+p32*p11
245 mt(24,8)=-p31*p22+p32*p21
246 mt(24,10)=p31*p12-p32*p11+p33*p11
247 mt(24,11)=p31*p22-p32*p21+p33*p21
248 mt(24,12)=p33*p31
249 mt(24,15)=-one
250 ENDIF
251C
252 IF (ncycle==0) THEN
253 st(22)=zero
254 st(23)=zero
255 st(24)=zero
256 ELSE
257 st(22)=fxbvit(13)+fxbvit(4)*p13*p11+fxbvit(5)*p13*p21
258 . +fxbvit(6)*p13*p31+fxbvit(8)*(p11*p22-p12*p21)
259 . +fxbvit(9)*(p11*p32-p12*p31)-fxbvit(10)*p13*p11
260 . -fxbvit(11)*(p11*p22-p12*p21+p13*p21)
261 . -fxbvit(12)*(p11*p32-p12*p31+p13*p31)
262C
263 st(23)=fxbvit(14)+fxbvit(4)*p23*p11+fxbvit(5)*p23*p21
264 . +fxbvit(6)*p23*p31+fxbvit(7)*(p21*p12-p22*p11)
265 . +fxbvit(9)*(p21*p32-p22*p31)
266 . -fxbvit(10)*(p21*p12-p22*p11+p23*p11)-fxbvit(11)*p23*p21
267 . -fxbvit(12)*(p21*p32-p22*p31+p23*p31)
268C
269 st(24)=fxbvit(15)+fxbvit(4)*p33*p11+fxbvit(5)*p33*p21
270 . +fxbvit(6)*p33*p31+fxbvit(7)*(p31*p12-p32*p11)
271 . +fxbvit(8)*(p31*p22-p32*p21)
272 . -fxbvit(10)*(p31*p12-p32*p11+p33*p11)
273 . -fxbvit(11)*(p31*p22-p32*p21+p33*p21)-fxbvit(12)*p33*p31
274C
275 st(22)=st(22)/dt05
276 st(23)=st(23)/dt05
277 st(24)=st(24)/dt05
278 ENDIF
279C
280 DO i=1,3
281 DO ii=1,15
282 mt(ii,21+i)=mt(21+i,ii)
283 ENDDO
284 ENDDO
285C
286 RETURN
287 END
288!||====================================================================
289!|| fxspin ../engine/source/constraints/fxbody/fxbodv.F
290!||--- called by ------------------------------------------------------
291!|| fxbodvp2 ../engine/source/constraints/fxbody/fxbodvp.F
292!||====================================================================
293 SUBROUTINE fxspin(FXBRPM, FXBVIT, S, R12, DT2)
294C-----------------------------------------------
295C I m p l i c i t T y p e s
296C-----------------------------------------------
297#include "implicit_f.inc"
298C-----------------------------------------------
299C D u m m y A r g u m e n t s
300C-----------------------------------------------
301 my_real :: fxbrpm(*), fxbvit(*), s(*), r12(*), dt2
302C-----------------------------------------------
303C L o c a l V a r i a b l e s
304C-----------------------------------------------
305 my_real sl(3),ddep(12),dt05
306 INTEGER I,J
307 dt05=half*dt2
308 DO i=1,12
309 ddep(i)=dt05*fxbvit(i)
310 ENDDO
311 DO i=1,3
312 DO j=1,3
313 r12(3*(i-1)+j)=fxbrpm(1+3*(i-1)+j)+ddep(3*(j-1)+i)-ddep(9+i)
314 ENDDO
315 ENDDO
316
317 sl(1)=-r12(2)*(fxbvit(7)-fxbvit(10))
318 . -r12(5)*(fxbvit(8)-fxbvit(11))
319 . -r12(8)*(fxbvit(9)-fxbvit(12))
320
321 sl(2)=r12(1)*(fxbvit(7)-fxbvit(10))
322 . +r12(4)*(fxbvit(8)-fxbvit(11))
323 . +r12(7)*(fxbvit(9)-fxbvit(12))
324
325 sl(3)=-r12(1)*(fxbvit(4)-fxbvit(10))
326 . -r12(4)*(fxbvit(5)-fxbvit(11))
327 . -r12(7)*(fxbvit(6)-fxbvit(12))
328
329 s(1)=r12(1)*sl(1)+r12(2)*sl(2)+r12(3)*sl(3)
330 s(2)=r12(4)*sl(1)+r12(5)*sl(2)+r12(6)*sl(3)
331 s(3)=r12(7)*sl(1)+r12(8)*sl(2)+r12(9)*sl(3)
332
333 RETURN
334 END
my_real
#define my_real
Definition cppsort.cpp:32
splink
subroutine splink(mt, st, dt1, fxbrpm, fxbvit, dmt)
Definition fxbodv.F:176
fxspin
subroutine fxspin(fxbrpm, fxbvit, s, r12, dt2)
Definition fxbodv.F:294
fxlink
subroutine fxlink(cr, sr, dt1, dt2, fxbrpm, fxbvit, nme)
Definition fxbodv.F:30