OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fail_fld_tsh.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine fail_fld_tsh (nel, nuparam, nuvar, nfunc, ifunc, npf, tf, time, timestep, uparam, uvar, ngl, ipg, ilay, iptt, epsxx, epsyy, epsxy, epsyz, epszx, off, foff, fld_idx, dam, dfmax, niparam, iparam, pla, lf_dammx)

Function/Subroutine Documentation

◆ fail_fld_tsh()

subroutine fail_fld_tsh ( integer, intent(in) nel,
integer, intent(in) nuparam,
integer, intent(in) nuvar,
integer, intent(in) nfunc,
integer, dimension(nfunc) ifunc,
integer, dimension(*) npf,
tf,
time,
intent(in) timestep,
dimension(nuparam) uparam,
uvar,
integer, dimension(nel) ngl,
integer, intent(in) ipg,
integer, intent(in) ilay,
integer, intent(in) iptt,
intent(in) epsxx,
intent(in) epsyy,
intent(in) epsxy,
intent(in) epsyz,
intent(in) epszx,
intent(in) off,
integer, dimension(nel), intent(inout) foff,
integer, dimension(nel), intent(inout) fld_idx,
intent(out) dam,
intent(inout) dfmax,
integer, intent(in) niparam,
integer, dimension(niparam) iparam,
intent(in) pla,
integer, intent(in) lf_dammx )

Definition at line 31 of file fail_fld_tsh.F.

