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

Function/Subroutine Documentation

◆ hm_read_fail_fld()

subroutine hm_read_fail_fld ( 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,
type (fail_tag_), intent(inout) fail_tag )

Definition at line 38 of file hm_read_fail_fld.F.

41C-----------------------------------------------
42c ROUTINE DESCRIPTION :
43c Read FLD failure model parameters
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE fail_param_mod
48 USE unitab_mod
49 USE message_mod
50 USE submodel_mod
51 USE hm_option_read_mod
52 USE elbuftag_mod
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "units_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER ,INTENT(IN) :: FAIL_ID ! failure model ID
65 INTEGER ,INTENT(IN) :: MAT_ID ! material law ID
66 INTEGER ,INTENT(IN) :: IRUPT ! failure model number
67 TYPE (UNIT_TYPE_) ,INTENT(IN) :: UNITAB ! table of input units
68 TYPE (SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(*) ! submodel table
69 INTEGER ,INTENT(INOUT) :: IXFEM ! XFEM activation flag
70 TYPE (FAIL_PARAM_) ,INTENT(INOUT) :: FAIL ! failure model data structure
71 TYPE (FAIL_TAG_) ,INTENT(INOUT) :: FAIL_TAG ! failure model tag for buffer allocation
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER :: IFAIL_SH,IMARGIN,IENG
76 INTEGER ,PARAMETER :: NFUNC = 2
77 INTEGER ,DIMENSION(NFUNC) :: IFUNC
78 my_real :: rani,dadv,fact_margin,fact_loosemetal,pthkf,fcut,alpha
79C-----------------------------------------------
80 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
81C=======================================================================
82 is_encrypted = .false.
83 is_available = .false.
84C--------------------------------------------------
85C EXTRACT DATA (IS OPTION CRYPTED)
86C--------------------------------------------------
87 CALL hm_option_is_encrypted(is_encrypted)
88C--------------------------------------------------
89C EXTRACT DATAS
90C--------------------------------------------------
91 fact_margin = em01 ! 0.1
92 fact_loosemetal = zep02 ! 0.02
93c
94Card1--------------------------------------------------
95 CALL hm_get_intv ('fct_ID' ,ifunc(1) ,is_available,lsubmodel)
96 CALL hm_get_intv ('Ifail_sh' ,ifail_sh ,is_available,lsubmodel)
97 CALL hm_get_intv ('I_marg' ,imargin ,is_available,lsubmodel)
98 CALL hm_get_intv ('fct_IDadv' ,ifunc(2) ,is_available,lsubmodel)
99 CALL hm_get_floatv ('Rani' ,rani ,is_available,lsubmodel,unitab)
100 CALL hm_get_floatv ('Dadv' ,dadv ,is_available,lsubmodel,unitab)
101 CALL hm_get_intv ('Istrain' ,ieng ,is_available,lsubmodel)
102 CALL hm_get_intv ('Ixfem' ,ixfem ,is_available,lsubmodel)
103C--------------------------------------------------
104 IF (imargin == 0) imargin = 1
105 IF (imargin > 1) THEN
106Card2--------------------------------------------------
107 CALL hm_get_floatv ('Factor_Marginal' ,fact_margin ,is_available,lsubmodel,unitab)
108 CALL hm_get_floatv ('Factor_Loosemetal',fact_loosemetal,is_available,lsubmodel,unitab)
109 ENDIF
110 IF (ieng > 1) THEN
111Card3--------------------------------------------------
112 CALL hm_get_floatv ('FCUT' ,fcut ,is_available,lsubmodel,unitab)
113 CALL hm_get_floatv ('ALPHA' ,alpha ,is_available,lsubmodel,unitab)
114 ELSE
115 fcut = zero
116 alpha = zero
117 ENDIF
118C --- check
119 IF (ifunc(1) == 0) CALL ancmsg(msgid=2001,msgtype=msgerror,anmode=aninfo_blind,
120 . i1=mat_id )
121C--------------------------------------------------
122 ieng = min(ieng,2)
123 ieng = max(ieng,0)
124 IF (fcut == zero) fcut = 10000.0d0*unitab%FAC_T_WORK
125 IF (alpha > zero) fcut = zero
126 IF (ifail_sh == 0) ifail_sh = 1
127 IF (rani == 0) rani = one
128 IF (dadv ==zero) THEN
129 IF (ifunc(2) == 0) THEN
130 dadv = half
131 ELSE
132 dadv = one
133 ENDIF
134 ENDIF
135 IF (ixfem /= 1 .AND. ixfem /= 2) ixfem = 0
136c
137 IF (ifail_sh == 1) THEN
138 pthkf = em06
139 ELSEIF (ifail_sh == 2) THEN
140 pthkf = one
141 ELSEIF (ifail_sh == 3) THEN ! membrane criterion only
142 pthkf = em06
143 ELSEIF (ifail_sh == 4) THEN ! no element suppression
144 pthkf = em06
145 ENDIF
146c---------------------------
147 fail%KEYWORD = 'FLD'
148 fail%IRUPT = irupt
149 fail%FAIL_ID = fail_id
150 fail%NUPARAM = 6
151 fail%NIPARAM = 3
152 fail%NUVAR = 3
153 fail%NFUNC = nfunc
154 fail%NTABLE = 0
155 IF (ieng == 2) THEN
156 fail%NMOD = 3
157 ELSE
158 fail%NMOD = 2
159 ENDIF
160 fail%PTHK = pthkf
161c
162 ALLOCATE (fail%UPARAM(fail%NUPARAM))
163 ALLOCATE (fail%IPARAM(fail%NIPARAM))
164 ALLOCATE (fail%IFUNC (fail%NFUNC))
165 ALLOCATE (fail%TABLE (fail%NTABLE))
166 ALLOCATE (fail%MODE (fail%NMOD))
167c
168 fail%IFUNC(1:nfunc) = ifunc(1:nfunc)
169c
170 fail%UPARAM(1) = fact_margin
171 fail%UPARAM(2) = dadv
172 fail%UPARAM(3) = rani ! average anisotropy (for zone index output in ANIM)
173 fail%UPARAM(4) = fact_loosemetal
174 fail%UPARAM(5) = fcut
175 fail%UPARAM(6) = alpha
176c
177 fail%IPARAM(1) = ifail_sh
178 fail%IPARAM(2) = imargin
179 fail%IPARAM(3) = ieng
180c
181 fail%MODE(1) = "FLDF Damage factor"
182 fail%MODE(2) = "FLDZ Failure zone factor"
183 IF (ieng == 2) THEN
184 fail%MODE(3) = "Incremental Strains ratio Beta"
185 ENDIF
186 fail_tag%LF_DAMMX = 1 + fail%NMOD
187 fail_tag%LF_DAM = 1 ! damage factor for ANIM output
188 fail_tag%LF_INDX = 1 ! FLD zone index for ANIM output
189c
190c--------------------------------------------------
191 IF (is_encrypted) THEN
192 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
193 ELSE
194 IF (ixfem == 0)THEN
195 WRITE(iout, 1000)
196 WRITE(iout, 1100) ifunc(1),rani,imargin,fact_margin,fact_loosemetal
197 WRITE(iout, 1600) ieng
198 IF (ieng > 1) WRITE(iout, 1800) fcut,alpha
199 IF (ifail_sh == 1) THEN
200 WRITE(iout, 1700)
201 ELSEIF (ifail_sh == 2) THEN
202 WRITE(iout, 1710)
203 ELSEIF (ifail_sh == 3) THEN
204 WRITE(iout, 1720)
205 ELSEIF (ifail_sh == 4) THEN
206 WRITE(iout, 1730)
207 ENDIF
208 ELSE
209 WRITE(iout, 1010)
210 WRITE(iout, 1110) ifunc(1),ifunc(2),dadv,rani,
211 & imargin,fact_margin,fact_loosemetal
212 WRITE(iout, 1600) ieng
213 IF (ieng > 1) WRITE(iout, 1800) fcut,alpha
214 WRITE(iout, 1400)
215 END IF
216 ENDIF
217C-----------
218 1000 FORMAT(
219 & 5x,'-----------------------------------------------------',/,
220 & 5x,' FAILURE CRITERION : FORMING LIMIT DIAGRAM ',/,
221 & 5x,'-----------------------------------------------------',/)
222 1100 FORMAT(
223 & 5x,'FORMING LIMIT DIAGRAM FUNCTION ID . . . . . . . . . =',i10/,
224 & 5x,'AVERAGE ANISOTROPY FACTOR (RANI). . . . . . . . . . =',1pg20.13/,
225 & 5x,'MARGINAL VALUE FLAG (I_MARG). . . . . . . . . . . . =',i10/,
226 & 5x,'FACTOR MARGINAL . . . . . . . . . . . . . . . . . . =',1pg20.13/,
227 & 5x,'FACTOR LOOSEMETAL . . . . . . . . . . . . . . . . . =',1pg20.13//)
228 1600 FORMAT(
229 & 5x,'INPUT/FORMULATION FLAG (ISTRAIN). . . . . . . . . . =',i10/,
230 & 5x,' = 0: TRUE STRAIN (CLASSIC) INPUT ',/,
231 & 5x,' = 1: ENGINEERING STRAIN INPUT FLAG ',/,
232 & 5x,' = 2: NON-LINEAR PATH FORMULATION ',/)
233 1700 FORMAT(
234 & 5x,' SHELL ELEMENT DELETION AFTER FAILURE',//)
235 1710 FORMAT(
236 & 5x,' STRESS TENSOR IN SHELL LAYER SET TO ZERO AFTER FAILURE',//)
237 1720 FORMAT(
238 & 5x,' ELEMENT IS DELETED ONLY WHEN MEMBRANE FAILS',//)
239 1730 FORMAT(
240 & 5x,' SHELL FAILURE IS DEACTIVATED',//)
241 1400 FORMAT(
242 & 5x,' SHELL ELEMENT CRACKING AFTER FAILURE',//)
243 1800 FORMAT(
244 & 5x,'STRAIN RATIO FILTERING FREQUENCY (FCUT) . . . . . . =',1pg20.13/,
245 & 5x,'strain ratio filtering weight(alpha) . . . . . . . =',1PG20.13//)
246 1010 FORMAT(
247 & 5X,'-----------------------------------------------------',/,
248 & 5X,' failure criterion : xfem forming limit diagram ',/,
249 & 5X,'-----------------------------------------------------',/)
250 1110 FORMAT(
251 & 5X,'forming limit diagram FUNCTION id . . . . . . . . . =',I10/,
252 & 5X,'crack advancement limit diagram function id . . . . =',I10/,
253 & 5X,'scale factor for crack advancement (DADV) . . . . . =',1PG20.13/,
254 & 5X,'average anisotropy factor (RANI). . . . . . . . . . =',1PG20.13/,
255 & 5X,'marginal value flag (I_MARG). . . . . . . . . . . . =',I10/,
256 & 5X,'factor marginal . . . . . . . . . . . . . . . . . . =',1PG20.13/,
257 & 5X,'factor loosemetal . . . . . . . . . . . . . . . . . =',1PG20.13//)
258c-----------
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_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
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
elbuftag_mod
Definition elbuftag_mod.F:227
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