45
48
49
50
51#include "implicit_f.inc"
52
53
54
55#include "scr17_c.inc"
56#include "units_c.inc"
57#include "comlock.inc"
58#include "com04_c.inc"
59#include "tabsiz_c.inc"
60
61
62
63 INTEGER, INTENT(IN) :: NEL,NUPARAM,NUVAR,NGL(NEL),NPG,IPG,NTABLF
64 INTEGER, DIMENSION(NTABLF) ,INTENT(IN) :: ITABLF
65 INTEGER, INTENT(INOUT) :: NOFF(NEL)
67 . time,uparam(nuparam),aldt(nel),
68 . dpla(nel),epsp(nel),temp(nel),
69 . signxx(nel),signyy(nel),signzz(nel),
70 . signxy(nel),signyz(nel),signzx(nel),
71 . voln(nel)
73 . uvar(nel,nuvar),dfmax(nel),tdele(nel),
74 . dmg_scale(nel),off(nel),uelr(nel),
75 . loff(nel)
76 TYPE (TTABLE), INTENT(IN), DIMENSION(NTABLE) :: TABLE
77
78
79
80 INTEGER, INTENT(IN) :: NPF(SNPC),NFUNC,IFUNC(NFUNC)
83 . finter
84 EXTERNAL finter
85
86
87
88 INTEGER I,J,INDX(NEL),NINDX,ITAB_EPSF,FAILIP,
89 . ITAB_INST,ITAB_SIZE,IREG,IPOS(NEL,3),
90 . NDIM,IPOS2(NEL),IAD(NEL),ILEN(NEL),
91 . LOG_SCALE1,LOG_SCALE2
93 . fcrit ,dn,dcrit,
ecrit,exp_ref,expo,el_ref,
94 . sr_ref1,fscale_el,shrf,biaxf ,sr_ref2,
95 . fscale_sr,cjc,fscale_dlim,temp_ref, fscale_temp, volfrac
97 . lambda,fac,df,inst(nel) ,dc(nel) ,l0(nel) ,
98 . triax(nel) ,xi(nel) ,epsf(nel) ,epsl(nel) ,
99 . depsf(nel) ,depsl(nel) ,xvec(nel,3) ,dpl_def ,
100 . cos3theta ,det,p,svm ,sxx,syy,szz ,sizefac(nel),
101 . ratefac(nel),dsize(nel) ,softexp(nel),dlim(nel) ,
102 . tempfac(nel),tempfac2(nel),dft(nel) ,var(nel)
103
104
105
106
107
108 fcrit = uparam(1)
109 failip =
min(nint(uparam(2)),npg)
110 dn = uparam(4)
111 dcrit = uparam(5)
113 exp_ref = uparam(7)
114 expo = uparam(8)
115 ireg = nint(uparam(9))
116 el_ref = uparam(10)
117 sr_ref1 = uparam(11)
118 fscale_el = uparam(12)
119 shrf = uparam(13)
120 biaxf = uparam(14)
121 sr_ref2 = uparam(15)
122 fscale_sr = uparam(16)
123 cjc = uparam(17)
124 fscale_dlim = uparam(18)
125 temp_ref = uparam(19)
126 fscale_temp = uparam(20)
127 log_scale1 = nint(uparam(21))
128 log_scale2 = nint(uparam(22))
129 volfrac = uparam(23)
130
131 itab_epsf = itablf(1)
132 itab_inst = itablf(2)
133 itab_size = itablf(3)
134
135
136 DO i=1,nel
137
138 IF ((itab_inst > 0).OR.(
ecrit > zero))
THEN
139
140 inst(i) = uvar(i,1)
141
142 IF (uvar(i,2) == zero) uvar(i,2) = one
143 dc(i) = uvar(i,2)
144 ENDIF
145 END DO
146
147
148
149
150 DO i=1,nel
151
152
153 p = third*(signxx(i) + signyy(i) + signzz(i))
154 sxx = signxx(i) - p
155 syy = signyy(i) - p
156 szz = signzz(i) - p
157 svm = half*(sxx**2 + syy**2 + szz**2)
158 . + signxy(i)**2 + signzx(i)**2 + signyz(i)**2
159 svm = sqrt(
max(three*svm,zero))
160 triax(i) = p/
max(em20,svm)
161 IF (triax(i) < -one) triax(i) = -one
162 IF (triax(i) > one) triax(i) = one
163
164
165 det = sxx*syy*szz + two*signxy(i)*signzx(i)*signyz(i)
166 . - sxx*signyz(i)**2-szz*signxy(i)**2 - syy*signzx(i)**2
167 cos3theta = half*twenty7*det/
max(em20,svm**3)
168 IF (cos3theta < -one) cos3theta = -one
169 IF (cos3theta > one) cos3theta = one
170 xi(i) = one - two*acos(cos3theta)/pi
171
172 ENDDO
173
174
175
176
177
178 IF (uvar(1,3) == zero) uvar(1:nel,3) = aldt(1:nel)
179 l0(1:nel) = uvar(1:nel,3)
180
181
182 IF (ifunc(1) > 0) THEN
183 DO i=1,nel
184 lambda = l0(i)/exp_ref
185 softexp(i) = finter(ifunc(1),lambda,npf,tf,df)
186 softexp(i) = expo*softexp(i)
187 ENDDO
188 ELSE
189 softexp(1:nel) = expo
190 ENDIF
191
192
193 IF (ifunc(4) > 0) THEN
194 var(1:nel) = temp(1:nel)/temp_ref
195 ipos2(1:nel) = 1
196 iad(1:nel) = npf(ifunc(4)) / 2 + 1
197 ilen(1:nel) = npf(ifunc(4)+1) / 2 - iad(1:nel) - ipos2(1:nel)
198 CALL vinter2(tf,iad,ipos2,ilen,nel,var,dft,tempfac)
199 tempfac(1:nel) = fscale_temp*tempfac(1:nel)
200 tempfac2(1:nel) = tempfac(1:nel)
201 ELSE
202 tempfac(1:nel) = one
203 tempfac2(1:nel) = one
204 ENDIF
205
206
207 IF (itab_size > 0) THEN
208
209 ndim = table(itab_size)%NDIM
210 IF (ireg == 1) THEN
211 SELECT CASE (ndim)
212
213 CASE(1)
214 xvec(1:nel,1) = l0(1:nel)/el_ref
215 xvec(1:nel,2:3) = zero
216 ipos(1:nel,1:3) = 1
217
218 CASE(2)
219 xvec(1:nel,1) = l0(1:nel)/el_ref
220 IF (log_scale1 > 0) THEN
221 DO i = 1,nel
222 xvec(i,2) = log(
max(epsp(i),em20)/sr_ref1)
223 ENDDO
224 ELSE
225 xvec(1:nel,2) = epsp(1:nel)/sr_ref1
226 ENDIF
227 xvec(1:nel,3) = zero
228 ipos(1:nel,1:3) = 1
229 END SELECT
230 ELSEIF (ireg == 2) THEN
231 SELECT CASE (ndim)
232
233 CASE(1)
234 xvec(1:nel,1) = l0(1:nel)/el_ref
235 xvec(1:nel,2:3) = zero
236 ipos(1:nel,1:3) = 1
237
238 CASE(2)
239 xvec(1:nel,1) = l0(1:nel)/el_ref
240 xvec(1:nel,2) = triax(1:nel)
241 xvec(1:nel,3) = zero
242 ipos(1:nel,1:3) = 1
243
244 CASE(3)
245 xvec(1:nel,1) = l0(1:nel)/el_ref
246 xvec(1:nel,2) = triax(1:nel)
247 xvec(1:nel,3) = xi(1:nel)
248 ipos(1:nel,1:3) = 1
249 END SELECT
250 ENDIF
251 CALL table_vinterp(table(itab_size),nel,nel,ipos,xvec,sizefac,dsize)
252 sizefac(1:nel) = sizefac(1:nel)*fscale_el
253 IF (ireg == 1) THEN
254 DO i = 1,nel
255 IF (triax(i) < shrf) THEN
256 sizefac(i) = one
257 ELSEIF (triax(i) > biaxf) THEN
258 sizefac(i) = one
259 ENDIF
260 ENDDO
261 ENDIF
262 ELSE
263 sizefac(1:nel) = one
264 ENDIF
265
266
267 IF (ifunc(2) > 0) THEN
268 IF (log_scale2 > 0) THEN
269 DO i = 1,nel
270 var(i) = log(
max(epsp(i),em20)/sr_ref2)
271 ENDDO
272 ELSE
273 var(1:nel) = epsp(1:nel)/sr_ref2
274 ENDIF
275 ipos2(1:nel) = 1
276 iad(1:nel) = npf(ifunc(2)) / 2 + 1
277 ilen(1:nel) = npf(ifunc(2)+1) / 2 - iad(1:nel) - ipos2(1:nel)
278 CALL vinter2(tf,iad,ipos2,ilen,nel,var,dft,ratefac)
279 ratefac(1:nel) = fscale_sr*ratefac(1:nel)
280 ELSEIF (cjc > zero) THEN
281 DO i=1,nel
282 IF (epsp(i) > sr_ref2) THEN
283 ratefac(i) = one + cjc*log(epsp(i)/sr_ref2)
284 ELSE
285 ratefac(i) = one
286 ENDIF
287 ENDDO
288 ELSE
289 ratefac(1:nel) = one
290 ENDIF
291
292
293 IF (ifunc(3) > 0) THEN
294 DO i = 1,nel
295 lambda = triax(i)
296 dlim(i) = finter(ifunc(3),lambda,npf,tf,df)
297 dlim(i) = fscale_dlim*dlim(i)
298 dlim(i) =
min(dlim(i),one)
299 dlim(i) =
max(dlim(i),zero)
300 ENDDO
301 ELSE
302 dlim(1:nel) = one
303 ENDIF
304
305
306
307
308 IF (itab_epsf > 0) THEN
309
310 ndim = table(itab_epsf)%NDIM
311 SELECT CASE (ndim)
312
313 CASE (1)
314 xvec(1:nel,1) = triax(1:nel)
315 xvec(1:nel,2:3) = zero
316 ipos(1:nel,1:3) = 1
317
318 CASE (2)
319 xvec(1:nel,1) = triax(1:nel)
320 xvec(1:nel,2) = xi(1:nel)
321 xvec(1:nel,3) = zero
322 ipos(1:nel,1:3) = 1
323
324 CASE (3)
325 xvec(1:nel,1) = triax(1:nel)
326 xvec(1:nel,2) = xi(1:nel)
327 xvec(1:nel,3) = temp(1:nel)/temp_ref
328 ipos(1:nel,1:3) = 1
329 tempfac(1:nel) = one
330 END SELECT
331 CALL table_vinterp(table(itab_epsf),nel,nel,ipos,xvec,epsf,depsf)
332 epsf(1:nel) = epsf(1:nel)*fcrit
333 ELSE
334 epsf(1:nel) = fcrit
335 ENDIF
336
337
338
339
340 IF (itab_inst > 0) THEN
341
342 ndim = table(itab_inst)%NDIM
343 SELECT CASE (ndim)
344
345 CASE(1)
346 xvec(1:nel,1) = triax(1:nel)
347 xvec(1:nel,2:3) = zero
348 ipos(1:nel,1:3) = 1
349
350 CASE(2)
351 xvec(1:nel,1) = triax(1:nel)
352 xvec(1:nel,2) = xi(1:nel)
353 xvec(1:nel,3) = zero
354 ipos(1:nel,1:3) = 1
355
356 CASE(3)
357 xvec(1:nel,1) = triax(1:nel)
358 xvec(1:nel,2) = xi(1:nel)
359 xvec(1:nel,3) = temp(1:nel)/temp_ref
360 ipos(1:nel,1:3) = 1
361 tempfac2(1:nel) = one
362 END SELECT
363 CALL table_vinterp(table(itab_inst),nel,nel,ipos,xvec,epsl,depsl)
364 epsl(1:nel) = epsl(1:nel)*
ecrit
365 ELSEIF (
ecrit > zero)
THEN
367 ENDIF
368
369
370
371
372
373 nindx = 0
374 indx(1:nel) = 0
375
376
377 DO i=1,nel
378
379
380 IF (loff(i) == one .AND. off(i) == one .AND. dpla(i) > zero) THEN
381
382
383 IF (dfmax(i) == zero) dfmax(i) = em20
384 IF (inst(i) == zero) inst(i) = em20
385
386
387 dpl_def = dpla(i)/
max(epsf(i)*ratefac(i)*sizefac(i)*tempfac(i),em20)
388 dfmax(i) = dfmax(i) + dpl_def*dn*(dfmax(i)**(one-(one/dn)))
389 dfmax(i) =
min(dfmax(i),dlim(i))
390 IF (dfmax(i) >= one) THEN
391 nindx = nindx + 1
392 indx(nindx) = i
393 noff(i) = noff(i) + 1
394 loff(i) = zero
395 uelr(i) = uelr(i) + voln(i)
396 IF ((npg > 1).AND.(volfrac > zero)) THEN
397 IF (uelr(i)/(npg*voln(i)) >= volfrac) THEN
398 off(i) = zero
399 tdele(i) = time
400 ENDIF
401 ELSE
402 IF (noff(i) >= failip) THEN
403 off(i) = zero
404 tdele(i) = time
405 ENDIF
406 ENDIF
407 ENDIF
408
409
410 IF ((itab_inst > 0).OR.(
ecrit > zero))
THEN
411 dpl_def = dpla(i)/
max(epsl(i)*ratefac(i)*sizefac(i)*tempfac2(i),em20)
412 inst(i) = inst(i) + dpl_def*dn*(inst(i)**(one-(one/dn)))
413 inst(i) =
min(inst(i),one)
414 IF ((inst(i) >= one).AND.(dc(i) == one)) THEN
415 dc(i) = dfmax(i)
416 ENDIF
417 ENDIF
418
419 ENDIF
420 ENDDO
421
422
423
424
425 DO i = 1,nel
426 IF ((itab_inst > 0).OR.(
ecrit > zero))
THEN
427 uvar(i,1) = inst(i)
428 uvar(i,2) = dc(i)
429 IF (dfmax(i) >= dc(i)) THEN
430 IF (dc(i) < one) THEN
431 dmg_scale(i) = one - ((dfmax(i)-dc(i))/
max(one-dc(i),em20))**softexp(i)
432 ELSE
433 dmg_scale(i) = zero
434 ENDIF
435 ELSE
436 dmg_scale(i) = one
437 ENDIF
438 ELSE
439 IF (dfmax(i) >= dcrit) THEN
440 IF (dcrit < one) THEN
441 dmg_scale(i) = one - ((dfmax(i)-dcrit)/
max(one-dcrit,em20))**softexp(i)
442 ELSE
443 dmg_scale(i) = zero
444 ENDIF
445 ELSE
446 dmg_scale(i) = one
447 ENDIF
448 ENDIF
449 ENDDO
450
451
452
453
454 IF (nindx > 0) THEN
455 DO j=1,nindx
456 i = indx(j)
457#include "lockon.inc"
458 WRITE(iout, 1000) ngl(i),ipg,time
459 WRITE(istdo,1000) ngl(i),ipg,time
460 IF (off(i) == zero) THEN
461 WRITE(iout, 2000) ngl(i),time
462 WRITE(istdo,2000) ngl(i),time
463 ENDIF
464#include "lockoff.inc"
465 END DO
466 END IF
467
468 1000 FORMAT(1x,'FOR SOLID ELEMENT NUMBER el#',i10,
469 . ' FAILURE (TAB2) AT GAUSS POINT ',i5,
470 . ' AT TIME :',1pe12.4)
471 2000 FORMAT(1x,'-- RUPTURE OF SOLID ELEMENT :',i10,
472 . ' AT TIME :',1pe12.4)
473
subroutine ecrit(timers, partsav, ms, v, in, r, dmas, weight, enintot, ekintot, a, ar, fxbipm, fxbrpm, monvol, xmom_sms, sensors, qfricint, ipari, weight_md, wfexth, iflag, ms_2d, multi_fvm, mas_nd, kend, h3d_data, dynain_data, usreint, output)
subroutine vinter2(tf, iad, ipos, ilen, nel0, x, dydx, y)