OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
law158_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!|| law158_upd ../starter/source/materials/mat/mat158/law158_upd.F
25!||--- called by ------------------------------------------------------
26!|| updmat ../starter/source/materials/updmat.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| func_slope ../starter/source/tools/curve/func_slope.F
30!|| matfun_usr2sys ../starter/source/materials/tools/matfun_usr2sys.F
31!||--- uses -----------------------------------------------------
32!|| message_mod ../starter/share/message_module/message_mod.F
33!|| table_mod ../starter/share/modules1/table_mod.F
34!||====================================================================
35 SUBROUTINE law158_upd(MAT_PARAM,TITR ,NPC ,PLD ,
36 . NFUNC ,NFUNL ,IFUNC ,MAT_ID ,FUNC_ID,
37 . PM ,SENSORS)
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE message_mod
42 USE table_mod
43 USE sensor_mod
44 USE matparam_def_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "param_c.inc"
54#include "tabsiz_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
59 INTEGER ,INTENT(IN) :: MAT_ID,NFUNC,NFUNL
60 INTEGER ,DIMENSION(NFUNC) ,INTENT(IN) :: FUNC_ID
61 INTEGER ,DIMENSION(NFUNC+NFUNL) ,INTENT(INOUT) :: IFUNC
62 INTEGER ,DIMENSION(SNPC) ,INTENT(IN) :: NPC
63 my_real ,DIMENSION(STF) ,INTENT(IN) :: pld
64 my_real ,DIMENSION(NPROPM) ,INTENT(OUT) :: pm
65 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
66 TYPE(matparam_struct_) ,INTENT(INOUT) :: MAT_PARAM
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER I,ISENS,SENS_ID,FUNC
71 my_real KCMAX,KTMAX,GMAX,STIFF,STIFFMIN,STIFFINI,STIFFMAX,STIFFAVG,
72 . yfac1,yfac2,yfac3,kflex1,kflex2
73C=======================================================================
74c Transform FUNC_ID -> Function number , leakmat only
75c NFUNL = IPM(6) : LEAK_MAT functions
76c
77 kcmax = zero
78 IF (nfunl > 0) THEN
79 CALL matfun_usr2sys(titr,mat_id,nfunl,ifunc(nfunc+1),func_id )
80 ENDIF
81c---------------------------------------------------------------
82 kflex1 = mat_param%UPARAM(6)
83 kflex2 = mat_param%UPARAM(7)
84 yfac1 = mat_param%UPARAM(12)
85 yfac2 = mat_param%UPARAM(13)
86 yfac3 = mat_param%UPARAM(14)
87
88 sens_id = mat_param%IPARAM(1)
89C----------------------------
90C SENSOR NUMBERING CHECK
91C----------------------------
92 isens = 0
93 IF (sens_id > 0 ) THEN
94 DO i=1,sensors%NSENSOR
95 IF (sens_id == sensors%SENSOR_TAB(i)%SENS_ID) THEN
96 isens = i
97 EXIT
98 END IF
99 ENDDO
100 IF (isens == 0)
101 . CALL ancmsg(msgid=1240,anmode=aninfo,msgtype=msgwarning,
102 . i1=mat_id,c1=titr,i2=isens)
103 ENDIF
104 mat_param%IPARAM(1) = isens
105c---------------------------------------------------------------
106c
107c fiber stiffness dir1 (load)
108c
109 func = ifunc(1)
110 IF (func > 0 ) THEN
111
112 CALL func_slope(func,yfac1,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)
113c
114 IF (stiffmin <= zero) THEN
115 CALL ancmsg(msgid=1581,msgtype=msgerror,anmode=aninfo_blind_2,
116 . i1=mat_id,
117 . i2=func_id(ifunc(1)),
118 . c1=titr)
119 ENDIF
120 kcmax = stiffmax
121c
122 ENDIF
123c
124c fiber stiffness dir2 (load)
125c
126 func = ifunc(2)
127 ktmax = zero
128 IF (func > 0 ) THEN
129 CALL func_slope(func,yfac2,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)
130c
131 IF (stiffmin <= zero) THEN
132 CALL ancmsg(msgid=1582 ,msgtype=msgerror,anmode=aninfo_blind_2,
133 . i1=mat_id,
134 . i2=func_id(ifunc(2)),
135 . c1=titr)
136 ENDIF
137 ktmax = stiffmax
138 ENDIF
139c
140c shear modulus (load)
141c
142 func = ifunc(3)
143 gmax = zero
144 IF (func > 0 ) THEN
145 CALL func_slope(func,yfac3,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)
146c
147 IF (stiffmin <= zero) THEN
148 CALL ancmsg(msgid=1583 ,msgtype=msgerror,anmode=aninfo_blind_2,
149 . i1=mat_id,
150 . i2=func_id(ifunc(3)),
151 . c1=titr)
152 ENDIF
153 gmax = stiffmax
154 ENDIF
155c
156c-------------------------------------------------
157c Flex stiffness dir1
158c
159 func = ifunc(4)
160 IF (func > 0 )THEN
161
162 CALL func_slope(func,kflex1,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)
163c
164 IF (stiffmin <= zero) THEN
165 CALL ancmsg(msgid=1581 , msgtype=msgerror, anmode=aninfo_blind_2,
166 . i1=mat_id,
167 . i2=func_id(ifunc(4)),
168 . c1=titr)
169 ENDIF
170 ENDIF
171c
172c Flex stiffness dir2
173c
174 func = ifunc(5)
175 IF (func > 0 )THEN
176 CALL func_slope(func,kflex2,npc,pld,stiffmin,stiffmax,stiffini,stiffavg)
177c
178 IF (stiffmin <= zero) THEN
179 CALL ancmsg(msgid=1582 , msgtype=msgerror, anmode=aninfo_blind_2,
180 . i1=mat_id,
181 . i2=func_id(ifunc(5)),
182 . c1=titr)
183 ENDIF
184 ENDIF
185c-----------
186 stiff = max(kcmax,ktmax)
187 mat_param%UPARAM(10) = stiff
188 mat_param%UPARAM(11) = gmax
189c-----------
190 pm(20) = stiff ! Stiffness contact
191 pm(21) = zero ! NU
192 pm(22) = stiff*half ! GMAX
193 pm(23) = em01*stiffavg ! Hourglass stiffness for QEPH
194 pm(24) = stiff ! Stiffness for time step computation
195c-----------
196 RETURN
197 END
#define my_real
Definition cppsort.cpp:32
subroutine func_slope(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition func_slope.F:37
subroutine law158_upd(mat_param, titr, npc, pld, nfunc, nfunl, ifunc, mat_id, func_id, pm, sensors)
Definition law158_upd.F:38
#define max(a, b)
Definition macros.h:21
subroutine matfun_usr2sys(titr, mat_id, nfunc, ifunc, func_id)
integer, parameter nchartitle
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