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) :: IMAT
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) :: NPROPMI
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(i))
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 .
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 ,pid ,ngl ,
196 . 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,mat_param%FAIL(1),
247 . snpc ,stf ,nel ,jthe ,dpla ,
248 . tempel ,ngl ,off ,epsd ,npf ,
249 . tf ,time ,iout ,istdo ,
250 . svm ,pressure,
area ,al ,
251 . f1 ,f2 ,f3 ,m1 ,m2 ,
252 . m3 ,ismstr ,exx ,exy ,exz ,
253 . kxx ,kyy ,kzz ,dtime ,
254 . ntable ,table ,elbuf_str%GBUF%PLA , sigy )
255
256
257 IF (elbuf_str%GBUF%G_DMGSCL > 0) THEN
258 DO i = 1,nel
259 f1(i) = f1(i)*elbuf_str%GBUF%DMGSCL(i)
260 f2(i) = f2(i)*elbuf_str%GBUF%DMGSCL(i)
261 f3(i) = f3(i)*elbuf_str%GBUF%DMGSCL(i)
262 m1(i) = m1(i)*elbuf_str%GBUF%DMGSCL(i)
263 m2(i) = m2(i)*elbuf_str%GBUF%DMGSCL(i)
264 m3(i) = m3(i)*elbuf_str%GBUF%DMGSCL(i)
265 ENDDO
266 ENDIF
267
268 END IF
269
270 DO i=1,nel
271 for(i,1)=f1(i)*off(i)
274 mom(i,1)=m1(i)*off(i)
275 mom(i,2)=m2(i)*off(i)
276 mom(i,3)=m3(i)*off(i)
277 ENDDO
278
279 DO i=1,nel
283 m1(i) = mom(i,1)
284 m2(i) = mom(i,2)
285 m3(i) = mom(i,3)
286 ENDDO
287
288
289 DO i=1,nel
290 degmb(i) = degmb(i) +
for(i,1)*exx(i)
291 degsh(i) = degsh(i) +
for(i,2)*exy(i) +
for(i,3)*exz(i)
292 degfx(i) = degfx(i) + mom(i,1)*kxx(i) + mom(i,2)*kyy(i) + mom(i,3)*kzz(i)
293 fact = half*off(i)*al(i)
294 eint(i,1) = eint(i,1) + (degsh(i)+degmb(i))*fact
295 eint(i,2) = eint(i,2) + fact*degfx(i)
296 ENDDO
297
298 RETURN
subroutine fail_beam3(elbuf_str, mat_param, fail, snpc, stf, nel, jthe, dpla, tempel, ngl, 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(mat_param, for, mom, eint, geo, off, pla, exx, exy, exz, kxx, kyy, kzz, al, fa1, fa2, fa3, ma1, ma2, ma3, nel, pid, ngl, 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)