OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
law58_upd.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!|| law58_upd ../starter/source/materials/mat/mat058/law58_upd.F
25!||--- called by ------------------------------------------------------
26!|| updmat ../starter/source/materials/updmat.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| func_inters ../starter/source/tools/curve/func_inters.F
30!|| func_inters_shear ../starter/source/tools/curve/func_inters.F
31!|| func_slope ../starter/source/tools/curve/func_slope.F
32!|| matfun_usr2sys ../starter/source/materials/tools/matfun_usr2sys.F
33!||--- uses -----------------------------------------------------
34!|| message_mod ../starter/share/message_module/message_mod.F
35!|| table_mod ../starter/share/modules1/table_mod.F
36!||====================================================================
37 SUBROUTINE law58_upd(MAT_PARAM,TITR ,NPC ,PLD ,
38 . NFUNC ,NFUNL ,IFUNC ,MAT_ID ,FUNC_ID,
39 . PM ,SENSORS)
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE message_mod
44 USE table_mod
45 USE sensor_mod
46 USE matparam_def_mod
47 USE names_and_titles_mod , ONLY : nchartitle
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "param_c.inc"
56#include "tabsiz_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
61 INTEGER ,INTENT(IN) :: MAT_ID,NFUNC,NFUNL
62 INTEGER ,DIMENSION(NFUNC) ,INTENT(IN) :: FUNC_ID
63 INTEGER ,DIMENSION(NFUNC+NFUNL) ,INTENT(INOUT) :: IFUNC
64 INTEGER ,DIMENSION(SNPC) ,INTENT(IN) :: NPC
65 my_real ,DIMENSION(STF) ,INTENT(IN) :: pld
66 my_real ,DIMENSION(NPROPM) ,INTENT(OUT) :: pm
67 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
68 TYPE(matparam_struct_) ,INTENT(INOUT) :: MAT_PARAM
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER I,K,FUNC,FUND,UNLOAD,PN,IOK,ISENS,SENS_ID
73 my_real KC,KT,KCMAX,KTMAX,KFC,KFT,GMAX,DERI,STIFF,STIFFMIN,STIFFINI,
74 . stiffmax,stiffavg,xint1,yint1,xint2,yint2,fac,fac1,fac2,gfrot,gsh
75C=======================================================================
76c Transform FUNC_ID -> Function number , leakmat only
77c NFUNL = IPM(6) : LEAK_MAT functions
78c
79 IF (nfunl > 0) THEN
80 CALL matfun_usr2sys(titr,mat_id,nfunl,ifunc(nfunc+1),func_id )
81 ENDIF
82c
83C----------------------------
84C SENSOR NUMBERING CHECK
85C----------------------------
86 sens_id = mat_param%IPARAM(2)
87 isens = 0
88 IF (sens_id > 0 ) THEN
89 DO i=1,sensors%NSENSOR
90 IF (sens_id == sensors%SENSOR_TAB(i)%SENS_ID) THEN
91 isens = i
92 EXIT
93 END IF
94 ENDDO
95 IF (isens == 0) THEN
96 CALL ancmsg(msgid=1240,anmode=aninfo,msgtype=msgwarning,
97 . i1=mat_id,c1=titr,i2=isens)
98 END IF
99 ENDIF
100 mat_param%IPARAM(2) = isens
101c---------------------------------------------------------------
102 kc = zero
103 kt = zero
104 kfc = zero
105 kft = zero
106 kcmax= zero
107 ktmax= zero
108 gmax = zero
109c
110c fiber stiffness dir1 (load)
111c
112 func = ifunc(1)
113 IF (func > 0 ) THEN
114
115 fac = mat_param%UPARAM(28)
116 CALL func_slope(func,fac,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)
117c
118 IF (stiffmin <= zero) THEN
119 CALL ancmsg(msgid=1581 ,
120 . msgtype=msgerror,
121 . anmode=aninfo_blind_2,
122 . i1=mat_id,
123 . i2=func_id(ifunc(1)),
124 . c1=titr)
125 ENDIF
126 kc = max(kc ,stiffmax)
127 kfc = max(kfc,stiffini)
128 kcmax = kc
129 mat_param%UPARAM(40) = stiffini
130c
131 ENDIF
132c
133c fiber stiffness dir2 (load)
134c
135 func = ifunc(2)
136 IF (func > 0 ) THEN
137 fac = mat_param%UPARAM(29)
138 CALL func_slope(func,fac,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)
139c
140 IF (stiffmin <= zero) THEN
141 CALL ancmsg(msgid=1582 ,
142 . msgtype=msgerror,
143 . anmode=aninfo_blind_2,
144 . i1=mat_id,
145 . i2=func_id(ifunc(2)),
146 . c1=titr)
147 ENDIF
148 kt = max(kt ,stiffmax)
149 kft = max(kft,stiffini)
150 ktmax = kt
151 mat_param%UPARAM(41) = stiffini
152 ENDIF
153c
154c shear modulus (load)
155c
156 func = ifunc(3)
157 IF (func > 0 ) THEN
158 fac = mat_param%UPARAM(30)
159 CALL func_slope(func,fac,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)
160c
161 IF (stiffmin <= zero) THEN
162 CALL ancmsg(msgid=1583 ,
163 . msgtype=msgerror,
164 . anmode=aninfo_blind_2,
165 . i1=mat_id,
166 . i2=func_id(ifunc(3)),
167 . c1=titr)
168 ENDIF
169 gmax = max(gmax,stiffmax)
170 gfrot = stiffini
171 gsh = stiffini
172 IF (mat_param%UPARAM(21) == zero) mat_param%UPARAM(21) = gfrot
173 IF (mat_param%UPARAM(32) == zero) mat_param%UPARAM(32) = gsh
174
175 ENDIF
176c
177 unload = mat_param%IPARAM(1)
178c-------------------------------------------------
179 IF (unload == 1) THEN ! hystheresis / unload option
180c-------------------------------------------------
181c
182c Fiber stiffness dir1 (unload)
183c
184 func = ifunc(4)
185 IF (func > 0 )THEN
186 fac = mat_param%UPARAM(33)
187 CALL func_slope(func,fac,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)
188 kcmax = max(kcmax,stiffmax)
189c
190 IF (stiffmin <= zero) THEN
191 CALL ancmsg(msgid=1581 ,
192 . msgtype=msgerror,
193 . anmode=aninfo_blind_2,
194 . i1=mat_id,
195 . i2=func_id(ifunc(4)),
196 . c1=titr)
197 ENDIF
198 ENDIF
199c
200c Fiber stiffness dir2 (unload)
201c
202 func = ifunc(5)
203 IF (func > 0 )THEN
204 fac = mat_param%UPARAM(34)
205 CALL func_slope(func,fac,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)
206 ktmax = max(ktmax,stiffmax)
207c
208 IF (stiffmin <= zero) THEN
209 CALL ancmsg(msgid=1582 ,
210 . msgtype=msgerror,
211 . anmode=aninfo_blind_2,
212 . i1=mat_id,
213 . i2=func_id(ifunc(5)),
214 . c1=titr)
215 ENDIF
216 ENDIF
217c
218c shear modulus (unload)
219c
220 func = ifunc(6)
221 IF (func > 0 )THEN
222 fac = mat_param%UPARAM(42)
223 CALL func_slope(func,fac,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)
224 gmax = max(gmax,stiffmax)
225c
226 IF (stiffmin <= zero) THEN
227 CALL ancmsg(msgid=1583 ,
228 . msgtype=msgerror,
229 . anmode=aninfo_blind_2,
230 . i1=mat_id,
231 . i2=func_id(ifunc(6)),
232 . c1=titr)
233 ENDIF
234 ENDIF
235c
236c Intersection - direction chaine : load = ifunc(1), unload = ifunc(4)
237c
238 func = ifunc(1)
239 fund = ifunc(4)
240c
241 IF (func == 0) THEN
242 mat_param%UPARAM(36) = infinity
243 mat_param%UPARAM(37) = infinity
244 ELSEIF (func == fund) THEN
245 pn = npc(func+1)
246 mat_param%UPARAM(36) = pld(pn - 2)
247 mat_param%UPARAM(37) = pld(pn - 1)
248 ELSE
249 fac1 = mat_param%UPARAM(28)
250 fac2 = mat_param%UPARAM(33)
251 CALL func_inters(titr ,mat_id ,func ,fund ,fac1 ,
252 . fac2 ,npc ,pld ,xint1 ,yint1 )
253 IF (xint1 == zero .or. yint1 == zero) THEN
254 CALL ancmsg(msgid=1716 ,msgtype=msgerror,anmode=aninfo_blind_2,
255 . i1 = mat_id,
256 . i2 = func_id(func),
257 . i3 = func_id(fund),
258 . c1 = titr )
259 ENDIF
260 mat_param%UPARAM(36) = xint1
261 mat_param%UPARAM(37) = yint1
262 ENDIF
263c
264c Intersection - direction trame : load = ifunc(2), unload = ifunc(5)
265c
266 func = ifunc(2)
267 fund = ifunc(5)
268c
269 IF (func == 0) THEN
270 mat_param%UPARAM(38) = infinity
271 mat_param%UPARAM(39) = infinity
272 ELSEIF (func == fund) THEN
273 pn = npc(func+1)
274 mat_param%UPARAM(38) = pld(pn - 2)
275 mat_param%UPARAM(39) = pld(pn - 1)
276 ELSE
277 fac1 = mat_param%UPARAM(29)
278 fac2 = mat_param%UPARAM(34)
279 CALL func_inters(titr ,mat_id ,func ,fund ,fac1 ,
280 . fac2 ,npc ,pld ,xint2 ,yint2 )
281 IF (xint1 == zero .or. yint1 == zero) THEN
282 CALL ancmsg(msgid=1716 ,msgtype=msgerror,anmode=aninfo_blind_2,
283 . i1 = mat_id,
284 . i2 = func_id(func),
285 . i3 = func_id(fund),
286 . c1 = titr )
287 ENDIF
288 mat_param%UPARAM(38) = xint2
289 mat_param%UPARAM(39) = yint2
290 ENDIF
291c
292c Intersection - Shear : load = ifunc(3), unload = ifunc(6)
293c
294 func = ifunc(3)
295 fund = ifunc(6)
296c
297 IF (func /= fund) THEN
298 fac1 = mat_param%UPARAM(30)
299 fac2 = mat_param%UPARAM(42)
300 CALL func_inters_shear(
301 . titr ,mat_id ,func ,fund ,fac1 ,fac2 ,
302 . npc ,pld ,xint1 ,yint1 ,xint2 ,yint2 )
303c
304 IF ((xint1 == zero .or. yint1 == zero .or.
305 . xint2 == zero .or. yint2 == zero) .or.
306 . xint1 * xint2 > 0) THEN
307 CALL ancmsg(msgid=1716 ,msgtype=msgerror,anmode=aninfo_blind_2,
308 . i1 = mat_id,
309 . i2 = func_id(func),
310 . i3 = func_id(fund),
311 . c1 = titr )
312 ENDIF
313c
314 mat_param%UPARAM(43) = xint1
315 mat_param%UPARAM(44) = yint1
316 mat_param%UPARAM(45) = xint2
317 mat_param%UPARAM(46) = yint2
318 ELSEIF (func > 0) THEN
319 pn = npc(func)
320 mat_param%UPARAM(43) = pld(pn)
321 mat_param%UPARAM(44) = pld(pn+1)
322 pn = npc(func+1)
323 mat_param%UPARAM(45) = pld(pn - 2)
324 mat_param%UPARAM(46) = pld(pn - 1)
325 ENDIF
326c-----------
327 ENDIF ! UNLOAD
328c-----------
329 IF (kcmax > 0 ) kcmax = kcmax * two
330 IF (ktmax > 0 ) ktmax = ktmax * two
331 IF (gmax > 0 ) gmax = gmax * two
332 kcmax = max(mat_param%UPARAM(9) , kcmax)
333 ktmax = max(mat_param%UPARAM(10), ktmax)
334 gmax = max(mat_param%UPARAM(14), gmax)
335 kcmax = max(mat_param%UPARAM(9) , kcmax)
336 ktmax = max(mat_param%UPARAM(10), ktmax)
337 gmax = max(mat_param%UPARAM(14), gmax)
338 mat_param%UPARAM(9) = kcmax
339 mat_param%UPARAM(10) = ktmax
340 mat_param%UPARAM(14) = gmax
341c
342 stiff = max(kcmax,ktmax)
343c
344 pm(20) = stiff ! Stiffness contact
345 pm(21) = zero ! NU
346 pm(22) = stiff*half ! GMAX
347 pm(24) = stiff ! Stiffness for time step computation
348C---- for QEPH (hourglass) :
349 stiffavg = max(kc,kt)
350 IF ( stiffavg > zero) pm(23) = em01*stiffavg
351c-----------
352 RETURN
353 END
my_real
#define my_real
Definition cppsort.cpp:32
func_inters
subroutine func_inters(titr, mat_id, func1, func2, fac1, fac2, npc, pld, xint, yint)
Definition func_inters.F:32
func_inters_shear
subroutine func_inters_shear(titr, mat_id, func, fund, fac1, fac2, npc, pld, xint1, yint1, xint2, yint2)
Definition func_inters.F:134
func_slope
subroutine func_slope(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition func_slope.F:37
law58_upd
subroutine law58_upd(mat_param, titr, npc, pld, nfunc, nfunl, ifunc, mat_id, func_id, pm, sensors)
Definition law58_upd.F:40
max
#define max(a, b)
Definition macros.h:21
matfun_usr2sys
subroutine matfun_usr2sys(titr, mat_id, nfunc, ifunc, func_id)
Definition matfun_usr2sys.F:36
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
table_mod
Definition table_mod.F:112
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889