OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rskew33.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!|| rskew33 ../engine/source/elements/joint/rskew33.F
25!||--- called by ------------------------------------------------------
26!|| rgjoint ../engine/source/elements/joint/rgjoint.F
27!||--- calls -----------------------------------------------------
28!|| get_u_skew ../engine/source/user_interface/uaccess.F
29!|| inv3 ../engine/source/elements/joint/rskew33.F
30!|| prod_ab ../engine/source/elements/joint/rskew33.F
31!|| qrot33 ../engine/source/elements/joint/rskew33.F
32!||--- uses -----------------------------------------------------
33!|| sensor_mod ../common_source/modules/sensor_mod.F90
34!||====================================================================
35 SUBROUTINE rskew33(JFT ,JLT ,IXR ,IOUT ,IPROP,
36 . NUVAR ,UVAR ,RBY ,X ,XL ,
37 . ROT1 ,ROT2 ,DX ,DY ,DZ ,
38 . RX ,RY ,RZ ,VR ,IGTYP,
39 . NSENSOR,SENSOR_TAB,ISENS ,NC1 ,NC2 ,
40 . XDP)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE sensor_mod
45C-----------------------------------------------
46C IXR | 5*NEL | I | R | SPRING CONNECTIVITY
47C | IXR(1,I) IPROP
48C | IXR(2,I) NODE 1 ID
49C | IXR(3,I) NODE 2 ID
50C | IXR(4,I) OPTIONAL NODE 3 ID
51C | IXR(5,I) Material ID
52C | IXR(6,I) SPRING ID
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C G l o b a l P a r a m e t e r s
59C-----------------------------------------------
60#include "mvsiz_p.inc"
61#include "param_c.inc"
62#include "com08_c.inc"
63#include "com04_c.inc"
64#include "com01_c.inc"
65#include "scr05_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 INTEGER ,INTENT(IN) :: NSENSOR
70 INTEGER JFT, JLT, IOUT, NUVAR, IPROP, IXR(NIXR,*),IGTYP,
71 . ISENS,NC1(*),NC2(*)
72C REAL
73 my_real UVAR(NUVAR,*),X(3,*),
74 . rot1(3,mvsiz),rot2(3,mvsiz),rby(*),
75 . dx(*), dy(*), dz(*), rx(*), ry(*), rz(*),vr(3,*)
76 DOUBLE PRECISION XDP(3,*),XL(MVSIZ,3)
77 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER I, J, K, JTYP, IERR, NRB, SKFLG,
82 . idsk1,idsk2,isk1,isk2,ip1,ip2,
83 . n1,n2,n3,usens,insens,
84 . isens_old,isens_act
85 my_real co,si,ksi,nx,ny,nz,th,
86 . u(lskew),v(lskew),u0(lskew),v0(lskew),ex(lskew),
87 . r1(3),r2(3),rm(3),rl1(3),rl2(3),t(3),
88 . x1(lskew),x2(lskew),q(lskew),a0(lskew),b0(lskew),
89 . a(lskew),b(lskew),exi(lskew),
90 . get_u_geo,nr,dt(3),dex(lskew),exprec(lskew)
91 DOUBLE PRECISION X21(MVSIZ),Y21(MVSIZ),Z21(MVSIZ)
92C-----------------------------------------------
93C E x t e r n a l F u n c t i o n s
94C-----------------------------------------------
95 INTEGER GET_U_SKEW
96 EXTERNAL get_u_skew
97C=======================================================================
98 DO i=jft,jlt
99 nc1(i)= ixr(2,i)
100 nc2(i)= ixr(3,i)
101 ENDDO
102C
103 ierr = 0
104 isens = 0
105 isens_act = 0
106 jtyp = nint(get_u_geo(1,iprop))
107 IF (igtyp==33) THEN
108C---------------- skew initialisation for kjoints
109 idsk1 = nint(get_u_geo(2,iprop))
110 idsk2 = nint(get_u_geo(3,iprop))
111 skflg = nint(get_u_geo(14,iprop))
112 isk1 = get_u_skew(idsk1,n1,n2,n2,u)
113 isk2 = get_u_skew(idsk2,n1,n2,n3,v)
114 ELSE
115 skflg = 0
116C---------------- sensor check for kjoints2
117 usens = nint(get_u_geo(2,iprop))
118 isens_act = 0
119 IF (usens>0) THEN
120 isens_old = nint(uvar(16,jft))
121 DO k=1,nsensor
122 IF(usens==sensor_tab(k)%SENS_ID) insens=k
123 ENDDO
124C
125 IF (tt>sensor_tab(insens)%TSTART) THEN
126 isens = 1
127 uvar(16,jft) = isens
128 ENDIF
129 IF (isens/=isens_old) isens_act = 1
130 ENDIF
131 ENDIF
132C
133C ----------------
134C
135 DO i=jft,jlt
136C
137C---------------- initizialisation at time 0
138C
139 IF ((ncycle==0).AND.(tt==0)) THEN
140 IF (igtyp==33) THEN
141 DO j=1,9
142 a0(j)= uvar(3+j,i)
143 END DO
144 ELSE
145 rx(i)= uvar(7,i)
146 ry(i)= uvar(8,i)
147 rz(i)= uvar(9,i)
148 ENDIF
149 ENDIF
150C
151C---------------- stockage of displacements if sensor is activated
152C
153 IF ((igtyp==45).AND.(isens_act==1)) THEN
154 uvar(4,i) = dx(i)
155 uvar(5,i) = dy(i)
156 uvar(6,i) = dz(i)
157 uvar(7,i) = rx(i)
158 uvar(8,i) = ry(i)
159 uvar(9,i) = rz(i)
160 ENDIF
161C
162C---------------- local frame
163C
164 IF (jtyp==5) THEN
165C---------------------------------------------
166C---- universal joint - orthogonalized ----
167C---------------------------------------------
168 IF (igtyp==45) THEN
169C-------------------- nod 1
170 dt(1)= vr(1,nc1(i))*dt1
171 dt(2)= vr(2,nc1(i))*dt1
172 dt(3)= vr(3,nc1(i))*dt1
173 u(1)=uvar(10,i) - uvar(11,i)*dt(3)+uvar(12,i)*dt(2)
174 u(2)=uvar(11,i) - uvar(12,i)*dt(1)+uvar(10,i)*dt(3)
175 u(3)=uvar(12,i) - uvar(10,i)*dt(2)+uvar(11,i)*dt(1)
176 nr =sqrt(u(1)*u(1)+u(2)*u(2)+u(3)*u(3))
177 IF (nr>0) THEN
178 u(1)=u(1)/nr
179 u(2)=u(2)/nr
180 u(3)=u(3)/nr
181 ENDIF
182C-----
183 uvar(10,i) = u(1)
184 uvar(11,i) = u(2)
185 uvar(12,i) = u(3)
186
187C-------------------- nod 2
188 dt(1)= vr(1,nc2(i))*dt1
189 dt(2)= vr(2,nc2(i))*dt1
190 dt(3)= vr(3,nc2(i))*dt1
191 v(1)=uvar(13,i) - uvar(14,i)*dt(3)+uvar(15,i)*dt(2)
192 v(2)=uvar(14,i) - uvar(15,i)*dt(1)+uvar(13,i)*dt(3)
193 v(3)=uvar(15,i) - uvar(13,i)*dt(2)+uvar(14,i)*dt(1)
194 nr =sqrt(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))
195 IF (nr>0) THEN
196 v(1)=v(1)/nr
197 v(2)=v(2)/nr
198 v(3)=v(3)/nr
199 ENDIF
200C-----
201 uvar(13,i) = v(1)
202 uvar(14,i) = v(2)
203 uvar(15,i) = v(3)
204 ENDIF
205
206 ex(1) = u(2)*v(3) - u(3)*v(2)
207 ex(2) = u(3)*v(1) - u(1)*v(3)
208 ex(3) = u(1)*v(2) - u(2)*v(1)
209 nx = sqrt(ex(1)*ex(1)+ex(2)*ex(2)+ex(3)*ex(3))
210 ex(1) = ex(1) / nx
211 ex(2) = ex(2) / nx
212 ex(3) = ex(3) / nx
213 ex(4) = u(1)
214 ex(5) = u(2)
215 ex(6) = u(3)
216 ex(7) = v(1)
217 ex(8) = v(2)
218 ex(9) = v(3)
219
220 CALL inv3(ex,exi)
221
222C----- Calcul du vecteur rotation R12
223 x21(i) = (vr(1,nc2(i))-vr(1,nc1(i)))*dt1
224 y21(i) = (vr(2,nc2(i))-vr(2,nc1(i)))*dt1
225 z21(i) = (vr(3,nc2(i))-vr(3,nc1(i)))*dt1
226C
227 rm(1) = rx(i)+exi(1)*x21(i)+exi(4)*y21(i)+exi(7)*z21(i)
228 rm(2) = ry(i)+exi(2)*x21(i)+exi(5)*y21(i)+exi(8)*z21(i)
229 rm(3) = rz(i)+exi(3)*x21(i)+exi(6)*y21(i)+exi(9)*z21(i)
230C-----
231 r2(1) = 0.5*rm(1)
232 r2(2) = 0.5*rm(2)
233 r2(3) = 0.5*rm(3)
234 r1(1) = -0.5*rm(1)
235 r1(2) = -0.5*rm(2)
236 r1(3) = -0.5*rm(3)
237C-----
238 x21(i) = x(1,nc2(i))-x(1,nc1(i))
239 y21(i) = x(2,nc2(i))-x(2,nc1(i))
240 z21(i) = x(3,nc2(i))-x(3,nc1(i))
241 xl(i,1)=exi(1)*x21(i)+exi(4)*y21(i)+exi(7)*z21(i)
242 xl(i,2)=exi(2)*x21(i)+exi(5)*y21(i)+exi(8)*z21(i)
243 xl(i,3)=exi(3)*x21(i)+exi(6)*y21(i)+exi(9)*z21(i)
244
245C---------------------------
246 ELSE
247C---------------------------
248 IF (skflg==1) THEN
249C---------------------------------------------
250C---- first skew is used as mean skew -----
251C---------------------------------------------
252
253 DO j=1,9
254 ex(j) = u(j)
255 ENDDO
256
257 ELSE
258C-------------------------------------
259C---- mean skew is calculated -----
260C-------------------------------------
261
262C----- Initialisation de EXPREC
263 IF ((ncycle==0).AND.(tt==0).AND.(igtyp==33)) THEN
264 CALL prod_ab(u,a0,a)
265 DO j=1,9
266 exprec(j) = a(j)
267 END DO
268 ELSE
269 DO j=1,9
270 exprec(j) = uvar(21+j,i)
271 END DO
272 ENDIF
273
274C----- Calcul de DEX
275 x21(i) = half*(vr(1,nc2(i))+vr(1,nc1(i)))*dt1
276 y21(i) = half*(vr(2,nc2(i))+vr(2,nc1(i)))*dt1
277 z21(i) = half*(vr(3,nc2(i))+vr(3,nc1(i)))*dt1
278 dt(1)=exprec(1)*x21(i)+exprec(2)*y21(i)+exprec(3)*z21(i)
279 dt(2)=exprec(4)*x21(i)+exprec(5)*y21(i)+exprec(6)*z21(i)
280 dt(3)=exprec(7)*x21(i)+exprec(8)*y21(i)+exprec(9)*z21(i)
281C-----
282 nr =sqrt(dt(1)*dt(1)+dt(2)*dt(2)+dt(3)*dt(3))
283 IF (nr>0) THEN
284 dt(1)=dt(1)/nr
285 dt(2)=dt(2)/nr
286 dt(3)=dt(3)/nr
287 ENDIF
288 co = cos(nr)
289 si = sin(nr)
290 CALL qrot33(dex, dt, co, si)
291
292C----- Calcul du nouveau EX
293 CALL prod_ab(exprec,dex,ex)
294
295C-------------------------------
296 ENDIF
297C-------------------------------
298C----- Calcul du vecteur rotation R12
299 x21(i) = (vr(1,nc2(i))-vr(1,nc1(i)))*dt1
300 y21(i) = (vr(2,nc2(i))-vr(2,nc1(i)))*dt1
301 z21(i) = (vr(3,nc2(i))-vr(3,nc1(i)))*dt1
302C
303 rm(1) = rx(i)+ex(1)*x21(i)+ex(2)*y21(i)+ex(3)*z21(i)
304 rm(2) = ry(i)+ex(4)*x21(i)+ex(5)*y21(i)+ex(6)*z21(i)
305 rm(3) = rz(i)+ex(7)*x21(i)+ex(8)*y21(i)+ex(9)*z21(i)
306C-----
307 r2(1) = 0.5*rm(1)
308 r2(2) = 0.5*rm(2)
309 r2(3) = 0.5*rm(3)
310 r1(1) = -0.5*rm(1)
311 r1(2) = -0.5*rm(2)
312 r1(3) = -0.5*rm(3)
313C-----
314 IF (iresp == 1) THEN
315C- simple precision - extended sple precsion only for translational dof
316 x21(i) = xdp(1,nc2(i))-xdp(1,nc1(i))
317 y21(i) = xdp(2,nc2(i))-xdp(2,nc1(i))
318 z21(i) = xdp(3,nc2(i))-xdp(3,nc1(i))
319 ELSE
320C- double precision
321 x21(i) = x(1,nc2(i))-x(1,nc1(i))
322 y21(i) = x(2,nc2(i))-x(2,nc1(i))
323 z21(i) = x(3,nc2(i))-x(3,nc1(i))
324 ENDIF
325C
326 xl(i,1)=ex(1)*x21(i)+ex(2)*y21(i)+ex(3)*z21(i)
327 xl(i,2)=ex(4)*x21(i)+ex(5)*y21(i)+ex(6)*z21(i)
328 xl(i,3)=ex(7)*x21(i)+ex(8)*y21(i)+ex(9)*z21(i)
329
330C-------------------------------
331 ENDIF
332C-------------------------------
333C
334 rot1(1,i) = r1(1)
335 rot1(2,i) = r1(2)
336 rot1(3,i) = r1(3)
337 rot2(1,i) = r2(1)
338 rot2(2,i) = r2(2)
339 rot2(3,i) = r2(3)
340C
341 DO j=1,9
342 uvar(21+j,i) = ex(j)
343 END DO
344 END DO ! DO I=JFT,JLT
345
346C-----------
347 RETURN
348 END
349!||====================================================================
350!|| inv3 ../engine/source/elements/joint/rskew33.F
351!||--- called by ------------------------------------------------------
352!|| i2curvf ../engine/source/interfaces/interf/i2curvf.F
353!|| i2curvfp ../engine/source/interfaces/interf/i2curvfp.F
354!|| i2curvv ../engine/source/interfaces/interf/i2curvv.F
355!|| i2loceq ../common_source/interf/i2loceq.F
356!|| i2loceq_27 ../common_source/interf/i2loceq.F
357!|| rskew33 ../engine/source/elements/joint/rskew33.F
358!||====================================================================
359 SUBROUTINE inv3(A,B)
360C----------------------------------------------------------
361C I m p l i c i t T y p e s
362C-----------------------------------------------
363#include "implicit_f.inc"
364#include "param_c.inc"
365C----------------------------------------------------------
366C D u m m y A r g u m e n t s a n d F u n c t i o n
367C----------------------------------------------------------
368 my_real a(lskew),b(lskew)
369C-----------------------------------------------
370C L o c a l V a r i a b l e s
371C-----------------------------------------------
372 my_real det
373C=======================================================================
374
375 det = a(1)*a(5)*a(9)+a(4)*a(8)*a(3)+a(7)*a(2)*a(6)
376 . - a(4)*a(2)*a(9)-a(1)*a(8)*a(6)-a(7)*a(5)*a(3)
377
378 b(1) = (a(5)*a(9)-a(6)*a(8)) / det
379 b(4) = -(a(4)*a(9)-a(6)*a(7)) / det
380 b(7) = (a(4)*a(8)-a(5)*a(7)) / det
381
382 b(2) = -(a(2)*a(9)-a(3)*a(8)) / det
383 b(5) = (a(1)*a(9)-a(3)*a(7)) / det
384 b(8) = -(a(1)*a(8)-a(2)*a(7)) / det
385
386 b(3) = (a(2)*a(6)-a(3)*a(5)) / det
387 b(6) = -(a(1)*a(6)-a(3)*a(4)) / det
388 b(9) = (a(1)*a(5)-a(2)*a(4)) / det
389C-----------------------------------------------
390 RETURN
391 END
392
393!||====================================================================
394!|| rotq33 ../engine/source/elements/joint/rskew33.f
395!||====================================================================
396 SUBROUTINE rotq33(SKEW, T, ROT, C, S)
397C-------------------------------------------------------------------------
398C I m p l i c i t T y p e s
399C-----------------------------------------------
400#include "implicit_f.inc"
401#include "param_c.inc"
402C----------------------------------------------------------
403C D u m m y A r g u m e n t s a n d F u n c t i o n
404C----------------------------------------------------------
405 my_real rot(3), t(3), skew(lskew), s, c
406C-----------------------------------------------
407C L o c a l V a r i a b l e s
408C-----------------------------------------------
409 INTEGER I
410 my_real e11,e22,e33,e12,e21,e13,e31,e23,e32,nr,ksi,
411 . pi1
412C=======================================================================
413CCsm45a2 PI= 2.*ATAN2(ONE,ZERO)
414 pi1 = 2.*atan2(one,zero)
415C--- first skew rotation
416 e11 = skew(1)
417 e12 = skew(4)
418 e13 = skew(7)
419 e21 = skew(2)
420 e22 = skew(5)
421 e23 = skew(8)
422 e31 = skew(3)
423 e32 = skew(6)
424 e33 = skew(9)
425 c = half * (e11+e22+e33 - one)
426 c = min(c,one)
427 c = max(c,-one)
428 ksi = acos(c)
429 s = sin(ksi)
430 IF(s/=zero) s = half / s
431 t(1) = (e32 - e23) * s
432 t(2) = (e13 - e31) * s
433 t(3) = (e21 - e12) * s
434 nr = sqrt(t(1)*t(1)+t(2)*t(2)+t(3)*t(3))
435 IF (nr/=zero) nr = one/nr
436 t(1) = t(1)*nr
437 t(2) = t(2)*nr
438 t(3) = t(3)*nr
439 rot(1) = t(1)*ksi
440 rot(2) = t(2)*ksi
441 rot(3) = t(3)*ksi
442C-----------------------------------------------
443 RETURN
444 END
445!||====================================================================
446!|| rot12 ../engine/source/elements/joint/rskew33.F
447!||====================================================================
448 SUBROUTINE rot12(SKEW, RVEC, C, S)
449C-------------------------------------------------------------------------
450C I m p l i c i t T y p e s
451C-----------------------------------------------
452#include "implicit_f.inc"
453#include "param_c.inc"
454C----------------------------------------------------------
455C D u m m y A r g u m e n t s a n d F u n c t i o n
456C----------------------------------------------------------
457 my_real skew(lskew), rvec(3), s, c
458C-----------------------------------------------
459C L o c a l V a r i a b l e s
460C-----------------------------------------------
461 INTEGER I
462 my_real e11,e22,e33,e12,e21,e13,e31,e23,e32,nr,ksi,
463 . pi1
464C=======================================================================
465C
466 pi1 = 2.*atan2(one,zero)
467C--- first skew rotation
468 e11 = skew(1)
469 e12 = skew(4)
470 e13 = skew(7)
471 e21 = skew(2)
472 e22 = skew(5)
473 e23 = skew(8)
474 e31 = skew(3)
475 e32 = skew(6)
476 e33 = skew(9)
477 c = half * (e11+e22+e33 - one)
478 c = min(c,one)
479 c = max(c,-one)
480 ksi = acos(c)
481 s = sin(ksi)
482 IF(s/=zero) s = half / s
483 rvec(1) = (e32 - e23) * s
484 rvec(2) = (e13 - e31) * s
485 rvec(3) = (e21 - e12) * s
486 nr = sqrt(rvec(1)*rvec(1)+rvec(2)*rvec(2)+rvec(3)*rvec(3))
487 IF (nr/=zero) nr = one/nr
488 rvec(1) = rvec(1)*nr
489 rvec(2) = rvec(2)*nr
490 rvec(3) = rvec(3)*nr
491C
492 c = half*(c+ one)
493 s = sqrt(one-c)
494 c = sqrt(c)
495C---------------------------
496 RETURN
497 END
498!||====================================================================
499!|| qrot33 ../engine/source/elements/joint/rskew33.F
500!||--- called by ------------------------------------------------------
501!|| rskew33 ../engine/source/elements/joint/rskew33.F
502!||====================================================================
503 SUBROUTINE qrot33(SKEW, T, C, S)
504C-------------------------------------------------------------------------
505C I m p l i c i t T y p e s
506C-----------------------------------------------
507#include "implicit_f.inc"
508#include "param_c.inc"
509C----------------------------------------------------------
510C D u m m y A r g u m e n t s a n d F u n c t i o n
511C----------------------------------------------------------
512 my_real t(3), skew(lskew)
513C-----------------------------------------------
514C L o c a l V a r i a b l e s
515C-----------------------------------------------
516 INTEGER I
517 my_real e11,e22,e33,e12,e21,e13,e31,e23,e32,
518 . u1,u2,u3, u1s, u2s, u3s, s,c,ci
519C=======================================================================
520 ci = one - c
521 u1 = t(1)
522 u2 = t(2)
523 u3 = t(3)
524 u1s = u1*s
525 u2s = u2*s
526 u3s = u3*s
527C
528 e11 = u1 * u1 *ci + c
529 e22 = u2 * u2 *ci + c
530 e33 = u3 * u3 *ci + c
531
532 e12 = u1 * u2 * ci
533 e21 = e12 + u3s
534 e12 = e12 - u3s
535 e13 = u1 * u3 * ci
536 e31 = e13 - u2s
537 e13 = e13 + u2s
538 e23 = u2 * u3 * ci
539 e32 = e23 + u1s
540 e23 = e23 - u1s
541C
542 skew(1) = e11
543 skew(4) = e12
544 skew(7) = e13
545 skew(2) = e21
546 skew(5) = e22
547 skew(8) = e23
548 skew(3) = e31
549 skew(6) = e32
550 skew(9) = e33
551C-----------------------------------------------
552 RETURN
553 END
554C====================================================
555!||====================================================================
556!|| prod_abt ../engine/source/elements/joint/rskew33.F
557!||====================================================================
558 SUBROUTINE prod_abt(A,B,X)
559#include "implicit_f.inc"
560#include "param_c.inc"
561 INTEGER I,J
562 my_real A(LSKEW),B(LSKEW),X(LSKEW)
563C
564 x(1)=a(1)*b(1)+a(4)*b(4)+a(7)*b(7)
565 x(2)=a(2)*b(1)+a(5)*b(4)+a(8)*b(7)
566 x(3)=a(3)*b(1)+a(6)*b(4)+a(9)*b(7)
567 x(4)=a(1)*b(2)+a(4)*b(5)+a(7)*b(8)
568 x(5)=a(2)*b(2)+a(5)*b(5)+a(8)*b(8)
569 x(6)=a(3)*b(2)+a(6)*b(5)+a(9)*b(8)
570 x(7)=a(1)*b(3)+a(4)*b(6)+a(7)*b(9)
571 x(8)=a(2)*b(3)+a(5)*b(6)+a(8)*b(9)
572 x(9)=a(3)*b(3)+a(6)*b(6)+a(9)*b(9)
573 RETURN
574 END
575C====================================================
576!||====================================================================
577!|| prod_atb ../engine/source/elements/joint/rskew33.F
578!||====================================================================
579 SUBROUTINE prod_atb(A,B,X)
580#include "implicit_f.inc"
581#include "param_c.inc"
582 my_real a(lskew),b(lskew),x(lskew)
583C
584 x(1)=a(1)*b(1)+a(2)*b(2)+a(3)*b(3)
585 x(2)=a(4)*b(1)+a(5)*b(2)+a(6)*b(3)
586 x(3)=a(7)*b(1)+a(8)*b(2)+a(9)*b(3)
587 x(4)=a(1)*b(4)+a(2)*b(5)+a(3)*b(6)
588 x(5)=a(4)*b(4)+a(5)*b(5)+a(6)*b(6)
589 x(6)=a(7)*b(4)+a(8)*b(5)+a(9)*b(6)
590 x(7)=a(1)*b(7)+a(2)*b(8)+a(3)*b(9)
591 x(8)=a(4)*b(7)+a(5)*b(8)+a(6)*b(9)
592 x(9)=a(7)*b(7)+a(8)*b(8)+a(9)*b(9)
593 RETURN
594 END
595C====================================================
596!||====================================================================
597!|| prod_ab ../engine/source/elements/joint/rskew33.F
598!||--- called by ------------------------------------------------------
599!|| rskew33 ../engine/source/elements/joint/rskew33.F
600!||====================================================================
601 SUBROUTINE prod_ab(A,B,X)
602#include "implicit_f.inc"
603#include "param_c.inc"
604 my_real a(lskew),b(lskew),x(lskew)
605C
606 x(1)=a(1)*b(1)+a(4)*b(2)+a(7)*b(3)
607 x(2)=a(2)*b(1)+a(5)*b(2)+a(8)*b(3)
608 x(3)=a(3)*b(1)+a(6)*b(2)+a(9)*b(3)
609 x(4)=a(1)*b(4)+a(4)*b(5)+a(7)*b(6)
610 x(5)=a(2)*b(4)+a(5)*b(5)+a(8)*b(6)
611 x(6)=a(3)*b(4)+a(6)*b(5)+a(9)*b(6)
612 x(7)=a(1)*b(7)+a(4)*b(8)+a(7)*b(9)
613 x(8)=a(2)*b(7)+a(5)*b(8)+a(8)*b(9)
614 x(9)=a(3)*b(7)+a(6)*b(8)+a(9)*b(9)
615 RETURN
616 END
617C====================================================
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
qrot33
subroutine qrot33(skew, t, c, s)
Definition rskew33.F:504
prod_atb
subroutine prod_atb(a, b, x)
Definition rskew33.F:580
rot12
subroutine rot12(skew, rvec, c, s)
Definition rskew33.F:449
prod_ab
subroutine prod_ab(a, b, x)
Definition rskew33.F:602
prod_abt
subroutine prod_abt(a, b, x)
Definition rskew33.F:559
rskew33
subroutine rskew33(jft, jlt, ixr, iout, iprop, nuvar, uvar, rby, x, xl, rot1, rot2, dx, dy, dz, rx, ry, rz, vr, igtyp, nsensor, sensor_tab, isens, nc1, nc2, xdp)
Definition rskew33.F:41
rotq33
subroutine rotq33(skew, t, rot, c, s)
Definition rskew33.F:397
inv3
subroutine inv3(a, b)
Definition rskew33.F:360