OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
law114_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!|| law114_upd ../starter/source/materials/mat/mat114/law114_upd.F
25!||--- called by ------------------------------------------------------
26!|| updmat ../starter/source/materials/updmat.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!||--- uses -----------------------------------------------------
30!|| message_mod ../starter/share/message_module/message_mod.F
31!|| table_mod ../starter/share/modules1/table_mod.F
32!||====================================================================
33 SUBROUTINE law114_upd(IOUT ,TITR ,UPARAM ,NPC ,PLD ,
34 . NFUNC ,IFUNC ,MAT_ID ,FUNC_ID,
35 . PM )
36 USE message_mod
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE message_mod
41 USE table_mod
42 USE names_and_titles_mod , ONLY : nchartitle
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "param_c.inc"
51#include "com04_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 CHARACTER(LEN=NCHARTITLE) :: TITR
56 INTEGER MAT_ID,IOUT,NFUNC
57 INTEGER NPC(*), FUNC_ID(*),IFUNC(NFUNC)
58 my_real uparam(*),pld(*),pm(npropm)
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER FUNC,NPT, J,J1,IF3,I7,I11,I13,FLAG_NEGATIVE,FUNC_UL,
63 . NPT_UL,J1_UL,J_UL,NEXT
64 my_real
65 . xk,hard,x1,x2,y1,y2,lscale,xk_ini,deri,h,e_offset,
66 . x1_ul,x2_ul,y1_ul,y2_ul,deri_ul,y,y_ul,eps,y_eps
67 CHARACTER(LEN=NCHARTITLE) :: TITR1
68C=======================================================================
69c Transform FUNC_ID -> Function number , leakmat only
70C
71C MAT_LAW114 - only Func1 and Func3 can be set on tension
72C
73 i7 = 40 ! 4 + 6*6
74 i11 = 64 ! 4 + 10*6
75 i13 = 76 ! 4 + 12*6
76 lscale = uparam(i7 + 1)
77 xk = uparam(i11 + 1)
78 hard = uparam(i13 + 1)
79 xk_ini = xk
80 e_offset = zero
81
82c---------------------------------------------------------------
83c traction loading curve
84c---------------------------------------------------------------
85
86 flag_negative = 0
87 func = ifunc(1)
88 IF (func > 0 ) THEN
89 npt=(npc(func+1)-npc(func))/2
90
91 IF ( npc(2*nfunct+func+1) < 0) THEN
92 CALL ancmsg(msgid=3079, ! incompatible with python functions
93 . msgtype=msgerror,
94 . anmode=aninfo_blind_1,
95 . i1=mat_id,
96 . c1=titr,
97 . i2=npc(nfunct+func+1))
98 ENDIF
99 DO j=2,npt
100 j1 =2*(j-2)
101 x1 = pld(npc(func) + j1)
102 y1 = pld(npc(func) + j1 + 1)
103 x2 = pld(npc(func) + j1 + 2)
104 y2 = pld(npc(func) + j1 + 3)
105 xk = max(xk,lscale*(y2 - y1)/(x2 - x1))
106 IF ((x1 < 0).AND.(y1 /= 0)) flag_negative = 1
107 IF ((x2 < 0).AND.(y2 /= 0)) flag_negative = 1
108 IF ((y2 > 0).AND.(y1 < 0)) THEN
109 e_offset = x1 - y1*(x2 - x1)/(y2 - y1)
110 ENDIF
111 ENDDO
112 IF(flag_negative > 0)THEN
113 CALL ancmsg(msgid=1914, !
114 . msgtype=msgwarning,
115 . anmode=aninfo_blind_1,
116 . i1=mat_id,
117 . c1=titr,
118 . i2=npc(nfunct+func+1))
119 ENDIF
120 uparam(i11 + 1)= xk
121C-- compression offset
122 uparam(118)= e_offset
123 ENDIF
124c
125c---------------------------------------------------------------
126c traction unloading curve
127c---------------------------------------------------------------
128C
129 flag_negative = 0
130 if3 = 12
131 func_ul = ifunc(if3+1)
132 IF (func_ul > 0 ) THEN
133 IF ( npc(2*nfunct+func_ul+1) < 0) THEN
134 CALL ancmsg(msgid=3079, ! incompatible with python functions
135 . msgtype=msgerror,
136 . anmode=aninfo_blind_1,
137 . i1=mat_id,
138 . c1=titr,
139 . i2=npc(nfunct+func_ul+1))
140 ENDIF
141
142 npt=(npc(func_ul +1)-npc(func_ul ))/2
143 DO j=2,npt
144 j1 =2*(j-2)
145 x1 = pld(npc(func_ul ) + j1)
146 y1 = pld(npc(func_ul ) + j1 + 1)
147 x2 = pld(npc(func_ul ) + j1 + 2)
148 y2 = pld(npc(func_ul ) + j1 + 3)
149 xk = max(xk,lscale*(y2 - y1)/(x2 - x1))
150 IF ((x1 < 0).AND.(y1 /= 0)) flag_negative = 1
151 IF ((x2 < 0).AND.(y2 /= 0)) flag_negative = 1
152 ENDDO
153 IF(flag_negative > 0)THEN
154 CALL ancmsg(msgid=1915, !
155 . msgtype=msgwarning,
156 . anmode=aninfo_blind_1,
157 . i1=mat_id,
158 . c1=titr,
159 . i2=npc(nfunct+func_ul+1))
160 ENDIF
161 uparam(i11 + 1)= max(xk,uparam(i11 + 1))
162 ENDIF
163C
164 IF (ifunc(1) > 0) THEN
165 IF ((xk_ini<xk).AND.(xk_ini > zero)) THEN
166 CALL ancmsg(msgid=1640, !
167 . msgtype=msgwarning,
168 . anmode=aninfo_blind_1,
169 . i1=mat_id,
170 . c1=titr,
171 . i2=npc(nfunct+func_ul+1),
172!! . C2=TITR1,
173 . r1=xk_ini,
174 . r2=xk,
175 . r3=xk)
176 ENDIF
177 ENDIF
178C
179c---------------------------------------------------------------
180c detection of first crossing point between loading/unloading curve
181c---------------------------------------------------------------
182C
183 func = ifunc(1)
184 if3 = 12
185 func_ul = ifunc(if3+1)
186 y_eps = zero
187C
188 IF ((func > 0).AND.(func_ul > 0).AND.(func_ul /= func)) THEN
189C
190 npt=(npc(func+1)-npc(func))/2
191 npt_ul=(npc(func_ul+1)-npc(func_ul))/2
192C
193 next = 1
194 j_ul = 2
195 j = 2
196C
197 DO WHILE (next > 0)
198C
199 next = 0
200C
201 j1 =2*(j-2)
202 x1 = pld(npc(func) + j1)
203 y1 = pld(npc(func) + j1 + 1)
204 x2 = pld(npc(func) + j1 + 2)
205 y2 = pld(npc(func) + j1 + 3)
206 deri = (y2 - y1)/(x2 - x1)
207C
208 j1_ul =2*(j_ul-2)
209 x1_ul = pld(npc(func_ul) + j1_ul)
210 y1_ul = pld(npc(func_ul) + j1_ul + 1)
211 x2_ul = pld(npc(func_ul) + j1_ul + 2)
212 y2_ul = pld(npc(func_ul) + j1_ul + 3)
213 deri_ul = (y2_ul - y1_ul)/(x2_ul - x1_ul)
214C
215 IF (x2_ul > x2) THEN
216 y_ul = y1_ul + deri_ul*(x2-x1_ul)
217 IF (y_ul < y2) THEN
218 j = j + 1
219 next = 1
220 ELSEIF (abs(deri_ul-deri) > em20) THEN
221 eps = (y1-y1_ul-deri*x1+deri_ul*x1_ul)/(deri_ul-deri)
222 y_eps = y1 + deri*(eps-x1)
223 ELSE
224 eps = max(y1,y1_ul)
225 y_eps = y1 + deri*(eps-x1)
226 ENDIF
227 ELSE
228 y = y1 + deri*(x2_ul-x1)
229 IF (y > y2_ul) THEN
230 j_ul = j_ul + 1
231 next = 1
232 ELSEIF (abs(deri_ul-deri) > em20) THEN
233 eps = (y1-y1_ul-deri*x1+deri_ul*x1_ul)/(deri_ul-deri)
234 y_eps = y1 + deri*(eps-x1)
235 ELSE
236 eps = max(y1,y1_ul)
237 y_eps = y1 + deri*(eps-x1)
238 ENDIF
239 ENDIF
240C
241 ENDDO
242C
243 ENDIF
244C
245 uparam(125)= y_eps
246C
247c-----------
248 RETURN
249 END
my_real
#define my_real
Definition cppsort.cpp:32
law114_upd
subroutine law114_upd(iout, titr, uparam, npc, pld, nfunc, ifunc, mat_id, func_id, pm)
Definition law114_upd.F:36
max
#define max(a, b)
Definition macros.h:21
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