38C-----------------------------------------------
39c FLD failure model
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C G l o b a l P a r a m e t e r s
46C-----------------------------------------------
47#include "comlock.inc"
48C---------+---------+---+---+--------------------------------------------
49C VAR | SIZE |TYP| RW| DEFINITION
50C---------+---------+---+---+--------------------------------------------
51C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
52C NUPARAM | 1 | I | R | SIZE OF THE USER PARAMETER ARRAY
53C UPARAM | NUPARAM | F | R | USER MATERIAL PARAMETER ARRAY
54C NUVAR | 1 | I | R | NUMBER OF USER ELEMENT VARIABLES
55C UVAR |NEL*NUVAR| F |R/W| USER ELEMENT VARIABLE ARRAY
56C---------+---------+---+---+--------------------------------------------
57C TIME | 1 | F | R | CURRENT TIME
58C TIMESTEP| 1 | F | R | CURRENT TIME STEP
59C---------+---------+---+---+--------------------------------------------
60C EPSXX | NEL | F | R | STRAIN XX
61C EPSYY | NEL | F | R | STRAIN YY
62C ... | | | |
63C---------+---------+---+---+--------------------------------------------
64C OFF | NEL | F | R | DELETED ELEMENT FLAG (=1. ON, =0. OFF)
65C FOFF | NEL | I |R/W| DELETED INTEGRATION POINT FLAG (=1 ON, =0 OFF)
66C DFMAX | NEL | F |R/W| MAX DAMAGE FACTOR
67C---------+---------+---+---+--------------------------------------------
68C NGL ELEMENT ID
69C IPG CURRENT GAUSS POINT (in plane)
70C ILAY CURRENT LAYER
71C IPT CURRENT INTEGRATION POINT IN THE LAYER (FOR OUTPUT ONLY)
72C---------+---------+---+---+--------------------------------------------
73C I N P U T A r g u m e n t s
74C-----------------------------------------------
75 INTEGER, INTENT(IN) :: NEL,NUPARAM,NUVAR,NFUNC,IPG,ILAY,IPTT,NIPARAM,LF_DAMMX
76 INTEGER ,DIMENSION(NEL) :: NGL
77 INTEGER ,DIMENSION(NFUNC) :: IFUNC
78 my_real time
79 my_real ,DIMENSION(NEL), INTENT(IN) :: timestep,off,
80 . epsxx,epsyy,epsxy,epsyz,epszx,pla
81 my_real,DIMENSION(NUPARAM) :: uparam
82 INTEGER, DIMENSION(NIPARAM) :: IPARAM
83C-----------------------------------------------
84C I N P U T O U T P U T A r g u m e n t s
85C-----------------------------------------------
86 INTEGER ,DIMENSION(NEL), INTENT(INOUT) :: FOFF,FLD_IDX
87 my_real ,DIMENSION(NEL,LF_DAMMX), INTENT(INOUT) :: dfmax
88 my_real ,DIMENSION(NEL), INTENT(OUT) :: dam
89 my_real uvar(nel,nuvar)
90C-----------------------------------------------
91C VARIABLES FOR FUNCTION INTERPOLATION
92C-----------------------------------------------
93 INTEGER NPF(*)
94 my_real finter , finterfld ,tf(*)
95 EXTERNAL finter
96C Y = FINTER(IFUNC(J),X,NPF,TF,DYDX)
97C Y : y = f(x)
98C X : x
99C DYDX : f'(x) = dy/dx
100C IFUNC(J): FUNCTION INDEX
101C J : FIRST(J=1), SECOND(J=2) .. FUNCTION USED FOR THIS LAW
102C NPF,TF : FUNCTION PARAMETER
103C-----------------------------------------------
104C L o c a l V a r i a b l e s
105C-----------------------------------------------
106 INTEGER :: I,II,J,IENG,LENF,NINDX,IMARGIN
107 INTEGER ,DIMENSION(NEL) :: INDX,INDXF
108 my_real :: rani,r1,r2,s1,s2,ss,q,dydx,e12,fact_margin,fact_loosemetal
109 my_real ,ALLOCATABLE, DIMENSION(:) :: xf
110 my_real ,DIMENSION(NEL) :: emaj,emin,em,beta
111C=======================================================================
112c
113 !=================================================================
114 ! - INITIALISATION OF COMPUTATION ON TIME STEP
115 !=================================================================
116 ! Recovering failure criterion parameters
117 ! -> Real parameters
118 fact_margin = uparam(1)
119 rani = uparam(3)
120 fact_loosemetal = uparam(4)
121 ! -> Integer parameters
122 imargin = iparam(2)
123 ieng = iparam(3)
124c
125 ! Check if the element is already broken
126 nindx = 0
127 DO i = 1,nel
128 IF (off(i) == one .and. foff(i) == 1) THEN
129 nindx = nindx + 1
130 indx(nindx) = i
131 ENDIF
132 ENDDO
133c
134 !=================================================================
135 ! - MINOR AND MAJOR (TRUE) STRAIN DEFORMATION
136 !=================================================================
137 DO j = 1,nindx
138 i = indx(j)
139 e12= half*epsxy(i)
140 s1 = half*(epsxx(i) + epsyy(i))
141 s2 = half*(epsxx(i) - epsyy(i))
142 q = sqrt(s2**2 + e12**2)
143 emaj(i) = s1 + q
144 emin(i) = s1 - q
145 IF (emin(i) >= emaj(i)) THEN
146 ss = emin(i)
147 emin(i) = emaj(i)
148 emaj(i) = ss
149 ENDIF
150 beta(i) = emin(i)/max(emaj(i),em20)
151 IF (ieng == 2) THEN
152 dfmax(i,4) = beta(i)
153 ENDIF
154 ENDDO
155c
156 !=================================================================
157 ! FAILURE MAJOR STRAIN FROM INPUT CURVE AND DAMAGE RATIO
158 !=================================================================
159 ! -> Engineering strains input
160 IF (ieng == 1) THEN ! transform input fld curve to true strain
161 ii = npf(ifunc(1))
162 lenf = npf(ifunc(1)+ 1) - npf(ifunc(1))
163 ALLOCATE(xf(lenf))
164 DO i = 1,lenf
165 xf(i) = log(tf(ii + i-1) + one)
166 ENDDO
167c
168 DO j = 1,nindx
169 i = indx(j)
170 em(i) = finterfld(emin(i),lenf,xf)
171 dam(i) = emaj(i) / em(i)
172 dfmax(i,2) = dam(i)
173 dfmax(i,1) = min(one, dam(i))
174 ENDDO
175 DEALLOCATE(xf)
176 ! -> True strains input
177 ELSE
178 ! -> Classical formulation
179 IF (ieng == 0) THEN
180 DO j = 1,nindx
181 i = indx(j)
182 em(i) = finter(ifunc(1),emin(i),npf,tf,dydx)
183 dam(i) = emaj(i) / em(i)
184 dfmax(i,2) = dam(i)
185 dfmax(i,1) = min(one, dam(i))
186 ENDDO
187 ! -> Non-linear path formulation
188 ELSEIF (ieng == 2) THEN
189 DO j = 1,nindx
190 i = indx(j)
191 em(i) = finter(ifunc(1),beta(i),npf,tf,dydx)
192 dam(i) = pla(i) / em(i)
193 dfmax(i,2) = dam(i)
194 dfmax(i,1) = min(one, dam(i))
195 ENDDO
196 ENDIF
197 ENDIF
198c
199 !=================================================================
200 ! FLD ZONE INDEX CALCULATION FOR ANIM OUTPUT
201 !=================================================================
202 r1 = fact_loosemetal
203 r2 = rani/(rani+one)
204
205 IF (ieng < 2) THEN
206 IF (imargin == 3) THEN
207 DO j = 1,nindx
208 i = indx(j)
209 IF (emaj(i) >= em(i)) THEN
210 fld_idx(i) = 6 ! zone 6 = failure
211 ELSEIF (emaj(i) >= em(i)*(one - fact_margin)) THEN
212 fld_idx(i) = 5 ! zone 5 = margin to fail
213 ELSEIF (emaj(i)**2 + emin(i)**2 < r1**2) THEN
214 fld_idx(i) = 1 ! zone 1 = radius 0.02
215 ELSEIF (emaj(i) >= abs(emin(i))) THEN
216 fld_idx(i) = 4 ! zone 4 = safe (45 deg line)
217 ELSEIF (emaj(i) >= r2*abs(emin(i))) THEN
218 fld_idx(i) = 3 ! zone 3 = angle atan(r/(1+r)) - compression
219 ELSE
220 fld_idx(i) = 2 ! zone 2 - high wrinkle tendency
221 ENDIF
222 dfmax(i,3) = fld_idx(i)
223 ENDDO
224 ELSE
225 DO j = 1,nindx
226 i = indx(j)
227 IF (emaj(i) >= em(i)) THEN
228 fld_idx(i) = 6 ! zone 6 = failure
229 ELSEIF (emaj(i) >= em(i) - fact_margin) THEN
230 fld_idx(i) = 5 ! zone 5 = margin to fail
231 ELSEIF (emaj(i)**2 + emin(i)**2 < r1**2) THEN
232 fld_idx(i) = 1 ! zone 1 = radius 0.02
233 ELSEIF (emaj(i) >= abs(emin(i))) THEN
234 fld_idx(i) = 4 ! zone 4 = safe (45 deg line)
235 ELSEIF (emaj(i) >= r2*abs(emin(i))) THEN
236 fld_idx(i) = 3 ! zone 3 = angle atan(r/(1+r)) - compression
237 ELSE
238 fld_idx(i) = 2 ! zone 2 - high wrinkle tendency
239 ENDIF
240 dfmax(i,3) = fld_idx(i)
241 ENDDO
242 ENDIF
243 ELSE
244 IF (imargin == 3) THEN
245 DO j = 1,nindx
246 i = indx(j)
247 IF (pla(i) >= em(i)) THEN
248 fld_idx(i) = 6 ! zone 6 = failure
249 ELSEIF (pla(i) >= em(i)*(one - fact_margin)) THEN
250 fld_idx(i) = 5 ! zone 5 = margin to fail
251 ELSEIF (pla(i)**2 + beta(i)**2 < r1**2) THEN
252 fld_idx(i) = 1 ! zone 1 = radius 0.02
253 ELSEIF (pla(i) >= abs(beta(i))) THEN
254 fld_idx(i) = 4 ! zone 4 = safe (45 deg line)
255 ELSEIF (pla(i) >= r2*abs(beta(i))) THEN
256 fld_idx(i) = 3 ! zone 3 = angle atan(r/(1+r)) - compression
257 ELSE
258 fld_idx(i) = 2 ! zone 2 - high wrinkle tendency
259 ENDIF
260 dfmax(i,3) = fld_idx(i)
261 ENDDO
262 ELSE
263 DO j = 1,nindx
264 i = indx(j)
265 IF (pla(i) >= em(i)) THEN
266 fld_idx(i) = 6 ! zone 6 = failure
267 ELSEIF (pla(i) >= em(i) - fact_margin) THEN
268 fld_idx(i) = 5 ! zone 5 = margin to fail
269 ELSEIF (pla(i)**2 + beta(i)**2 < r1**2) THEN
270 fld_idx(i) = 1 ! zone 1 = radius 0.02
271 ELSEIF (pla(i) >= abs(beta(i))) THEN
272 fld_idx(i) = 4 ! zone 4 = safe (45 deg line)
273 ELSEIF (pla(i) >= r2*abs(beta(i))) THEN
274 fld_idx(i) = 3 ! zone 3 = angle atan(r/(1+r)) - compression
275 ELSE
276 fld_idx(i) = 2 ! zone 2 - high wrinkle tendency
277 ENDIF
278 dfmax(i,3) = fld_idx(i)
279 ENDDO
280 ENDIF
281 ENDIF
282C------------------------
283 RETURN
#define my_real
Definition cppsort.cpp:32
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21