37
38
39
40 USE elbufdef_mod
43
44
45
46#include "implicit_f.inc"
47
48
49
50#include "param_c.inc"
51#include "com01_c.inc"
52#include "com04_c.inc"
53#include "scr03_c.inc"
54
55
56
57 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
58 TYPE (NLOCAL_STR_) , TARGET :: NLOC_DMG
59 INTEGER IXTG(NIXTG,*),NFT,NEL,NG,IPM(NPROPMI,*)
60 my_real ,
DIMENSION(NUMELC+NUMELTG),
INTENT(IN) ::
63 . x(3,*),xreftg(3,3,*),dt_nl,bufmat(*),time
64 LOGICAL :: FAILURE
65
66
67
68 INTEGER :: IMAT,NDOF,L_NLOC,N1,N2,N3,
69 . K,I,NPTR,NPTS,IR,IS,NDNOD
70 INTEGER, DIMENSION(NEL) :: POS1,POS2,POS3
72 . le_min,len,damp,dens,ntn_unl,ntn_vnl,
73 . ntvar,z01(11,11),wf1(11,11),zn1(12,11),b1,b2,b3,
74 . nth1,nth2,bth1,bth2,k1,k12,k2,sspnl,le_max
75 my_real,
DIMENSION(:,:),
ALLOCATABLE :: var_reg,vpred
77 . DIMENSION(:), POINTER :: fnl,unl,vnl,dnl,mnl,thck
78 my_real,
DIMENSION(NEL) :: x1,x2,x3,y1,y2,y3,
79 . px1,py1,px2,py2,e1x,e2x,e3x,e1y,e2y,e3y,e1z
80 . x2l,y2l,x3l,y3l,z1,z2,z3,surf,x31,y31,z31,offg,
81 . vols,btb11,btb12,btb13,btb22,btb23,btb33
82 TYPE(BUF_NLOC_),POINTER :: BUFNL
83 my_real,
DIMENSION(:,:),
POINTER ::
84 . massth,fnlth,vnlth,unlth
85
86 DATA z01/
87 1 0. ,0. ,0. ,0. ,0. ,
88 1 0. ,0. ,0. ,0. ,0. ,0. ,
89 2 -.5 ,0.5 ,0. ,0. ,0. ,
90 2 0. ,0. ,0. ,0. ,0. ,0. ,
91 3 -.5 ,0. ,0.5 ,0. ,0. ,
92 3 0. ,0. ,0. ,0. ,0. ,0. ,
93 4 -.5 ,-.1666667,0.1666667,0.5 ,0. ,
94 4 0. ,0. ,0. ,0. ,0. ,0. ,
95 5 -.5 ,-.25 ,0. ,0.25 ,0.5 ,
96 5 0. ,0. ,0. ,0. ,0. ,0. ,
97 6 -.5 ,-.3 ,-.1 ,0.1 ,0.3 ,
98 6 0.5 ,0. ,0. ,0. ,0. ,0. ,
99 7 -.5 ,-.3333333,-.1666667,0.0 ,0.1666667,
100 7 0.3333333,0.5 ,0. ,0. ,0. ,0. ,
101 8 -.5 ,-.3571429,-.2142857,-.0714286,0.0714286,
102 8 0.2142857,0.3571429,0.5 ,0. ,0. ,0. ,
103 9 -.5 ,-.375 ,-.25 ,-.125 ,0.0 ,
104 9 0.125 ,0.25 ,0.375 ,0.5 ,0. ,0. ,
105 a -.5 ,-.3888889,-.2777778,-.1666667,-.0555555,
106 a 0.0555555,0.1666667,0.2777778,0.3888889,0.5 ,0. ,
107 b -.5 ,-.4 ,-.3 ,-.2 ,-.1 ,
108 b 0. ,0.1 ,0.2 ,0.3 ,0.4 ,0.5 /
109
110 DATA wf1/
111 1 1. ,0. ,0. ,0. ,0. ,
112 1 0. ,0. ,0. ,0. ,0. ,0. ,
113 2 0.5 ,0.5 ,0. ,0. ,0. ,
114 2 0. ,0. ,0. ,0. ,0. ,0. ,
115 3 0.25 ,0.5 ,0.25 ,0. ,0. ,
116 3 0. ,0. ,0. ,0. ,0. ,0. ,
117 4 0.1666667,0.3333333,0.3333333,0.1666667,0. ,
118 4 0. ,0. ,0. ,0. ,0. ,0. ,
119 5 0.125 ,0.25 ,0.25 ,0.25 ,0.125 ,
120 5 0. ,0. ,0. ,0. ,0. ,0. ,
121 6 0.1 ,0.2 ,0.2 ,0.2 ,0.2 ,
122 6 0.1 ,0. ,0. ,0. ,0. ,0. ,
123 7 0.0833333,0.1666667,0.1666667,0.1666667,0.1666667,
124 7 0.1666667,0.0833333,0. ,0. ,0. ,0. ,
125 8 0.0714286,0.1428571,0.1428571,0.1428571,0.1428571,
126 8 0.1428571,0.1428571,0.0714286,0. ,0. ,0. ,
127 9 0.0625 ,0.125 ,0.125 ,0.125 ,0.125 ,
128 9 0.125 ,0.125 ,0.125 ,0.0625 ,0. ,0. ,
129 a 0.0555556,0.1111111,0.1111111,0.1111111,0.1111111,
130 a 0.1111111,0.1111111,0.1111111,0.1111111,0.0555556,0. ,
131 b 0.05 ,0.1 ,0.1 ,0.1 ,0.1 ,
132 b 0.1 ,0.1 ,0.1 ,0.1 ,0.1 ,0.05 /
133
134 DATA zn1/
135 1 0. ,0. ,0. ,0. ,0. ,0. ,
136 1 0. ,0. ,0. ,0. ,0. ,0. ,
137 2 -.5 ,0.5 ,0. ,0. ,0. ,0. ,
138 2 0. ,0. ,0. ,0. ,0. ,0. ,
139 3 -.5 ,-.25 ,0.25 ,0.5 ,0. ,0. ,
140 3 0. ,0. ,0. ,0. ,0. ,0. ,
141 4 -.5 ,-.3333333,0. ,0.3333333,0.5 ,0. ,
142 4 0. ,0. ,0. ,0. ,0. ,0. ,
143 5 -.5 ,-.375 ,-0.125 ,0.125 ,0.375 ,0.5 ,
144 5 0. ,0. ,0. ,0. ,0. ,0. ,
145 6 -.5 ,-.4 ,-.2 ,0.0 ,0.2 ,0.4 ,
146 6 0.5 ,0. ,0. ,0. ,0. ,0. ,
147 7 -.5 ,-.4166667,-.25 ,-.0833333,0.0833333,0.25 ,
148 7 0.4166667,0.5 ,0. ,0. ,0. ,0. ,
149 8 -.5 ,-.4285715,-.2857143,-.1428572,0.0 ,0.1428572,
150 8 0.2857143,0.4285715,0.5 ,0. ,0. ,0. ,
151 9 -.5 ,-.4375 ,-.3125 ,-.1875 ,-.0625 ,0.0625 ,
152 9 0.1875 ,0.3125 ,0.4375 ,0.5 ,0. ,0. ,
153 a -.5 ,-.4444444,-.3333333,-.2222222,-.1111111,0. ,
154 a 0.1111111,0.2222222,0.3333333,0.4444444,0.5 ,0. ,
155 b -.5 ,-.45 ,-.35 ,-.25 ,-.15 ,-.05 ,
156 b 0.05 ,0.15 ,0.25 ,0.35 ,0.45 ,0.5 /
157
158
159 l_nloc = nloc_dmg%L_NLOC
160
161 fnl => nloc_dmg%FNL(1:l_nloc,1)
162 vnl => nloc_dmg%VNL(1:l_nloc)
163 dnl => nloc_dmg%DNL(1:l_nloc)
164 unl => nloc_dmg%UNL(1:l_nloc)
165 mnl => nloc_dmg%MASS(1:l_nloc)
166
167 imat = ixtg(1,1+nft)
168
169 le_min = sqrt((four/sqrt(three))*minval(
area(numelc+nft+1:numelc+nft+nel)))
170
171 ndof = elbuf_tab(ng)%BUFLY(1)%NPTT
172
173 thck => elbuf_tab(ng)%GBUF%THK(1:nel)
174
175 IF (ndof>1) THEN
176 le_min =
min(le_min,minval(thck(1:nel))/ndof)
177 ENDIF
178
179 len = nloc_dmg%LEN(imat)
180
181 le_max = nloc_dmg%LE_MAX(imat)
182
183 damp = nloc_dmg%DAMP(imat)
184
185 dens = nloc_dmg%DENS(imat)
186
187 sspnl = nloc_dmg%SSPNL(imat)
188
189 dt_nl =
min(dt_nl,0.5d0*((two*
min(le_min,le_max)*sqrt(three*dens))/
190 . (sqrt(twelve*(len**2)+(
min(le_min,le_max)**2)))))
191
192 IF (ndof>1) THEN
193 IF (ndof > 2) THEN
194 ALLOCATE(vpred(nel,ndof+1))
195 ndnod = ndof+1
196 ELSE
197 ALLOCATE(vpred(nel,ndof))
198 ndnod = ndof
199 ENDIF
200 ENDIF
201
202 nptr = elbuf_tab(ng)%NPTR
203 npts = elbuf_tab(ng)%NPTS
204
205 IF (.NOT.ALLOCATED(var_reg)) ALLOCATE(var_reg(nel,ndof))
206
207
208# include "vectorize.inc"
209 DO i = 1,nel
210
211 IF (nxref == 0) THEN
212 x1(i)=x(1,ixtg(2,nft+i))
213 y1(i)=x(2,ixtg(2,nft+i
214 z1(i)=x(3,ixtg(2,nft+i))
215 x2(i)=x(1,ixtg(3,nft+i))
216 y2(i)=x(2,ixtg(3,nft+i))
217 z2(i)=x(3,ixtg(3,nft+i))
218 x3(i)=x(1,ixtg(4,nft+i))
219 y3(i)=x(2,ixtg(4,nft+i))
220 z3(i)=x(3,ixtg(4,nft+i))
221 ELSE
222 x1(i)=xreftg(1,1,nft+i)
223 y1(i)=xreftg(1,2,nft+i)
224 z1(i)=xreftg(1,3,nft+i)
225 x2(i)=xreftg(2,1,nft+i)
226 y2(i)=xreftg(2,2,nft+i)
227 z2(i)=xreftg(2,3,nft+i)
228 x3(i)=xreftg(3,1,nft+i)
229 y3(i)=xreftg(3,2,nft+i)
230 z3(i)=xreftg(3,3,nft+i)
231 ENDIF
232
233
234 n1 = nloc_dmg%IDXI(ixtg(2,nft+i))
235 n2 = nloc_dmg%IDXI(ixtg(3,nft+i))
236 n3 = nloc_dmg%IDXI(ixtg(4,nft+i))
237
238 pos1(i) = nloc_dmg%POSI(n1)
239 pos2(i) = nloc_dmg%POSI(n2)
240 pos3(i) = nloc_dmg%POSI(n3)
241 ENDDO
242
243
244 DO k = 1,ndof
245
246# include "vectorize.inc"
247 DO i = 1,nel
248 var_reg(i,k) = third*(dnl(pos1(i)+k-1)
249 . + dnl(pos2(i)+k-1)
250 . + dnl(pos3(i)+k-1))
251 ENDDO
252 ENDDO
253
255 . x1 ,x2 ,x3 ,y1 ,y2 ,
256 . y3 ,z1 ,z2 ,z3 ,
257 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,
258 . e1z ,e2z ,e3z )
259
260
262 . bufmat ,time ,var_reg ,
263 . failure )
264
265
266
267
268
269# include "vectorize.inc"
270 DO i=1,nel
271
272
273 x2l(i) = e1x(i)*(x2(i)-x1(i))+e1y(i)*(y2(i)-y1(i))+e1z(i)*(z2(i)-z1(i))
274 y2l(i) = e2x(i)*(x2(i)-x1(i))+e2y(i)*(y2(i)-y1(i))+e2z(i)*(z2(i)-z1(i))
275 y3l(i) = e2x(i)*(x3(i)-x1(i))+e2y(i)*(y3(i)-y1(i))+e2z(i)*(z3(i)-z1(i))
276 x3l(i) = e1x(i)*(x3(i)-x1(i))+e1y(i)*(y3(i)-y1(i))+e1z(i)*(z3(i)-z1(i))
277
278
279 px1(i) = (y2l(i)-y3l(i))*(half/surf(i))
280 py1(i) = (x3l(i)-x2l(i))*(half/surf(i))
281 px2(i) = y3l(i)*(half/surf(i))
282 py2(i) = -x3l(i)*(half/surf(i))
283
284
285 btb11(i) = px1(i)**2 + py1(i)**2
286 btb12(i) = -px1(i)**2 + py1(i)*py2(i)
287 btb13(i) = -py1(i)*(py1(i)+py2(i))
288 btb22(i) = px1(i)**2 + py2(i)**2
289 btb23(i) = -py2(i)*(py1(i)+py2(i))
290 btb33(i) = (py1(i)+py2(i))**2
291
292
293 vols(i) =
area(numelc+nft+i)*thck(i)
294
295
296 offg(i) = elbuf_tab(ng)%GBUF%OFF(i)
297 ENDDO
298
299
300
301
302
303 IF ((ndof > 1).AND.(len>zero)) THEN
304
305
306 bufnl => elbuf_tab(ng)%NLOC(1,1)
307
308
309 massth => bufnl%MASSTH(1:nel,1:ndnod)
310 unlth => bufnl%UNLTH(1:nel ,1:ndnod)
311 vnlth => bufnl%VNLTH(1:nel ,1:ndnod)
312 fnlth => bufnl%FNLTH(1:nel ,1:ndnod)
313
314 DO k = 1,ndnod
315 DO i = 1,nel
316
317 vpred(i,k) = vnlth(i,k) - (fnlth(i,k)/massth(i,k))*(dt_nl/two)
318 ENDDO
319 ENDDO
320 DO k = 1,ndnod
321 DO i = 1,nel
322
323 fnlth(i,k) = zero
324 ENDDO
325 ENDDO
326
327
328 DO k = 1, ndof
329
330
331 IF ((ndof==2).AND.(k==2)) THEN
332 nth1 = (z01(k,ndof) - zn1(k,ndof))/(zn1(k-1,ndof) - zn1(k,ndof))
333 nth2 = (z01(k,ndof) - zn1(k-1,ndof)) /(zn1(k,ndof) - zn1(k-1,ndof))
334 ELSE
335 nth1 = (z01(k,ndof) - zn1(k+1,ndof))/(zn1(k,ndof) - zn1(k+1,ndof))
336 nth2 = (z01(k,ndof) - zn1(k,ndof)) /(zn1(k+1,ndof) - zn1(k,ndof))
337 ENDIF
338
339
340 DO i = 1,nel
341
342 IF ((ndof==2).AND.(k==2)) THEN
343 bth1 = (one/(zn1(k-1,ndof) - zn1(k,ndof)))*(one/thck(i))
344 bth2 = (one/(zn1(k,ndof) - zn1(k-
345 ELSE
346 bth1 = (one/(zn1(k,ndof) - zn1(k+1,ndof)))*(one/thck(i))
347 bth2 = (one/(zn1(k+1,ndof) - zn1(k,ndof)))*(one/thck(i))
348 ENDIF
349
350
351 k1 = (len**2)*(bth1**2) + nth1**2
352 k12 = (len**2)*(bth1*bth2)+ (nth1*nth2)
353 k2 = (len**2)*(bth2**2) + nth2**2
354
355
356 IF ((ndof==2).AND.(k==2)) THEN
357 fnlth(i,k-1) = fnlth(i,k-1) + (k1*unlth(i,k-1) + k12*unlth(i,k)
358 . + damp*((nth1**2)*vpred(i,k-1)
359 . + (nth1*nth2)*vpred(i,k))
360 . - (nth1*var_reg(i,k)))*vols(i)*wf1(k,ndof)
361 fnlth(i,k) = fnlth(i,k) + (k12*unlth(i,k-1) + k2*unlth(i,k)
362 . + damp*(nth1*nth2*vpred(i,k-1)
363 . + (nth2**2)*vpred(i,k))
364 . - nth2*var_reg(i,k))*vols(i)*wf1(k,ndof)
365 ELSE
366 fnlth(i,k) = fnlth(i,k) + (k1*unlth(i,k) + k12*unlth(i,k+1)
367 . + damp*((nth1**2)*vpred(i,k)
368 . + (nth1*nth2)*vpred(i,k+1))
369 . - (nth1*var_reg(i,k)))*vols(i)*wf1(k,ndof)
370 fnlth(i,k+1) = fnlth(i,k+1) + (k12*unlth(i,k) + k2*unlth(i,k+1)
371 . + damp*(nth1*nth2*vpred(i,k)
372 . + (nth2**2)*vpred(i,k+1))
373 . - nth2*var_reg(i,k))*vols(i)*wf1(k,ndof)
374 ENDIF
375 ENDDO
376 ENDDO
377
378 DO k = 1,ndnod
379 DO i = 1,nel
380
381 vnlth(i,k) = vnlth(i,k) - (fnlth(i,k)/massth(i,k))*dt_nl
382 ENDDO
383 ENDDO
384
385 DO k = 1,ndnod
386 DO i = 1,nel
387
388 unlth(i,k) = unlth(i,k) + vnlth(i,k)*dt_nl
389 ENDDO
390 ENDDO
391
392
393 DO k = 1, ndof
394
395 IF ((ndof==2).AND.(k==2)) THEN
396 nth1 = (z01(k,ndof) - zn1(k,ndof))/(zn1(k-1,ndof) - zn1
397 nth2 = (z01(k,ndof) - zn1(k-1,ndof)) /(zn1(k,ndof) - zn1(k-1,ndof))
398 ELSE
399 nth1 = (z01(k,ndof) - zn1(k+1,ndof))/(zn1(k,ndof) - zn1(k
400 nth2 = (z01(k,ndof) - zn1(k,ndof)) /(zn1(k+1,ndof) - zn1(k,ndof))
401 ENDIF
402
403 DO i = 1,nel
404
405 IF ((ndof==2).AND.(k==2)) THEN
406 var_reg(i,k) = nth1*unlth(i,k-1) + nth2*unlth(i,k)
407 ELSE
408 var_reg(i,k) = nth1*unlth(i,k) + nth2*unlth(i,k+1)
409 ENDIF
410 ENDDO
411 ENDDO
412
413 DO ir = 1,nptr
414 DO is = 1,npts
415 bufnl => elbuf_tab(ng)%NLOC(ir,is)
416 bufnl%MASSTH(1:nel,1:ndnod) = elbuf_tab(ng)%NLOC(1,1)%MASSTH(1:nel,1:ndnod)
417 bufnl%MASSTH(1:nel,1:ndnod) = elbuf_tab(ng)%NLOC(1,1)%UNLTH(1:nel,1:ndnod)
418 bufnl%MASSTH(1:nel,1:ndnod) = elbuf_tab(ng)%NLOC(1,1)%VNLTH(1:nel,1:ndnod)
419 bufnl%MASSTH(1:nel,1:ndnod) = elbuf_tab(ng)%NLOC(1,1)%FNLTH(1:nel,1:ndnod)
420 ENDDO
421 ENDDO
422 ENDIF
423
424
425
426
427
428 DO k = 1,ndof
429
430
431# include "vectorize.inc"
432 DO i = 1,nel
433
434
435 IF (offg(i) > zero) THEN
436
437
438 b1 = ((len**2)*vols(i))*wf1(k,ndof)*(btb11(i)*unl(pos1(i)+k-1) + btb12(i)*unl(pos2(i)+k-1)
439 . + btb13(i)*unl(pos3(i)+k-1))
440 b2 = ((len**2)*vols(i))*wf1(k,ndof)*(btb12(i)*unl(pos1(i)+k-1) + btb22(i)*unl(pos2(i)+k-1)
441 . + btb23(i)*unl(pos3(i)+k-1
442 b3 = ((len**2)*vols(i))*wf1(k,ndof)*(btb13(i)*unl(pos1(i)+k-1) + btb23(i)*unl(pos2(i)+k-1)
443 . + btb33(i)*unl(pos3(i)+k-1))
444
445 ntn_unl = ((unl(pos1(i)+k-1) + unl(pos2(i)+k-1) + unl(pos3(i)+k-1))*third*third)*vols(i)*wf1(k,ndof)
446
447 ntn_vnl = ((vnl(pos1(i)+k-1) + vnl(pos2(i)+k-1) + vnl(pos3(i)+k-1))*third*third)*damp*vols(i)*wf1(k,ndof)
448
449 ntvar = var_reg(i,k)*third*vols(i)*wf1(k,ndof)
450
451 fnl(pos1(i)+k-1) = fnl(pos1(i)+k-1) - (ntn_unl + ntn_vnl - ntvar + b1)
452 fnl(pos2(i)+k-1) = fnl(pos2(i)+k-1) - (ntn_unl + ntn_vnl - ntvar + b2)
453 fnl(pos3(i)+k-1) = fnl(pos3(i)+k-1) - (ntn_unl + ntn_vnl - ntvar + b3)
454 ELSE
455
456 fnl(pos1(i)+k-1) = fnl(pos1(i)+k-1) -
457 . wf1(k,ndof)*dens*sspnl*vnl(pos1(i)+k-1)*sqrt((four/sqrt(three))*(le_max**2))*thck(i)
458 fnl(pos2(i)+k-1) = fnl(pos2(i)+k-1) -
459 . wf1(k,ndof)*dens*sspnl*vnl(pos2(i)+k-1)*sqrt((four/sqrt(three))*(le_max**2))*thck(i)
460 fnl(pos3(i)+k-1) = fnl(pos3(i)+k-1) -
461 . wf1(k,ndof)*dens*sspnl*vnl(pos3(i)+k-1)*sqrt((four/sqrt(three))*(le_max**2))*thck(i)
462 ENDIF
463 ENDDO
464 ENDDO
465
466 IF (ALLOCATED(var_reg)) DEALLOCATE(var_reg)
467 IF (ALLOCATED(vpred)) DEALLOCATE(vpred)
subroutine cdkevec3(jft, jlt, area, x1, x2, x3, y1, y2, y3, z1, z2, z3, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
subroutine cnloc_matini(elbuf_str, nel, ipm, bufmat, time, varnl, failure)
subroutine area(d1, x, x2, y, y2, eint, stif0)