OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
subrot.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!|| subrotvect ../starter/source/model/submodel/subrot.F
25!||--- called by ------------------------------------------------------
26!|| hm_prop_read21 ../starter/source/properties/thickshell/hm_read_prop21.F
27!|| hm_read_friction_orientations ../starter/source/interfaces/friction/reader/hm_read_friction_orientations.F
28!|| hm_read_frm ../starter/source/tools/skew/hm_read_frm.F
29!|| hm_read_inistate_d00 ../starter/source/elements/initia/hm_read_inistate_d00.F
30!|| hm_read_inivel ../starter/source/initial_conditions/general/inivel/hm_read_inivel.F
31!|| hm_read_prop06 ../starter/source/properties/solid/hm_read_prop06.F
32!|| hm_read_prop09 ../starter/source/properties/shell/hm_read_prop09.F
33!|| hm_read_prop10 ../starter/source/properties/shell/hm_read_prop10.F
34!|| hm_read_prop11 ../starter/source/properties/shell/hm_read_prop11.F
35!|| hm_read_prop16 ../starter/source/properties/shell/hm_read_prop16.F
36!|| hm_read_prop17 ../starter/source/properties/shell/hm_read_prop17.F
37!|| hm_read_prop22 ../starter/source/properties/thickshell/hm_read_prop22.F
38!|| hm_read_prop51 ../starter/source/properties/shell/hm_read_prop51.F
39!|| hm_read_rwall_cyl ../starter/source/constraints/general/rwall/hm_read_rwall_cyl.F
40!|| hm_read_rwall_lagmul ../starter/source/constraints/general/rwall/hm_read_rwall_lagmul.F
41!|| hm_read_rwall_paral ../starter/source/constraints/general/rwall/hm_read_rwall_paral.F
42!|| hm_read_rwall_plane ../starter/source/constraints/general/rwall/hm_read_rwall_plane.F
43!|| hm_read_rwall_spher ../starter/source/constraints/general/rwall/hm_read_rwall_spher.F
44!|| hm_read_stack ../starter/source/stack/hm_read_stack.F
45!|| lecsec42 ../starter/source/tools/sect/hm_read_sect.F
46!|| lecsec4bolt ../starter/source/tools/sect/lecsec4bolt.F
47!|| lectrans ../starter/source/model/transformation/lectrans.F
48!||--- calls -----------------------------------------------------
49!|| euler_vrot ../starter/source/model/submodel/euler_vrot.F
50!||--- uses -----------------------------------------------------
51!|| submodel_mod ../starter/share/modules1/submodel_mod.F
52!||====================================================================
53 SUBROUTINE subrotvect (X,Y,Z,RTRANS,SUB_ID,LSUBMODEL)
54C-----------------------------------------------
55C M o d u l e s
56C-----------------------------------------------
57 USE submodel_mod
58C-----------------------------------------------
59C I m p l i c i t T y p e s
60C-----------------------------------------------
61#include "implicit_f.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "com04_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 INTEGER SUB_ID
70 TYPE(submodel_data) LSUBMODEL(*)
71 my_real
72 . x,y,z, rtrans(ntransf,*)
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER I,L,K,CPTZERO,IDSUBMODEL,SUB_LEVEL,CUR_SUBMOD,ITY
77 my_real
78 . rot(9),p(3),x0(3),x1(3),sx,sy,sz,s,tx,ty,tz
79C======================================================================
80 x0 = zero
81 idsubmodel = 0
82 IF(sub_id /= 0) THEN
83 DO k= 1,nsubmod
84 IF(lsubmodel(k)%NOSUBMOD == sub_id) THEN
85 idsubmodel = k
86 EXIT
87 ENDIF
88 ENDDO
89 ENDIF
90 cur_submod = idsubmodel
91 sub_level = lsubmodel(idsubmodel)%LEVEL
92 DO WHILE (sub_level /= 0)
93 DO i=1,lsubmodel(cur_submod)%NBTRANS
94 IF (lsubmodel(cur_submod)%IDTRANS(i) /= 0) THEN
95 ity = rtrans(lsubmodel(cur_submod)%IDTRANS(i),2)
96 IF ( ity == 5 )THEN
97 DO k=1,3
98 x0(k)=rtrans(lsubmodel(cur_submod)%IDTRANS(i),k+11)
99 ENDDO
100 DO k=1,3
101 x1(k)=rtrans(lsubmodel(cur_submod)%IDTRANS(i),k+14)
102 ENDDO
103 tx = x1(1) - x0(1)
104 ty = x1(2) - x0(2)
105 tz = x1(3) - x0(3)
106 s = one/max(sqrt(tx*tx + ty*ty + tz*tz),em20)
107 tx = tx*s
108 ty = ty*s
109 tz = tz*s
110 sx = x - x0(1)
111 sy = y - x0(2)
112 sz = z - x0(3)
113 s = sx*tx + sy*ty + sz*tz
114 x = x - two*tx*s
115 y = y - two*ty*s
116 z = z - two*tz*s
117 ELSE IF ( ity == 6 )THEN
118 DO l=1,3
119 x0(l) = rtrans(lsubmodel(cur_submod)%IDTRANS(i),l+11)
120 ENDDO
121 sx = rtrans(lsubmodel(cur_submod)%IDTRANS(i),20)
122 sy = rtrans(lsubmodel(cur_submod)%IDTRANS(i),21)
123 sz = rtrans(lsubmodel(cur_submod)%IDTRANS(i),22)
124 x = x * sx
125 y = y * sy
126 z = z * sz
127 ELSE
128 cptzero = 0
129 DO l=1,9
130 rot(l) = rtrans(lsubmodel(cur_submod)%IDTRANS(i),l+2)
131 IF (rot(l) == zero ) cptzero = cptzero + 1
132 ENDDO
133 IF(cptzero == 9) cycle
134 p(1) = x
135 p(2) = y
136 p(3) = z
137 CALL euler_vrot (x0,p,rot)
138 x = p(1)
139 y = p(2)
140 z = p(3)
141 ENDIF
142 ENDIF
143 ENDDO
144 sub_level = sub_level - 1
145 cur_submod = lsubmodel(cur_submod)%IFATHER
146 ENDDO
147
148C---
149 RETURN
150 END
151!||====================================================================
152!|| subrotpoint ../starter/source/model/submodel/subrot.F
153!||--- called by ------------------------------------------------------
154!|| create_ellipse_clause ../starter/source/model/sets/create_ellipse_clause.F
155!|| create_plane_clause ../starter/source/model/sets/create_plane_clause.F90
156!|| hm_read_frm ../starter/source/tools/skew/hm_read_frm.F
157!|| hm_read_pblast ../starter/source/loads/pblast/hm_read_pblast.F
158!|| hm_read_rwall_cyl ../starter/source/constraints/general/rwall/hm_read_rwall_cyl.F
159!|| hm_read_rwall_lagmul ../starter/source/constraints/general/rwall/hm_read_rwall_lagmul.F
160!|| hm_read_rwall_paral ../starter/source/constraints/general/rwall/hm_read_rwall_paral.F
161!|| hm_read_rwall_plane ../starter/source/constraints/general/rwall/hm_read_rwall_plane.F
162!|| hm_read_rwall_spher ../starter/source/constraints/general/rwall/hm_read_rwall_spher.F
163!|| hm_read_rwall_therm ../starter/source/constraints/general/rwall/hm_read_rwall_therm.F
164!|| hm_read_skw ../starter/source/tools/skew/hm_read_skw.F
165!|| hm_read_sphio ../starter/source/loads/sph/hm_read_sphio.F
166!|| hm_read_surf ../starter/source/groups/hm_read_surf.F
167!|| hm_read_xref ../starter/source/loads/reference_state/xref/hm_read_xref.F
168!|| lecsec42 ../starter/source/tools/sect/hm_read_sect.F
169!|| lecsec4bolt ../starter/source/tools/sect/lecsec4bolt.F
170!|| lectrans ../starter/source/model/transformation/lectrans.F
171!|| read_box_cyl ../starter/source/model/box/read_box_cyl.F
172!|| read_box_rect ../starter/source/model/box/read_box_rect.F
173!|| read_box_spher ../starter/source/model/box/read_box_spher.F
174!||--- calls -----------------------------------------------------
175!|| euler_vrot ../starter/source/model/submodel/euler_vrot.F
176!||--- uses -----------------------------------------------------
177!|| submodel_mod ../starter/share/modules1/submodel_mod.F
178!||====================================================================
179 SUBROUTINE subrotpoint (X,Y,Z,RTRANS,SUB_ID,LSUBMODEL)
180C-----------------------------------------------
181C M o d u l e s
182C-----------------------------------------------
183 USE submodel_mod
184C-----------------------------------------------
185C I m p l i c i t T y p e s
186C-----------------------------------------------
187#include "implicit_f.inc"
188C-----------------------------------------------
189C C o m m o n B l o c k s
190C-----------------------------------------------
191#include "com04_c.inc"
192C-----------------------------------------------
193C D u m m y A r g u m e n t s
194C-----------------------------------------------
195 INTEGER SUB_ID
196 TYPE(submodel_data) LSUBMODEL(*)
197 my_real
198 . x,y,z, rtrans(ntransf,*)
199C-----------------------------------------------
200C L o c a l V a r i a b l e s
201C-----------------------------------------------
202 INTEGER I,L,K,IDSUBMODEL,ITY,SUB_LEVEL,CUR_SUBMOD
203 my_real
204 . rot(9),p(3),x0(3),x1(3),tx,ty,tz,xp,yp,zp,xcold(3),xcnew(3),
205 . sx,sy,sz,s
206C======================================================================
207 idsubmodel = 0
208 IF(sub_id /= 0) THEN
209 DO k= 1,nsubmod
210 IF(lsubmodel(k)%NOSUBMOD == sub_id) THEN
211 idsubmodel = k
212 EXIT
213 ENDIF
214 ENDDO
215 ENDIF
216 cur_submod = idsubmodel
217 sub_level = lsubmodel(idsubmodel)%LEVEL
218 DO WHILE (sub_level /= 0)
219 DO i=1,lsubmodel(cur_submod)%NBTRANS
220 IF (lsubmodel(cur_submod)%IDTRANS(i) /= 0) THEN
221 ity = rtrans(lsubmodel(cur_submod)%IDTRANS(i),2)
222 IF (ity ==1 )THEN
223 tx = rtrans(lsubmodel(cur_submod)%IDTRANS(i),15)
224 ty = rtrans(lsubmodel(cur_submod)%IDTRANS(i),16)
225 tz = rtrans(lsubmodel(cur_submod)%IDTRANS(i),17)
226 x = x + tx
227 y = y + ty
228 z = z + tz
229 ELSEIF(ity ==2 )THEN
230 DO l=1,3
231 x0(l) = rtrans(lsubmodel(cur_submod)%IDTRANS(i),l+11)
232 ENDDO
233 DO l=1,9
234 rot(l) = rtrans(lsubmodel(cur_submod)%IDTRANS(i),l+2)
235 ENDDO
236 p(1) = x
237 p(2) = y
238 p(3) = z
239 CALL euler_vrot (x0,p,rot)
240 x = p(1)
241 y = p(2)
242 z = p(3)
243 ELSEIF(ity ==3 )THEN
244 tx = rtrans(lsubmodel(cur_submod)%IDTRANS(i),15)
245 ty = rtrans(lsubmodel(cur_submod)%IDTRANS(i),16)
246 tz = rtrans(lsubmodel(cur_submod)%IDTRANS(i),17)
247 DO l=1,9
248 rot(l) = rtrans(lsubmodel(cur_submod)%IDTRANS(i),l+2)
249 ENDDO
250 xp = rot(1)*x + rot(4)*y + rot(7)*z + tx
251 yp = rot(2)*x + rot(5)*y + rot(8)*z + ty
252 zp = rot(3)*x + rot(6)*y + rot(9)*z + tz
253 x = xp
254 y = yp
255 z = zp
256 ELSEIF(ity ==4 )THEN
257 DO k=1,3
258 xcold(k)=rtrans(lsubmodel(cur_submod)%IDTRANS(i),k+11)
259 ENDDO
260 DO k=1,3
261 xcnew(k)=rtrans(lsubmodel(cur_submod)%IDTRANS(i),k+14)
262 ENDDO
263 DO k=1,9
264 rot(k)=rtrans(lsubmodel(cur_submod)%IDTRANS(i),k+2)
265 ENDDO
266 xp = x - xcold(1)
267 yp = y - xcold(2)
268 zp = z - xcold(3)
269 x = xcnew(1) + rot(1)*xp + rot(4)*yp + rot(7)*zp
270 y = xcnew(2) + rot(2)*xp + rot(5)*yp + rot(8)*zp
271 z = xcnew(3) + rot(3)*xp + rot(6)*yp + rot(9)*zp
272 ELSEIF (ity == 5)THEN
273 DO k=1,3
274 x0(k)=rtrans(lsubmodel(cur_submod)%IDTRANS(i),k+11)
275 ENDDO
276 DO k=1,3
277 x1(k)=rtrans(lsubmodel(cur_submod)%IDTRANS(i),k+14)
278 ENDDO
279 tx = x1(1) - x0(1)
280 ty = x1(2) - x0(2)
281 tz = x1(3) - x0(3)
282 s = one/max(sqrt(tx*tx + ty*ty + tz*tz),em20)
283 tx = tx*s
284 ty = ty*s
285 tz = tz*s
286 sx = x - x0(1)
287 sy = y - x0(2)
288 sz = z - x0(3)
289 s = sx*tx + sy*ty + sz*tz
290 x = x - two*tx*s
291 y = y - two*ty*s
292 z = z - two*tz*s
293 ELSEIF (ity == 6)THEN
294 DO l=1,3
295 x0(l) = rtrans(lsubmodel(cur_submod)%IDTRANS(i),l+11)
296 ENDDO
297 sx = rtrans(lsubmodel(cur_submod)%IDTRANS(i),20)
298 sy = rtrans(lsubmodel(cur_submod)%IDTRANS(i),21)
299 sz = rtrans(lsubmodel(cur_submod)%IDTRANS(i),22)
300 x = x0(1) + x * sx
301 y = x0(2) + y * sy
302 z = x0(3) + z * sz
303 ENDIF
304 ENDIF
305 ENDDO
306 sub_level = sub_level - 1
307 cur_submod = lsubmodel(cur_submod)%IFATHER
308 ENDDO
309
310C---
311 RETURN
312 END
313!||====================================================================
314!|| subrottens ../starter/source/model/submodel/subrot.F
315!||--- called by ------------------------------------------------------
316!|| hm_read_inistate_d00 ../starter/source/elements/initia/hm_read_inistate_d00.F
317!||--- uses -----------------------------------------------------
318!|| submodel_mod ../starter/share/modules1/submodel_mod.F
319!||====================================================================
320 SUBROUTINE subrottens (TENS,RTRANS,SUB_ID,LSUBMODEL)
321C-----------------------------------------------
322C M o d u l e s
323C-----------------------------------------------
324 USE submodel_mod
325C-----------------------------------------------
326C I m p l i c i t T y p e s
327C-----------------------------------------------
328#include "implicit_f.inc"
329C-----------------------------------------------
330C C o m m o n B l o c k s
331C-----------------------------------------------
332#include "com04_c.inc"
333C-----------------------------------------------
334C D u m m y A r g u m e n t s
335C-----------------------------------------------
336 INTEGER SUB_ID
337 TYPE(submodel_data) LSUBMODEL(*)
338 my_real
339 . tens(6), rtrans(ntransf,*)
340C-----------------------------------------------
341C L o c a l V a r i a b l e s
342C-----------------------------------------------
343 INTEGER I,L,K,CPTZERO,IDSUBMODEL,SUB_LEVEL,CUR_SUBMOD
344 my_real
345 . rot(9),p(3),x0(3),l11,l22,l33,l12,l23,l13,s11,s12,
346 . s13,s21,s22,s23,s31,s32,s33,r11,r12,
347 . r13,r21,r22,r23,r31,r32,r33
348C======================================================================
349 x0 = zero
350 idsubmodel = 0
351 IF(sub_id /= 0) THEN
352 DO k= 1,nsubmod
353 IF(lsubmodel(k)%NOSUBMOD == sub_id) THEN
354 idsubmodel = k
355 EXIT
356 ENDIF
357 ENDDO
358 ENDIF
359 cur_submod = idsubmodel
360 sub_level = lsubmodel(idsubmodel)%LEVEL
361 DO WHILE (sub_level /= 0)
362 DO i=1,lsubmodel(cur_submod)%NBTRANS
363 IF (lsubmodel(cur_submod)%IDTRANS(i) /= 0) THEN
364 cptzero = 0
365 DO l=1,9
366 rot(l) = rtrans(lsubmodel(cur_submod)%IDTRANS(i),l+2)
367 IF (rot(l) == zero ) cptzero = cptzero + 1
368 ENDDO
369 IF(cptzero == 9) cycle
370 r11 = rot(1)
371 r12 = rot(2)
372 r13 = rot(3)
373 r21 = rot(4)
374 r22 = rot(5)
375 r23 = rot(6)
376 r31 = rot(7)
377 r32 = rot(8)
378 r33 = rot(9)
379 l11 =tens(1)
380 l22 =tens(2)
381 l33 =tens(3)
382 l12 =tens(4)
383 l23 =tens(5)
384 l13 =tens(6)
385 s11 =l11*r11+l12*r12+l13*r13
386 s12 =l11*r21+l12*r22+l13*r23
387 s13 =l11*r31+l12*r32+l13*r33
388 s21 =l12*r11+l22*r12+l23*r13
389 s22 =l12*r21+l22*r22+l23*r23
390 s23 =l12*r31+l22*r32+l23*r33
391 s31 =l13*r11+l23*r12+l33*r13
392 s32 =l13*r21+l23*r22+l33*r23
393 s33 =l13*r31+l23*r32+l33*r33
394 tens(1)=r11*s11+r12*s21+r13*s31
395 tens(2)=r21*s12+r22*s22+r23*s32
396 tens(3)=r31*s13+r32*s23+r33*s33
397 tens(4)=r11*s12+r12*s22+r13*s32
398 tens(5)=r21*s13+r22*s23+r23*s33
399 tens(6)=r11*s13+r12*s23+r13*s33
400 ENDIF
401 ENDDO
402 sub_level = sub_level - 1
403 cur_submod = lsubmodel(cur_submod)%IFATHER
404 ENDDO
405
406C---
407 RETURN
408 END
my_real
#define my_real
Definition cppsort.cpp:32
euler_vrot
subroutine euler_vrot(x0, x, rot)
Definition euler_vrot.F:35
max
#define max(a, b)
Definition macros.h:21
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
submodel_mod::submodel_data
Definition submodel_mod.F:723
subrotvect
subroutine subrotvect(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:54
subrottens
subroutine subrottens(tens, rtrans, sub_id, lsubmodel)
Definition subrot.F:321
subrotpoint
subroutine subrotpoint(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:180