32 1 NLOC_DMG,VAR_REG, THK, NEL,
33 2 OFF, AREA, NC1, NC2,
35 4 BUFNL, IMAT, NDDL, ITASK,
36 5 DT2T, LE, THK0, AREA0,
46#include "implicit_f.inc"
58 INTEGER,
INTENT(IN) :: NFT
59 INTEGER :: NEL,IMAT,NDDL,ITASK
60 INTEGER,
DIMENSION(NEL) :: NC1,NC2,NC3
61 my_real,
DIMENSION(NEL,NDDL),
INTENT(INOUT)::
63 my_real,
DIMENSION(NEL),
INTENT(IN) ::
64 .
area,off,px1,py1,py2,thk,le,thk0,area0
65 my_real,
INTENT(INOUT) ::
68 TYPE(BUF_NLOC_) ,
TARGET :: BUFNL
72 INTEGER I,K,N1,N2,N3,L_NLOC,II,J,NDNOD
74 . l2,ntn,ntn_unl,ntn_vnl,xi,ntvar,a,
75 . b1,b2,b3,zeta,sspnl,
76 . nth1,nth2,bth1,bth2,k1,k2,k12,
77 . dtnl_th,dtnl,le_max,maxstif,
79 my_real,
DIMENSION(:,:),
ALLOCATABLE ::
80 . f1,f2,f3,sti1,sti2,sti3
81 my_real,
DIMENSION(:) ,
ALLOCATABLE ::
82 . btb11,btb12,btb13,btb22,btb23,btb33,vol
83 INTEGER,
DIMENSION(:),
ALLOCATABLE ::
85 my_real,
POINTER,
DIMENSION(:) ::
86 . vnl,fnl,unl,stifnl,mass,mass0,vnl0
87 my_real,
POINTER,
DIMENSION(:,:) ::
88 . massth,unlth,vnlth,fnlth
89 my_real,
DIMENSION(:,:),
ALLOCATABLE ::
93 my_real,
PARAMETER :: csta = 40.0d0
95 my_real,
PARAMETER :: cdamp = 0.7d0
101 l2 = nloc_dmg%LEN(imat)**2
102 xi = nloc_dmg%DAMP(imat)
103 zeta = nloc_dmg%DENS(imat)
104 sspnl = nloc_dmg%SSPNL(imat)
105 l_nloc = nloc_dmg%L_NLOC
106 le_max = nloc_dmg%LE_MAX(imat)
108 ALLOCATE(f1(nel,nddl),f2(nel,nddl),f3(nel,nddl))
112 ALLOCATE(sti1(nel,nddl),sti2(nel,nddl),sti3(nel,nddl))
114 mass => nloc_dmg%MASS(1:l_nloc)
116 mass0 => nloc_dmg%MASS0(1:l_nloc)
118 ALLOCATE(btb11(nel),btb12(nel),btb13(nel),btb22(nel),
119 . btb23(nel),btb33(nel),vol(nel),pos1(nel),
120 . pos2(nel),pos3(nel))
122 vnl => nloc_dmg%VNL(1:l_nloc)
123 vnl0 => nloc_dmg%VNL_OLD(1:l_nloc)
124 unl => nloc_dmg%UNL(1:l_nloc)
132# include "vectorize.inc"
136 n1 = nloc_dmg%IDXI(nc1(i))
137 n2 = nloc_dmg%IDXI(nc2(i))
138 n3 = nloc_dmg%IDXI(nc3(i))
141 pos1(i) = nloc_dmg%POSI(n1)
142 pos2(i) = nloc_dmg%POSI(n2)
143 pos3(i) = nloc_dmg%POSI(n3)
146 vol(i) =
area(i)*thk(i)
149 btb11(i) = px1(i)**2 + py1(i)**2
150 btb12(i) = -px1(i)**2 + py1(i)*py2(i)
151 btb13(i) = -py1(i)*(py1(i)+py2(i))
152 btb22(i) = px1(i)**2 + py2(i)**2
153 btb23(i) = -py2(i)*(py1(i)+py2(i))
154 btb33(i) = (py1(i)+py2(i))**2
162 IF ((nddl > 1).AND.(l2>zero))
THEN
167 ALLOCATE(stifnlth(nel,nddl+1))
168 ALLOCATE(dtn(nel,nddl+1))
173 ALLOCATE(stifnlth(nel,nddl))
174 ALLOCATE(dtn(nel,nddl))
180 massth => bufnl%MASSTH(1:nel,1:ndnod)
181 unlth => bufnl%UNLTH(1:nel ,1:ndnod)
182 vnlth => bufnl%VNLTH(1:nel ,1:ndnod)
183 fnlth => bufnl%FNLTH(1:nel ,1:ndnod)
200 IF ((nddl==2).AND.(k==2))
THEN
201 nth1 = (z0(k,nddl) - zth(k,nddl)) / (zth(k-1,nddl) - zth(k,nddl))
202 nth2 = (z0(k,nddl) - zth(k-1,nddl)) / (zth(k,nddl) - zth(k-1,nddl))
204 nth1 = (z0(k,nddl) - zth(k+1,nddl)) / (zth(k,nddl)
205 nth2 = (z0(k,nddl) - zth(k,nddl)) / (zth(k+1,nddl) - zth(k,nddl))
211 IF ((nddl==2).AND.(k==2))
THEN
212 bth1 = (one/(zth(k-1,nddl) - zth(k,nddl)))*(one/thk(i))
213 bth2 = (one/(zth(k,nddl) - zth(k-1,nddl)))*(one/thk(i))
215 bth1 = (one/(zth(k,nddl) - zth(k+1,nddl)))*(one/thk(i))
216 bth2 = (one/(zth(k+1,nddl) - zth(k,nddl)))*(one/thk(i))
220 k1 = l2*(bth1**2) + nth1**2
221 k12 = l2*(bth1*bth2)+ (nth1*nth2)
222 k2 = l2*(bth2**2) + nth2**2
225 IF ((nddl==2).AND.(k==2))
THEN
226 fnlth(i,k-1) = fnlth(i,k-1) + (k1*unlth(i,k-1) + k12*unlth(i,k)
227 . + xi*((nth1**2)*vnlth(i,k-1)
228 . + (nth1*nth2)*vnlth(i,k))
229 . - (nth1*var_reg(i,k)))*vol(i)*wf(k,nddl)
230 fnlth(i,k) = fnlth(i,k) + (k12*unlth(i,k-1) + k2*unlth(i,k)
231 . + xi*(nth1*nth2*vnlth(i,k-1)
232 . + (nth2**2)*vnlth(i,k))
233 . - nth2*var_reg(i,k))*vol(i)*wf(k,nddl)
236 . + xi*((nth1**2)*vnlth(i,k)
237 . + (nth1*nth2)*vnlth(i,k+1))
238 . - (nth1*var_reg(i,k)))*vol(i)*wf(k,nddl)
239 fnlth(i,k+1) = fnlth(i,k+1) + (k12*unlth(i,k) + k2*unlth(i,k+1)
240 . + xi*(nth1*nth2*vnlth(i,k)
241 . + (nth2**2)*vnlth(i,k+1))
242 . - nth2*var_reg(i,k))*vol(i)*wf(k,nddl)
247 IF ((nddl==2).AND.(k==2))
THEN
248 stifnlth(i,k-1) = stifnlth(i,k-1) +
max(abs(k1)+abs(k12),abs(k12)+abs(k2))*vol(i)*wf(k,nddl)
249 stifnlth(i,k) = stifnlth(i,k) +
max(abs(k1)+abs(k12),abs(k12)+abs(k2))*vol(i)*wf(k,nddl)
251 stifnlth(i,k) = stifnlth(i,k) +
max(abs(k1)+abs(k12),abs(k12)+abs(k2))*vol(i)*wf(k,nddl)
252 stifnlth(i,k+1) = stifnlth(i,k+1) +
max(abs(k1)+abs(k12),abs(k12)+abs(k2))*vol(i)*wf(k,nddl)
266 dtn(i,k) = dtfac1(11)*cdamp*sqrt(two * massth(i,k) /
max(stifnlth(i,k),em20
267 dtnod =
min(dtn(i,k),dtnod)
272 IF ((idtmin(11)==3).OR.(idtmin(11)==4).OR.(idtmin(11)==8))
THEN
274 IF (dtnod < dtmin1(11))
THEN
277 IF (dtn(i,k) < dtmin1(11))
THEN
278 dt2p = dtmin1(11)/(dtfac1(11)*cdamp)
279 massth(i,k) =
max(massth(i,k),csta*half*stifnlth(i,k)*dt2p*dt2p*onep00001)
284 dtnod = dtmin1(11)*(sqrt(csta))
288 IF (dtnod < dt2t)
THEN
289 dt2t =
min(dt2t,dtnod)
296 vnlth(i,k) = vnlth(i,k) - (fnlth(i,k)/massth(i,k))*dt12
303 unlth(i,k) = unlth(i,k) + vnlth(i,k)*dt1
310 IF ((nddl==2).AND.(k==2))
THEN
311 nth1 = (z0(k,nddl) - zth(k,nddl))/(zth(k-1,nddl) - zth(k,nddl))
312 nth2 = (z0(k,nddl) - zth(k-1,nddl)) /(zth(k,nddl) - zth(k-1,nddl))
314 nth1 = (z0(k,nddl) - zth(k+1,nddl))/(zth(k,nddl) - zth(k
315 nth2 = (z0(k,nddl) - zth(k,nddl)) /(zth(k+1,nddl) - zth(k,nddl))
320 IF ((nddl==2).AND.(k==2))
THEN
321 var_reg(i,k) = nth1*unlth(i,k-1) + nth2*unlth(i,k
323 var_reg(i,k) = nth1*unlth(i,k) + nth2*unlth(i,k+1)
336# include "vectorize.inc"
340 IF (off(i) /= zero)
THEN
344 b1 = (l2 / vol(i)) * wf(k,nddl)*(btb11(i)*unl(pos1(i)+k-1) + btb12(i)*unl(pos2(i)+k-1)
345 . + btb13(i)*unl(pos3(i)+k-1))
347 b2 = (l2 / vol(i)) * wf(k,nddl)*(btb12(i)*unl(pos1(i)+k-1) + btb22(i)*unl(pos2(i)+k-1)
348 . + btb23(i)*unl(pos3(i)+k-1))
350 b3 = (l2 / vol(i)) * wf(k,nddl)*(btb13(i)*unl(pos1(i)+k-1)
351 . + btb33(i)*unl(pos3(i)+k-1))
354 ntn_unl = (unl(pos1(i)+k-1) + unl(pos2(i)+k-1) + unl(pos3(i)+k-1))/ntn
357 ntn_vnl = (vnl(pos1(i)+k-1) + vnl(pos2(i)+k-1) + vnl(pos3(i)+k-1))/ntn
359 ntn_vnl =
min(sqrt(mass(pos1(i)+k-1)/mass0(pos1(i)+k-1)),
360 . sqrt(mass(pos2(i)+k-1)/mass0(pos2(i)+k-1)),
361 . sqrt(mass(pos3(i)+k-1)/mass0(pos3(i)+k-1)))*ntn_vnl
365 ntn_unl = ntn_unl * vol(i) * wf(k,nddl)
366 ntn_vnl = ntn_vnl * xi * vol(i) * wf(k,nddl)
369 ntvar = var_reg(i,k)*third*vol(i)*wf(k,nddl)
372 a = ntn_unl + ntn_vnl - ntvar
379 sti1(i,k) = wf(k,nddl)*(abs((l2/vol(i))*btb11(i) + one/ntn*vol(i)) +
380 . abs((l2/vol(i))*btb12(i) + one/ntn*vol(i)) +
382 sti2(i,k) = wf(k,nddl)*(abs((l2/vol(i))*btb12(i) + one/ntn*vol(i)) +
383 . abs((l2/vol(i))*btb22(i) + one/ntn*vol(i)) +
384 . abs((l2/vol(i))*btb23(i) + one/ntn*vol(i)))
385 sti3(i,k) = wf(k,nddl)*(abs((l2/vol(i))*btb13(i) + one/ntn*vol(i)) +
386 . abs((l2/vol(i))*btb23(i) + one/ntn*vol(i)) +
387 . abs((l2/vol(i))*btb33(i) + one/ntn*vol(i)))
394 f1(i,k) = wf(k,nddl)*sqrt(mass(pos1(i)+k-1)/mass0(pos1(i)+k-1))*zeta*sspnl*
395 . half*(vnl(pos1(i)+k-1)+vnl0(pos1(i)+k-1))*sqrt((four/sqrt(three))*(area0(i)))*thk0(i)
396 f2(i,k) = wf(k,nddl)*sqrt(mass(pos2(i)+k-1)/mass0(pos2(i)+k-1))*zeta*sspnl*
397 . half*(vnl(pos2(i)+k-1)+vnl0(pos2(i)+k-1))*sqrt((four/sqrt(three))*(area0(i)))*thk0(i)
398 f3(i,k) = wf(k,nddl)*sqrt(mass(pos3(i)+k-1)/mass0(pos3(i)+k-1))*zeta*sspnl*
399 . half*(vnl(pos3(i)+k-1)+vnl0(pos3(i)+k-1))*sqrt((four/sqrt(three))*(area0(i)))*thk0(i)
406 f1(i,k) = wf(k,nddl)*zeta*sspnl*half*(vnl(pos1(i)+k-1)+vnl0(pos1(i)+k-1))*
407 . sqrt((four/sqrt(three))*(area0(i)))*thk0(i)
408 f2(i,k) = wf(k,nddl)*zeta*sspnl*half*(vnl(pos2(i)+k-1)+vnl0(pos2(i)+k-1))*
409 . sqrt((four/sqrt(three))*(area0(i)))*thk0(i)
410 f3(i,k) = wf(k,nddl)*zeta*sspnl*half*(vnl(pos3(i)+k-1)+vnl0(pos3(i)+k-1))*
411 . sqrt((four/sqrt(three))*(area0(i)))*thk0(i)
422 IF (iparit == 0)
THEN
424 fnl => nloc_dmg%FNL(1:l_nloc,itask+1)
425 IF (nodadt > 0) stifnl => nloc_dmg%STIFNL(1:l_nloc,itask+1)
429#include "vectorize.inc"
432 fnl(pos1(i)+k-1) = fnl(pos1(i)+k-1) - f1(i,k)
433 fnl(pos2(i)+k-1) = fnl(pos2(i)+k-1) - f2(i,k)
434 fnl(pos3(i)+k-1) = fnl(pos3(i)+k-1) - f3(i,k)
437 maxstif =
max(sti1(i,k),sti2(i,k),sti3(i,k))
439 stifnl(pos1(i)+k-1) = stifnl(pos1(i)+k-1) + maxstif
440 stifnl(pos2(i)+k-1) = stifnl(pos2(i)+k-1) + maxstif
441 stifnl(pos3(i)+k-1) = stifnl(pos3(i)+k-1) + maxstif
448 ! loop over additional d.o.fs
457 maxstif =
max(sti1(i,j),sti2(i,j),sti3(i,j))
460 k = nloc_dmg%IADTG(1,ii)
461 nloc_dmg%FSKY(k,j) = -f1(i,j)
462 IF (nodadt > 0) nloc_dmg%STSKY(k,j) = maxstif
464 k = nloc_dmg%IADTG(2,ii)
465 nloc_dmg%FSKY(k,j) = -f2(i,j)
466 IF (nodadt > 0) nloc_dmg%STSKY(k,j) = maxstif
468 k = nloc_dmg%IADTG(3,ii)
469 nloc_dmg%FSKY(k,j) = -f3(i,j)
470 IF (nodadt > 0) nloc_dmg%STSKY(k,j) = maxstif
480 IF (nodadt == 0)
THEN
483 IF (off(i)/=zero)
THEN
485 dtnl = (two*(
min(le(i),le_max))*sqrt(three*zeta))/
486 . sqrt(twelve*l2 + (
min(le(i),le_max))**2)
490 dtnl_th = (two*(
min(thk(i)/nddl,le_max))*sqrt(three*zeta))/
491 . sqrt(twelve*l2 + (
min(thk(i)/nddl,le_max))**2)
493 dtnl_th = (two*(
min(thk(i),le_max))*sqrt(three*zeta))/
494 . sqrt(twelve*l2 + (
min(thk(i),le_max))**2)
500 dt2t =
min(dt2t,dtfac1(1)*cdamp*dtnl_th,dtfac1(1)*cdamp*dtnl)
506 IF (
ALLOCATED(f1))
DEALLOCATE(f1)
507 IF (
ALLOCATED(f2))
DEALLOCATE(f2)
508 IF (
ALLOCATED(f3))
DEALLOCATE(f3)
509 IF (
ALLOCATED(sti1))
DEALLOCATE(sti1)
510 IF (
ALLOCATED(sti2))
DEALLOCATE(sti2)
511 IF (
ALLOCATED(sti3))
DEALLOCATE(sti3)
512 IF (
ALLOCATED(btb11))
DEALLOCATE(btb11)
513 IF (
ALLOCATED(btb12))
DEALLOCATE(btb12)
514 IF (
ALLOCATED(btb13))
DEALLOCATE(btb13)
515 IF (
ALLOCATED(btb22))
DEALLOCATE(btb22)
516 IF (
ALLOCATED(btb23))
DEALLOCATE(btb23)
517 IF (
ALLOCATED(btb33))
DEALLOCATE(btb33)
518 IF (
ALLOCATED(stifnlth))
DEALLOCATE(stifnlth)
519 IF (
ALLOCATED(pos1))
DEALLOCATE(pos1)
520 IF (
ALLOCATED(pos2))
DEALLOCATE(pos2)
521 IF (
ALLOCATED(pos3))
DEALLOCATE(pos3)
522 IF (
ALLOCATED(vol))
DEALLOCATE(vol)