OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_fail_alter.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_alter (fail, fail_tag, maxfail, mat_id, fail_id, irupt, ixfem, ifailwave, lsubmodel, unitab)

Function/Subroutine Documentation

◆ hm_read_fail_alter()

subroutine hm_read_fail_alter ( type(fail_param_), intent(inout) fail,
type(fail_tag_), dimension(0:maxfail), intent(inout) fail_tag,
integer, intent(in) maxfail,
integer, intent(in) mat_id,
integer, intent(in) fail_id,
integer, intent(in) irupt,
integer, intent(inout) ixfem,
integer, intent(inout) ifailwave,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type(unit_type_), intent(in) unitab )

Definition at line 37 of file hm_read_fail_alter.F.

40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE fail_param_mod
44 USE unitab_mod
45 USE elbuftag_mod
46 USE submodel_mod
47 USE hm_option_read_mod
48C-----------------------------------------------
49C ROUTINE DESCRIPTION : WINDSHIELD FAILURE MODEL (/FAIL/ALTER)
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "units_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER ,INTENT(IN) :: FAIL_ID ! failure model ID
62 INTEGER ,INTENT(IN) :: MAT_ID ! material law ID
63 INTEGER ,INTENT(IN) :: IRUPT ! failure model type number
64 INTEGER ,INTENT(IN) :: MAXFAIL ! fail model table size
65 TYPE(UNIT_TYPE_) ,INTENT(IN) :: UNITAB ! table of input units
66 TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(*) ! submodel table
67 INTEGER ,INTENT(INOUT) :: IXFEM ! XFEM activation flag
68 INTEGER ,INTENT(INOUT) :: IFAILWAVE ! fail wave propagation activation flag
69 TYPE(FAIL_PARAM_) ,INTENT(INOUT) :: FAIL ! failure model data structure
70 TYPE(FAIL_TAG_) ,DIMENSION(0:MAXFAIL) ,INTENT(INOUT) :: FAIL_TAG
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER :: NEMA,ELGR3N,ELGR4N,IDEB,IMOD,ISRATE,PERIOD,ISIDE,SEED,
75 . ITGLASS,PFLAG,NUVAR
76 my_real :: exp_n,cr_foil,cr_air,cr_core,cr_edge,k_ic,k_th,v0,vc,
77 . alpha,geored,rlen,fac_l,tdelay,kres1,kres2,
78 . eta1,beta1,tau1,eta2,beta2,tau2,a_ref,sig_ini,pscale
79 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
80c------------------------------------------------
81c IMOD - choice of failure propagation model between neighbor elements
82c IMOD = 0 => no failure information propagation
83c IMOD = 1 => XFEM FAILURE PROPAGATION
84c IMOD = 2 => ISOTROPIC FRONTWAVE PROPAGATION
85c IMOD = 3 => DIRECTIONAL FRONTWAVE PROPAGATION - edges only
86c IMOD = 4 => DIRECTIONAL FRONTWAVE PROPAGATION - edges and diagonals
87C=======================================================================
88 is_encrypted = .false.
89 is_available = .false.
90C--------------------------------------------------
91c Check crypting option
92C--------------------------------------------------
93c
94 CALL hm_option_is_encrypted(is_encrypted)
95c
96c--------------------------------------------------
97c Extract input Parameters
98c--------------------------------------------------
99card1
100 CALL hm_get_floatv ('Exp_n' ,exp_n ,is_available,lsubmodel,unitab)
101 CALL hm_get_floatv ('V0' ,v0 ,is_available,lsubmodel,unitab)
102 CALL hm_get_floatv ('Vc' ,vc ,is_available,lsubmodel,unitab)
103 CALL hm_get_intv ('EMA' ,nema ,is_available,lsubmodel)
104 CALL hm_get_intv ('Irate' ,israte ,is_available,lsubmodel)
105 CALL hm_get_intv ('Iside' ,iside ,is_available,lsubmodel)
106 CALL hm_get_intv ('mode' ,imod ,is_available,lsubmodel)
107card2
108 CALL hm_get_floatv ('Cr_foil' ,cr_foil ,is_available,lsubmodel,unitab)
109 CALL hm_get_floatv ('Cr_air' ,cr_air ,is_available,lsubmodel,unitab)
110 CALL hm_get_floatv ('cr_core' ,CR_CORE ,IS_AVAILABLE,LSUBMODEL,UNITAB)
111 CALL HM_GET_FLOATV ('cr_edge' ,CR_EDGE ,IS_AVAILABLE,LSUBMODEL,UNITAB)
112 CALL HM_GET_INTV ('grsh4n' ,ELGR4N ,IS_AVAILABLE,LSUBMODEL)
113 CALL HM_GET_INTV ('grsh3n' ,ELGR3N ,IS_AVAILABLE,LSUBMODEL)
114card3
115 CALL HM_GET_FLOATV ('kic' ,K_IC ,IS_AVAILABLE,LSUBMODEL,UNITAB)
116 CALL HM_GET_FLOATV ('kth' ,K_TH ,IS_AVAILABLE,LSUBMODEL,UNITAB)
117 CALL HM_GET_FLOATV ('rlen' ,RLEN ,IS_AVAILABLE,LSUBMODEL,UNITAB)
118 CALL HM_GET_FLOATV ('tdel' ,TDELAY ,IS_AVAILABLE,LSUBMODEL,UNITAB)
119 CALL HM_GET_INTV ('out_flag' ,IDEB ,IS_AVAILABLE,LSUBMODEL)
120card4
121 CALL HM_GET_FLOATV ('kres1' ,KRES1 ,IS_AVAILABLE,LSUBMODEL,UNITAB)
122 CALL HM_GET_FLOATV ('kres2' ,KRES2 ,IS_AVAILABLE,LSUBMODEL,UNITAB)
123c
124card5 new input cards for Ch.Brokmann extension
125 CALL HM_GET_FLOATV ('eta1' ,ETA1 ,IS_AVAILABLE,LSUBMODEL,UNITAB)
126 CALL HM_GET_FLOATV ('beta1' ,BETA1 ,IS_AVAILABLE,LSUBMODEL,UNITAB)
127 CALL HM_GET_FLOATV ('tau1' ,TAU1 ,IS_AVAILABLE,LSUBMODEL,UNITAB)
128 CALL HM_GET_FLOATV ('a_ref' ,a_ref ,is_available,lsubmodel,unitab)
129card6
130 CALL hm_get_floatv ('Eta2' ,eta2 ,is_available,lsubmodel,unitab)
131 CALL hm_get_floatv ('Beta2' ,beta2 ,is_available,lsubmodel,unitab)
132 CALL hm_get_floatv ('Tau2' ,tau2 ,is_available,lsubmodel,unitab)
133card7
134 CALL hm_get_floatv ('Sig_0' ,sig_ini ,is_available,lsubmodel,unitab)
135 CALL hm_get_floatv ('Pscale' ,pscale ,is_available,lsubmodel,unitab)
136 CALL hm_get_intv ('Pflag' ,pflag ,is_available,lsubmodel)
137 CALL hm_get_intv ('seed' ,seed ,is_available,lsubmodel)
138c-------------------------------------------------------------------------------
139c DEFAULT VALUES
140c--------------------------------------------------
141c GEORED should be initialized in fail_windshield_init depending of element type
142 geored = one / sqrt(pi) ! here adjusted for underintegrated 4N shells only
143c
144 IF (exp_n== zero) exp_n = 16.0
145 IF (rlen == zero) THEN
146 CALL hm_get_floatv_dim('rlen' ,FAC_L ,IS_AVAILABLE, LSUBMODEL, UNITAB)
147 RLEN = ONE*FAC_L
148 ENDIF
149c
150 IF (IMOD >= 10) THEN
151 IMOD = IMOD-10
152 IDEB = 1
153 END IF
154 IF (IMOD == 1) THEN
155 IXFEM = 1
156 ELSE IF (IMOD > 1) THEN
157 IXFEM = 0
158 IFAILWAVE = IMOD-1
159 ENDIF
160c
161c flag for Ch. Brokmann extension
162c
163 IF (SIG_INI*ETA1*BETA1*TAU1 > ZERO) THEN
164 ITGLASS = 1 ! Alter + Brokmann extension
165 IF (ETA2 == ZERO) ETA2 = ETA1
166 IF (BETA2 == ZERO) BETA2 = BETA1
167 IF (TAU2 == ZERO) TAU2 = TAU1
168 ELSE
169 ITGLASS = 0 ! Base Alter
170 END IF
171c--------------------------------------------------
172 NUVAR = 21
173 IF (ITGLASS == 1) THEN
174 ISRATE = 0
175 ELSE IF (ISRATE == 1) THEN
176 NUVAR = 130
177 END IF
178c
179 IF (NEMA == 0) NEMA = 15
180 IF (ISRATE == 1) THEN
181 PERIOD = 50
182 ELSE
183 PERIOD = NEMA
184 ENDIF
185 ALPHA = TWO / (NEMA + 1)
186c----------------------------------
187 FAIL%KEYWORD = 'windshield-alter'
188 FAIL%IRUPT = IRUPT
189 FAIL%FAIL_ID = FAIL_ID
190 FAIL%NUPARAM = 35
191 FAIL%NIPARAM = 1
192 FAIL%NUVAR = NUVAR
193 FAIL%NFUNC = 0
194 FAIL%NTABLE = 0
195 FAIL%NMOD = 0
196c
197 ALLOCATE (FAIL%UPARAM(FAIL%NUPARAM))
198 ALLOCATE (FAIL%IPARAM(FAIL%NIPARAM))
199 ALLOCATE (FAIL%IFUNC (FAIL%NFUNC))
200 ALLOCATE (FAIL%TABLE (FAIL%NTABLE))
201c
202 FAIL%IPARAM(1) = SEED
203c
204 FAIL%UPARAM(1) = EXP_N
205 FAIL%UPARAM(2) = CR_FOIL
206 FAIL%UPARAM(3) = CR_AIR
207 FAIL%UPARAM(4) = CR_CORE
208 FAIL%UPARAM(5) = CR_EDGE
209 FAIL%UPARAM(6) = K_IC
210 FAIL%UPARAM(7) = K_TH
211 FAIL%UPARAM(8) = V0
212 FAIL%UPARAM(9) = VC
213 FAIL%UPARAM(10)= ALPHA
214 FAIL%UPARAM(11)= GEORED
215 FAIL%UPARAM(12)= ELGR4N
216 FAIL%UPARAM(13)= ELGR3N
217 FAIL%UPARAM(14)= RLEN
218 FAIL%UPARAM(15)= IMOD
219 FAIL%UPARAM(16)= ISRATE
220 FAIL%UPARAM(17)= IDEB
221 FAIL%UPARAM(18)= ISIDE
222 FAIL%UPARAM(19)= TDELAY
223 FAIL%UPARAM(20)= KRES1
224 FAIL%UPARAM(21)= KRES2
225 FAIL%UPARAM(22)= ITGLASS
226c
227 FAIL%UPARAM(23)= A_REF
228 FAIL%UPARAM(24)= ETA1
229 FAIL%UPARAM(25)= BETA1
230 FAIL%UPARAM(26)= TAU1
231 FAIL%UPARAM(27)= ETA2
232 FAIL%UPARAM(28)= BETA2
233 FAIL%UPARAM(29)= TAU2
234 FAIL%UPARAM(30)= SIG_INI
235 FAIL%UPARAM(31)= PSCALE
236 FAIL%UPARAM(32)= PFLAG
237 FAIL%UPARAM(33)= UNITAB%FAC_M_WORK
238 FAIL%UPARAM(34)= UNITAB%FAC_L_WORK
239 FAIL%UPARAM(35)= UNITAB%FAC_T_WORK
240c---------------------------
241 FAIL_TAG%LF_DIR = 2
242 FAIL_TAG%LF_DAM = 1
243c--------------------------------------------------
244 WRITE(IOUT,1000)
245 IF (IS_ENCRYPTED) THEN
246 WRITE(IOUT, 2000)
247 ELSE
248 WRITE(IOUT,3000) EXP_N,CR_FOIL,CR_AIR,CR_CORE,CR_EDGE,RLEN,
249 . K_IC,K_TH,V0,VC,KRES1,KRES2,TDELAY,ELGR4N,ELGR3N,
250 . ISRATE,PERIOD,ISIDE,IMOD,IDEB
251 IF (ITGLASS == 1) THEN
252 WRITE(IOUT,4000) ETA1,BETA1,TAU1,ETA2,BETA2,TAU2,SIG_INI,A_REF,
253 . PSCALE,PFLAG,SEED
254 END IF
255 ENDIF
256C--------------------------------------------------
257 1000 FORMAT(
258 & 5X,' windshield failure model(christian alter) ',/,
259 & 5X,' -------------------------------------------- ',/)
260 2000 FORMAT(
261 & 5X,' confidential DATA '/,
262 & 5X,' ----------------- '/)
263 3000 FORMAT(
264 & 5X,'crack grow exponent . . . . . . . . . . . . . . . .=',E12.4/
265 & 5X,'foil side crack depth . . . . . . . . . . . . . . .=',E12.4/
266 & 5X,'air side crack depth. . . . . . . . . . . . . . . .=',E12.4/
267 & 5X,'core crack depth. . . . . . . . . . . . . . . . . .=',E12.4/
268 & 5X,'edge element crack depth. . . . . . . . . . . . . .=',E12.4/
269 & 5X,'reference element length. . . . . . . . . . . . . .=',E12.4/
270 & 5X,'k_ic. . . . . . . . . . . . . . . . . . . . . . . .=',E12.4/
271 & 5X,'k_th. . . . . . . . . . . . . . . . . . . . . . . .=',E12.4/
272 & 5X,'v_0 . . . . . . . . . . . . . . . . . . . . . . . .=',E12.4/
273 & 5X,'v_c . . . . . . . . . . . . . . . . . . . . . . . .=',E12.4/
274 & 5X,'residual stress factor in dir1. . . . . . . . . . .=',E12.4/
275 & 5X,'residual stress factor in dir2. . . . . . . . . . .=',E12.4/
276 & 5X,'time delay before element suppression . . . . . . .=',E12.4/
277 & 5X,'edge 4n shell element group . . . . . . . . . . . .=',I10/
278 & 5X,'edge 3n shell element group . . . . . . . . . . . .=',I10/
279 & 5X,'stress rate filtering option. . . . . . . . . . . .=',I3/
280 & 5X,' = 0 => exponential smoothing ',/
281 & 5X,' = 1 => linear smoothing, fixed period = 50 ',/
282 & 5X,'stress rate filtering period(number of cycles). .=',I10/
283 & 5X,'stress rate dependency flag flag(iside) : . . . .=',I3/
284 & 5X,' = 0 => air side only ',/
285 & 5X,' = 1 => air and foil side ',/
286 & 5X,'failure propagation formulation flag(imod) : =',I3/
287 & 5X,' = 0 => no propagation ',/
288 & 5X,' = 1 => xfem ',/
289 & 5X,' = 2 => isotropic frontwave ',/
290 & 5X,' = 3 => directional frontwave through edges ',/
291 & 5X,' = 4 => directional frontwave through diagonals ',/
292 & 5X,'extended output information . . . . . . . . . . . .=',I3/)
293 4000 FORMAT(
294 & 5X,' stochastic failure model(christopher brokmann) ',/,
295 & 5X,'eta1. . . . . . . . . . . . . . . . . . . . . . . .=',E12.4/
296 & 5X,'beta1 . . . . . . . . . . . . . . . . . . . . . . .=',E12.4/
297 & 5X,'tau1. . . . . . . . . . . . . . . . . . . . . . . .=',E12.4/
298 & 5X,'eta2. . . . . . . . . . . . . . . . . . . . . . . .=',E12.4/
299 & 5X,'beta2 . . . . . . . . . . . . . . . . . . . . . . .=',E12.4/
300 & 5X,'tau2. . . . . . . . . . . . . . . . . . . . . . . .=',E12.4/
301 & 5X,'initial surface stress. . . . . . . . . . . . . . .=',E12.4/
302 & 5X,'reference element surface . . . . . . . . . . . . .=',E12.4/
303 & 5X,'p_scale . . . . . . . . . . . . . . . . . . . . . .=',E12.4/
304 & 5X,'pflag . . . . . . . . . . . . . . . . . . . . . . .=',I3/
305 & 5X,'random seed . . . . . . . . . . . . . . . . . . . .=',I3//)
306C---------------------------------------------------------------------
307 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
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_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
seed
#define seed()
Definition macros.h:43
elbuftag_mod
Definition elbuftag_mod.F:227
hm_option_read_mod
Definition hm_option_read_mod.F:408
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513