OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
subrot.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine subrotvect (x, y, z, rtrans, sub_id, lsubmodel)
subroutine subrotpoint (x, y, z, rtrans, sub_id, lsubmodel)
subroutine subrottens (tens, rtrans, sub_id, lsubmodel)

Function/Subroutine Documentation

◆ subrotpoint()

subroutine subrotpoint ( x,
y,
z,
rtrans,
integer sub_id,
type(submodel_data), dimension(*) lsubmodel )

Definition at line 179 of file subrot.F.

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
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

◆ subrottens()

subroutine subrottens ( tens,
rtrans,
integer sub_id,
type(submodel_data), dimension(*) lsubmodel )

Definition at line 320 of file subrot.F.

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

◆ subrotvect()

subroutine subrotvect ( x,
y,
z,
rtrans,
integer sub_id,
type(submodel_data), dimension(*) lsubmodel )

Definition at line 53 of file subrot.F.

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