48
49
50
51 USE mat_elem_mod
52 USE elbufdef_mod
53
54
55
56#include "implicit_f.inc"
57
58
59
60 INTEGER ,INTENT(IN) :: NEL
61 INTEGER ,INTENT(IN) :: ILAW
62 INTEGER ,INTENT(IN) ::
63 INTEGER ,INTENT(IN) :: JTHE
64 INTEGER ,INTENT(IN) :: IFAIL
65 INTEGER ,INTENT(IN) :: SBUFMAT
66 INTEGER ,INTENT(IN) :: SNPC
67 INTEGER ,INTENT(IN) :: STF
68 INTEGER ,INTENT(IN) :: NUMMAT
69 INTEGER ,INTENT(IN) :: NUMGEO
70 INTEGER ,INTENT(IN) ::
71 INTEGER ,INTENT(IN) :: NPROPM
72 INTEGER ,INTENT(IN) :: NPROPG
73 INTEGER ,INTENT(IN) :: IOUT
74 INTEGER ,INTENT(IN) :: ISTDO
75 INTEGER ,INTENT(IN) :: NUVAR
76 INTEGER ,INTENT(IN) :: ISMSTR
77 INTEGER ,INTENT(IN) :: NTABLE
78 TYPE(TTABLE), DIMENSION(NTABLE), INTENT(INOUT) :: TABLE
79 INTEGER ,DIMENSION(SNPC) ,INTENT(IN) :: NPF
80 INTEGER ,DIMENSION(NPROPMI,NUMMAT) ,INTENT(IN) :: IPM
81 INTEGER ,DIMENSION(NEL) ,INTENT(IN) :: MAT
82 INTEGER ,DIMENSION(NEL) ,INTENT(IN) :: PID
83 INTEGER ,DIMENSION(NEL) ,INTENT(IN) :: NGL
86 my_real ,
INTENT(IN) :: pm(npropm,nummat)
87 my_real ,
INTENT(IN) :: geo(npropg,numgeo)
89 my_real ,
INTENT(IN) :: bufmat(sbufmat)
90 my_real ,
DIMENSION(NEL) ,
INTENT(IN) :: al
91 my_real ,
DIMENSION(NEL) ,
INTENT(INOUT) :: tempel
92 my_real ,
DIMENSION(NEL) ,
INTENT(INOUT) :: exx,exy,exz
93 my_real ,
DIMENSION(NEL) ,
INTENT(INOUT) :: kxx,kyy,kzz
94 my_real ,
DIMENSION(NEL) ,
INTENT(INOUT) :: off
95 my_real ,
DIMENSION(NEL) ,
INTENT(INOUT) :: f1,f2,f3
96 my_real ,
DIMENSION(NEL) ,
INTENT(INOUT) :: m1,m2,m3
97 my_real ,
DIMENSION(NEL,2),
INTENT(INOUT) :: eint
98 my_real ,
DIMENSION(NEL,3),
INTENT(INOUT) ::
for,mom
99 my_real ,
DIMENSION(NEL) ,
INTENT(OUT) :: epsd
100 my_real ,
DIMENSION(NEL,NUVAR) ,
INTENT(INOUT) :: uvar
101 TYPE (ELBUF_STRUCT_) ,INTENT(INOUT) :: ELBUF_STR
102 TYPE (MATPARAM_STRUCT_) ,INTENT(IN) :: MAT_PARAM
103
104
105
106 INTEGER :: I,IPID,IPLA,ISRATE,NUPARAM,NFUNC,IADBUF,IFUNC(100)
108 my_real ,
DIMENSION(NEL) :: dpla,svm,pressure,degmb,degfx,degsh,sigy,
109 . svm0
110
111 ipid = pid(1)
112
113
114
115 israte = ipm(3,imat)
116 asrate =
min(one, pm(9,imat)*dtime)
117
118
120 ixx = geo(4 ,ipid)
121 iyy = geo(2 ,ipid)
122 izz = geo(18,ipid)
123
124 DO i = 1,nel
125 epsdi = half*(exx(i)**2) + (half*exy(i))**2 + (half*exz(i))**2
126 epsdi = al(i)*sqrt(three*epsdi)/three_half
127 sigy(i) = 1.e30
128 IF (israte > 0) THEN
129 epsd(i)= asrate*epsdi + (one - asrate)*epsd(i)
130 ELSE
131 epsd(i)= epsdi
132 ENDIF
133 ENDDO
134
135
136
137 DO i=1,nel
138
139 exx(i) = exx(i) * dtime
140 exy(i) = exy(i) * dtime
141 exz(i) = exz(i) * dtime
142 kxx(i) = kxx(i) * dtime
143 kyy(i) = kyy(i) * dtime
144 kzz(i) = kzz(i) * dtime
145
146 degmb(i) =
for(i,1)*exx(i)
147 degsh(i) =
for(i,2)*exy(i)+
for(i,3)*exz(i)
148 degfx(i) = mom(i,1)*kxx(i)+mom(i,2)*kyy(i)+mom(i,3)*kzz(i)
149 ENDDO
150
151
152 IF (elbuf_str%GBUF%G_DMGSCL > 0) THEN
153 DO i = 1,nel
154 for(i,1) =
for(i,1)/
max(em20,elbuf_str%GBUF%DMGSCL
155 for(i,2) =
for(i,2)/
max(em20,elbuf_str%GBUF%DMGSCL(i))
156 for(i,3) =
for(i,3)/
max(em20,elbuf_str%GBUF%DMGSCL(i))
157 mom(i,1) = mom(i,1)/
max(em20,elbuf_str%GBUF%DMGSCL(i))
158 mom(i,2) = mom(i,2)/
max(em20,elbuf_str%GBUF%DMGSCL(i))
159 mom(i,3) = mom(i,3)/
max(em20,elbuf_str%GBUF%DMGSCL(i))
160 ENDDO
161 ENDIF
162
163 ipla = elbuf_str%GBUF%G_PLA
164
165 IF (ipla > 0) THEN
166 DO i = 1,nel
167 dpla(i) = elbuf_str%GBUF%PLA(i)
169 . ( mom(i,1)*mom(i,1) /
max(ixx,em20)
170 . + mom(i,2)*mom(i,2) /
max(iyy,em20)
171 . + mom(i,3)*mom(i,3) /
max(izz,em20))
172 svm0(i) = sqrt(svm0(i)) /
area
173 ENDDO
174 ENDIF
175
176
177
178
179 SELECT CASE(ilaw)
180
181 CASE (1)
184 . off ,exx ,exy ,exz ,kxx,
185 . kyy ,kzz ,al ,f1 ,f2 ,
186 . f3 ,m1 ,m2 ,m3 ,nel,
187 . mat ,pid )
188
189 CASE (2)
191 . pm ,
for ,mom ,eint ,geo ,
192 . off ,elbuf_str%GBUF%PLA ,exx ,exy ,exz ,
193 . kxx ,kyy ,kzz ,al ,f1 ,
194 . f2 ,f3 ,m1 ,m2 ,m3 ,
195 . nel ,mat ,pid ,ngl ,ipm ,
196 . nummat ,nuvar ,uvar ,sigy )
197
198 CASE (44)
199 iadbuf = ipm(7 ,imat)
200 nuparam = ipm(9 ,imat)
201 nfunc = ipm(10,imat)
202 DO i=1,nfunc
203 ifunc(i) = ipm(10+i,imat)
204 ENDDO
206 . nel ,ngl ,mat ,pid ,nuparam ,bufmat(iadbuf),
207 . geo ,off ,elbuf_str%GBUF%PLA ,al ,
208 . exx ,exy ,exz ,kxx ,kyy ,kzz ,
209 . f1 ,f2 ,f3 ,m1 ,m2 ,m3 ,
210 .
for ,mom ,pm ,nuvar ,uvar ,nfunc ,
211 . ifunc ,tf ,npf ,sigy )
212
213 END SELECT
214
215
216
217
218 IF (ipla > 0 .OR. ifail > 0) THEN
219 DO i = 1,nel
220 dpla(i) = elbuf_str%GBUF%PLA(i) - dpla(i)
221 ENDDO
222
223 DO i = 1,nel
224 svm(i) = f1(i)*f1(i) + three *
area *
225 . ( m1(i)*m1(i) /
max(ixx,em20)
226 . + m2(i)*m2(i) /
max(iyy,em20)
227 . + m3(i)*m3(i) /
max(izz,em20) )
228 svm(i) = sqrt(svm(i)) /
area
229 pressure(i) = third * f1(i) /
area
230 ENDDO
231
232 IF (ipla > 0) THEN
233 DO i = 1,nel
234 IF (elbuf_str%GBUF%G_WPLA > 0) elbuf_str%GBUF%WPLA(i) = elbuf_str%GBUF%WPLA(i) +
235 . half*(svm(i)+svm0(i))*dpla(i)*
area*al(i)
236 ENDDO
237 ENDIF
238
239 ENDIF
240
241
242
243
244 IF (ifail > 0) THEN
245
246 CALL fail_beam3(elbuf_str ,mat_param%FAIL(1),nummat ,
247 . npropm ,snpc ,stf ,
248 . nel ,imat ,jthe ,dpla ,
249 . tempel ,ngl ,pm ,
250 . off ,epsd ,npf ,tf ,
251 . time ,iout ,istdo ,
252 . svm ,pressure,
area ,al ,
253 . f1 ,f2 ,f3 ,m1 ,m2 ,
254 . m3 ,ismstr ,exx ,exy ,exz ,
255 . kxx ,kyy ,kzz ,dtime ,
256 . ntable ,table ,elbuf_str%GBUF%PLA , sigy )
257
258
259 IF (elbuf_str%GBUF%G_DMGSCL > 0) THEN
260 DO i = 1,nel
261 f1(i) = f1(i)*elbuf_str%GBUF%DMGSCL(i)
262 f2(i) = f2(i)*elbuf_str%GBUF%DMGSCL(i)
263 f3(i) = f3(i)*elbuf_str%GBUF%DMGSCL(i)
264 m1(i) = m1(i)*elbuf_str%GBUF%DMGSCL(i)
265 m2(i) = m2(i)*elbuf_str%GBUF%DMGSCL(i)
266 m3(i) = m3(i)*elbuf_str%GBUF%DMGSCL(i)
267 ENDDO
268 ENDIF
269
270 END IF
271
272 DO i=1,nel
273 for(i,1)=f1(i)*off(i)
276 mom(i,1)=m1(i)*off(i)
277 mom(i,2)=m2(i)*off(i)
278 mom(i,3)=m3(i)*off(i)
279 ENDDO
280
281 DO i=1,nel
285 m1(i) = mom(i,1)
286 m2(i) = mom(i,2)
287 m3(i) = mom(i,3)
288 ENDDO
289
290
291 DO i=1,nel
292 degmb(i) = degmb(i) +
for(i,1)*exx(i)
293 degsh(i) = degsh(i) +
for(i,2)*exy(i) +
for(i,3)*exz(i)
294 degfx(i) = degfx(i) + mom(i,1)*kxx(i) + mom(i,2)*kyy(i) + mom(i,3)*kzz(i)
295 fact = half*off(i)*al(i)
296 eint(i,1) = eint(i,1) + (degsh(i)+degmb(i))*fact
297 eint(i,2) = eint(i,2) + fact*degfx(i)
298 ENDDO
299
300 RETURN
subroutine fail_beam3(elbuf_str, fail, nummat, npropm, snpc, stf, nel, imat, jthe, dpla, tempel, ngl, pm, off, epsd, npf, tf, time, iout, istdo, svm, pressure, area, al, f1, f2, f3, m1, m2, m3, ismstr, epsxx, epsxy, epsxz, kxx, kyy, kzz, dtime, ntable, table, pla, sigy)
subroutine area(d1, x, x2, y, y2, eint, stif0)
subroutine m1lawp(pm, for, mom, geo, off, exx, exy, exz, kxx, kyy, kzz, al, f1, f2, f3, m1, m2, m3, nel, mat, pid)
subroutine m2lawp(pm, for, mom, eint, geo, off, pla, exx, exy, exz, kxx, kyy, kzz, al, fa1, fa2, fa3, ma1, ma2, ma3, nel, mat, pid, ngl, ipm, nummat, nuvar, uvar, sigy)
for(i8=*sizetab-1;i8 >=0;i8--)
subroutine sigeps44p(nel, ngl, mat, pid, nuparam, uparam, geo, off, pla, al, exx, exy, exz, kxx, kyy, kzz, fa1, fa2, fa3, ma1, ma2, ma3, for, mom, pm, nuvar, uvar, nfunc, ifunc, tf, npf, sigy)