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 IXC(NIXC,*),NFT,NEL,NG,IPM(NPROPMI,*)
60 my_real ,
DIMENSION(NUMELC+NUMELTG),
INTENT(IN) ::
63 . x(3,*),xrefc(4,3,*),dt_nl,bufmat(*),time
64 LOGICAL :: FAILURE
65
66
67
68 INTEGER :: IMAT,,L_NLOC,N1,N2,N3,N4,K,I,NDNOD
69 INTEGER, DIMENSION(NEL) :: POS1,POS2,POS3,POS4
71 . le_min,len,damp,dens,ntn_unl,ntn_vnl,
72 . ntvar,z01(11,11),wf1(11,11),zn1(12,11),b1,b2,
73 . b3,b4,nth1,nth2,bth1,bth2,k1,k12,k2,sspnl,le_max
74 my_real,
DIMENSION(:,:),
ALLOCATABLE :: var_reg,vpred
76 . DIMENSION(:), POINTER :: fnl,unl,vnl,dnl,mnl,thck
77 my_real,
DIMENSION(NEL) :: x1,x2,x3,x4,
78 . y1,y2,y3,y4,px1,px2,py1,py2,e1x,e2x,e3x,
79 . e1y,e2y,e3y,e1z,e2z,e3z,x2l,y2l,x3l,y3l,
80 . x4l,y4l,z1,z2,z3,z4,surf,offg,vols,btb11,
81 . btb12,btb22
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.
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
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
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 = ixc(1,1+nft)
168
169 le_min = sqrt(minval(
area(nft+1: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 IF (.NOT.ALLOCATED(var_reg)) ALLOCATE(var_reg(nel,ndof))
203
204
205# include "vectorize.inc"
206 DO i = 1,nel
207
208 IF (nxref == 0) THEN
209 x1(i)=x(1,ixc(2,nft+i))
210 y1(i)=x(2,ixc(2,nft+i))
211 z1(i)=x(3,ixc(2,nft+i))
212 x2(i)=x(1,ixc(3,nft+i))
213 y2(i)=x(2,ixc(3,nft+i))
214 z2(i)=x(3,ixc(3,nft+i))
215 x3(i)=x(1,ixc(4,nft+i))
216 y3(i)=x(2,ixc(4,nft+i))
217 z3(i)=x(3,ixc(4,nft+i))
218 x4(i)=x(1,ixc(5,nft+i))
219 y4(i)=x(2,ixc(5,nft+i))
220 z4(i)=x(3,ixc(5,nft+i))
221 ELSE
222 x1(i)=xrefc(1,1,nft+i)
223 y1(i)=xrefc(1,2,nft+i)
224 z1(i)=xrefc(1,3,nft+i)
225 x2(i)=xrefc(2,1,nft+i)
226 y2(i)=xrefc(2,2,nft+i)
227 z2(i)=xrefc(2,3,nft+i)
228 x3(i)=xrefc(3,1,nft+i)
229 y3(i)=xrefc(3,2,nft+i)
230 z3(i)=xrefc(3,3,nft+i)
231 x4(i)=xrefc(4,1,nft+i)
232 y4(i)=xrefc(4,2,nft+i)
233 z4(i)=xrefc(4,3,nft+i)
234 ENDIF
235
236
237 n1 = nloc_dmg%IDXI(ixc(2,nft+i))
238 n2 = nloc_dmg%IDXI(ixc(3,nft+i))
239 n3 = nloc_dmg%IDXI(ixc(4,nft+i))
240 n4 = nloc_dmg%IDXI(ixc(5,nft+i))
241
242 pos1(i) = nloc_dmg%POSI(n1)
243 pos2(i) = nloc_dmg%POSI(n2)
244 pos3(i) = nloc_dmg%POSI(n3)
245 pos4(i) = nloc_dmg%POSI(n4)
246 ENDDO
247
248
249
250 DO k = 1,ndof
251
252 DO i = 1,nel
253 var_reg(i,k) = fourth*(dnl(pos1(i)+k-1) + dnl(pos2(i)+k-1)
254 . + dnl(pos3(i)+k-1) + dnl(pos4(i)+k-1))
255 ENDDO
256 ENDDO
257
259 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
260 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
261 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,
262 . e1z ,e2z ,e3z )
263
264
266 . bufmat ,time ,var_reg ,
267 . failure )
268
269
270
271
272
273# include "vectorize.inc"
274 DO i=1,nel
275
276
277 x2l(i) = e1x(i)*(x2(i)-x1(i))+e1y(i)*(y2(i)-y1(i))+e1z(i)*(z2(i)-z1(i))
278 y2l(i) = e2x(i)*(x2(i)-x1(i))+e2y(i)*(y2
279 x3l(i) = e1x(i)*(x3(i)-x1(i))+e1y(i)*(y3(i)-y1(i))+e1z(i)*(z3(i)-z1(i))
280 y3l(i) = e2x(i)*(x3(i)-x1(i))+e2y(i)*(y3(i)-y1(i))+e2z(i)*(z3(i)-z1(i))
281 x4l(i) = e1x(i)*(x4(i)-x1(i))+e1y(i)*(y4(i)-y1(i))+e1z(i)*(z4(i)-z1
282 y4l(i) = e2x(i)*(x4(i)-x1(i))+e2y(i)*(y4(i
283
284 px1(i) = half *(y2l(i)-y4l(i))
285 px2(i) = half * y3l(i)
286 py1(i) = -half *(x2l(i)-x4l(i))
287 py2(i) = -half * x3l(i)
288
289
290 btb11(i) = px1(i)**2 + py1(i)**2
291
292 btb22(i) = px2(i)**2 + py2(i)**2
293
294
295 vols(i) =
area(nft+i)*thck(i)
296
297
298 offg(i) = elbuf_tab(ng)%GBUF%OFF(i)
299
300 ENDDO
301
302
303
304
305
306 IF ((ndof > 1).AND.(len>zero)) THEN
307
308
309 bufnl => elbuf_tab(ng)%NLOC(1,1)
310
311
312 massth => bufnl%MASSTH(1:nel,1:ndnod)
313 unlth => bufnl%UNLTH(1:nel ,1:ndnod)
314 vnlth => bufnl%VNLTH(1:nel ,1:ndnod)
315 fnlth => bufnl%FNLTH(1:nel ,1:ndnod)
316
317 DO k = 1,ndnod
318 DO i = 1,nel
319
320 vpred(i,k) = vnlth(i,k) - (fnlth
321 ENDDO
322 ENDDO
323 DO k = 1,ndnod
324 DO i = 1,nel
325
326 fnlth(i,k) = zero
327 ENDDO
328 ENDDO
329
330
331 DO k = 1, ndof
332
333
334 IF ((ndof==2).AND.(k==2)) THEN
335 nth1 = (z01(k,ndof) - zn1(k,ndof))/(zn1(k-1,ndof) - zn1(k,ndof))
336 nth2 = (z01(k,ndof) - zn1(k-1,ndof)) /(zn1(k,ndof) - zn1(k-1,ndof))
337 ELSE
338 nth1 = (z01(k,ndof) - zn1(k+1,ndof))/(zn1(k,ndof) - zn1(k+1,ndof))
339 nth2 = (z01(k,ndof) - zn1(k,ndof)) /(zn1(k+1,ndof) - zn1(k,ndof))
340 ENDIF
341
342
343 DO i = 1,nel
344
345 IF ((ndof==2).AND.(k==2)) THEN
346 bth1 = (one/(zn1(k-1,ndof) - zn1(k
347 bth2 = (one/(zn1(k,ndof) - zn1(k-1,ndof)))*(one/thck(i))
348 ELSE
349 bth1 = (one/(zn1(k,ndof) - zn1(k+1,ndof)))*(one/thck(i))
350 bth2 = (one/(zn1(k+1,ndof) - zn1(k,ndof)))*(one/thck(i))
351 ENDIF
352
353
354 k1 = (len**2)*(bth1**2) + nth1**2
355 k12 = (len**2)*(bth1*bth2)+ (nth1*nth2)
356 k2 = (len**2)*(bth2**2) + nth2**2
357
358
359IF ((ndof==2).AND.(k==2)) THEN
360 fnlth(i,k-1) = fnlth(i,k-1) + (k1*unlth(i,k-1) + k12*unlth(i,k)
361 . + damp*((nth1**2)*vpred(i,k-1)
362 . + (nth1*nth2)*vpred(i,k))
363 . - (nth1*var_reg(i,k)))*vols(i)*wf1(k,ndof)
364 fnlth(i,k) = fnlth(i,k) + (k12*unlth(i,k-1) + k2*unlth(i,k)
365 . + damp*(nth1*nth2*vpred(i,k-1)
366 . + (nth2**2)*vpred(i,k))
367 . - nth2*var_reg(i,k))*vols(i)*wf1(k,ndof)
368 ELSE
369 fnlth(i,k) = fnlth(i,k) + (k1*unlth(i,k) + k12*unlth(i,k+1)
370 . + damp*((nth1**2)*vpred(i,k)
371 . + (nth1*nth2)*vpred(i,k+1))
372 . - (nth1*var_reg(i,k)))*vols(i)*wf1(k,ndof)
373 fnlth(i,k+1) = fnlth(i,k+1) + (k12*unlth(i,k) + k2*unlth(i,k+1)
374 . + damp*(nth1*nth2
375 . + (nth2**2)*vpred(i,k+1))
376 . - nth2*var_reg(i,k))*vols(i)*wf1(k,ndof)
377 ENDIF
378 ENDDO
379 ENDDO
380
381 DO k = 1,ndnod
382 DO i = 1,nel
383
384 vnlth(i,k) = vnlth(i,k) - (fnlth(i,k)/massth(i,k))*dt_nl
385 ENDDO
386 ENDDO
387
388 DO k = 1,ndnod
389 DO i = 1,nel
390
391 unlth(i,k) = unlth(i,k) + vnlth(i,k)*dt_nl
392 ENDDO
393 ENDDO
394
395
396 DO k = 1, ndof
397
398 IF ((ndof==2).AND.(k==2)) THEN
399 nth1 = (z01(k,ndof) - zn1(k,ndof))/(zn1(k-1,ndof) - zn1(k,ndof))
400 nth2 = (z01(k,ndof) - zn1(k-1,ndof)) /(zn1(k,ndof) - zn1(k-1,ndof))
401 ELSE
402 nth1 = (z01(k,ndof) - zn1(k+1,ndof))/(zn1(k,ndof) - zn1(k+1,ndof))
403 nth2 = (z01(k,ndof) - zn1(k,ndof)) /(zn1(k+1,ndof) - zn1
404 ENDIF
405
406 DO i = 1,nel
407
408 IF ((ndof==2).AND.(k==2)) THEN
409 var_reg(i,k) = nth1*unlth(i,k-1) + nth2*unlth(i,k)
410 ELSE
411 var_reg(i,k) = nth1*unlth(i,k) + nth2*unlth(i,k+1)
412 ENDIF
413 ENDDO
414 ENDDO
415 ENDIF
416
417
418
419
420
421 DO k = 1,ndof
422
423
424# include "vectorize.inc"
425 DO i = 1,nel
426
427
428 IF (offg(i) > zero) THEN
429
430 b1 = ((len**2)/vols(i))*wf1(k,ndof)*(btb11(i)*unl(pos1(i)+k-1) + btb12(i)*unl(pos2(i)+k-1)
431 . - btb11(i)*unl(pos3(i)+k-1) - btb12(i)*unl(pos4(i)+k-1))
432 b2 = ((len**2)/vols(i))*wf1(k,ndof)*(btb12(i)*unl(pos1(i)+k-1) + btb22(i)*unl(pos2(i)+k-1)
433 . - btb12(i)*unl(pos3(i)+k-1) - btb22(i)*unl(pos4(i)+k-1))
434 b3 = ((len**2)/vols(i))*wf1(k,ndof)*(-btb11(i)*unl(pos1(i)+k-1) - btb12(i)*unl(pos2(i)+k-1)
435 . + btb11(i)*unl(pos3(i)+k-1) + btb12(i)*unl(pos4(i)+k-1))
436 b4 = ((len**2)/vols(i))*wf1(k,ndof)*(-btb12(i)*unl(pos1(i)+k-1) - btb22(i)*unl(pos2(i)+k-1)
437 . + btb12(i)*unl(pos3(i)+k-1) + btb22(i)*unl(pos4(i)+k-1))
438
439 ntn_unl = ((unl(pos1(i)+k-1) + unl(pos2(i)+k-1) + unl(pos3(i)+k-1) +
440 . unl(pos4(i)+k-1))*fourth*fourth)*vols(i)*wf1(k,ndof)
441
442 ntn_vnl = ((vnl(pos1(i)+k-1) + vnl(pos2(i)+k-1) + vnl(pos3(i)+k-1) +
443 . vnl(pos4(i)+k-1))*fourth*fourth)*damp*vols(i)*wf1(k,ndof)
444
445 ntvar = var_reg(i,k)*fourth*vols(i)*wf1(k,ndof)
446
447 fnl(pos1(i)+k-1) = fnl(pos1(i)+k-1) - (ntn_unl + ntn_vnl - ntvar + b1)
448 fnl(pos2(i)+k-1) = fnl(pos2(i)+k-1) - (ntn_unl + ntn_vnl - ntvar + b2)
449 fnl(pos3(i)+k-1) = fnl(pos3(i)+k-1)
450 fnl(pos4(i)+k-1) = fnl(pos4(i)+k-1) - (ntn_unl + ntn_vnl - ntvar + b4)
451
452 ELSE
453
454 fnl(pos1(i)+k-1) = fnl(pos1(i)+k-1) - wf1(k,ndof)*dens*sspnl*vnl(pos1(i)+k-1)*le_max*thck(i)
455 fnl(pos2(i)+k-1) = fnl(pos2(i)+k-1) - wf1(k,ndof)*dens*sspnl*vnl(pos2(i)+k-1)*le_max*thck(i)
456 fnl(pos3(i)+k-1) = fnl(pos3(i)+k-1) - wf1(k,ndof)*dens*sspnl*vnl(pos3(i)+k-1)*le_max*thck(i)
457 fnl(pos4(i)+k-1) = fnl(pos4(i)+k-1) - wf1(k,ndof)*dens*sspnl*vnl(pos4(i)+k-1)*le_max*thck(i)
458 ENDIF
459 ENDDO
460 ENDDO
461
462 IF (ALLOCATED(var_reg)) DEALLOCATE(var_reg)
463 IF (ALLOCATED(vpred)) DEALLOCATE(vpred)
subroutine ceveci(jft, jlt, area, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, 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)