OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fail_tab_old_c.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "comlock.inc"
#include "vectorize.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine fail_tab_old_c (nel, nuparam, nuvar, uparam, uvar, nfunc, ifunc, npf, tf, time, ngl, ipg, ilay, ipt, signxx, signyy, signxy, signyz, signzx, dpla, epsp, thk, aldt, temp, off, foff, dfmax, tdel)

Function/Subroutine Documentation

◆ fail_tab_old_c()

subroutine fail_tab_old_c ( integer, intent(in) nel,
integer, intent(in) nuparam,
integer, intent(in) nuvar,
intent(in) uparam,
intent(inout) uvar,
integer nfunc,
integer, dimension(nfunc) ifunc,
integer, dimension(*) npf,
tf,
intent(in) time,
integer, dimension(nel), intent(in) ngl,
integer, intent(in) ipg,
integer, intent(in) ilay,
integer, intent(in) ipt,
intent(in) signxx,
intent(in) signyy,
intent(in) signxy,
intent(in) signyz,
intent(in) signzx,
intent(in) dpla,
intent(in) epsp,
intent(in) thk,
intent(in) aldt,
intent(in) temp,
intent(in) off,
integer, dimension(nel), intent(inout) foff,
intent(inout) dfmax,
intent(out) tdel )

Definition at line 34 of file fail_tab_old_c.F.

