OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
law114_upd.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine law114_upd (iout, titr, uparam, npc, pld, nfunc, ifunc, mat_id, func_id, pm)

Function/Subroutine Documentation

◆ law114_upd()

subroutine law114_upd ( integer iout,
character(len=nchartitle) titr,
uparam,
integer, dimension(*) npc,
pld,
integer nfunc,
integer, dimension(nfunc) ifunc,
integer mat_id,
integer, dimension(*) func_id,
pm )

Definition at line 33 of file law114_upd.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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