OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
m2lawp.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"
#include "com08_c.inc"
#include "impl1_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine m2lawp (pm, for, mom, eint, geo, off, pla, exx, exy, exz, kxx, kyy, kzz, al, fa1, fa2, fa3, ma1, ma2, ma3, nel, mat, pid, ngl, ipm, nummat, nuvar, uvar, sigy)

Function/Subroutine Documentation

◆ m2lawp()

subroutine m2lawp ( pm,
for,
mom,
eint,
geo,
off,
pla,
exx,
exy,
exz,
kxx,
kyy,
kzz,
al,
fa1,
fa2,
fa3,
ma1,
ma2,
ma3,
integer, intent(in) nel,
integer, dimension(nel), intent(in) mat,
integer, dimension(nel), intent(in) pid,
integer, dimension(nel), intent(in) ngl,
integer, dimension(npropmi,nummat), intent(in) ipm,
integer, intent(in) nummat,
integer, intent(in) nuvar,
intent(inout) uvar,
intent(inout) sigy )

Definition at line 28 of file m2lawp.F.

35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39#include "comlock.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "units_c.inc"
44#include "param_c.inc"
45#include "scr17_c.inc"
46#include "com08_c.inc"
47#include "impl1_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER ,INTENT(IN) :: NEL,NUMMAT,NUVAR
52 INTEGER ,INTENT(IN) :: MAT(NEL),PID(NEL),NGL(NEL)
53 INTEGER ,DIMENSION(NPROPMI,NUMMAT) ,INTENT(IN) :: IPM
54 my_real
55 . pm(npropm,*), for(nel,3), mom(nel,3), eint(nel,2), geo(npropg,*),
56 . off(*), pla(*),
57 . al(nel),
58 . exx(nel),exy(nel),exz(nel),kxx(nel),kyy(nel),
59 . kzz(nel),fa1(nel),fa2(nel),fa3(nel),
60 . ma1(nel),ma2(nel),ma3(nel),a1(nel)
61 my_real ,DIMENSION(NEL,NUVAR), INTENT(INOUT) :: uvar
62 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: sigy
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER INDX(NEL),ICC(NEL),IRTY(NEL)
67 INTEGER I,NPIF, J, NINDX
68 my_real
69 . yldtmp(nel),ym(nel),
70 . b1(nel), b2(nel), b3(nel), degmb(nel),
71 . degfx(nel),esp(nel),rho(nel),g(nel),
72 . dmpm(nel), dmpf(nel), shf(nel),
73 . f1(nel), m1(nel), m2(nel), m3(nel),
74 . degsh(nel), yeq(nel), yld(nel), dwpla(nel),
75 . epmx(nel), dwelm(nel), dwelf(nel),z3(nel),z4(nel),
76 . ca(nel), cb(nel), cn(nel), ymax(nel),
77 . rr(nel), cc(nel), epdr(nel), epsp(nel),
78 . sh(nel), yma2(nel), sh10(nel), sh20(nel), sh0(nel),
79 . sh1(nel), sh2(nel), fact, epif,plap(nel),dpla(nel),
80 . tmp1(nel), tmp2(nel), tmp3(nel), etmp,plap1,vp,asrate,
81 . factphi,yma2phi, sh10p, sh20p, sh1p, sh2p,shp, sh0p,
82 . ys,ysp,gs,gsp,trm1,trm1p,trm2,trm2p,trm3,trm3p,yeq0,yeq1
83C-----------------------------------------------
84 epif = zero
85 npif = 0
86C
87 IF (impl_s == 0 .OR. idyna > 0) THEN
88 DO i=1,nel
89 dmpm(i)=geo(16,pid(i))*al(i)
90 dmpf(i)=geo(17,pid(i))*al(i)
91 ENDDO
92 ELSE
93 DO i=1,nel
94 dmpm(i)=zero
95 dmpf(i)=zero
96 ENDDO
97 ENDIF
98C
99
100 DO i=1,nel
101 vp = ipm(255,mat(i))
102 rho(i) = pm( 1,mat(i))
103 asrate = min(one, pm(9,mat(i))*dt1)
104 g(i) =pm(22,mat(i))
105 ym(i) =pm(20,mat(i))
106C--------------------------
107 ca(i) =pm(38,mat(i))
108 cb(i) =pm(39,mat(i))
109 cn(i) =pm(40,mat(i))
110 epmx(i)=pm(41,mat(i))
111 ymax(i)=pm(42,mat(i))
112 cc(i) =pm(43,mat(i))
113 IF(vp == 1)THEN
114 epdr(i) = max(em20,pm(44,mat(i)))
115 ELSE
116 epdr(i) = max(em20,pm(44,mat(i))*dt1)
117 ENDIF
118 icc(i) =nint(pm(49,mat(i)))
119C-----------------------------
120 a1(i) =geo(1,pid(i))
121 b1(i) =geo(2,pid(i))
122 b2(i) =geo(18,pid(i))
123 b3(i) =geo(4,pid(i))
124C SHF(I) =GEO(13,PID(I))
125 shf(i) =geo(37,pid(i))
126 epif = max(epif,cc(i))
127 irty(i) = nint(pm(50,mat(i)))
128 npif = npif+irty(i)
129 z3(i) =pm(51,mat(i))
130 z4(i) =pm(52,mat(i))
131 ENDDO
132C-----------------------------
133C DAMPING terms removed to pforce3
134C-----------------------------
135 DO i=1,nel
136 esp(i) = (eint(i,1)+eint(i,2))/al(i)/a1(i)
137 ENDDO
138C
139 DO i=1,nel
140 degmb(i) = for(i,1)*exx(i)
141 degsh(i) = for(i,2)*exy(i)+for(i,3)*exz(i)
142 degfx(i) = mom(i,1)*kxx(i)+mom(i,2)*kyy(i)+mom(i,3)*kzz(i)
143 ENDDO
144C
145C CISAILLEMENT TRANSVERSAL CALCULE AVEC K1=12EI/L**2 K2=5/6GA
146C
147 DO i=1,nel
148 sh(i)=five_over_6*g(i)*a1(i)
149 yma2(i)=twelve*ym(i)/al(i)**2
150 sh10(i)=yma2(i)*b1(i)
151 sh20(i)=yma2(i)*b2(i)
152 sh0(i)=(one - shf(i))*sh(i)
153 sh1(i)=sh0(i)*sh10(i)/(sh(i)+sh10(i)) + shf(i)*sh10(i)
154 sh2(i)=sh0(i)*sh20(i)/(sh(i)+sh20(i)) + shf(i)*sh20(i)
155C
156 f1(i) =for(i,1)+ exx(i)*a1(i)*ym(i)
157 for(i,2)=for(i,2)+ exy(i)*sh2(i)
158 for(i,3)=for(i,3)+ exz(i)*sh1(i)
159 m1(i) =mom(i,1)+ kxx(i)*g(i) *b3(i)
160 m2(i) =mom(i,2)+ kyy(i)*ym(i)*b1(i)
161 m3(i) =mom(i,3)+ kzz(i)*ym(i)*b2(i)
162 ENDDO
163C-------------
164C CRITERE
165C-------------
166 DO i=1,nel
167 yeq(i)= f1(i)*f1(i) + three * a1(i) *
168 + ( m1(i)*m1(i) / max(b3(i),em20)
169 + + m2(i)*m2(i) / max(b1(i),em20)
170 + + m3(i)*m3(i) / max(b2(i),em20) )
171 yeq(i)= sqrt(yeq(i))/a1(i)
172 ENDDO
173C-------------
174C STRAIN RATE (JOHNSON-COOK, ZERILLI-ARMSTRONG)
175C-------------
176 IF (epif /= zero) THEN
177 DO i=1,nel
178 IF(vp == 1)THEN
179 plap(i) = uvar(i,1)
180 plap(i) = max(plap(i),epdr(i))
181 epsp(i) = log(plap(i)/epdr(i))
182 ELSE
183 epsp(i)=abs(degmb(i)+degfx(i))/(yeq(i)+ em20)/a1(i)
184 tmp2(i)=abs(degmb(i)+degfx(i))
185 tmp3(i)=epsp(i)
186 epsp(i)= max(epsp(i),epdr(i))
187 epsp(i)= log(epsp(i)/epdr(i))
188 ENDIF
189 ENDDO
190 IF (npif == zero) THEN
191 DO i=1,nel
192 epsp(i)=(one + cc(i) * epsp(i))
193 IF (icc(i) == 1) ymax(i) = ymax(i) * epsp(i)
194 ENDDO
195 ELSEIF (npif == nel) THEN
196 DO i=1,nel
197 epsp(i)=(one + cc(i) * epsp(i))
198 tmp1(i)=epsp(i)
199 epsp(i)= cc(i)*exp((-z3(i)+z4(i) * epsp(i))*esp(i))
200 IF(icc(i)==1)ymax(i)= ymax(i) + epsp(i)
201 ca(i) = ca(i) + epsp(i)
202 epsp(i)=one
203 ENDDO
204 ELSE
205 DO i=1,nel
206 IF (irty(i) == 0)THEN
207 epsp(i)=(one + cc(i) * epsp(i))
208 tmp1(i)=ymax(i)
209 IF(icc(i)==1) ymax(i) = ymax(i) * epsp(i)
210 ELSE
211 epsp(i)=(one + cc(i) * epsp(i))
212 tmp1(i)=epsp(i)
213 epsp(i)= cc(i)*exp((-z3(i)+z4(i) * epsp(i))*esp(i))
214 IF(icc(i)==1)ymax(i)= ymax(i) + epsp(i)
215 ca(i) = ca(i) + epsp(i)
216 epsp(i)=one
217 ENDIF
218 ENDDO
219 ENDIF
220 ELSE
221 DO i=1,nel
222 epsp(i)=one
223 ENDDO
224 ENDIF
225C-----------------------------------
226C YIELD
227C-----------------------------------
228 DO i=1,nel
229 yld(i)= ca(i) + cb(i) * exp(cn(i) * log(pla(i)+em30))
230 yldtmp(i)=yld(i)
231 yld(i)= min(yld(i)*epsp(i),ymax(i))
232 rr(i) = min(one,yld(i)/(yeq(i)+ em20))
233 sigy(i) = yld(i)
234 ENDDO
235C
236 DO i=1,nel
237 f1(i) = f1(i)*rr(i)
238 dwelm(i) =(f1(i)+for(i,1))*(f1(i)-for(i,1))/ym(i)/a1(i)
239 degmb(i) = degmb(i) + f1(i)*exx(i)
240 ENDDO
241C
242 DO i=1,nel
243 m1(i) = m1(i)*rr(i)
244 m2(i) = m2(i)*rr(i)
245 m3(i) = m3(i)*rr(i)
246 dwelf(i) =(m1(i)+mom(i,1))*(m1(i)-mom(i,1))/ g(i)/b3(i)+
247 . (m2(i)+mom(i,2))*(m2(i)-mom(i,2))/ym(i)/b1(i)+
248 . (m3(i)+mom(i,3))*(m3(i)-mom(i,3))/ym(i)/b2(i)
249 degfx(i) = degfx(i)+ m1(i)*kxx(i)+m2(i)*kyy(i)+m3(i)*kzz(i)
250 ENDDO
251C
252 DO i=1,nel
253 dwpla(i)= degmb(i)+degfx(i)-dwelm(i)-dwelf(i)
254 ENDDO
255C-----------------------
256C EPS PLASTIQUE
257C-----------------------
258 DO i=1,nel
259 tmp1(i)=epsp(i)*dwpla(i)/yld(i)
260c PLA(I)=PLA(I)+OFF(I)*MAX(ZERO,0.5*EPSP(I)*DWPLA(I)/YLD(I)/A1(I))
261 dpla(i) = max(zero,half*tmp1(i)/a1(i))
262 pla(i) = pla(i)+off(i) * dpla(i)
263 ENDDO
264 DO i=1,nel
265 IF (vp == 1) THEN
266 plap1 = dpla(i) / max(em20,dt1)
267 uvar(i,1) = asrate * plap1 + (one - asrate) * plap(i)
268 ENDIF
269 ENDDO
270
271C--------------------------------
272C TEST DE RUPTURE DUCTILE
273C--------------------------------
274 DO i=1,nel
275 IF (off(i) < em01) off(i) = zero
276 IF (off(i) < one ) off(i) = off(i)*four_over_5
277 ENDDO
278C
279 nindx = 0
280 DO i=1,nel
281 IF (off(i) < one) cycle
282 IF (pla(i) < epmx(i)) cycle
283 off(i)=four_over_5
284 idel7nok = 1
285 nindx=nindx+1
286 indx(nindx)=i
287 ENDDO
288C
289 IF (nindx > 0 .AND. imconv == 1) THEN
290 DO j=1,nindx
291#include "lockon.inc"
292 WRITE(iout, 1000) ngl(indx(j))
293 WRITE(istdo,1100) ngl(indx(j)),tt
294#include "lockoff.inc"
295 ENDDO
296 ENDIF
297C
298 DO i=1,nel
299 fa1(i) = f1(i)
300 fa2(i) = for(i,2)
301 fa3(i) = for(i,3)
302 ma1(i) = m1(i)
303 ma2(i) = m2(i)
304 ma3(i) = m3(i)
305 ENDDO
306C
307 1000 FORMAT(1x,'-- RUPTURE OF BEAM ELEMENT NUMBER ',i10)
308 1100 FORMAT(1x,'-- RUPTURE OF BEAM ELEMENT :',i10,' AT TIME :',g11.4)
309C-----------------------------------------------
310 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91