OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_fail_tab1.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_fail_tab1 (fail, mat_id, fail_id, irupt, ixfem, lsubmodel, unitab)

Function/Subroutine Documentation

◆ hm_read_fail_tab1()

subroutine hm_read_fail_tab1 ( type (fail_param_), intent(inout) fail,
integer, intent(in) mat_id,
integer, intent(in) fail_id,
integer, intent(in) irupt,
integer, intent(inout) ixfem,
type (submodel_data), dimension(*), intent(in) lsubmodel,
type (unit_type_), intent(in) unitab )

Definition at line 39 of file hm_read_fail_tab1.F.

42C-----------------------------------------------
43C ROUTINE DESCRIPTION :
44C ===================
45C READ TABULATED FAILURE MODEL (/FAIL/TAB1)
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE fail_param_mod
50 USE unitab_mod
51 USE message_mod
52 USE submodel_mod
54 USE table_mod
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "units_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 INTEGER ,INTENT(IN) :: FAIL_ID ! failure model ID
67 INTEGER ,INTENT(IN) :: MAT_ID ! material law ID
68 INTEGER ,INTENT(IN) :: IRUPT ! failure model number
69 TYPE (UNIT_TYPE_) ,INTENT(IN) :: UNITAB ! table of input units
70 TYPE (SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(*)
71 INTEGER ,INTENT(INOUT) :: IXFEM ! XFEM activation flag
72 TYPE (FAIL_PARAM_) ,INTENT(INOUT) :: FAIL
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER :: IFAIL_SH,ISOLID,DMG_FLAG,INST_FLAG,
77 . IFUN_DMG,ITAB_EPSF,ITAB_INST,IFUN_SIZE,IFUN_TEMP
78 my_real :: p_thick,pthkf,p_thinnfail,scale_temp,scale_el,el_ref,
79 . y1scale,x1scale,y2scale,x2scale,dcrit,dd,dn,dadv,
80 . ecrit,fade_expo,fscal_unit,shrf,biaxf
81C-----------------------------------------------
82 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
83C-----------------------------------------------
84c UVAR storage:
85C 1 = DAMAGE
86C 2 = initial shell thickness
87C 3 = DCrit_NS --> instability starts
88C 4 = percent from instability to failure
89C 5 = initial characteristic el. length
90C 6 = IPOS 1 for Table
91C 7 = IPOS 2 for Table
92C 8 = IPOS 1 for vinter
93C=======================================================================
94 is_encrypted = .false.
95 is_available = .false.
96 dadv = zero
97 ecrit = zero
98C--------------------------------------------------
99C EXTRACT DATA (IS OPTION CRYPTED)
100C--------------------------------------------------
101 CALL hm_option_is_encrypted(is_encrypted)
102C--------------------------------------------------
103C EXTRACT INPUT DATA
104C--------------------------------------------------
105Card1
106 CALL hm_get_intv ('Ifail_sh' ,ifail_sh ,is_available,lsubmodel)
107 CALL hm_get_intv ('Ifail_so' ,isolid ,is_available,lsubmodel)
108 CALL hm_get_floatv ('P_thickfail' ,p_thick ,is_available,lsubmodel,unitab)
109 CALL hm_get_floatv ('P_thinfail' ,p_thinnfail ,is_available,lsubmodel,unitab)
110 CALL hm_get_intv ('Ixfem' ,ixfem ,is_available,lsubmodel)
111Card2
112 CALL hm_get_floatv ('Dcrit' ,dcrit ,is_available,lsubmodel,unitab)
113 CALL hm_get_floatv ('D' ,dd ,is_available,lsubmodel,unitab)
114 CALL hm_get_floatv ('n' ,dn ,is_available,lsubmodel,unitab)
115 CALL hm_get_floatv ('Dadv' ,dadv ,is_available,lsubmodel,unitab)
116 CALL hm_get_intv ('fct_IDd' ,ifun_dmg ,is_available,lsubmodel)
117Card3
118 CALL hm_get_intv ('table1_ID' ,itab_epsf ,is_available,lsubmodel)
119 CALL hm_get_floatv ('Xscale1' ,y1scale ,is_available,lsubmodel,unitab)
120 CALL hm_get_floatv ('Xscale2' ,x1scale ,is_available,lsubmodel,unitab)
121 CALL hm_get_intv ('table2_ID' ,itab_inst ,is_available,lsubmodel)
122 CALL hm_get_floatv ('Xscale3' ,y2scale ,is_available,lsubmodel,unitab)
123 CALL hm_get_floatv ('Xscale4' ,x2scale ,is_available,lsubmodel,unitab)
124Card4
125 CALL hm_get_intv ('fct_IDel' ,ifun_size ,is_available,lsubmodel)
126 CALL hm_get_floatv ('Fscale_el' ,scale_el ,is_available,lsubmodel,unitab)
127 CALL hm_get_floatv ('EI_ref' ,el_ref ,is_available,lsubmodel,unitab)
128 CALL hm_get_floatv ('Inst_start' ,ecrit ,is_available,lsubmodel,unitab)
129 CALL hm_get_floatv ('Fad_exp' ,fade_expo ,is_available,lsubmodel,unitab)
130 CALL hm_get_intv ('Ch_i_f' ,inst_flag ,is_available,lsubmodel)
131Card5
132 CALL hm_get_intv ('fct_IDt' ,ifun_temp ,is_available,lsubmodel)
133 CALL hm_get_floatv ('FscaleT' ,scale_temp ,is_available,lsubmodel,unitab)
134 CALL hm_get_floatv ('Shear_limit' ,shrf ,is_available,lsubmodel,unitab)
135 CALL hm_get_floatv ('Biax_limit' ,biaxf ,is_available,lsubmodel,unitab)
136c-----------------------------------------------------------------------
137 ! Error massage: 'table1_ID' is mandatory:
138 IF (itab_epsf == 0) THEN
139 CALL ancmsg(msgid=2068, msgtype=msgerror, anmode=aninfo_blind,
140 . i1=mat_id)
141 ENDIF
142c-----------------------------------------------------------------------
143c Set default parameter values
144c-----------------------------------------------------------------------
145 IF (dcrit == zero) dcrit = one
146 IF (dadv == zero) dadv = dcrit
147 IF (dadv > dcrit) THEN
148 dadv = dcrit
149 CALL ancmsg(msgid=974, msgtype=msgwarning, anmode=aninfo,
150 . i1=mat_id)
151 ENDIF
152 IF (dd == one ) dd = 0.999
153 IF (itab_inst > 0) THEN
154 ecrit = zero
155 ELSEIF (ecrit == zero) THEN
156 ecrit = dd
157 ENDIF
158 IF (dn == zero) dn = one
159 IF (ifail_sh == 0) ifail_sh = 1
160 IF (isolid == 0) isolid = 1
161 IF (ixfem /= 1 .AND. ixfem /= 2) ixfem = 0
162 IF (ixfem > 0) isolid = 0
163 IF (y1scale == zero) y1scale = one
164 IF (y2scale == zero) y2scale = one
165 IF (scale_el == zero) scale_el = one
166 IF (scale_temp == zero) scale_temp = one
167 IF (shrf == zero) shrf =-one
168 IF (biaxf == zero) biaxf = one
169c
170 IF (fade_expo > zero .or. ecrit /= zero) THEN
171 dmg_flag = 1
172 ELSE
173 dmg_flag = 0
174 ENDIF
175 IF (inst_flag == 0 .OR. inst_flag > 3) inst_flag = 1
176 IF (p_thick == one ) p_thick = p_thick - em06
177 IF (p_thick == zero) p_thick = one-em06
178 p_thick = min(p_thick, one)
179 p_thick = max(p_thick,-one)
180c---------------------------
181 IF (p_thick > zero .and. ifail_sh > 1) THEN
182 pthkf = p_thick
183 ELSEIF (ifail_sh == 1) THEN
184 pthkf = em06
185 ELSEIF (ifail_sh == 2) THEN
186 pthkf = one - em06
187 ENDIF
188c-----------------------------------------------------------------------
189 CALL hm_get_floatv_dim('Xscale2' ,fscal_unit ,is_available ,lsubmodel ,unitab)
190 IF (x1scale == zero) x1scale = one*fscal_unit
191c
192 CALL hm_get_floatv_dim('xscale4' ,FSCAL_UNIT ,IS_AVAILABLE ,LSUBMODEL ,UNITAB)
193 IF (X2SCALE == ZERO) X2SCALE = ONE*FSCAL_UNIT
194c
195 CALL HM_GET_FLOATV_DIM('ei_ref' ,FSCAL_UNIT ,IS_AVAILABLE ,LSUBMODEL ,UNITAB)
196 IF (EL_REF == ZERO) EL_REF = ONE*FSCAL_UNIT
197c-----------------------------------------------------------------------
198 FAIL%KEYWORD = 'tab1'
199 FAIL%IRUPT = IRUPT
200 FAIL%FAIL_ID = FAIL_ID
201 FAIL%NUPARAM = 22
202 FAIL%NIPARAM = 0
203 FAIL%NUVAR = 8
204 FAIL%NFUNC = 4
205 FAIL%NTABLE = 2
206 FAIL%NMOD = 0
207 FAIL%PTHK = PTHKF
208c
209 ALLOCATE (FAIL%UPARAM(FAIL%NUPARAM))
210 ALLOCATE (FAIL%IPARAM(FAIL%NIPARAM))
211 ALLOCATE (FAIL%IFUNC (FAIL%NFUNC))
212 ALLOCATE (FAIL%TABLE (FAIL%NTABLE))
213c
214 FAIL%UPARAM(1) = ISOLID
215 FAIL%UPARAM(2) = IFAIL_SH
216 FAIL%UPARAM(3) = 0 ! not used (P_THICK)
217 FAIL%UPARAM(4) = DCRIT
218 FAIL%UPARAM(5) = DD
219 FAIL%UPARAM(6) = DN
220 FAIL%UPARAM(7) = SCALE_TEMP
221 FAIL%UPARAM(8) = SCALE_EL
222 FAIL%UPARAM(9) = EL_REF
223 FAIL%UPARAM(10)= 0 ! not used (xfem)
224 FAIL%UPARAM(11)= DADV
225 FAIL%UPARAM(12)= Y1SCALE
226 FAIL%UPARAM(13)= ONE / X1SCALE
227 FAIL%UPARAM(14)= Y2SCALE
228 FAIL%UPARAM(15)= ONE / X2SCALE
229 FAIL%UPARAM(16)= P_THINNFAIL
230 FAIL%UPARAM(17)= ECRIT
231 FAIL%UPARAM(18)= FADE_EXPO
232 FAIL%UPARAM(19)= DMG_FLAG
233 FAIL%UPARAM(20)= INST_FLAG
234 FAIL%UPARAM(21)= SHRF
235 FAIL%UPARAM(22)= BIAXF
236c
237 FAIL%TABLE(1) = ITAB_EPSF
238 FAIL%TABLE(2) = ITAB_INST
239 FAIL%IFUNC(1) = IFUN_SIZE
240 FAIL%IFUNC(2) = IFUN_TEMP
241 FAIL%IFUNC(3) = IFUN_DMG
242 IF (FADE_EXPO < ZERO) THEN
243 FAIL%IFUNC(4) = INT(ABS(FADE_EXPO))
244 ELSE
245 FAIL%IFUNC(4) = 0
246 ENDIF
247c-----------------------------------------------------------------------
248 IF (IS_ENCRYPTED)THEN
249 WRITE(IOUT,'(5x,a,//)')'confidential data'
250 ELSE
251 WRITE(IOUT,100) MAT_ID,IRUPT,FAIL_ID
252
253 WRITE(IOUT, 1001) ITAB_EPSF, Y1SCALE, X1SCALE
254 IF (ITAB_INST /= 0) THEN
255 WRITE(IOUT, 1002) ITAB_INST, Y2SCALE, X2SCALE
256 ENDIF
257 IF (IXFEM > 0) WRITE(IOUT, 1003) IXFEM,DADV
258 WRITE(IOUT, 1004) P_THICK,P_THINNFAIL
259 IF (IFUN_DMG > 0) THEN
260 WRITE(IOUT, 1009) DCRIT,IFUN_DMG,ECRIT
261 ELSE
262 WRITE(IOUT, 1005) DCRIT,DD,DN,ECRIT
263 ENDIF
264 IF (FADE_EXPO >= ZERO) THEN
265 WRITE(IOUT, 1006) FADE_EXPO
266 ELSE
267 WRITE(IOUT, 1007) INT(ABS(FADE_EXPO))
268 ENDIF
269 WRITE(IOUT, 1008) DMG_FLAG,
270 . IFUN_TEMP,SCALE_TEMP,
271 . IFUN_SIZE,SCALE_EL,EL_REF,SHRF,BIAXF,INST_FLAG
272 WRITE(IOUT, 1008) DMG_FLAG,IFUN_TEMP,SCALE_TEMP,IFUN_SIZE,SCALE_EL,
273 . EL_REF,SHRF,BIAXF,INST_FLAG
274c for shell
275 IF (IXFEM == 0) THEN
276 IF(IFAIL_SH == 1) THEN
277 WRITE(IOUT, 1100)
278 ELSEIF (IFAIL_SH == 2) THEN
279 WRITE(IOUT, 1200)
280 ELSEIF (IFAIL_SH == 3) THEN
281 WRITE(IOUT, 1300)
282 ENDIF
283 ELSE IF (IXFEM == 1) THEN
284 WRITE(IOUT, 1400)
285 END IF
286c for solid
287 IF (ISOLID == 1) THEN
288 WRITE(IOUT, 2100)
289 ELSEIF(ISOLID == 2) THEN
290 WRITE(IOUT, 2200)
291 ENDIF
292C
293 ENDIF ! IS_ENCRYPTED
294c-----------
295 RETURN
296c-----------------------------------------------------------------------
297 100 FORMAT(//
298 & 5X,'mat_id . . . . . . . . . . . . . . .=',I10/
299 & 5X,'failure model. . . . . . . . . . . .=',I10/
300 & 5X,'fail_id. . . . . . . . . . . . . . .=',I10/)
301 1001 FORMAT(
302 & 5X,'tabulated failure criteria with damage',//,
303 & 5X,'strain table id . . . . . . . . . . . . . . . . . . .=',I10/
304 & 5X,' scale factor for failure strain . . . . . . . . .=',1PG20.13/
305 & 5X,' strain rate factor for failure strain . . . . . .=',1PG20.13)
306 1002 FORMAT(
307 & 5X,'necking table id . . . . . . . . . . . . . . . .=',I10/
308 & 5X,' scale factor for necking strain. . . . . . . . .=',1PG20.13/
309 & 5X,' strain rate factor for necking strain. . . . . .=',1PG20.13)
310 1003 FORMAT(
311 & 5X,'flag xfem. . . . . . . .. . . . . . . . . . . . . . .=',I10/
312 & 5X,' xfem advancement softening factor. . . . . . . .=',1PG20.13)
313 1004 FORMAT(
314 & 5X,'shell element deletion PARAMETER pthickfail . . . . .=',1PG20.13,/,
315 & 5X,' > 0.0 : fraction of failed thickness ',/,
316 & 5X,' < 0.0 : fraction of failed intg. points or layers',/,
317 & 5X,'shell failure due to thinning . . . . . . . . . . . .=',1PG20.13)
318 1005 FORMAT(
319 & 5X,'critical damage VALUE . . . . . . . . . . . . . . . .=',1PG20.13/
320 & 5X,'damage PARAMETER d. . . . . . . . . . . . . . . . . .=',1PG20.13/
321 & 5X,'damage PARAMETER n. . . . . . . . . . . . . . . . . .=',1PG20.13/
322 & 5X,'instability strain. . . . . . . . . . . . . . . . . .=',1PG20.13)
323 1009 FORMAT(
324 & 5X,'critical damage VALUE . . . . . . . . . . . . . . . .=',1PG20.13/
325 & 5X,'damage evolution FUNCTION . . . . . . . . . . . . . .=',I10/
326 & 5X,'instability strain. . . . . . . . . . . . . . . . . .=',1PG20.13)
327 1006 FORMAT(
328 & 5X,'fade parameter. . . . . . . . . . . . . . . . . . . .=',1PG20.13)
329 1007 FORMAT(
330 & 5X,'fade function . . . . . . . . . . . . . . . . . . . .=',i10)
331 1008 FORMAT(
332 & 5x,'DAMAGE FLAG . . . . . . . . . . . . . . . . . . . . .=',i10/
333 & 5x,'TEMPERATURE SCALE FUNCTION. . . . . . . . . . . . . .=',i10/
334 & 5x,'SCALE FACTOR OF TEMPERATURE FUNCTION. . . . . . . . .=',1pg20.13/
335 & 5x,'ELEMENT LENGTH FUNCTION . . . . . . . . . . . . . . .=',i10/
336 & 5x,'SCALE FACTOR OF LENGTH FUNCTION . . . . . . . . . . .=',1pg20.13/
337 & 5x,'REFERENCE ELEMENT LENGTH. . . . . . . . . . . . . . .=',1pg20.13/
338 & 5x,'SHEAR TRIAXIALITY LIMIT FOR ELEMENT SIZE SCALING. . .=',1pg20.13/
339 & 5x,'BI-TRACT TRIAXIALITY LIMIT FOR ELEMENT SIZE SCALING .=',1pg20.13/
340 & 5x,'REGULARIZATION FLAG . . . . . . . . . . . . . . . . .=',i10/
341 & 5x,'FAILURE OPTION:')
342 1100 FORMAT(
343 & 5x,' SHELL ELEMENT DELETION AFTER FAILURE OF ONE LAYER')
344 1200 FORMAT(
345 & 5x,' STRESS TENSOR IN SHELL LAYER SET TO ZERO AFTER FAILURE')
346 1300 FORMAT(
347 & 5x,' SHELL ELEMENT DELETION AFTER FAILURE OF ALL LAYERS')
348 1400 FORMAT(
349 & 5x,' SHELL ELEMENT CRACKING AFTER FAILURE')
350 2100 FORMAT(
351 & 5x,' SOLID ELEMENT DELETION AFTER FAILURE')
352 2200 FORMAT(
353 & 5x,' DEVIATORIC STRESS IN SOLID WILL VANISH AFTER FAILURE')
354c-----------------------------------------------------------------------
#define my_real
Definition cppsort.cpp:32
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)
Definition ecrit.F:52
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
initmumps id
for(i8=*sizetab-1;i8 >=0;i8--)
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
subroutine tabulated(iflag, nel, pm, off, eint, mu, espe, dvol, df, vnew, mat, psh, pnew, dpdm, dpde, npf, tf)
Definition tabulated.F:32