OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sigeps44t.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "units_c.inc"
#include "comlock.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine sigeps44t (nel, ngl, mat, pid, uparam, ipm, geo, off, for, sti, pla, eint, area, al0, al, epsp, nuvar, uvar, npf, tf, nfunc, ifunc)

Function/Subroutine Documentation

◆ sigeps44t()

subroutine sigeps44t ( integer, intent(in) nel,
integer, dimension(nel), intent(in) ngl,
integer, dimension(nel), intent(in) mat,
integer, dimension(nel), intent(in) pid,
intent(in) uparam,
integer, dimension(npropmi,nummat), intent(in) ipm,
intent(in) geo,
dimension(nel) off,
dimension(nel) for,
dimension(nel) sti,
dimension(nel) pla,
dimension(nel) eint,
dimension(nel) area,
dimension(nel) al0,
dimension(nel) al,
dimension(nel) epsp,
integer, intent(in) nuvar,
dimension(nel,nuvar) uvar,
integer, dimension(*), intent(in) npf,
intent(in) tf,
integer, intent(in) nfunc,
integer, dimension(nfunc), intent(in) ifunc )

Definition at line 30 of file sigeps44t.F.

35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C C o m m o n B l o c k s
41C-----------------------------------------------
42#include "param_c.inc"
43#include "scr17_c.inc"
44#include "com04_c.inc"
45#include "com08_c.inc"
46#include "units_c.inc"
47#include "comlock.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER ,INTENT(IN) :: NEL,NUVAR,NPF(*),NFUNC,IFUNC(NFUNC)
52 INTEGER ,DIMENSION(NEL) ,INTENT(IN) :: MAT,PID,NGL
53 INTEGER ,DIMENSION(NPROPMI,NUMMAT) ,INTENT(IN) :: IPM
54 my_real ,DIMENSION(NPROPG ,NUMGEO) ,INTENT(IN) :: geo
55 my_real ,DIMENSION(*) ,INTENT(IN) :: uparam,tf
56 my_real ,DIMENSION(NEL) :: off,for,eint,area,al0,al,pla,sti,epsp
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER :: I,J,IADBUF,NINDX
61 INTEGER ,DIMENSION(NEL) :: INDX,ICC,ISRATE,VFLAG
62 my_real :: yma,epif,dmg,frate,epsdot,alpha
63 my_real ,DIMENSION(NEL) :: e,nu,ca,cb,cn,cp,yld,yldmax,aa,hh,ff,
64 . gap,epst,epdr,epmax,epsr1,epsr2,asrate,
65 . yscale,dpla
66 my_real ,DIMENSION(NEL,NUVAR) :: uvar
67C-----------------------------------------------
68C E x t e r n a l F u n c t i o n s
69C-----------------------------------------------
70 my_real :: cvmgt,finter
71 EXTERNAL finter
72c=======================================================================
73 epif = zero
74c
75 DO i=1,nel
76 iadbuf = ipm(7,mat(i))-1
77 e(i) = uparam(iadbuf+1)
78 nu(i) = uparam(iadbuf+2)
79 ca(i) = uparam(iadbuf+3)
80 yldmax(i)= uparam(iadbuf+4)
81 epmax(i) = uparam(iadbuf+5)
82 epsr1(i) = uparam(iadbuf+6)
83 epsr2(i) = uparam(iadbuf+7)
84 cb(i) = uparam(iadbuf+8)
85 cn(i) = uparam(iadbuf+9)
86 icc(i) = nint(uparam(iadbuf+10))
87 epdr(i) = uparam(iadbuf+11)
88 epif = max(epif,epdr(i))
89 cp(i) = uparam(iadbuf+12)
90 israte(i)= nint(uparam(iadbuf+13))
91 asrate(i)= uparam(iadbuf+14)
92 vflag(i) = nint(uparam(iadbuf+23))
93 yscale(i)= uparam(iadbuf+24)
94c
95 gap(i) = geo(2,pid(i))
96 dpla(i) = zero
97 ENDDO
98c
99 DO i=1,nel
100 IF (gap(i) > zero .AND. al(i) <= (al0(i)-gap(i))) off(i) = one
101 ENDDO
102c
103 DO i=1,nel
104 eint(i) = eint(i) + for(i)*epsp(i)*al(i)*dt1*half
105 ENDDO
106c
107 DO i=1,nel
108 area(i) = area(i)*(one - two*nu(i)*epsp(i)*dt1*off(i))
109 ENDDO
110c
111 DO i=1,nel
112 yma = e(i)*area(i)
113 for(i) = for(i) + yma*epsp(i)*dt1
114 epst(i) = for(i) / yma
115 sti(i) = yma / al(i)
116 ENDDO
117c
118 DO i=1,nel
119 IF (nfunc>0) THEN
120 yld(i) = yscale(i)*finter(ifunc(1),pla(i),npf,tf,hh(i))
121 hh(i) = yscale(i)*hh(i)
122 ELSE
123 yld(i) = ca(i) + cb(i)*(pla(i)**cn(i))
124 IF (cn(i) == one) THEN
125 hh(i) = cb(i)
126 ELSE
127 IF (pla(i) > zero) THEN
128 hh(i) = cb(i)*cn(i)/pla(i)**(one-cn(i))
129 ELSE
130 hh(i) = zero
131 ENDIF
132 ENDIF
133 ENDIF
134 ENDDO
135C-------------
136C STRAIN RATE EFFECT
137C-------------
138 IF (epif > zero) THEN
139 DO i = 1,nel
140 IF (epdr(i) > zero) THEN
141 IF (vflag(i) /= 1) THEN
142 IF (israte(i) == 1) THEN
143 alpha = min(one, asrate(i)*dt1)
144 epsdot = alpha*abs(epsp(i)) + (one-alpha)*uvar(i,1)
145 uvar(i,1) = epsdot
146 ELSE
147 epsdot = abs(epsp(i))
148 ENDIF
149 ELSE
150 epsdot = uvar(i,1)
151 ENDIF
152 frate = one + (epsdot*epdr(i))**cp(i)
153 IF (icc(i)== 1) yldmax(i) = yldmax(i) * frate
154 IF ((nfunc > 0) .AND. (ca(i) /= zero)) THEN
155 yld(i) = yld(i) + (ca(i) + cb(i)*(pla(i)**cn(i)))*(frate-one)
156 IF (cn(i) == one) THEN
157 hh(i) = hh(i) + cb(i)*(frate-one)
158 ELSE
159 IF (pla(i) > zero) THEN
160 hh(i) = hh(i) + cb(i)*cn(i)/pla(i)**(one-cn(i))*(frate-one)
161 ENDIF
162 ENDIF
163 ELSE
164 yld(i) = yld(i) * frate
165 hh(i) = hh(i) * frate
166 ENDIF
167 ENDIF
168 ENDDO
169 ENDIF
170c-------------
171 DO i=1,nel
172 aa(i) = (e(i) + hh(i))*area(i)
173 yld(i) = min(yld(i),yldmax(i))
174 ff(i) = abs(for(i)) - yld(i)*area(i)
175 ff(i) = max(zero,ff(i))
176 ENDDO
177c
178 DO i=1,nel
179 dpla(i) = ff(i)/aa(i)
180 pla(i) = pla(i) + ff(i)/aa(i)
181 ENDDO
182c
183 DO i=1,nel
184 for(i) = cvmgt(sign(yld(i)*area(i),for(i)),for(i),ff(i) > zero)
185 ENDDO
186C--------------------------------
187C TEST DE RUPTURE DUCTILE
188C-------------------------------
189 DO i=1,nel
190 IF (off(i) < em01) off(i) = zero
191 IF (off(i) < one) off(i) = off(i)*four_over_5
192 ENDDO
193c--------------------------------
194c AXIAL TENSION OR PLASTIC STRAIN FAILURE
195c--------------------------------
196 nindx = 0
197 DO i = 1,nel
198 IF (off(i) == one) THEN
199 dmg = one
200 IF (epst(i) > epsr1(i)) THEN
201 dmg = (epsr2(i) - epst(i)) / (epsr2(i) - epsr1(i))
202 dmg = max(dmg, zero)
203 for(i) = for(i)*dmg
204 ENDIF
205c test strain failure
206 IF (dmg == zero .or. pla(i) >= epmax(i)) THEN
207 off(i) = four_over_5
208 idel7nok = 1
209 nindx = nindx+1
210 indx(nindx) = i
211 ENDIF
212c
213 IF (vflag(i)==1) THEN
214 alpha = min(one, asrate(i)*dt1)
215 epsdot = dpla(i)/max(em20,dt1)
216 uvar(i,1) = alpha*epsdot + (one - alpha)*uvar(i,1)
217 ENDIF
218 ENDIF
219 ENDDO
220c
221 IF (nindx > 0) THEN
222 DO j=1,nindx
223 i = indx(j)
224#include "lockon.inc"
225 WRITE(iout,1000) ngl(i)
226 WRITE(istdo,1100) ngl(i),tt
227#include "lockoff.inc"
228 ENDDO
229 ENDIF
230c
231 DO i=1,nel
232 sti(i) = sti(i)*off(i)
233 for(i) = for(i)*off(i)
234 ENDDO
235c
236 DO i=1,nel
237 eint(i) = eint(i) + for(i)*epsp(i)*al(i)*dt1*half
238 ENDDO
239c-----------------------------------------------
240 1000 FORMAT(1x,'-- RUPTURE OF TRUSS ELEMENT NUMBER ',i10)
241 1100 FORMAT(1x,'-- RUPTURE OF TRUSS ELEMENT :',i10,' AT TIME :',g11.4)
242c-----------------------------------------------
243 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91