45
46 USE elbufdef_mod
47
48
49
50#include "implicit_f.inc"
51
52
53
54#include "com08_c.inc"
55#include "units_c.inc"
56#include "comlock.inc"
57
58
59
60 INTEGER NEL,NUPARAM,NUVAR,NFUNC,INLOC,
61 . IPG,IPT,NPF(*),NGL(NEL),
62 . IFUNC(NFUNC),NPTR,NPTS,
63 INTEGER, DIMENSION(NEL), INTENT(INOUT) :: IOFF_DUCT
65 . timestep,time,tf(*),uparam(nuparam)
66 my_real,
DIMENSION(NEL),
INTENT(IN) ::
67 . rho,thkly,gs,dt,
68 . depsxx,depsyy,depsxy,depsyz,depszx,
69 . epspxx,epspyy,epspxy,epspyz,epspzx,
70 . sigoxx,sigoyy,sigoxy,sigoyz,sigozx
71 my_real,
DIMENSION(NEL),
INTENT(OUT) ::
72 . soundsp,signxx,signyy,signxy,signyz,signzx
73 my_real,
DIMENSION(NEL) :: sigy,et
74 my_real,
DIMENSION(NEL),
INTENT(INOUT) ::
75 . pla,epsd,thk,off,varnl,dpla,offl
76 my_real,
DIMENSION(NEL,NUVAR),
INTENT(INOUT) ::
77 . uvar
78 TYPE() :: BUFLY
79
80
81
82 INTEGER I,J,IRES,Ifail,NINDX,NINDX2,INDX(NEL),INDX2(NEL),
83 . IPOS(NEL),IAD(NEL),ILEN(NEL),IR,IS,IT
84 my_real dtmin,xscale_fail,yscale_fail,s1,s2,q,s11(nel),
85 . s22(nel),r_inter,dfdepsd(nel),fail(nel),seq(nel)
86
87
88 ires = nint(uparam(11))
89
90
91 ifail = nint(uparam(13))
92
93
94
95
96
97 dtmin = uparam(15)
98 xscale_fail = uparam(22)
99 yscale_fail = uparam(23)
100
101
102 SELECT CASE (ires)
103
104 CASE(1)
105
107 1 nel ,ngl ,nuparam ,nuvar ,nfunc ,ifunc ,npf ,
108 2 tf ,timestep,time ,uparam ,uvar ,rho ,pla ,
109 3 dpla ,soundsp ,epsd ,gs ,thk ,thkly ,off ,
110 4 depsxx ,depsyy ,depsxy ,depsyz ,depszx ,
111 5 epspxx ,epspyy ,epspxy ,epspyz ,epspzx ,
112 6 sigoxx ,sigoyy ,sigoxy ,sigoyz
113 7 signxx ,signyy ,signxy ,signyz ,signzx ,
114 8 sigy ,et ,varnl ,seq ,inloc ,offl )
115
116 CASE(2)
117
119 1 nel ,ngl ,nuparam ,nuvar ,nfunc ,ifunc ,npf ,
120 2 tf ,timestep,time ,uparam ,uvar ,rho ,pla ,
121 3 dpla ,soundsp ,epsd ,gs ,thk
122 4 depsxx ,depsyy ,depsxy ,depsyz ,depszx ,
123 5 epspxx ,epspyy ,epspxy ,epspyz ,epspzx ,
124 6 sigoxx ,sigoyy ,sigoxy ,sigoyz ,sigozx ,
125 7 signxx ,signyy ,signxy ,signyz ,signzx ,
126 8 sigy ,et ,varnl ,seq ,inloc ,offl )
127
128 END SELECT
129
130
131 ioff_duct(1:nel) = 1
132
133
134
135
136
137
138 IF (ifunc(4) > 0) THEN
139 ipos(1:nel) = 1
140 iad(1:nel) = npf(ifunc(4)) / 2 + 1
141 ilen(1:nel) = npf(ifunc(4)+1) / 2 - iad(1:nel) - ipos(1:nel)
142 CALL vinter2(tf,iad,ipos,ilen,nel,epsd/xscale_fail,dfdepsd,fail)
143 fail(1:nel) = yscale_fail*fail(1:nel)
144 ENDIF
145
146
147 nindx = 0
148 nindx2 = 0
149 IF (dtmin > zero .OR. ifunc(4) > 0) THEN
150 DO i = 1,nel
151
152
153 IF ((dt(i) > em20).AND.(dt(i) < dtmin).AND.(off(i) == one)) THEN
154 off(i) = zero
155 nindx = nindx+1
156 indx(nindx) = i
157 ENDIF
158
159
160 IF ((ifunc(4) > 0).AND.(off(i) == one)) THEN
161
162 IF (offl(i) < em01) offl(i) = zero
163 IF (offl(i) < one) offl(i) = offl(i)*four_over_5
164
165 IF ((nptr == 1).AND.(npts == 1)) THEN
166
167 IF (ipt == 1) THEN
168 off(i) = zero
169 ENDIF
170
171 IF (offl(i)>zero) off(i) = one
172
173 ELSE
174 IF ((ipg == 1).AND.(ipt == 1)) THEN
175
176 off(i) = zero
177
178 DO ir = 1,nptr
179 DO is = 1,npts
180 DO it = 1,nptt
181
182 IF (bufly%LBUF(ir,is,it)%OFF(i)>zero) off(i) = one
183 ENDDO
184 ENDDO
185 ENDDO
186 ENDIF
187 ENDIF
188
189 IF (offl(i) == one) THEN
190
191 IF (ifail == 0) THEN
192 IF (seq(i) >= fail(i)) offl(i) = four_over_5
193
194 ELSEIF (ifail == 1) THEN
195 IF (pla(i) >= fail(i)) offl(i) = four_over_5
196
197 ELSEIF (ifail == 2) THEN
198 s1 = half*(signxx(i) + signyy(i))
199 s2 = half*(signxx(i) - signyy(i))
200 q = sqrt(s2**2 + signxy(i)**2)
201 s11(i) = s1 + q
202 s22(i) = s1 - q
203 IF (s22(i) >= s11(i)) THEN
204 r_inter = s22(i)
205 s22(i) = s11(i)
206 s11(i) = r_inter
207 ENDIF
208 IF ((s11(i)>=fail(i)).OR.(abs(s22(i))>=fail(i))) offl(i) = four_over_5
209
210 ELSEIF (ifail == 3) THEN
211 s1 = half*(signxx(i) + signyy(i))
212 s2 = half*(signxx(i) - signyy(i))
213 q = sqrt(s2**2 + signxy(i)**2)
214 s11(i) = s1 + q
215 s22(i) = s1 - q
216 IF (s22(i) >= s11(i)) THEN
217 r_inter = s22(i)
218 s22(i) = s11(i)
219 s11(i) = r_inter
220 ENDIF
221 IF (s11(i)>=fail(i)) offl(i) = four_over_5
222 ENDIF
223
224 IF (offl(i) == four_over_5) THEN
225 nindx2 = nindx2+1
226 indx2(nindx2) = i
227 ENDIF
228 ENDIF
229 ENDIF
230 ENDDO
231 ENDIF
232
233
234 IF (nindx>0) THEN
235 DO j=1,nindx
236#include "lockon.inc"
237 WRITE(iout, 1000) ngl(indx(j))
238 WRITE(istdo,1100) ngl(indx(j)),tt
239#include "lockoff.inc"
240 ENDDO
241 ENDIF
242
243
244 IF (nindx2>0) THEN
245 DO j=1,nindx2
246#include "lockon.inc"
247 WRITE(iout, 2000) ngl(indx2(j)),ipg,ipt
248 WRITE(istdo,2100) ngl(indx2(j)),ipg,ipt,tt
249#include "lockoff.inc"
250 ENDDO
251 ENDIF
252
253 1000 FORMAT(1x,'MINIMUM TIMESTEP (PLAS_RATE) REACHED, DELETED SHELL ELEMENT ',i10)
254 1100 FORMAT(1x,'MINIMUM TIMESTEP (PLAS_RATE) REACHED, DELETED SHELL ELEMENT ',i10,1x,'AT TIME :',1pe12.4)
255 2000 FORMAT(1x,'FAILURE (PLAS_RATE) IN SHELL ELEMENT ',i10,1x,',GAUSS PT',i2,1x,',THICKNESS INTG. PT',i3)
256 2100 FORMAT(1x,'FAILURE (PLAS_RATE) IN SHELL ELEMENT ',i10,1x,',GAUSS PT',i2,1x,',THICKNESS INTG. PT'
257 . 1x,'AT TIME :',1pe12.4)
258
259
subroutine mat121c_newton(nel, ngl, nuparam, nuvar, nfunc, ifunc, npf, tf, timestep, time, uparam, uvar, rho, pla, dpla, soundsp, epsd, gs, thk, thkly, off, depsxx, depsyy, depsxy, depsyz, depszx, epspxx, epspyy, epspxy, epspyz, epspzx, sigoxx, sigoyy, sigoxy, sigoyz, sigozx, signxx, signyy, signxy, signyz, signzx, sigy, et, dplanl, seq, inloc, loff)
subroutine mat121c_nice(nel, ngl, nuparam, nuvar, nfunc, ifunc, npf, tf, timestep, time, uparam, uvar, rho, pla, dpla, soundsp, epsd, gs, thk, thkly, off, depsxx, depsyy, depsxy, depsyz, depszx, epspxx, epspyy, epspxy, epspyz, epspzx, sigoxx, sigoyy, sigoxy, sigoyz, sigozx, signxx, signyy, signxy, signyz, signzx, sigy, et, dplanl, seq, inloc, loff)
subroutine vinter2(tf, iad, ipos, ilen, nel0, x, dydx, y)