OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pri324.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!|| pri324 ../engine/source/materials/mat/mat024/pri324.F
25!||--- called by ------------------------------------------------------
26!|| dama24 ../engine/source/materials/mat/mat024/dama24.F
27!||====================================================================
28 SUBROUTINE pri324(SIG,EPSTOT,EPS,VEC)
29C-----------------------------------------------
30C I m p l i c i t T y p e s
31C-----------------------------------------------
32#include "implicit_f.inc"
33C-----------------------------------------------
34C D u m m y A r g u m e n t s
35C-----------------------------------------------
36 my_real
37 . sig(*), epstot(*), eps(*), vec(*)
38C-----------------------------------------------
39C L o c a l V a r i a b l e s
40C-----------------------------------------------
41 INTEGER IPERM(3), I, L, LMAX
42 my_real
43 . cs(6), str(3), a(3,3), v(3,3), b(3,3), xmag(3), pr, aa, bb,
44 . cc, angp, dd, ftpi, ttpi, strmax, tol1, tol2, xmax, vmag, s11,
45 . s21, s31, s12, s22, s32, s13, s23, s33, a11, a12, a13, a21,
46 . a22, a23, a31, a32, a33
47C-----------------------------------------------
48 DATA ftpi,ttpi / 4.188790205, 2.094395102 /
49 DATA iperm/2,3,1/
50C=======================================================================
51C DEVIATEUR PRINCIPAL DE CONTRAINTE
52C . . . . . . . . . . . . . . . . . . .
53 DO i=1,6
54 vec(i)=zero
55 cs(i)=sig(i)
56 ENDDO
57 vec(1)=1
58 vec(5)=1
59C
60 pr = -(cs(1)+cs(2)+cs(3)) * third
61 cs(1)=cs(1) + pr
62 cs(2)=cs(2) + pr
63 cs(3)=cs(3) + pr
64C
65 aa = cs(4)**2 + cs(5)**2 + cs(6)**2 - cs(1)*cs(2) - cs(2)*cs(3)
66 & - cs(1)*cs(3)
67
68 IF (aa < em20) RETURN
69C
70 bb = cs(1)*cs(5)**2 + cs(2)*cs(6)**2 + cs(3)*cs(4)**2
71 & - cs(1)*cs(2)*cs(3) - two*cs(4)*cs(5)*cs(6)
72C
73 cc=-sqrt(twenty7/aa)*bb*half/aa
74 cc= min(cc,one)
75 cc= max(cc,-one)
76 angp=acos(cc) * third
77 dd=two*sqrt(aa*third)
78 str(1)=dd*cos(angp)
79 str(2)=dd*cos(angp+ftpi)
80 str(3)=dd*cos(angp+ttpi)
81C . . . . . . . . . . .
82C VECTEURS PROPRES
83C . . . . . . . . . . .
84 strmax= max(abs(str(1)),abs(str(3)))
85
86 tol1= max(em20,sixem4*strmax**2)
87 tol2= twoem4*strmax
88
89 a(1,1)=cs(1)-str(1)
90 a(2,2)=cs(2)-str(1)
91 a(3,3)=cs(3)-str(1)
92 a(1,2)=cs(4)
93 a(2,1)=cs(4)
94 a(2,3)=cs(5)
95 a(3,2)=cs(5)
96 a(1,3)=cs(6)
97 a(3,1)=cs(6)
98C
99 DO l=1,3
100 b(1,l) = a(2,l)*a(3,iperm(l))-a(3,l)*a(2,iperm(l))
101 b(2,l) = a(3,l)*a(1,iperm(l))-a(1,l)*a(3,iperm(l))
102 b(3,l) = a(1,l)*a(2,iperm(l))-a(2,l)*a(1,iperm(l))
103 xmag(l)= sqrt(b(1,l)**2+b(2,l)**2+b(3,l)**2)
104 ENDDO
105
106 xmax=zero
107 lmax = 1
108 DO l=1,3
109 IF (xmag(l) > xmax) THEN
110 xmax=xmag(l)
111 lmax=l
112 ENDIF
113 ENDDO
114C
115 IF (xmax > tol1) THEN
116 v(1,1)=b(1,lmax)/xmax
117 v(2,1)=b(2,lmax)/xmax
118 v(3,1)=b(3,lmax)/xmax
119 a(1,1)=cs(1)-str(3)
120 a(2,2)=cs(2)-str(3)
121 a(3,3)=cs(3)-str(3)
122 a(1,2)=cs(4)
123 a(2,1)=cs(4)
124 a(2,3)=cs(5)
125 a(3,2)=cs(5)
126 a(1,3)=cs(6)
127 a(3,1)=cs(6)
128C
129 DO l=1,3
130 b(1,l)=a(2,l)*v(3,1)-a(3,l)*v(2,1)
131 b(2,l)=a(3,l)*v(1,1)-a(1,l)*v(3,1)
132 b(3,l)=a(1,l)*v(2,1)-a(2,l)*v(1,1)
133 xmag(l)=sqrt(b(1,l)**2+b(2,l)**2+b(3,l)**2)
134 ENDDO
135 xmax=zero
136 DO l=1,3
137 IF(xmag(l) > xmax)THEN
138 xmax=xmag(l)
139 lmax=l
140 ENDIF
141 ENDDO
142C
143 IF (xmax > tol2) THEN
144 v(1,3)= b(1,lmax)/xmax
145 v(2,3)= b(2,lmax)/xmax
146 v(3,3)= b(3,lmax)/xmax
147 v(1,2)= v(2,3)*v(3,1)-v(2,1)*v(3,3)
148 v(2,2)= v(3,3)*v(1,1)-v(3,1)*v(1,3)
149 v(3,2)= v(1,3)*v(2,1)-v(1,1)*v(2,3)
150 vmag = sqrt(v(1,2)**2 + v(2,2)**2 + v(3,2)**2)
151 v(1,2)= v(1,2)/vmag
152 v(2,2)= v(2,2)/vmag
153 v(3,2)= v(3,2)/vmag
154 ELSE
155 vmag = sqrt(v(1,1)**2 + v(2,1)**2 + v(3,1)**2)
156 IF (vmag > tol2/strmax) THEN
157 v(1,2)=-v(2,1)/vmag
158 v(2,2)= v(1,1)/vmag
159 v(3,2)= zero
160 ELSE
161 v(1,2)=one
162 v(2,2)=zero
163 v(3,2)=zero
164 ENDIF
165 ENDIF
166 ELSE
167C . . . . . . . . . . . . .
168C SOLUTION DOUBLE
169C . . . . . . . . . . . . .
170 DO l=1,3
171 xmag(l) = sqrt(a(1,l)**2 + a(2,l)**2)
172 ENDDO
173 xmax = zero
174 DO l=1,3
175 IF(xmag(l) > xmax)THEN
176 lmax=l
177 xmax=xmag(l)
178 ENDIF
179 ENDDO
180C
181 IF(max(abs(a(3,1)),abs(a(3,2)),abs(a(3,3))) < tol2)THEN
182 v(1,1) = zero
183 v(2,1) = zero
184 v(3,1) = one
185 v(1,2) = -a(2,lmax)/xmax
186 v(2,2) = a(1,lmax)/xmax
187 v(3,2) = zero
188C
189 ELSEIF(xmax > tol2)THEN
190 v(1,1) = -a(2,lmax)/xmax
191 v(2,1) = a(1,lmax)/xmax
192 v(3,1) = zero
193 v(1,2) = -a(3,lmax)*v(2,1)
194 v(2,2) = a(3,lmax)*v(1,1)
195 v(3,2) = a(1,lmax)*v(2,1)-a(2,lmax)*v(1,1)
196 vmag = sqrt(v(1,2)**2 + v(2,2)**2 + v(3,2)**2)
197 v(1,2)=v(1,2)/vmag
198 v(2,2)=v(2,2)/vmag
199 v(3,2)=v(3,2)/vmag
200 ELSE
201 v(1,1) = one
202 v(2,1) = zero
203 v(3,1) = zero
204 v(1,2) = zero
205 v(2,2) = one
206 v(3,2) = zero
207 ENDIF
208 ENDIF
209C
210 vec(1)=v(1,1)
211 vec(2)=v(2,1)
212 vec(3)=v(3,1)
213 vec(4)=v(1,2)
214 vec(5)=v(2,2)
215 vec(6)=v(3,2)
216C . . . . . . . . . . . .
217C ROTATION EPS EPSTOT
218C . . . . . . . . . . . .
219 s11=vec(1)
220 s21=vec(2)
221 s31=vec(3)
222 s12=vec(4)
223 s22=vec(5)
224 s32=vec(6)
225 s13=s21*s32-s31*s22
226 s23=s31*s12-s11*s32
227 5 s33=s11*s22-s21*s12
228C
229 a11=sig(1)*s11+sig(4)*s21+sig(6)*s31
230 a12=sig(1)*s12+sig(4)*s22+sig(6)*s32
231 a13=sig(1)*s13+sig(4)*s23+sig(6)*s33
232 a21=sig(4)*s11+sig(2)*s21+sig(5)*s31
233 a22=sig(4)*s12+sig(2)*s22+sig(5)*s32
234 a23=sig(4)*s13+sig(2)*s23+sig(5)*s33
235 a31=sig(6)*s11+sig(5)*s21+sig(3)*s31
236 a32=sig(6)*s12+sig(5)*s22+sig(3)*s32
237 a33=sig(6)*s13+sig(5)*s23+sig(3)*s33
238 sig(4)=s11*a12+s21*a22+s31*a32
239 sig(5)=s12*a13+s22*a23+s32*a33
240 sig(6)=s11*a13+s21*a23+s31*a33
241C
242 eps(4)=half*eps(4)
243 eps(5)=half*eps(5)
244 eps(6)=half*eps(6)
245 a11=eps(1)*s11+eps(4)*s21+eps(6)*s31
246 a12=eps(1)*s12+eps(4)*s22+eps(6)*s32
247 a13=eps(1)*s13+eps(4)*s23+eps(6)*s33
248 a21=eps(4)*s11+eps(2)*s21+eps(5)*s31
249 a22=eps(4)*s12+eps(2)*s22+eps(5)*s32
250 a23=eps(4)*s13+eps(2)*s23+eps(5)*s33
251 a31=eps(6)*s11+eps(5)*s21+eps(3)*s31
252 a32=eps(6)*s12+eps(5)*s22+eps(3)*s32
253 a33=eps(6)*s13+eps(5)*s23+eps(3)*s33
254 eps(1)=s11*a11+s21*a21+s31*a31
255 eps(2)=s12*a12+s22*a22+s32*a32
256 eps(3)=s13*a13+s23*a23+s33*a33
257 epstot(4)=half*epstot(4)
258 epstot(5)=half*epstot(5)
259 epstot(6)=half*epstot(6)
260 a11=epstot(1)*s11+epstot(4)*s21+epstot(6)*s31
261 a12=epstot(1)*s12+epstot(4)*s22+epstot(6)*s32
262 a13=epstot(1)*s13+epstot(4)*s23+epstot(6)*s33
263 a21=epstot(4)*s11+epstot(2)*s21+epstot(5)*s31
264 a22=epstot(4)*s12+epstot(2)*s22+epstot(5)*s32
265 a23=epstot(4)*s13+epstot(2)*s23+epstot(5)*s33
266 a31=epstot(6)*s11+epstot(5)*s21+epstot(3)*s31
267 a32=epstot(6)*s12+epstot(5)*s22+epstot(3)*s32
268 a33=epstot(6)*s13+epstot(5)*s23+epstot(3)*s33
269 epstot(1)=s11*a11+s21*a21+s31*a31
270 epstot(2)=s12*a12+s22*a22+s32*a32
271 epstot(3)=s13*a13+s23*a23+s33*a33
272c-----------
273 RETURN
274 END
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
pri324
subroutine pri324(sig, epstot, eps, vec)
Definition pri324.F:29