OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
m16law.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!|| m16law ../engine/source/materials/mat/mat016/m16law.F
25!||--- called by ------------------------------------------------------
26!|| mmain ../engine/source/materials/mat_share/mmain.F90
27!||====================================================================
28 SUBROUTINE m16law(PM ,OFF ,SIG ,NEL ,
29 2 EPXE ,THETA ,EPD ,XIST ,
30 3 MAT ,D1 ,D2 ,D3 ,
31 4 D4 ,D5 ,D6 ,POLD )
32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35#include "implicit_f.inc"
36C-----------------------------------------------
37C G l o b a l P a r a m e t e r s
38C-----------------------------------------------
39#include "mvsiz_p.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "com08_c.inc"
44#include "param_c.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER MAT(*),NEL
49 my_real
50 . PM(NPROPM,*), OFF(*), SIG(NEL,6), EPXE(*), THETA(*),
51 . epd(*), xist(*), d1(*), d2(*),
52 . d3(*), d4(*), d5(*), d6(*), pold(*)
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER I, MX
57 my_real
58 . G(MVSIZ), G1(MVSIZ), G2(MVSIZ), AK(MVSIZ), QH(MVSIZ), TMELT(MVSIZ),
59 . aj2(mvsiz), dav(mvsiz), epmx(mvsiz),
60 . thetl(mvsiz), ca(mvsiz), cb(mvsiz), cc(mvsiz), cn(mvsiz), epdr(mvsiz), cmx(mvsiz),
61 . sigmx(mvsiz), tstar, ct, ce, ch, scale(mvsiz), dpla(mvsiz)
62C------------------------------------------------------------------------------------------
63 mx = mat(1)
64 DO i=1,nel
65 g(i) =pm(22,mx)*off(i)
66 ca(i) =pm(38,mx)
67 cb(i) =pm(39,mx)
68 cn(i) =pm(40,mx)
69 cc(i) =pm(43,mx)
70 cmx(i) =pm(45,mx)
71 tmelt(i)=pm(46,mx)
72 epdr(i) =pm(44,mx)
73 thetl(i)=pm(47,mx)
74 epmx(i) =pm(41,mx)
75 sigmx(i)=pm(42,mx)
76 ENDDO
77C
78 DO i=1,nel
79 pold(i)=-third*(sig(i,1)+sig(i,2)+sig(i,3))
80 dav(i) =-third*(d1(i)+d2(i)+d3(i))
81 g1(i) =dt1*g(i)
82 g2(i) =two*g1(i)
83 ENDDO
84C-------------------------------
85C CONTRAINTES DEVIATORIQUES
86C-------------------------------
87 DO i=1,nel
88 sig(i,1)=sig(i,1)+pold(i)+g2(i)*(d1(i)+dav(i))
89 sig(i,2)=sig(i,2)+pold(i)+g2(i)*(d2(i)+dav(i))
90 sig(i,3)=sig(i,3)+pold(i)+g2(i)*(d3(i)+dav(i))
91 sig(i,4)=sig(i,4)+g1(i)*d4(i)
92 sig(i,5)=sig(i,5)+g1(i)*d5(i)
93 sig(i,6)=sig(i,6)+g1(i)*d6(i)
94 ENDDO
95C
96 DO i=1,nel
97 aj2(i)=half*(sig(i,1)**2+sig(i,2)**2+sig(i,3)**2)
98 1 +sig(i,4)**2+sig(i,5)**2+sig(i,6)**2
99 aj2(i)=sqrt(three*aj2(i))
100 ENDDO
101C
102 DO i=1,nel
103 IF(theta(i)>=tmelt(i)) cycle
104C
105 tstar=zero
106 ct=one
107 IF(theta(i)<=three100) GOTO 60
108 tstar=(theta(i)-three100)/(tmelt(i)-three100)
109 IF(theta(i)>thetl(i)) cmx(i)=one
110 ct=one-tstar**cmx(i)
111C
112 60 ce=one
113C
114 epd(i)=off(i) * max( abs(d1(i)), abs(d2(i)), abs(d3(i)),
115 . half*abs(d4(i)),half*abs(d5(i)),half*abs(d6(i)))
116C----------------------------------------------------------
117 IF(epd(i)<=epdr(i)) GOTO 70
118 ce=one+cc(i) * log(epd(i)/epdr(i))
119C
120 70 ch=ca(i)
121 IF(epxe(i)<=zero) GOTO 80
122 ch=ca(i)+cb(i)*epxe(i)**cn(i)
123 IF(epxe(i)>epmx(i)) ch=ca(i)+cb(i)*epmx(i)**cn(i)
124C
125 80 ak(i)= min(sigmx(i),ch)*ce*ct
126C-----------------------
127C MODULE ECROUISSAGE
128C-----------------------
129 IF(cn(i)>=1) THEN
130 qh(i)= (cb(i)*cn(i)*epxe(i)**(cn(i)-one))*ce*ct
131 ELSEIF(epxe(i)/=zero)THEN
132 qh(i)= (cb(i)*cn(i)/epxe(i)**(one-cn(i)))*ce*ct
133 ELSE
134 qh(i)=zero
135 ENDIF
136C-------------------------------
137C PROJECTION
138C-------------------------------
139 IF(aj2(i)<=ak(i)) THEN
140 scale(i)=one
141 ELSEIF(aj2(i)/=zero) THEN
142 scale(i)=ak(i)/aj2(i)
143 ELSE
144 scale(i)=zero
145 ENDIF
146 ENDDO
147C
148 DO i=1,nel
149 IF(theta(i)>=tmelt(i) .OR. xist(i)/=zero) THEN
150 epxe(i)=zero
151 sig(i,1)=zero
152 sig(i,2)=zero
153 sig(i,3)=zero
154 sig(i,4)=zero
155 sig(i,5)=zero
156 sig(i,6)=zero
157 ELSEIF(aj2(i)>ak(i)) THEN
158 dpla(i)=(one -scale(i))*aj2(i)/(three*g(i)+qh(i))
159 ak(i)=ak(i)+dpla(i)*qh(i)
160 scale(i)= min(one,ak(i)/ max(aj2(i),em15))
161 sig(i,1)=scale(i)*sig(i,1)
162 sig(i,2)=scale(i)*sig(i,2)
163 sig(i,3)=scale(i)*sig(i,3)
164 sig(i,4)=scale(i)*sig(i,4)
165 sig(i,5)=scale(i)*sig(i,5)
166 sig(i,6)=scale(i)*sig(i,6)
167 epxe(i)=epxe(i)+dpla(i)
168 epxe(i)=epxe(i)*off(i)
169 ENDIF
170 ENDDO
171C
172 RETURN
173 END
subroutine m16law(pm, off, sig, nel, epxe, theta, epd, xist, mat, d1, d2, d3, d4, d5, d6, pold)
Definition m16law.F:32
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21