OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
qrota_group.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!|| qrota_group ../engine/source/output/anim/generate/qrota_group.F
25!||--- called by ------------------------------------------------------
26!|| h3d_quad_tensor ../engine/source/output/h3d/h3d_results/h3d_quad_tensor.F
27!||--- uses -----------------------------------------------------
28!|| element_mod ../common_source/modules/elements/element_mod.F90
29!||====================================================================
30 SUBROUTINE qrota_group(
31 1 X, IXQ, KCVT, TENS,
32 2 GAMA, NEL, ISORTH)
33 use element_mod , only : nixq
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C G l o b a l P a r a m e t e r s
40C-----------------------------------------------
41#include "mvsiz_p.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER, INTENT(IN) :: ISORTH
49C REAL
50 my_real
51 . x(3,*),tens(6,*),gama(6,*)
52 INTEGER IXQ(NIXQ,*), KCVT, NEL
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56C REAL
57 my_real
58 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
59 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
60 . r22(mvsiz),r23(mvsiz),r32(mvsiz),r33(mvsiz),
61 .
62 . sy(mvsiz),sz(mvsiz),ty(mvsiz),tz(mvsiz),
63 . g22,g33,g23,g32,
64 . ct,cs,suma,
65 . t1,t2,t3,t4,s1,s2,s4
66 INTEGER NC1(MVSIZ), NC2(MVSIZ), NC3(MVSIZ), NC4(MVSIZ),
67 . I
68C-----------------------------------------------
69 IF (kcvt == 0) THEN
70 DO i=1,nel
71 nc1(i)=ixq(2,i)
72 nc2(i)=ixq(3,i)
73 nc3(i)=ixq(4,i)
74 nc4(i)=ixq(5,i)
75C----------------------------
76C NODE COORDINATES
77C----------------------------
78 y1(i)=x(2,nc1(i))
79 z1(i)=x(3,nc1(i))
80 y2(i)=x(2,nc2(i))
81 z2(i)=x(3,nc2(i))
82 y3(i)=x(2,nc3(i))
83 z3(i)=x(3,nc3(i))
84 y4(i)=x(2,nc4(i))
85 z4(i)=x(3,nc4(i))
86C---------------------------------------
87C LOCAL REFERENCE FRAME (ISOPARAMETRIC)
88C---------------------------------------
89 sy(i)=half*(y2(i)+y3(i)-y1(i)-y4(i))
90 sz(i)=half*(z2(i)+z3(i)-z1(i)-z4(i))
91 ty(i)=half*(y3(i)+y4(i)-y1(i)-y2(i))
92 tz(i)=half*(z3(i)+z4(i)-z1(i)-z2(i))
93 ENDDO
94C-----------
95C convected frame
96C-----------
97 DO i=1,nel
98 ct = ty(i)*ty(i)+tz(i)*tz(i)
99 cs = sy(i)*sy(i)+sz(i)*sz(i)
100 IF(cs /= zero) THEN
101 suma = sqrt(ct/max(em20,cs))
102 sy(i) = sy(i)*suma + tz(i)
103 sz(i) = sz(i)*suma - ty(i)
104 ELSEIF(ct /= zero)THEN
105 suma = sqrt(cs/max(em20,ct))
106 sy(i) = sy(i) + tz(i)*suma
107 sz(i) = sz(i) - ty(i)*suma
108 END IF
109 suma=one/max(sqrt(sy(i)**2+sz(i)**2),em20)
110 sy(i)=sy(i)*suma
111 sz(i)=sz(i)*suma
112C-----------
113C TRANSFORMATION MATRIX GLOBAL -> CONVECTED
114C-----------
115 r22(i)= sy(i)
116 r32(i)=-sz(i)
117 r23(i)= sz(i)
118 r33(i)= sy(i)
119 ENDDO
120c
121 ELSEIF (isorth /= 0) THEN
122 DO i=1,nel
123 g22=gama(i,2)
124 g32=gama(i,3)
125 g23=gama(i,5)
126 g33=gama(i,6)
127C-----------
128c TRANSFORMATION MATRIX ORTHOTROPIC -> CONVECTED
129C-----------
130 r22(i)= g22
131 r23(i)=-g23
132 r32(i)=-g32
133 r33(i)= g33
134 ENDDO
135 END IF
136c
137 DO i=1,nel
138C-----------
139C SIZE(TENS)=6 STORED AS SOLIDS BUT ONLY USE 1, 2 and 4
140C-----------
141 s1=tens(1,i)
142 s2=tens(2,i)
143 s4=tens(4,i)
144C-----------
145 IF (kcvt == 0) THEN
146C-----------
147C Rotation from GLOBAL FRAME TO CONVECTED FRAME
148C-----------
149 t1=s1*r22(i)+s4*r23(i)
150 t2=s4*r32(i)+s2*r33(i)
151 t3=s1*r32(i)+s4*r33(i)
152 t4=s4*r22(i)+s2*r23(i)
153 tens(1,i)=r22(i)*t1+r23(i)*t4
154 tens(2,i)=r32(i)*t3+r33(i)*t2
155 tens(4,i)=r22(i)*t3+r23(i)*t2
156 ELSE
157C-----------
158C Rotation from ORTHO FRAME TO CONVECTED FRAME
159C-----------
160 t1=s1*r22(i)-s4*r23(i)
161 t2=-s4*r32(i)+s2*r33(i)
162 t3=-s1*r32(i)+s4*r33(i)
163 t4=s4*r22(i)-s2*r23(i)
164 tens(1,i)=r22(i)*t1-r23(i)*t4
165 tens(2,i)=-r32(i)*t3+r33(i)*t2
166 tens(4,i)=r22(i)*t3-r23(i)*t2
167 ENDIF
168 ENDDO
169C-----------
170 RETURN
171 END
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
qrota_group
subroutine qrota_group(x, ixq, kcvt, tens, gama, nel, isorth)
Definition qrota_group.F:33