31 . IPM ,GEO ,OFF ,FOR ,STI ,
32 . PLA ,EINT ,AREA ,AL0 ,AL ,
33 . EPSP ,NUVAR ,UVAR ,NPF ,TF ,
38#include "implicit_f.inc"
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
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,,YLD,YLDMAX,AA,HH,FF,
64 . gap,epst,epdr,epmax,epsr1,epsr2,asrate,
66 my_real ,
DIMENSION(NEL,NUVAR) :: uvar
70 my_real :: cvmgt,finter
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)
95 gap(i) = geo(2,pid(i))
100 IF (gap(i) > zero .AND. al(i) <= (al0(i)-gap(i))) off(i) = one
104 eint(i) = eint(i) +
for(i)*epsp(i)*al(i)*dt1*half
108 area(i) =
area(i)*(one - two*nu(i)*epsp(i)*dt1*off(i))
113 for(i) =
for(i) + yma*epsp(i)*dt1
114 epst(i) =
for(i) / yma
120 yld(i) = yscale(i)*finter(ifunc(1),pla(i),npf,tf,hh(i))
121 hh(i) = yscale(i)*hh(i)
123 yld(i) = ca(i) + cb(i)*(pla(i)**cn(i))
124 IF (cn(i) == one)
THEN
127 IF (pla(i) > zero)
THEN
128 hh(i) = cb(i)*cn(i)/pla(i)**(one-cn(i))
138 IF (epif > zero)
THEN
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)
147 epsdot = abs(epsp(i))
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)
159 IF (pla(i) > zero)
THEN
160 hh(i) = hh(i) + cb(i)*cn(i)/pla(i)**(one-cn(i))*(frate-one)
164 yld(i) = yld(i) * frate
165 hh(i) = hh(i) * frate
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))
179 dpla(i) = ff(i)/aa(i)
180 pla(i) = pla(i) + ff(i)/aa(i)
184 for(i) = cvmgt(sign(yld(i)*
area(i),
for(i)),
for(i),ff(i) > zero)
190 IF (off(i) < em01) off(i) = zero
191 IF (off(i) < one) off(i) = off(i)*four_over_5
198 IF (off(i) == one)
THEN
200 IF (epst(i) > epsr1(i))
THEN
201 dmg = (epsr2(i) - epst(i)) / (epsr2(i) - epsr1(i))
206 IF (dmg == zero .or. pla(i) >= epmax(i))
THEN
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)
225 WRITE(iout,1000) ngl(i)
226 WRITE(istdo,1100) ngl(i),tt
227#include "lockoff.inc"
232 sti(i) = sti(i)*off(i)
237 eint(i) = eint(i) +
for(i)*epsp(i)*al(i)*dt1*half
240 1000
FORMAT(1x,
'-- RUPTURE OF TRUSS ELEMENT NUMBER ',i10)
241 1100
FORMAT(1x,
'-- RUPTURE OF TRUSS ELEMENT :',i10,
' AT TIME :',g11.4)
subroutine sigeps44t(nel, ngl, mat, pid, uparam, ipm, geo, off, for, sti, pla, eint, area, al0, al, epsp, nuvar, uvar, npf, tf, nfunc, ifunc)