86
87
88
89 USE output_mod, only : output_
90 USE timer_mod
91 USE mmain_mod
93 USE mat_elem_mod
97 USE elbufdef_mod
99 use glob_therm_mod
100 USE sensor_mod
101 use element_mod , only : nixs
102
103
104
105#include "implicit_f.inc"
106#include "comlock.inc"
107
108
109
110#include "mvsiz_p.inc"
111
112
113
114#include "com01_c.inc"
115#include "com04_c.inc"
116#include "com08_c.inc"
117#include "scr19_c.inc"
118#include "param_c.inc"
119#include "timeri_c.inc"
120#include "scr18_c.inc"
121#include "ige3d_c.inc"
122
123
124
125 TYPE(TIMER_) ,INTENT(INOUT) :: TIMERS
126 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
127 INTEGER, INTENT(INOUT) :: JPLASOL
128 INTEGER, INTENT(INOUT) :: JSPH
129 INTEGER, INTENT(IN) :: JCVT
130 INTEGER, INTENT(IN) :: ISMSTR
131 INTEGER, INTENT(IN) :: JALE
132 INTEGER, INTENT(IN) :: JEUL
133 INTEGER, INTENT(IN) :: JLAG
134 INTEGER, INTENT(IN) :: SNPC
135 INTEGER, INTENT(IN) :: STF
136 INTEGER, INTENT(IN) :: SBUFMAT
137 INTEGER, INTENT(IN) :: IDTMINS
138 INTEGER, INTENT(IN) :: NSVOIS
139 INTEGER, INTENT(IN) :: IRESP
140 INTEGER ,INTENT(IN) :: IDEL7NG
141 INTEGER ,INTENT(INOUT) :: IDEL7NOK
142 INTEGER, INTENT(IN) :: IMPL_S
143 INTEGER, INTENT(IN) :: IDYNA
144 INTEGER, INTENT(IN) :: USERL_AVAIL
145
146 INTEGER LFT,LLT,NEL,NFT,MTN,IGTYP,IFAILURE,NPT,JSMS,
147 . NCTRL,NG,NELTST,ITYPTST,OFFSET,IEXPAN,ITASK,H3D_STRAIN
148 INTEGER IXS(NIXS,*), IPARG(NPARG,*), NPF(*),IADS(8,*),
149 . IPARTS(*), IGEO(NPROPGI,*), IPM(NPROPMI,*),
150 . KXIG3D(NIXIG3D,*),IXIG3D(*),FLUX(6,*),FLU1(*),
151 . IOUTPRT,PX,PY,PZ,GRTH(*),IGRTH(*)
153 . pm(npropm,*), geo(npropg,*),x(3,*),a(3,*),v(3,*),ms(*),w(*),
154 . ar(3,*), vr(3,*), in(3,*),d(3,*),tf(*), bufmat(*),fr_wave(*),
155 . partsav(*),stifn(*), stifr(*), fsky(*),eani(*),
156 . fx(mvsiz,*),fy(mvsiz,*),fz(mvsiz,*),
157 . mssa(*), dmels(*),knot(*),wige(*),dt2t, fv(*),knotlocpc(deg_max,3,*),
158 . knotlocel(2,3,*),gresav(*)
159 my_real,
DIMENSION(MVSIZ,6)INTENT(INOUT) :: svis
160 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
161 TYPE(TTABLE) TABLE(*)
162 TYPE (NLOCAL_STR_) , TARGET ::
163 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
164 TYPE (MAT_ELEM_) ,INTENT(INOUT) :: MAT_ELEM
165 TYPE(DT_) ,INTENT(IN) :: DT
166 type (glob_therm_) ,intent(inout) :: glob_therm
167 type (sensors_),INTENT(INOUT) :: SENSORS
168
169
170
171 INTEGER I, J, NF1, IFLAG, NUPARAM,
172 . NUVAR,IMAT,N1,N2,N3,NKNOT1,NKNOT2,NKNOT3,
173 . IDX(MVSIZ),IDY(MVSIZ),IDZ(MVSIZ),IFUNC(MAXFUNC),NFUNC,IADBUF,
174 . IBID,ISTRAIN,IBIDV(1),ILAY,IERROR,IAD_KNOT,IDFRSTLOCKNT,
175 . IDX2(MVSIZ),IDY2(MVSIZ),IDZ2(MVSIZ)
176
177 INTEGER IPROP
179 .
180 . sti(mvsiz) ,rho0(mvsiz)
182 . off(mvsiz) ,
183 . xx(nctrl,nel),yy(nctrl,nel),zz(nctrl,nel),
184 . dx(nctrl,nel),dy(nctrl,nel),dz(nctrl,nel),
185 .
186 . vx(nctrl,nel),vy(nctrl,nel),vz(nctrl,nel),
187 .
188 . ww(nctrl,nel),rbid, zr, zs, zt
189
190 TYPE(G_BUFEL_) ,POINTER :: GBUF
191 TYPE(L_BUFEL_) ,POINTER :: LBUF
192
194 . DIMENSION(:),POINTER :: uvar
195 INTEGER MXT(MVSIZ),NGL(MVSIZ),NGEO(MVSIZ)
197 . voln(mvsiz), vd2(mvsiz) , dvol(mvsiz),deltax(mvsiz),
198 . vis(mvsiz) , qvis(mvsiz), cxx(mvsiz) ,
199 . s1(mvsiz) , s2(mvsiz) , s3(mvsiz) ,
200 . s4(mvsiz) , s5(mvsiz) , s6(mvsiz) ,
201 . d4(mvsiz) , d5(mvsiz) , d6(mvsiz) ,
202 .
203 .
204 .
205 . aj1(mvsiz) , aj2(mvsiz) , aj3(mvsiz) ,
206 . aj4(mvsiz) , aj5(mvsiz) , aj6(mvsiz),
207 . wxx(mvsiz) , wyy(mvsiz) , wzz(mvsiz),
208 . vdx(mvsiz) , vdy(mvsiz) , vdz(mvsiz),
209 . muvoid(mvsiz),ssp_eq(mvsiz),aire(mvsiz),
210 . sigy(mvsiz),et(mvsiz),r1_free(mvsiz),
211 . r3_free(mvsiz),defp(mvsiz),
212 . mfxx(mvsiz),mfxy(mvsiz),mfyx(mvsiz),
213 . mfyy(mvsiz),mfyz(mvsiz),mfzy(mvsiz),
214 . mfzz(mvsiz),mfzx(mvsiz),mfxz(mvsiz),
215 . gama(mvsiz,6),bid(mvsiz),tempel(mvsiz),die(mvsiz),
216 . stig(mvsiz,nctrl)
217
219 . dxx(mvsiz), dyy(mvsiz), dzz(mvsiz),
220 . dxy(mvsiz), dxz(mvsiz), dyx(mvsiz),
221 . dyz(mvsiz), dzx(mvsiz), dzy(mvsiz),divde(mvsiz)
222
223 INTEGER ITEL, ITNCTRL, K, N,
225 . DIMENSION(NCTRL) :: r
227 . DIMENSION(NCTRL,3) :: drdxi
229 . DIMENSION(NCTRL,MVSIZ) :: matn
231 . DIMENSION(3*NCTRL,MVSIZ) :: matb
233 . DIMENSION(MVSIZ) :: matdet
235 . detjac, pgauss, volg(mvsiz)
237 . btdbaloc(3*nctrl,mvsiz),
238 . ba(6,mvsiz),dba(6,mvsiz), aloc(3*nctrl,mvsiz),
239 . mass(nctrl,mvsiz),mmunk(mvsiz),knotlocx(px+1,nctrl,mvsiz),
240 . knotlocy(py+1,nctrl,mvsiz),knotlocz(pz+1,nctrl,mvsiz),
241 . knotlocelx(2,mvsiz),
242 . knotlocely(2,mvsiz),knotlocelz(2,mvsiz)
244 . airenurbs(3), aface(6,mvsiz), tc,
245 . vmin(mvsiz), smax(mvsiz), sumv,amu(mvsiz)
248 . ALLOCATABLE, DIMENSION(:,:) :: vgauss
249 INTEGER SZ_IX
250
251 double precision
252 . w_gauss(9,9),a_gauss(9,9),voldp(mvsiz)
253 DATA w_gauss /
254 1 2.d0 ,0.d0 ,0.d0 ,
255 1 0.d0 ,0.d0 ,0.d0 ,
256 1 0.d0 ,0.d0 ,0.d0 ,
257 2 1.d0 ,1.d0 ,0.d0 ,
258 2 0.d0 ,0.d0 ,0.d0 ,
259 2 0.d0 ,0.d0 ,0.d0 ,
260 3 0.555555555555556d0,0.888888888888889d0,0.555555555555556d0,
261 3 0.d0 ,0.d0 ,0.d0 ,
262 3 0.d0 ,0.d0 ,0.d0 ,
263 4 0.347854845137454d0,0.652145154862546d0,0.652145154862546d0,
264 4 0.347854845137454d0,0.d0 ,0.d0 ,
265 4 0.d0 ,0.d0 ,0.d0 ,
266 5 0.236926885056189d0,0.478628670499366d0,0.568888888888889d0,
267 5 0.478628670499366d0,0.236926885056189d0,0.d0 ,
268 5 0.d0 ,0.d0 ,0.d0 ,
269 6 0.171324492379170d0,0.360761573048139d0,0.467913934572691d0,
270 6 0.467913934572691d0,0.360761573048139d0,0.171324492379170d0,
271 6 0.d0 ,0.d0 ,0.d0 ,
272 7 0.129484966168870d0,0.279705391489277d0,0.381830050505119d0,
273 7 0.417959183673469d0,0.381830050505119d0,0.279705391489277d0,
274 7 0.129484966168870d0,0.d0 ,0.d0 ,
275 8 0.101228536290376d0,0.222381034453374d0,0.313706645877887d0,
276 8 0.362683783378362d0,0.362683783378362d0,0.313706645877887d0,
277 8 0.222381034453374d0,0.101228536290376d0,0.d0 ,
278 9 0.081274388361574d0,0.180648160694857d0,0.260610696402935d0,
279 9 0.312347077040003d0,0.330239355001260d0,0.312347077040003d0,
280 9 0.260610696402935d0,0.180648160694857d0,0.081274388361574d0/
281 DATA a_gauss /
282 1 0.d0 ,0.d0 ,0.d0 ,
283 1 0.d0 ,0.d0 ,0.d0 ,
284 1 0.d0 ,0.d0 ,0.d0 ,
285 2 -.577350269189625d0,0.577350269189625d0,0.d0 ,
286 2 0.d0 ,0.d0 ,0.d0 ,
287 2 0.d0 ,0.d0 ,0.d0 ,
288 3 -.774596669241483d0,0.d0 ,0.774596669241483d0,
289 3 0.d0 ,0.d0 ,0.d0 ,
290 3 0.d0 ,0.d0 ,0.d0 ,
291 4 -.861136311594053d0,-.339981043584856d0,0.339981043584856d0,
292 4 0.861136311594053d0,0.d0 ,0.d0 ,
293 4 0.d0 ,0.d0 ,0.d0 ,
294 5 -.906179845938664d0,-.538469310105683d0,0.d0 ,
295 5 0.538469310105683d0,0.906179845938664d0,0.d0 ,
296 5 0.d0 ,0.d0 ,0.d0 ,
297 6 -.932469514203152d0,-.661209386466265d0,-.238619186083197d0,
298 6 0.238619186083197d0,0.661209386466265d0,0.932469514203152d0,
299 6 0.d0 ,0.d0 ,0.d0 ,
300 7 -.949107912342759d0,-.741531185599394d0,-.405845151377397d0,
301 7 0.d0 ,0.405845151377397d0,0.741531185599394d0,
302 7 0.949107912342759d0,0.d0 ,0.d0 ,
303 8 -.960289856497536d0,-.796666477413627d0,-.525532409916329d0,
304 8 -.183434642495650d0,0.183434642495650d0,0.525532409916329d0,
305 8 0.796666477413627d0,0.960289856497536d0,0.d0 ,
306 9 -.968160239507626d0,-.836031107326636d0,-.613371432700590d0,
307 9 -.324253423403809d0,0.d0 ,0.324253423403809d0,
308 9 0.613371432700590d0,0.836031107326636d0,0.968160239507626d0/
309
310
311
312 sz_ix=numelq+numels+nsvois
313 ibid = 0
314 ibidv = 0
315 istrain = 1
316 bid = zero
317 rbid = zero
318 gbuf => elbuf_tab(ng)%GBUF
319 uvar => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR
320 iprop = iparg(62,ng)
321 ilay = 1
322 nf1=nft+1
323 knotlocx = zero
324 knotlocy = zero
325 knotlocz = zero
326 knotlocelx = zero
327 knotlocely = zero
328 knotlocelz = zero
329
330 off = one
331 DO i=lft,llt
332 imat = kxig3d(1,i+nft)
333 ngeo(i)=kxig3d(2,i+nft)
334 mxt(i)=imat
335 vis(i)=zero
336 qvis(i)=zero
337 vdx(i)=zero
338 vdy(i)=zero
339 vdz(i)=zero
340 vd2(i)=zero
341
342 DO j=1,nctrl
343 IF( j <= kxig3d(3,i+nft) ) THEN
344 xx(j,i)=x(1,ixig3d(kxig3d(4,i+nft)+j-1))
345 yy(j,i)=x(2,ixig3d(kxig3d(4,i+nft)+j-1))
346 zz(j,i)=x(3,ixig3d(kxig3d(4,i+nft)+j-1))
347 dx(j,i)=d(1,ixig3d(kxig3d(4,i+nft)+j-1))
348 dy(j,i)=d(2,ixig3d(kxig3d(4,i+nft)+j-1))
349 dz(j,i)=d(3,ixig3d(kxig3d(4,i+nft)+j-1))
350 vx(j,i)=v(1,ixig3d(kxig3d(4,i+nft)+j-1))
351 vy(j,i)=v(2,ixig3d(kxig3d(4,i+nft)+j-1))
352 vz(j,i)=v(3,ixig3d(kxig3d(4,i+nft)+j-1))
353 ww(j,i)=1
354 DO k=1,px+1
355 knotlocx(k,j,i)=knotlocpc(k,1,(ngeo(i)-1)*numnod+ixig3d(kxig3d(4,i+nft)+j-1))
356 ENDDO
357 DO k=1,py+1
358 knotlocy(k,j,i)=knotlocpc(k,2,(ngeo(i)-1)*numnod+ixig3d(kxig3d(4,i+nft)+j-1))
359 ENDDO
360 DO k=1,pz+1
361 knotlocz(k,j,i)=knotlocpc(k,3,(ngeo(i)-1)*numnod+ixig3d(kxig3d(4,i+nft)+j-1))
362 ENDDO
363 ENDIF
364 ENDDO
365 ngl(i) = kxig3d(5,i+nft)
366 idx(i) = kxig3d(6,i+nft)
367 idy(i) = kxig3d(7,i+nft)
368 idz(i) = kxig3d(8,i+nft)
369 idx2(i) = kxig3d(9,i+nft)
370 idy2(i) = kxig3d(10,i+nft)
371 idz2(i) = kxig3d(11,i+nft)
372 knotlocelx(1,i) = knotlocel(1,1,i+nft)
373 knotlocely(1,i) = knotlocel(1,2,i+nft)
374 knotlocelz(1,i) = knotlocel(1,3,i+nft)
375 knotlocelx(2,i) = knotlocel(2,1,i+nft)
376 knotlocely(2,i) = knotlocel(2,2,i+nft)
377 knotlocelz(2,i) = knotlocel(2,3,i+nft)
378 rho0(i)= pm(1,imat)
379 ENDDO
380 iad_knot = igeo(40,iprop)
381 n1 = igeo(44,iprop)
382 n2 = igeo(45,iprop)
383 n3 = igeo(46,iprop)
384 idfrstlocknt = igeo(47,iprop)
385 nknot1 = n1+px
386 nknot2 = n2+py
387 nknot3 = n3+pz
388
389 iadbuf = ipm(7,imat)
390 nuvar = ipm(8,imat)
391 nuparam = ipm(9,imat)
392 nfunc = ipm(10,imat)
393 DO i=1,nfunc
394 ifunc(i) = ipm(10+i,imat)
395 ENDDO
396
397
398 IF (tt==zero) THEN
399 DO i=1,px
400 DO j=1,py
401 DO k=1,pz
402 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(i,j,k)
403 lbuf%VOL0DP(lft:llt) = lbuf%VOL(lft:llt)
404 ENDDO
405 ENDDO
406 ENDDO
407 END IF
408
409
410
411
412 deltax=ep20
413 bid = zero
414 ibid = 0
415 tc = ep10
416 smax(:)=zero
417
418 ALLOCATE(vgauss(px*py*pz,mvsiz),stat=ierror)
419 IF(ierror/=0)THEN
420 CALL ancmsg(msgid=246,anmode=aninfo)
422 END IF
423 vgauss(:,:)=zero
424
426 1 nctrl, volg, gbuf%SIG, gbuf%EINT,
427 2 gbuf%RHO, gbuf%QVIS, fx, fy,
428 3 fz, btdbaloc, stig, mass,
429 4 mmunk, aface, vmin, gbuf%PLA,
430 5 gbuf%EPSD, gbuf%G_PLA, gbuf%G_EPSD,nel)
431
432 n=0
433 DO i=1,px
434 DO j=1,py
435 DO k=1,pz
436
437 n=n+1
438 zr = a_gauss(i,px)
439 zs = a_gauss(j,py)
440 zt = a_gauss(k,pz)
441 pgauss = w_gauss(i,px)*w_gauss(j,py)*w_gauss(k,pz)
442
443 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(i,j,k)
444
445
446
447
448
449 DO itel=lft,llt
450
451
452
453
454
455
456
458 1 itel ,n ,xx(:,itel) ,yy(:,itel),
459 2 zz(:,itel),ww(:,itel) ,idx(itel) ,idy(itel) ,
460 3 idz(itel) ,knotlocx(:,:,itel) ,knotlocy(:,:,itel),knotlocz(:,:,itel) ,
461 4 drdxi ,r ,detjac ,nctrl ,
462 5 zr ,zs ,zt ,knot(iad_knot+1),
463 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
464 7 py-1 ,pz-1 ,1 ,
465 8 idx2(itel),idy2(itel) ,idz2(itel) ,
466 9 knotlocelx(:,itel),knotlocely(:,itel),knotlocelz(:,itel))
467
468 voln(itel) = pgauss*detjac
469 vgauss(n,itel) = pgauss*detjac
470 volg(itel) = volg(itel) + voln(itel)
471
472 IF(idtmin(101)==1)THEN
473 DO itnctrl=1,nctrl
474 mass(itnctrl,itel)=mass(itnctrl,itel)+pm(89,mxt(itel))*r(itnctrl)*lbuf%VOL(itel)
475 ENDDO
476 ENDIF
477
478
479
480
481
483 . itel ,nctrl ,r ,drdxi ,
484 . detjac,matn ,matb ,matdet)
485
486 ENDDO
487
488
489
490
491
493 1 vx, vy, vz, matb,
494 2 nctrl, wxx, wyy, wzz,
495 3 dxx, dyy, dzz, dxy,
496 4 dyx, dyz, dzy, dxz,
497 5 dzx, d4, d5, d6,
498 6 ba, aloc, nel)
499
500
501
502
503
505 1 lbuf%SIG,s1, s2, s3,
506 2 s4, s5, s6, wxx,
507 3 wyy, wzz, nel, mtn,
508 4 iparg(9,ng))
509
510
511
512
513 voldp(lft:llt) = voln(lft:llt)
514 divde(1:nel) = dt1*(dxx(1:nel)+ dyy(1:nel)+ dzz(1:nel))
515
517 1 pm, lbuf%VOL, lbuf%RHO, lbuf%EINT,
518 2 divde, flux(1,nf1), flu1(nf1), voln,
519 3 dvol, ngl, mxt, off,
520 4 iparg(64,ng),gbuf%TAG22, voldp, lbuf%VOL0DP,
521 5 amu, gbuf%OFF, nel, mtn,
522 6 jale, ismstr, jeul, jlag)
523
524
525
526
527
528
529
530
531
532 IF ((itask==0).AND.(imon_mat==1))
CALL startime(timers,35)
533 CALL mmain(timers, output,
534 1 elbuf_tab, ng, pm, geo,
535 2 ale_connect, ixs, iparg,
536 3 v, tf, npf, bufmat,
537 4 sti, x, dt2t, neltst,
538 5 ityptst, offset, nel, w,
539 6 off, ngeo, mxt, ngl,
540 7 voln, vd2, dvol, deltax,
541 8 vis, qvis, cxx, s1,
542 9 s2, s3, s4, s5,
543 a s6, dxx, dyy, dzz,
544 b d4, d5, d6, wxx,
545 c wyy, wzz, aj1, aj2,
546 d aj3, aj4, aj5, aj6,
547 e vdx, vdy, vdz, muvoid,
548 f ssp_eq, aire, sigy, et,
549 g r1_free, defp, r3_free, amu,
550 h mfxx, mfxy, mfxz, mfyx,
551 i mfyy, mfyz, mfzx, mfzy,
552 j mfzz, ipm, gama, bid,
553 k dxy, dyx, dyz, dzy,
554 l dzx, dxz, istrain, tempel,
555 m die, iexpan, ilay, mssa,
556 n dmels, i, j, k,
557 o table, bid, bid, bid,
558 p bid, iparg(1,ng), igeo, bid,
559 q itask, nloc_dmg, varnl, mat_elem,
560 r h3d_strain, jplasol, jsph, mvsiz,
561 s snpc, stf, sbufmat, glob_therm,
562 * svis, sz_ix, iresp,
563 t n2d, th_strain, ngroup, tt,
564 . dt1, ntable, numelq, nummat,
565 . numgeo, numnod, numels,
566 . idel7nok, idtmin, maxfunc,
567 . imon_mat, userl_avail, impl_s,
568 . idyna, dt ,bid ,sensors)
569
571 1 dxx, dyy, dzz, d4,
572 2 d5, d6, lbuf%STRA,wxx,
573 3 wyy, wzz, off, nel,
574 4 jcvt)
575
576 IF ((itask==0).AND.(imon_mat==1))
CALL stoptime(timers,35)
577
578
579
580
581
583 1 pm, mxt, kxig3d, lbuf%SIG,
584 2 nctrl, matb, fx, fy,
585 3 fz, voln, btdbaloc,dba,
586 4 ssp_eq, stig, nel, nft)
587
588 ENDDO
589 ENDDO
590 ENDDO
591
592
593
594
595
597 1 gbuf%OFF,off, nel, ismstr)
598
599
600
601 n=0
602 DO i=1,px
603 DO j=1,py
604 DO k=1,pz
605
606 n=n+1
607 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(i,j,k)
608
610 1 lbuf%SIG, gbuf%SIG, lbuf%VOL, gbuf%VOL,
611 2 lbuf%RHO, lbuf%EINT, gbuf%EINT, gbuf%RHO,
612 3 vgauss(n,:),volg, lbuf%PLA, gbuf%PLA,
613 4 gbuf%G_PLA, lbuf%EPSD, gbuf%EPSD, nel,
614 5 iparg(40,ng))
615
616 ENDDO
617 ENDDO
618 ENDDO
619
620
621
622
623 iflag=mod(ncycle,ncpri)
624 IF (ioutprt>0)THEN
625 CALL ige3dbilan(partsav,gbuf%EINT,gbuf%RHO,volg,
626 . vx, vy, vz,iparts,gbuf%VOL,
627 . gresav,grth,igrth,
628 . xx, yy, zz, nctrl,itask,iparg(1,ng),
629 . sensors)
630 ENDIF
631
632
633
634
635
637 1 ixig3d, kxig3d, nctrl, gbuf%OFF,
638 2 a, fx, fy, fz,
639 3 btdbaloc,stig, stifn, nel,
640 4 nft)
641
642
643
644
645
646
647
648 IF(idtmin(101)==1)THEN
649 DO i=lft,llt
650 DO j=1,nctrl
651 IF( j <= kxig3d(3,i+nft) ) THEN
652 mmunk(i) =
min(mmunk(i),mass(j,i)/stig(i,j))
653 ENDIF
654 ENDDO
655 tc = sqrt(2*mmunk(i))
656 tc = dtfac1(101)*tc
657 IF(tc<dt2t)THEN
658 dt2t =tc
659 ityptst=101
660 neltst =ngl(i)
661 ENDIF
662 ENDDO
663
664
665
666
667
668 ELSEIF(idtmin(101)==2)THEN
669
670 n=0
671 DO i=1,px
672 DO j=1,py
673 n=n+1
674 zr = a_gauss(i,px)
675 zs = a_gauss(j,py)
676 zt = -one
677 pgauss = w_gauss(i,px)*w_gauss(j,py)
678
679 DO itel=lft,llt
680
682 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
683 . idx(itel), idy(itel), idz(itel), airenurbs,
684 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
685 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
686
687 aface(1,itel) = aface(1,itel) + airenurbs(1)*pgauss
688
689 ENDDO
690
691 zt = one
692
693 DO itel=lft,llt
695 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
696 . idx(itel), idy(itel), idz(itel), airenurbs,
697 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
698 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
699
700 aface(2,itel) = aface(2,itel) + airenurbs(1)*pgauss
701 ENDDO
702 ENDDO
703 ENDDO
704
705 n=0
706 DO i=1,px
707 DO k=1,pz
708 n=n+1
709 zs = -one
710 zr = a_gauss(i,px)
711 zt = a_gauss(k,pz)
712 pgauss = w_gauss(i,px)*w_gauss(k,pz)
713
714 DO itel=lft,llt
716 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
717 . idx(itel), idy(itel), idz(itel), airenurbs,
718 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
719 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
720
721 aface(3,itel) = aface(3,itel) + airenurbs(2)*pgauss
722 ENDDO
723
724 zs = one
725
726 DO itel=lft,llt
728 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
729 . idx(itel), idy(itel), idz(itel), airenurbs,
730 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
731 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
732
733 aface(4,itel) = aface(4,itel) + airenurbs(2)*pgauss
734 ENDDO
735 ENDDO
736 ENDDO
737
738 n=0
739 DO j=1,py
740 DO k=1,pz
741 n=n+1
742 zr = -one
743 zs = a_gauss(j,py)
744 zt = a_gauss(k,pz)
745 pgauss = w_gauss(j,py)*w_gauss(k,pz)
746
747 DO itel=lft,llt
749 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
750 . idx(itel), idy(itel), idz(itel), airenurbs,
751 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
752 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
753
754 aface(5,itel) = aface(5,itel) + airenurbs(3)*pgauss
755 ENDDO
756
757 zr = one
758
759 DO itel=lft,llt
761 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
762 . idx(itel), idy(itel), idz(itel), airenurbs,
763 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
764 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
765
766 aface(6,itel) = aface(6,itel) + airenurbs(3)*pgauss
767 ENDDO
768 ENDDO
769 ENDDO
770
771
772
773
774
775 DO itel=lft,llt
776 DO i=1,px
777 DO j=1,py
778 sumv=zero
779 DO k=1,pz
780 sumv=sumv+vgauss((j-1)*pz+(i-1)*pz*py+k,itel)
781 ENDDO
782 vmin(itel)=
min(vmin(itel),sumv)
783 ENDDO
784 ENDDO
785
786 deltax(itel)=
min(deltax(itel),px*py*vmin(itel)/
max(aface(1,itel),aface(2,itel)))
787 vmin(itel)=ep10
788 sumv=zero
789
790 DO i=1,px
791 DO j=1,pz
792 sumv=zero
793 DO k=1,py
794 sumv=sumv+vgauss(j+(i-1)*py*pz+(k-1)*pz,itel)
795 ENDDO
796 vmin(itel)=
min(vmin(itel),sumv)
797 ENDDO
798 ENDDO
799
800 deltax(itel)=
min(deltax(itel),px*pz*vmin(itel)/
max(aface(3,itel),aface(4,itel)))
801 vmin(itel)=ep10
802
803 DO i=1,py
804 DO j=1,pz
805 sumv=zero
806 DO k=1,px
807 sumv=sumv+vgauss(j+(i-1)*pz+(k-1)*py*pz,itel)
808 ENDDO
809 vmin(itel)=
min(vmin(itel),sumv)
810 ENDDO
811 ENDDO
812
813 deltax(itel)=
min(deltax(itel),pz*py*vmin(itel)/
max(aface(5,itel),aface(6,itel)))
814 vmin(itel)=ep10
815 sumv=zero
816
817 ENDDO
818
819 DEALLOCATE(vgauss)
820 ENDIF
821
822
823
824
825 RETURN
subroutine ige3daire(itel, n, xxi, yyi, zzi, wwi, idx, idy, idz, aire, nctrl, gaussx, gaussy, gaussz, kx, ky, kz, px, py, pz)
subroutine ig3daverage(sig, sigg, vol0, vol0g, rho, eint, eintg, rhog, vol, volg, eplas, eplasg, g_pla, epsd, epsdg, nel, israt)
subroutine ig3dcumu3(ixig3d, kxig3d, nctrl, offg, e, fx, fy, fz, btdbaloc, stig, stifn, nel, nft)
subroutine ig3dderishap(i, nctrl, r, drdxi, detjac, n, b, det)
subroutine ig3dfint(pm, mxt, kxig3d, sig, nctrl, matb, fx, fy, fz, vol, btdba, dba, ssp_eq, stig, nel, nft)
subroutine ige3dbilan(partsav, eint, rho, vol, vx, vy, vz, iparts, vol0, gresav, grth, igrth, x, y, z, ncp, itask, iparg, sensors)
subroutine ige3ddefo(vx, vy, vz, matb, nctrl, wxx, wyy, wzz, dxx, dyy, dzz, dxy, dyx, dyz, dzy, dxz, dzx, d4, d5, d6, ba, a, nel)
subroutine ige3dzero(nctrl, volm, sigm, eintm, rhom, qm, fx, fy, fz, btdba, stig, mass, mmunk, aface, detmin, eplasm, epsdg, g_pla, g_epsd, nel)
subroutine mmain(pm, elbuf_str, ix, nix, x, geo, iparg, nel, skew, bufmat, ipart, ipartel, nummat, matparam, imat, ipm, ngl, pid, npf, tf, mfxx, mfxy, mfxz, mfyx, mfyy, mfyz, mfzx, mfzy, mfzz, rx, ry, rz, sx, sy, sz, gama, voln, dvol, s1, s2, s3, s4, s5, s6, dxx, dyy, dzz, d4, d5, d6, wxx, wyy, wzz)
subroutine smallb3(offg, off, nel, ismstr)
subroutine srota3(sig, s1, s2, s3, s4, s5, s6, wxx, wyy, wzz, nel, mtn, ismstr)
subroutine sstra3(dxx, dyy, dzz, d4, d5, d6, strain, wxx, wyy, wzz, off, nel, jcvt)
subroutine ig3donederiv(itel, n, xxi, yyi, zzi, wwi, idx, idy, idz, knotlocx, knotlocy, knotlocz, drdx, r, detjac, nctrl, gaussx, gaussy, gaussz, kx, ky, kz, px, py, pz, boolg, idx2, idy2, idz2, knotlocelx, knotlocely, knotlocelz)
subroutine srho3(pm, volo, rhon, eint, dxx, dyy, dzz, voln, dvol, mat)
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
subroutine startime(event, itask)
subroutine stoptime(event, itask)