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