41C-----------------------------------------------
42C tabulated failure model
43C-----------------------------------------------
44 USE message_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C G l o b a l P a r a m e t e r s
51C-----------------------------------------------
52#include "units_c.inc"
53#include "comlock.inc"
54C-----------------------------------------------
55C I N P U T A r g u m e n t s
56C-----------------------------------------------
57 INTEGER ,INTENT(IN) :: NEL,NUPARAM,NUVAR,IPG,ILAY,IPT
58 INTEGER ,DIMENSION(NEL) ,INTENT(IN) :: NGL
59 my_real ,INTENT(IN) :: time
60 my_real ,DIMENSION(NEL) ,INTENT(IN) :: off,thk,aldt,dpla,epsp,
61 . temp,signxx,signyy,signxy,signyz,signzx
62 my_real,DIMENSION(NUPARAM) ,INTENT(IN) :: uparam
63C-----------------------------------------------
64C I N P U T O U T P U T A r g u m e n t s
65C-----------------------------------------------
66 INTEGER ,DIMENSION(NEL) ,INTENT(INOUT) :: FOFF
67 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: dfmax
68 my_real ,DIMENSION(NEL) ,INTENT(OUT) :: tdel
69 my_real ,DIMENSION(NEL,NUVAR) ,INTENT(INOUT) :: uvar
70C-----------------------------------------------
71C VARIABLES FOR FUNCTION INTERPOLATION
72C-----------------------------------------------
73 INTEGER NPF(*), NFUNC, IFUNC(NFUNC)
74 my_real finter ,tf(*)
75 EXTERNAL finter
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER :: I,J,J1,J2,K,IP_THICK,NINDX,NINDXF,IFAIL_SH,NRATE,
80 . IFUN_EL,IFUN_TEMP
81 INTEGER, DIMENSION(NEL) :: INDX,INDXF,IPOSV,IADP,ILENP
82 INTEGER IPOST(NEL,2)
83 INTEGER ,DIMENSION(NFUNC) :: IFUN_STR
84C
85 my_real :: p,svm,df,fac,lambda,dcrit,el_ref,sc_el,sc_temp,p_thick,
86 . dp,dd,dn,yy,yy_n,ef1,ef2
87 my_real, DIMENSION(NFUNC) :: yfac,rate
88 my_real, DIMENSION(NEL) :: epsf,epsf_n,sigm,yyv,dxdyv,lambdav
89C-----------------------------------------------
90C UVAR(1) = DAMAGE
91C UVAR(2) = initial characteristic el. length
92C UVAR(3) = IPOS variable for element length scale function interpolation
93C=======================================================================
94 IF (uvar(1,2) == zero) THEN
95 uvar(1:nel,2) = aldt(1:nel)
96 ENDIF
97c---------------------------
98 ifail_sh = int(uparam(2))
99 p_thick = uparam(3)
100 dcrit = uparam(4)
101 dd = uparam(5)
102 dn = uparam(6)
103 sc_temp = uparam(7)
104 sc_el = uparam(8)
105 el_ref = uparam(9)
106 nrate = nfunc - 2
107 yfac(1:nrate) = uparam(11+1 :11+nrate)
108 rate(1:nrate) = uparam(11+nrate:11+nrate*2)
109c-------------------------------------------------------------------
110c---- Failure strain functions
111 ifun_str(1:nrate) = ifunc(1:nrate)
112c---- Scale functions
113 ifun_el = ifunc(nrate+1)
114 ifun_temp = ifunc(nrate+2)
115C---------
116 nindxf = 0
117 nindx = 0
118 DO i=1,nel
119 IF (off(i) == one .and. foff(i) == 1) THEN
120 nindx = nindx+1
121 indx(nindx) = i
122 ENDIF
123 ENDDO
124c-------------------------------------------------------------------
125c Failure strain value - function interpolation
126c-------------------------------------------------------------------
127 DO j=1,nindx
128 i = indx(j)
129 j1 = 1
130 DO k=2, nrate-1
131 IF (epsp(i) > rate(i)) j1 = k
132 ENDDO
133 p = third*(signxx(i) + signyy(i))
134 svm = sqrt(signxx(i)*signxx(i) + signyy(i)*signyy(i)
135 . - signxx(i)*signyy(i) + three*signxy(i)*signxy(i))
136 sigm = p / max(em20,svm)
137c----
138 IF (nrate > 1) THEN
139 j2 = j1+1
140 ef1 = yfac(j1)*finter(ifunc(j1),sigm,npf,tf,df)
141 ef2 = yfac(j2)*finter(ifunc(j2),sigm,npf,tf,df)
142 fac = (epsp(i) - rate(j1)) / (rate(j2) - rate(j1))
143 epsf(i) = max(ef1 + fac*(ef2 - ef1), em20)
144 ELSE
145 epsf(i) = yfac(j1)*finter(ifunc(j1),sigm,npf,tf,df)
146 ENDIF
147 ENDDO
148c----
149 IF (ifun_el > 0) THEN
150#include "vectorize.inc"
151 DO j=1,nindx
152 i = indx(j)
153c---- element length scale function
154 lambdav(j) = uvar(i,2) / el_ref
155 iposv(j) = nint(uvar(i,3))
156 iadp(j) = npf(ifun_el) / 2 + 1
157 ilenp(j) = npf(ifun_el + 1) / 2 -iadp(j) - iposv(j)
158 ENDDO
159c
160 CALL vinter(tf,iadp,iposv,ilenp,nindx,lambdav,dxdyv,yyv)
161c
162#include "vectorize.inc"
163 DO j=1,nindx
164 i = indx(j)
165 fac = sc_el*yyv(j)
166 epsf(i) = epsf(i)* fac
167 uvar(i,3) = iposv(j)
168 ENDDO
169 ENDIF
170c----
171#include "vectorize.inc"
172 DO j=1,nindx
173 i = indx(j)
174 epsf_n(i) = zero
175 ENDDO
176c---- temperature scale function
177 IF (ifun_temp > 0) THEN
178 DO j=1,nindx
179 i = indx(j)
180 fac = sc_temp*finter(ifun_temp,temp(i),npf,tf,df)
181 epsf(i) = epsf(i)* fac
182 ENDDO
183 ENDIF
184c-----------------------------------------------------------------------------
185 DO j=1,nindx
186 i = indx(j)
187 IF (uvar(i,1) < dcrit) THEN
188 IF (uvar(i,1) == zero) THEN
189 dp = one
190 ELSE
191 dp = dn*uvar(i,1)**(one-one/dn)
192 ENDIF
193 IF (epsf(i) > zero) uvar(i,1) = uvar(i,1)+dp*dpla(i)/epsf(i)
194c-----
195 IF (uvar(i,1) >= dcrit) THEN
196 nindxf = nindxf+1
197 indxf(nindxf) = i
198 tdel(i)= time
199 IF (ifail_sh == 3) THEN
200 foff(i) = -1
201 ELSE
202 foff(i) = 0
203 ENDIF
204 ENDIF
205 ENDIF
206 ENDDO ! IEL
207c
208c--------------------------------------------
209c Maximum Damage storing for output : 0 < DFMAX < 1
210c
211 DO j=1,nindx
212 i = indx(j)
213 dfmax(i)= min(one,max(dfmax(i),uvar(i,1)/dcrit))
214 ENDDO
215c--------------------------------------------
216c print
217c--------------------------------------------
218 IF (nindxf > 0) THEN
219 DO j=1,nindxf
220 i = indxf(j)
221#include "lockon.inc"
222 WRITE(iout, 2000) ngl(i),ipg,ilay,ipt
223 WRITE(istdo,2100) ngl(i),ipg,ilay,ipt,time
224#include "lockoff.inc"
225 ENDDO
226 ENDIF
227c------------------------
228 2000 FORMAT(1x,'FAILURE (FTAB) OF SHELL ELEMENT ',i10,1x,',GAUSS PT',
229 . i2,1x,',LAYER',i3,1x,',INTEGRATION PT',i3)
230 2100 FORMAT(1x,'FAILURE (FTAB) OF SHELL ELEMENT ',i10,1x,',GAUSS PT',
231 . i2,1x,',LAYER',i3,1x,',INTEGRATION PT',i3,1x,'AT TIME :',1pe12.4)
232c------------------------
233 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1249
vinter
subroutine vinter(tf, iad, ipos, ilen, nel, x, dydx, y)
Definition vinter.F:72