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

Function/Subroutine Documentation

◆ hm_read_fail_johnson()

subroutine hm_read_fail_johnson ( type(fail_param_), intent(inout) fail,
integer, intent(in) mat_id,
integer, intent(in) fail_id,
integer, intent(in) ilaw,
integer, intent(in) irupt,
integer, intent(inout) ixfem,
character(len=nchartitle), intent(in) titr,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type(unit_type_), intent(in) unitab )

Definition at line 37 of file hm_read_fail_johnson.F.

40C-----------------------------------------------
41c ROUTINE DESCRIPTION :
42c Read Johnoson-Cook failure model parameters
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE fail_param_mod
47 USE unitab_mod
48 USE message_mod
49 USE submodel_mod
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
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) :: ILAW ! material law type number
64 INTEGER ,INTENT(IN) :: IRUPT ! failure model type number
65 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR ! material model title
66 TYPE(UNIT_TYPE_) ,INTENT(IN) :: UNITAB ! table of input units
67 TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(*) ! submodel table
68 INTEGER ,INTENT(INOUT) :: IXFEM ! XFEM activation flag
69 TYPE(FAIL_PARAM_) ,INTENT(INOUT) :: FAIL ! failure model data structure
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER IFAIL_SH,ISOLID,I,FAILIP
74 my_real d1,d2,d3,d4,d5,epsp0,unit_t,dadv,pthkf,epsf_min
75 my_real triax,epsf,depsf_dtriax
76 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
77C=======================================================================
78 is_encrypted = .false.
79 is_available = .false.
80C--------------------------------------------------
81C Check encryption
82C--------------------------------------------------
83 CALL hm_option_is_encrypted(is_encrypted)
84C--------------------------------------------------
85C EXTRACT PARAMETERS
86C--------------------------------------------------
87 CALL hm_get_floatv ('D1' ,d1 ,is_available,lsubmodel,unitab)
88 CALL hm_get_floatv ('D2' ,d2 ,is_available,lsubmodel,unitab)
89 CALL hm_get_floatv ('D3' ,d3 ,is_available,lsubmodel,unitab)
90 CALL hm_get_floatv ('D4' ,d4 ,is_available,lsubmodel,unitab)
91 CALL hm_get_floatv ('D5' ,d5 ,is_available,lsubmodel,unitab)
92 CALL hm_get_floatv ('Epsilon_Dot_0',epsp0 ,is_available,lsubmodel,unitab)
93 CALL hm_get_intv ('Ifail_sh' ,ifail_sh,is_available,lsubmodel)
94 CALL hm_get_intv ('Ifail_so' ,isolid ,is_available,lsubmodel)
95 CALL hm_get_floatv ('EPSF_MIN' ,epsf_min,is_available,lsubmodel,unitab)
96 CALL hm_get_floatv ('Dadv' ,dadv ,is_available,lsubmodel,unitab)
97 CALL hm_get_intv ('Ixfem' ,ixfem ,is_available,lsubmodel)
98 CALL hm_get_intv ('FAILIP' ,failip ,is_available,lsubmodel)
99 IF (failip == 0) failip = 1
100!
101 ! CHECK COMPATIBILITY WITH MATERIAL LAW
102 IF (ilaw == 25) THEN
103 CALL ancmsg(msgid=3001, msgtype=msgwarning, anmode=aninfo_blind,
104 . i1=mat_id,
105 . c1=titr)
106 ENDIF
107!
108 ! Check the Johnson-Cook Failure criterion
109 triax = one
110 epsf = d1 + d2*exp(d3*triax)
111 ! -> Check if criterion reaches negative values
112 IF ((epsf <= zero).AND.(epsf_min == zero)) THEN
113 DO i = 1,10
114 depsf_dtriax = d2*d3*exp(d3*triax)
115 triax = triax - epsf/depsf_dtriax
116 triax = min(triax, one)
117 triax = max(triax,-one)
118 epsf = d1 + d2*exp(d3*triax)
119 ENDDO
120 ! -> Print warning message
121 IF ((abs(epsf) < em06) .AND. (triax < one) .AND. (triax > -one)) THEN
122 CALL ancmsg(msgid=3058,
123 . msgtype=msgwarning,
124 . anmode=aninfo_blind,
125 . i1=mat_id,
126 . c1=titr,
127 . r1=triax)
128 ENDIF
129 ENDIF
130!
131 IF (epsp0 == zero) epsp0=em20
132 IF (ifail_sh == 0) ifail_sh=1
133 IF (isolid == 0) isolid=1
134 IF (ixfem /= 1 .AND. ixfem /= 2) ixfem = 0
135 IF (ixfem > 0) isolid = 0
136 IF (dadv == zero .OR. dadv > one) dadv = one
137c-----------------------------
138 IF (ifail_sh == 1) THEN
139 pthkf = em06
140 ELSEIF (ifail_sh == 2) THEN
141 pthkf = one
142 ENDIF
143c----------------------------------
144 fail%KEYWORD = 'JOHNSON-COOK'
145 fail%IRUPT = irupt
146 fail%FAIL_ID = fail_id
147 fail%NUPARAM = 13
148 fail%NIPARAM = 0
149 fail%NUVAR = 0
150 fail%NFUNC = 0
151 fail%NTABLE = 0
152 fail%NMOD = 0
153 fail%PTHK = pthkf
154c
155 ALLOCATE (fail%UPARAM(fail%NUPARAM))
156 ALLOCATE (fail%IPARAM(fail%NIPARAM))
157 ALLOCATE (fail%IFUNC (fail%NFUNC))
158 ALLOCATE (fail%TABLE (fail%NTABLE))
159c
160 fail%UPARAM(1) = d1
161 fail%UPARAM(2) = d2
162 fail%UPARAM(3) = d3
163 fail%UPARAM(4) = d4
164 fail%UPARAM(5) = d5
165 fail%UPARAM(6) = epsp0
166 fail%UPARAM(7) = ifail_sh
167 fail%UPARAM(8) = isolid
168 fail%UPARAM(9) = 0 ! not used
169 fail%UPARAM(10)= dadv
170 fail%UPARAM(11)= ixfem
171 fail%UPARAM(12)= epsf_min
172 fail%UPARAM(13)= failip
173c---------------------------
174c OUTPUT
175c---------------------------
176 IF (is_encrypted) THEN
177 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
178 ELSE
179
180 WRITE(iout,500) mat_id,irupt,fail_id
181
182C---
183C for shell
184C---
185 IF (ixfem == 0)THEN
186 WRITE(iout, 1000)d1,d2,d3,d4,d5,epsf_min,failip
187 IF (ifail_sh == 1)THEN
188 WRITE(iout, 1100)
189 ELSEIF(ifail_sh == 2)THEN
190 WRITE(iout, 1200)
191 ENDIF
192 ELSE
193 WRITE(iout, 1010)d1,d2,d3,d4,d5,ixfem,dadv,epsf_min
194 WRITE(iout, 1400)
195 END IF
196C---
197C for solid
198C---
199 IF (ixfem == 0) THEN ! XFEM is not available for solids
200 IF(isolid == 1) THEN
201 WRITE(iout, 2100)
202 ELSEIF (isolid == 2) THEN
203 WRITE(iout, 2200)
204 ELSEIF (isolid == 3) THEN
205 WRITE(iout, 2300)
206 ELSEIF (isolid == 4) THEN
207 WRITE(iout, 2400)
208 ENDIF
209 ENDIF
210C
211 IF (d3 > zero)THEN
212 CALL ancmsg(msgid=831, msgtype=msgwarning, anmode=aninfo,
213 . i1=mat_id)
214 ENDIF
215 ENDIF ! IF (IS_ENCRYPTED)
216c-----------------------------------------------------------
217 500 FORMAT(//
218 & 5x,'MAT_ID . . . . . . . . . . . . . . .=',i10/
219 & 5x,'FAILURE MODEL. . . . . . . . . . . .=',i10/
220 & 5x,'FAIL_ID. . . . . . . . . . . . . . .=',i10/)
221 1000 FORMAT(
222 & 5x,' ---------------------------------------------------- ',/
223 & 5x,' FAILURE CRITERION : JOHNSON-COOK ',/,
224 & 5x,' ---------------------------------------------------- ',/
225 & 5x,'FIRST FAILURE PARAMETER (D1). . . . . . . . . . . . . .=',1pg20.13/
226 & 5x,'SECOND FAILURE PARAMETER (D2). . . . . . . . . . . . . .=',1pg20.13/
227 & 5x,'THIRD FAILURE PARAMETER (D3). . . . . . . . . . . . . .=',1pg20.13/
228 & 5x,'FORTH FAILURE PARAMETER (D4). . . . . . . . . . . . . .=',1pg20.13/
229 & 5x,'FIFTH FAILURE PARAMETER (D5). . . . . . . . . . . . . .=',1pg20.13/
230 & 5x,'LOWER PLASTIC STRAIN AT FAILURE (EPSF_MIN). . . . . . . =',1pg20.13/
231 & 5x,'NUMBER OF FAILED INTG. POINTS PRIOR TO ELEM DELETION .=',i10/)
232 1100 FORMAT(
233 & 5x,' SHELL ELEMENT DELETION AFTER FAILURE')
234 2100 FORMAT(
235 & 5x,' SOLID ELEMENT DELETION AFTER FAILURE')
236
237 1200 FORMAT(
238 & 5x,' STRESS TENSOR IN SHELL LAYER SET TO ZERO AFTER FAILURE')
239 1400 FORMAT(
240 & 5x,' SHELL ELEMENT CRACKING AFTER FAILURE')
241 2200 FORMAT(
242 & 5x,' DEVIATORIC STRESS TENSOR IN SOLID WILL VANISH AFTER FAILURE')
243 2300 FORMAT(
244 & 5x,' DEVIATORIC STRESS TENSOR IN SOLID WILL VANISH AFTER FAILURE',/,
245 & 5x,' PRESSURE CAN STILL BE POSITIVE OR NULL')
246 2400 FORMAT(
247 & 5x,' THE STRESS TENSOR IN SOLID WILL VANISH AFTER FAILURE')
248C
249 1010 FORMAT(
250 & 5x,' ---------------------------------------------------- ',/
251 & 5x,' FAILURE CRITERION : X-FEM JOHNSON-COOK ',/,
252 & 5x,' ---------------------------------------------------- ',/
253 & 5x,'FIRST FAILURE PARAMETER (D1). . . . . . . . . . . . . .=',1pg20.13/
254 & 5x,'SECOND FAILURE PARAMETER (D2). . . . . . . . . . . . . .=',1pg20.13/
255 & 5x,'THIRD FAILURE PARAMETER (D3). . . . . . . . . . . . . .=',1pg20.13/
256 & 5x,'FORTH FAILURE PARAMETER (D4). . . . . . . . . . . . . .=',1pg20.13/
257 & 5x,'FIFTH FAILURE PARAMETER (D5). . . . . . . . . . . . . .=',1pg20.13/
258 & 5x,'FLAG XFEM. . . . . . . . . . . . . . . . . . . . . . . .=',i10/
259 & 5x,'CRITICAL ADVANCEMENT VALUE . . . . . . . . . . . . . . .=',1pg20.13/
260 & 5x,'LOWER PLASTIC STRAIN AT FAILURE (EPSF_MIN). . . . . . . =',1pg20.13//)
261C-----------
262 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
integer, parameter nchartitle
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