OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_fail_alter.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| hm_read_fail_alter ../starter/source/materials/fail/windshield_alter/hm_read_fail_alter.f
25!||--- called by ------------------------------------------------------
26!|| hm_read_fail ../starter/source/materials/fail/hm_read_fail.F
27!||--- calls -----------------------------------------------------
28!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
29!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
32!||--- uses -----------------------------------------------------
33!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
34!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
35!|| submodel_mod ../starter/share/modules1/submodel_mod.f
36!||====================================================================
37 SUBROUTINE hm_read_fail_alter(FAIL ,FAIL_TAG ,
38 . MAXFAIL ,MAT_ID ,FAIL_ID ,IRUPT ,
39 . IXFEM ,IFAILWAVE,LSUBMODEL,UNITAB )
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
308 END
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
hm_read_fail_alter
subroutine hm_read_fail_alter(fail, fail_tag, maxfail, mat_id, fail_id, irupt, ixfem, ifailwave, lsubmodel, unitab)
Definition hm_read_fail_alter.F:40
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
starter
program starter
Definition starter.F:39
elbuftag_mod::fail_tag_
Definition elbuftag_mod.F:473
submodel_mod::submodel_data
Definition submodel_mod.F:723
unitab_mod::unit_type_
Definition unitab_mod.F:520