OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_fail_tab_old.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_tab_old (fail, mat_id, fail_id, irupt, ixfem, lsubmodel, unitab)

Function/Subroutine Documentation

◆ hm_read_fail_tab_old()

subroutine hm_read_fail_tab_old ( 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 40 of file hm_read_fail_tab_old.F.

43C-----------------------------------------------
44C ROUTINE DESCRIPTION :
45C ===================
46C TABULATED FAILURE MODEL (/FAIL/TAB)
47C-----------------------------------------------
48C M o d u l e s
49C-----------------------------------------------
50 USE fail_param_mod
51 USE unitab_mod
52 USE message_mod
53 USE submodel_mod
54 USE hm_option_read_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 :: I,IFAIL_SH,ISOLID,NRATE,IFUN_SIZE,IFUN_TEMP
77 my_real :: p_thick,scale_temp,scale_el,el_ref,dcrit,dd,dn,dadv,
78 . fscal_unit
79 INTEGER ,PARAMETER :: MAXFUNC = 100
80 INTEGER, DIMENSION(MAXFUNC) :: IFUNC
81 my_real, DIMENSION(MAXFUNC) :: yfac,rate
82C-----------------------------------------------
83 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
84C=======================================================================
85 is_encrypted = .false.
86 is_available = .false.
87 dadv = zero
88C--------------------------------------------------
89C EXTRACT DATA (IS OPTION CRYPTED)
90C--------------------------------------------------
91 CALL hm_option_is_encrypted(is_encrypted)
92C--------------------------------------------------
93C EXTRACT INPUT DATA
94C--------------------------------------------------
95Card1
96 CALL hm_get_intv ('Ifail_sh' ,ifail_sh ,is_available,lsubmodel)
97 CALL hm_get_intv ('Ifail_so' ,isolid ,is_available,lsubmodel)
98 CALL hm_get_intv ('N_rate' ,nrate ,is_available,lsubmodel)
99 CALL hm_get_floatv ('P_THICK' ,p_thick ,is_available,lsubmodel,unitab)
100 CALL hm_get_intv ('Ixfem' ,ixfem ,is_available,lsubmodel)
101Card2
102 CALL hm_get_floatv ('Dcrit' ,dcrit ,is_available,lsubmodel,unitab)
103 CALL hm_get_floatv ('D' ,dd ,is_available,lsubmodel,unitab)
104 CALL hm_get_floatv ('n' ,dn ,is_available,lsubmodel,unitab)
105 CALL hm_get_floatv ('Dadv' ,dadv ,is_available,lsubmodel,unitab)
106Card3
107 DO i = 1,nrate
108 CALL hm_get_int_array_index('fct_ID_TAB' ,ifunc(i),i,is_available,lsubmodel)
109 CALL hm_get_float_array_index('Fscale' ,yfac(i) ,i,is_available,lsubmodel,unitab)
110 CALL hm_get_float_array_index('Epsdot' ,rate(i) ,i,is_available,lsubmodel,unitab)
111 ENDDO
112Card4
113 CALL hm_get_intv ('fct_IDel' ,ifun_size ,is_available,lsubmodel)
114 CALL hm_get_floatv ('Fscale_el' ,scale_el ,is_available,lsubmodel,unitab)
115 CALL hm_get_floatv ('EI_ref' ,el_ref ,is_available,lsubmodel,unitab)
116Card5
117 CALL hm_get_intv ('fct_IDt' ,ifun_temp ,is_available,lsubmodel)
118 CALL hm_get_floatv ('FscaleT' ,scale_temp ,is_available,lsubmodel,unitab)
119c-----------------------------------------------------------------------
120c Set default parameter values
121c-----------------------------------------------------------------------
122 IF (dcrit == zero) dcrit = one
123 IF (dadv == zero) dadv = dcrit
124 IF (dadv > dcrit) THEN
125 dadv = dcrit
126 CALL ancmsg(msgid=974, msgtype=msgwarning, anmode=aninfo,
127 . i1=mat_id)
128 ENDIF
129 IF (el_ref == zero) THEN
130 CALL hm_get_floatv_dim('EI_ref' ,fscal_unit ,is_available ,lsubmodel ,unitab)
131 el_ref = one*fscal_unit
132 END IF
133 IF (dd == one ) dd = 0.999
134 IF (dn == zero) dn = one
135 IF (ifail_sh == 0) ifail_sh = 1
136 IF (isolid == 0) isolid = 1
137 IF (ixfem /= 1 .AND. ixfem /= 2) ixfem = 0
138 IF (ixfem > 0) isolid = 0
139 IF (scale_el == zero) scale_el = one
140 IF (scale_temp == zero) scale_temp = one
141c
142 IF (p_thick == one) p_thick = p_thick - em06
143c---------------------------
144 IF (p_thick > zero .and. ifail_sh > 1) THEN
145 CONTINUE
146 ELSEIF (ifail_sh == 1) THEN
147 p_thick = em06
148 ELSEIF (ifail_sh == 2) THEN
149 p_thick = one - em06
150 ENDIF
151c-----------------------------------------------------------------------
152c UPARAM
153c-----------------------------------------------------------------------
154 fail%KEYWORD = 'FAIL_TAB'
155 fail%IRUPT = irupt
156 fail%FAIL_ID = fail_id
157 fail%NUPARAM = 11 + nrate * 2
158 fail%NIPARAM = 0
159 fail%NUVAR = 3
160 fail%NFUNC = nrate + 2
161 fail%NTABLE = 0
162 fail%NMOD = 0
163 fail%PTHK = p_thick
164c
165 ALLOCATE (fail%UPARAM(fail%NUPARAM))
166 ALLOCATE (fail%IPARAM(fail%NIPARAM))
167 ALLOCATE (fail%IFUNC (fail%NFUNC))
168 ALLOCATE (fail%TABLE (fail%NTABLE))
169c
170 fail%UPARAM(1) = isolid
171 fail%UPARAM(2) = ifail_sh
172 fail%UPARAM(3) = 0 ! P_THICK
173 fail%UPARAM(4) = dcrit
174 fail%UPARAM(5) = dd
175 fail%UPARAM(6) = dn
176 fail%UPARAM(7) = scale_temp
177 fail%UPARAM(8) = scale_el
178 fail%UPARAM(9) = el_ref
179 fail%UPARAM(10)= ixfem
180 fail%UPARAM(11)= dadv
181 DO i = 1,nrate
182 fail%UPARAM(11 + i) = yfac(i)
183 fail%UPARAM(11 + i + nrate) = rate(i)
184 ENDDO
185c
186 fail%IFUNC(1:nrate) = ifunc(1:nrate)
187 fail%IFUNC(nrate+1) = ifun_size
188 fail%IFUNC(nrate+2) = ifun_temp
189c-----------------------------------------------------------------------
190 IF (is_encrypted)THEN
191 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
192 ELSE
193 WRITE(iout, 1000) fail_id
194 WRITE(iout, 1001)(fail%IFUNC(i),yfac(i),rate(i),i=1,nrate)
195 WRITE(iout, 1002) ixfem,dadv,fail%UPARAM(3)
196 WRITE(iout, 1003) dcrit,dd,dn
197 WRITE(iout, 1004) ifun_size,scale_temp,ifun_temp,scale_el,el_ref
198c for shell
199 IF (ixfem == 0) THEN
200 IF(ifail_sh == 1) THEN
201 WRITE(iout, 1100)
202 ELSEIF (ifail_sh == 2) THEN
203 WRITE(iout, 1200)
204 ELSEIF (ifail_sh == 3) THEN
205 WRITE(iout, 1300)
206 ENDIF
207 ELSE IF (ixfem == 1) THEN
208 WRITE(iout, 1400)
209 END IF
210c for solid
211 IF (isolid == 1) THEN
212 WRITE(iout, 2100)
213 ELSEIF(isolid == 2) THEN
214 WRITE(iout, 2200)
215 ENDIF
216C
217 ENDIF ! IS_ENCRYPTED
218c-----------
219 RETURN
220c-----------------------------------------------------------------------
221 1000 FORMAT(
222 & 5x,'TABULATED FAILURE CRITERIA WITH DAMAGE',//,
223 & 5x,'FAILURE MODEL ID. . . . . . . . . . . . . . .=',i10/
224 & 5x,'FAILURE STRAIN FUNCTIONS : ')
225 1001 FORMAT(
226 & 5x,' YIELD STRESS FUNCTION NUMBER. . . . . .=',i10/
227 & 5x,' YIELD SCALE FACTOR. . . . . . . . . . .=',1pg20.13/
228 & 5x,' STRAIN RATE . . . . . . . . . . . . . .=',1pg20.13)
229 1002 FORMAT(
230 & 5x,'FLAG XFEM. . . . . . . .. . . . . . . . . . .=',i10/
231 & 5x,'CRITICAL ADVANCEMENT VALUE . . . . . . . . .=',e12.4/
232 & 5x,'PER HUNDRED OF SHELL THICKNESS FAILURE . . . . .=',e12.4)
233 1003 FORMAT(
234 & 5x,'CRITICAL DAMAGE VALUE . . . . . . . . . . . .=',e12.4/
235 & 5x,'DAMAGE PARAMETER D. . . . . . . . . . . . . .=',e12.4/
236 & 5x,'DAMAGE PARAMETER N. . . . . . . . . . . . . .=',e12.4)
237 1004 FORMAT(
238 & 5x,'TEMPERATURE SCALE FUNCTION. . . . . . . . . .=',i10/
239 & 5x,'SCALE FACTOR OF TEMPERATURE FUNCTION. . . . .=',e12.4/
240 & 5x,'ELEMENT LENGTH FUNCTION . . . . . . . . . . .=',i10/
241 & 5x,'SCALE FACTOR OF LENGTH FUNCTION . . . . . . .=',e12.4/
242 & 5x,'REFERENCE ELEMENT LENGTH. . . . . . . . . . .=',e12.4/
243 & 5x,'REGULARIZATION FLAG . . . . . . . . . . . . .=',i10/
244 & 5x,'FAILURE OPTION:')
245 1100 FORMAT(
246 & 5x,' SHELL ELEMENT DELETION AFTER FAILURE OF ONE LAYER')
247 1200 FORMAT(
248 & 5x,' STRESS TENSOR IN SHELL LAYER SET TO ZERO AFTER FAILURE')
249 1300 FORMAT(
250 & 5x,' SHELL ELEMENT DELETION AFTER FAILURE OF ALL LAYERS')
251 1400 FORMAT(
252 & 5x,' SHELL ELEMENT CRACKING AFTER FAILURE')
253 2100 FORMAT(
254 & 5x,' SOLID ELEMENT DELETION AFTER FAILURE')
255 2200 FORMAT(
256 & 5x,' DEVIATORIC STRESS IN SOLID WILL VANISH AFTER FAILURE')
257c-----------------------------------------------------------------------
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:159
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
hm_option_read_mod
Definition hm_option_read_mod.F:408
message_mod
Definition message_mod.F:1249
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
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