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:418
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:161
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:288
seed
#define seed()
Definition macros.h:43
elbuftag_mod
Definition elbuftag_mod.F:230
hm_option_read_mod
Definition hm_option_read_mod.F:412
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517