114
115
116
117 USE timer_mod
118 USE output_mod, only : output_
119 USE mmain_mod
121 USE mat_elem_mod
124 USE sensor_mod
126 USE elbufdef_mod
127 USE sdistor_ini_mod, ONLY : sdistor_ini
128 use glob_therm_mod
129 USE s10get_x0_mod, ONLY : s10get_x0
130
131
132
133#include "implicit_f.inc"
134
135
136
137#include "mvsiz_p.inc"
138
139
140
141#include "com01_c.inc"
142#include "com04_c.inc"
143#include "com08_c.inc"
144#include "scr03_c.inc"
145#include "vect01_c.inc"
146#include "parit_c.inc"
147#include "param_c.inc"
148#include "timeri_c.inc"
149#include "scr18_c.inc"
150#include "scr05_c.inc"
151
152
153
154 INTEGER NPE
155 parameter(npe=10)
156
157
158
159 TYPE(TIMER_), INTENT(INOUT) :: TIMERS
160 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
161 INTEGER, INTENT(IN) :: S_SFEM_NODVAR
162 INTEGER, INTENT(INOUT) :: IDEL7NOK
163 INTEGER, INTENT(IN) :: SNPC
164 INTEGER, INTENT(IN) :: STF
165 INTEGER, INTENT(IN) :: SBUFMAT
166 INTEGER, INTENT(IN) :: NSVOIS
167 INTEGER, INTENT(IN) :: IDTMINS
168 INTEGER ,INTENT(IN) :: IDEL7NG
169 INTEGER ,INTENT(IN) :: MAXFUNC
170 INTEGER, INTENT(IN) :: IMPL_S
171 INTEGER, INTENT(IN) :: IDYNA
172 INTEGER, INTENT(IN) :: USERL_AVAIL
173 INTEGER IXS(NIXS,*),IPARG(NPARG,NGROUP),NPF(*),IADS(8,*),
174 . IPARTS(*),IXS10(6,*),IADS10(6,*),IPM(*),ITASK,GRTH(*),
175 . IGRTH(*),IGEO(NPROPGI,*),IOUTPRT,H3D_STRAIN
176 INTEGER NELTST,ITYPTST,OFFSET,NEL,NG,ISTRAIN,ISOLNOD,IEXPAN,ITAGDN(*)
177 DOUBLE PRECISION XDP(3,*)
178
180 my_real pm(npropm,*), geo(npropg,*), x(*), a(*), v(3,*), ms(*), w(*),
181 . flux(6,*),flu1(*), veul(*), fv(*), tf(*),
182 . bufmat(*),partsav(*),stifn(*), fsky(*),eani(*),
183 . ar(*),vr(*) ,dr(*) ,stifr(*),d(*), mssa(*) ,dmels(*)
184 my_real fx(mvsiz,10),fy(mvsiz,10),fz(mvsiz,10),
185 . temp(*), fthe(*), fthesky(*),gresav(*),voln(mvsiz),condn(*),
186 . condnsky(*),sfem_nodvar(s_sfem_nodvar)
187 my_real,
DIMENSION(MVSIZ,6),
INTENT(INOUT) :: svis
188 TYPE(TTABLE) TABLE(*)
189 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
190 TYPE (NLOCAL_STR_) , TARGET :: NLOC_DMG
191 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
192 TYPE (MAT_ELEM_) ,INTENT(INOUT) :: MAT_ELEM
193 TYPE (SENSORS_) ,INTENT(INOUT) :: SENSORS
194 TYPE(DT_) ,INTENT(INOUT) :: DT
195 type (glob_therm_) ,intent(inout) :: glob_therm
196
197
198
199 INTEGER I,J,IP,LCO,NF1,NF2,IFLAG,IOFFS,IPTR,IPTS,IPTT,ILAY,IMAT
200 INTEGER IBID,IBIDON(1),NNEGA,INDEX(MVSIZ),ITET,iel,ISM12_11
201
202 INTEGER MXT(MVSIZ),NGL(MVSIZ),NGEO(MVSIZ)
204 . vd2(mvsiz) , dvol(mvsiz),deltax(mvsiz),
205 . vis(mvsiz) , qvis(mvsiz), cxx(mvsiz) ,deltax2(mvsiz),
206 . s1(mvsiz) , s2(mvsiz) , s3(mvsiz) ,
207 . s4(mvsiz) , s5(mvsiz) , s6(mvsiz) ,
208 . dxx(mvsiz) , dyy(mvsiz) , dzz(mvsiz) ,
209 . d4(mvsiz) , d5(mvsiz) , d6(mvsiz) ,
210 . rx(mvsiz) , ry(mvsiz) , rz(mvsiz) ,
211 . sx(mvsiz) , sy(mvsiz) , sz(mvsiz) ,
212 . vdx(mvsiz), vdy(mvsiz), vdz(mvsiz),ssp_eq(mvsiz),aire(mvsiz),
213 . conde(mvsiz),condeg(mvsiz), volg(mvsiz), jacgm(mvsiz)
214
215
217 . sti(mvsiz),
218 . wxx(mvsiz) , wyy(mvsiz) , wzz(mvsiz),
219 . wxxg(mvsiz) , wyyg(mvsiz) , wzzg(mvsiz)
220
222 . muvoid(mvsiz)
223
224
226 . sigy(mvsiz),et(mvsiz),gama(mvsiz,6),
227 . r1_free(mvsiz),r3_free(mvsiz),r4_free(mvsiz)
228
229 INTEGER NC(MVSIZ,10),ICP,MX,IPLAW1
230
231 double precision
232 . xx(mvsiz,10), yy(mvsiz,10), zz(mvsiz,10),
233 . wxx0(mvsiz) , wyy0(mvsiz) , wzz0(mvsiz),
234 . xx0(mvsiz,10), yy0(mvsiz,10), zz0(mvsiz,10),voldp(mvsiz,5)
235
237 . tx(mvsiz),ty(mvsiz),tz(mvsiz),off(mvsiz),volp(mvsiz,5),
238 . rhoo(mvsiz),offs(mvsiz),them(mvsiz,10),tempel(mvsiz),
239 . vx(mvsiz,10),vy(mvsiz,10),vz(mvsiz,10),
240 . px(mvsiz,10,5),py(mvsiz,10,5),pz(mvsiz,10,5),
241 . nx(mvsiz,10,5),vdxx(mvsiz,10),vdyy(mvsiz,10),vdzz(mvsiz,10),
242 . dxy(mvsiz),dyx(mvsiz),dyz(mvsiz),dzy(mvsiz),
243 . dzx(mvsiz),dxz(mvsiz),
244 . stig(mvsiz), wip(5,5), alph(5,5), beta(5,5),bid(mvsiz),
245 . die(mvsiz), mbid(1),offg0(mvsiz),amu(mvsiz),sum,rho0_1,cns2
248 . e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z
249
251 . vx0(mvsiz,10),vy0(mvsiz,10),vz0(mvsiz,10),
252 . mfxx(mvsiz,5),mfxy(mvsiz,5),mfyx(mvsiz,5),
253 . mfyy(mvsiz,5),mfyz(mvsiz,5),mfzy(mvsiz,5),
254 . mfzz(mvsiz,5),mfzx(mvsiz,5),mfxz(mvsiz,5),divde(mvsiz),
255 . nu(mvsiz),fac(mvsiz),facp(mvsiz),e0(mvsiz),c1,dvm(mvsiz),
256 . visp(mvsiz),facdb,rbid(mvsiz),sigp(nel,6),
257 . fld(mvsiz),sti_c(mvsiz),ll(mvsiz),offg(mvsiz),fqmax
258
259 my_real varnl(nel),deltax4(mvsiz)
260
261 INTEGER IBOLTP,NBPRELD,II(6),ISCTL,ISTAB(MVSIZ)
262 INTEGER SZ_IX
264 . DIMENSION(:), POINTER :: bpreld
265 my_real,
dimension(mvsiz) :: fheat
266
267 TYPE(G_BUFEL_) ,POINTER :: GBUF
268 TYPE(L_BUFEL_) ,POINTER :: LBUF
269
270 DATA wip / 1. ,0. ,0. ,0. ,0. ,
271 2 0. ,0. ,0. ,0. ,0. ,
272 3 0. ,0. ,0. ,0. ,0. ,
273 4 0.25,0.25,0.25,0.25,0. ,
274 5 0.45,0.45,0.45,0.45,-0.8/
275
276
277
278 gbuf => elbuf_tab(ng)%GBUF
279 iboltp = iparg(72,ng)
280 nbpreld = gbuf%G_BPRELD
281 bpreld =>gbuf%BPRELD(1:nbpreld*nel)
282 ism12_11 = elbuf_tab(ng)%BUFLY(1)%L_SIGL
283
284 sz_ix=numelq+numels+nsvois
285 nf1=nft+1
286 nf2=nf1-numels8
287 ibid = 0
288 ibidon = 0
289 ioffs=0
290 ipts = 1
291 iptt = 1
292 ilay = 1
293 IF(isrot == 1) THEN
294 iisrot=1
295 nf2=1
296 END IF
297 icp = iparg(10,ng)
298 DO i=lft,llt
299 offs(i)=ep20
300 END DO
301
302 DO ip=1,3
303 DO j=1,5
304 alph(j,ip)=zero
305 beta(j,ip)=zero
306 END DO
307 END DO
308
309 alph(1,4)=zep5854102
310 alph(2,4)=zep5854102
311 alph(3,4)=zep5854102
312 alph(4,4)=zep5854102
313 alph(5,4)=zero
314 alph(1,5)=half
315 alph(2,5)=half
316 alph(3,5)=half
317 alph(4,5)=half
318 alph(5,5)=fourth
319 beta(1,4)=zep1381966
320 beta(2,4)=zep1381966
321 beta(3,4)=zep1381966
322 beta(4,4)=zep1381966
323 beta(5,4)=zero
324 beta(1,5)=one_over_6
325 beta(2,5)=one_over_6
326 beta(3,5)=one_over_6
327 beta(4,5)=one_over_6
328 beta(5,5)=fourth
329
330 tempel(:) = zero
331 fheat(:) = zero
332 IF (jthe < 0) them(lft:llt,1:10) = zero
333
334 IF (icp==1) THEN
335 mx = ixs(1,nf1)
336 nu(lft:llt)=
min(half,pm(21,mx))
337 facp(lft:llt)=one
338 ELSEIF (icp==2) THEN
339 mx = ixs(1,nf1)
340 nu(lft:llt)=
min(half,pm(21,mx))
341 c1 =pm(32,mx)
342 e0(lft:llt) =three*(one-two*nu(lft:llt))*c1
343 sigp=zero
344 IF (gbuf%G_PLA>0) THEN
345 CALL s8e_sigp(elbuf_tab(ng),sigp, nel)
346 END IF
347 CALL s10sigp3(sigp,e0 ,gbuf%PLA,facp ,gbuf%G_PLA,nel )
348 END IF
349
351 1 x, ixs(1,nf1), ixs10(1,nf2),v,
352 2 w, xx, yy, zz,
353 3 vx, vy, vz, vdxx,
354 4 vdyy, vdzz, vdx, vdy,
355 5 vdz, vd2, vis, gbuf%OFF,
356 6 off, gbuf%SMSTR, nc, ngl,
357 7 mxt, ngeo, fx, fy,
358 8 fz, stig, gbuf%SIG, gbuf%EINT,
359 9 gbuf%RHO, gbuf%QVIS, gbuf%PLA, gbuf%EPSD,
360 a vr, dr, d, wxxg,
361 b wyyg, wzzg, gbuf%G_PLA, xdp,
362 c nel, condeg, gbuf%G_EPSD, jale,
363 d ismstr, jeul, jlag, israt,
364 e isrot)
365
366 iplaw1 = 0
367 cns2 = zero
368 IF (ism12_11>0 .AND.idtmin(1)==3) THEN
369 mx = ixs(1,nf1)
370 rho0_1 =pm( 1,mx)
371 IF (pm(21,mx)>0.49) iplaw1=1
372 IF (iplaw1==1) THEN
373 facdb = one- zep02
374 facdb =
min(facdb,two*pm(21,mx))
375 facp(lft:llt)=facdb
376 visp(lft:llt)=two
377 cns2 = zep02
378 IF (igeo(35,ngeo(1))>0) cns2=cns2-abs(geo(17,ngeo(1)))
379 END IF
380 ELSEIF (ismstr==10.AND.mtn==1) THEN
381 mx = ixs(1,nf1)
382 rho0_1 =pm( 1,mx)
383 IF (pm(21,mx)>0.49) THEN
384 visp(lft:llt)=two
385 cns2 = zep02
386 IF (igeo(35,ngeo(1))>0) cns2=cns2-abs(geo(17,ngeo(1)))
387 END IF
388 END IF
389 isctl = igeo(97,ngeo(1))
390 IF (isrot == 1) isctl = 0
391
393 1 nx, nel, npt)
394 IF(jthe < 0 .AND. isolnod == 4)
CALL s10nxt4(nxt4,nel)
395
396
397
398 IF (ismstr >= 10.AND.ismstr <= 12) THEN
400 1 xx, yy, zz, x,
401 2 xdp, xx0, yy0, zz0,
402 3 vx0, vy0, vz0, gbuf%SMSTR,
403 4 nc, d, gbuf%OFF, offg0,
404 5 nel, mtn, ismstr)
405
406 IF (ismstr == 11) THEN
408 1 volp, deltax, deltax2, xx0,
409 2 yy0, zz0, px, py,
410 3 pz, nx, rx, ry,
411 4 rz, sx, sy, sz,
412 5 tx, ty, tz, wip(1,npt),
413 6 alph(1,npt),beta(1,npt),voln, volg,
414 7 voldp, nel, gbuf%OFF, npt)
416 1 volp, ngl, deltax, deltax2,
417 2 px, py, pz, volg,
418 3 gbuf%VOL, rx, ry, rz,
419 4 sx, sy, sz, tx,
420 5 ty, tz, nc, nel,
421 6 mxt, pm, gbuf%ISMS, gbuf%DT_PITER,
422 7 npt, iint, isrot, iformdt)
423 ELSE
424
425 IF (ismstr == 12.AND.ism12_11==0.AND.idtmin(1)==3) THEN
427 1 gbuf%OFF,x, xdp, nc,
428 2 e1x, e2x, e3x, e1y,
429 3 e2y, e3y, e1z, e2z,
430 4 e3z, nel)
431 END IF
432 ibid = 1
433 DO ip=1,npt
434 lbuf => elbuf_tab(ng)%BUFLY(ibid)%LBUF(ip,ibid,ibid)
435 CALL s10pijto3(px(1,1,ip),py(1,1,ip),pz(1,1,ip),lbuf%PIJ,llt)
436 ENDDO
437 END IF
438 DO ip=1,npt
440 1 px(1,1,ip),py(1,1,ip),pz(1,1,ip),vx0,
441 2 vy0, vz0, mfxx(1,ip),mfxy(1,ip),
442 3 mfxz(1,ip),mfyx(1,ip),mfyy(1,ip),mfyz(1,ip),
443 4 mfzx(1,ip),mfzy(1,ip),mfzz(1,ip),nel)
444 END DO
445 IF (ismstr == 12.AND.ism12_11==0.AND.idtmin(1)==3) THEN
446 DO ip=1,npt
447 CALL sordeft12(lft,llt,mfxx(1,ip), mfxy(1,ip), mfxz(1,ip),
448 . mfyx(1,ip), mfyy(1,ip), mfyz(1,ip),
449 . mfzx(1,ip), mfzy(1,ip), mfzz(1,ip),
450 . e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z,gbuf%OFF)
451 END DO
452 ENDIF
453 ENDIF
454
455 IF (ismstr /= 11) THEN
457 1 off, volp,
458 2 deltax2, xx, yy, zz,
459 3 px, py, pz, nx,
460 4 rx, ry, rz, sx,
461 5 sy, sz, tx, ty,
462 6 tz, wip(1,npt), alph(1,npt),beta(1,npt),
463 7 voln, volg, voldp, nc,
464 8 gbuf%SMSTR, gbuf%OFF, nel, npt,
465 9 ismstr, jlag)
466
468 1 volp, ngl, deltax, deltax2,
469 2 px, py, pz, volg,
470 3 gbuf%VOL, rx, ry, rz,
471 4 sx, sy, sz, tx,
472 5 ty, tz, nc, nel,
473 6 mxt, pm, gbuf%ISMS, gbuf%DT_PITER,
474 7 npt, iint, isrot, iformdt)
475
476 IF (iplaw1>0) THEN
478 . px, py, pz, vx, vy, vz,
479 . dvm ,gbuf%OFF, npt ,nel)
480 END IF
481
482 IF (ismstr == 2 .OR.ismstr ==12) THEN
483 DO ip=1,npt
484 iptr = ip
485 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(iptr,ipts,iptt)
486 DO i=lft,llt
487 IF (gbuf%OFF(i)==two) lbuf%OFF(i)=gbuf%OFF(i)
488 ENDDO
489 ENDDO
490 END IF
491 END IF
492
493
494
495 IF (ismstr <= 3.OR.(ismstr==4.AND.jlag>0)) THEN
497 1 gbuf%OFF, gbuf%SMSTR,nc, xx,
498 2 yy, zz, nel)
499 END IF
500
501 IF (isorth == 0) THEN
502 DO i=lft,llt
503 gama(i,1) = one
504 gama(i,2) = zero
505 gama(i,3) = zero
506 gama(i,4) = zero
507 gama(i,5) = one
508 gama(i,6) = zero
509 ENDDO
510 ELSE
512 1 rx, ry, rz, sx,
513 2 sy, sz, tx, ty,
514 3 tz, e1x, e2x, e3x,
515 4 e1y, e2y, e3y, e1z,
516 5 e2z, e3z, llt)
518 1 rx, ry, rz, sx,
519 2 sy, sz, tx, ty,
520 3 tz, e1x, e2x, e3x,
521 4 e1y, e2y, e3y, e1z,
522 5 e2z, e3z, gbuf%GAMA,gama,
523 6 nel, irep)
524 ENDIF
525 IF(icp >0 .AND. ismstr/=10) THEN
526 DO i=lft,llt
527 IF(gbuf%OFF(i) == zero) cycle
528 sum=sfem_nodvar(nc(i,1))+sfem_nodvar(nc(i,2))+sfem_nodvar(nc(i,3))+sfem_nodvar(nc(i,4))
529 jacgm(i)=fourth*sum
530 ENDDO
531 ENDIF
532
533
534
535 DO ip=1,npt
536 iptr = ip
537 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(iptr,ipts,iptt)
538 IF (ioffs == 1)THEN
539 DO i=lft,llt
540 IF (offs(i)<=two) lbuf%OFF(i)=offs(i)
541 ENDDO
542 END IF
543
545 1 px(1,1,ip),py(1,1,ip),pz(1,1,ip),vx,
546 2 vy, vz, dxx, dxy,
547 3 dxz, dyx, dyy, dyz,
548 4 dzx, dzy, dzz, d4,
549 5 d5, d6, wxx, wyy,
550 6 wzz, volp(1,ip),voln, lbuf%RHO,
551 7 rhoo, nel, jhbe, isrot)
552
553 IF (ismstr == 12.AND.ism12_11==0.AND.idtmin(1)==3) THEN
554 CALL sordef12(lft,llt,dxx, dyy, dzz,
555 . d4, d5, d6,
556 . e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z,offg0)
557 ENDIF
558 IF (icp>0) THEN
559 IF (ismstr==10) THEN
560 DO i=lft,llt
561 IF(gbuf%OFF(i) == zero) cycle
562 jacgm(i)=sfem_nodvar(nc(i,ip))
563 ENDDO
564 END IF
566 1 gbuf%OFF, jacgm, facp, nu,
567 2 mfxx(1,ip), mfxy(1,ip), mfxz(1,ip), mfyx(1,ip),
568 3 mfyy(1,ip), mfyz(1,ip), mfzx(1,ip), mfzy(1,ip),
569 4 mfzz(1,ip), lbuf%VOL, voln, lbuf%VOL0DP,
570 5 voldp(1,ip),nel, ismstr)
571 ENDIF
572
573 divde(1:nel) = dt1*(dxx(1:nel)+ dyy(1:nel)+ dzz(1:nel))
574 IF (iplaw1>0)
CALL s10divde12(dvm ,divde ,facp,gbuf%OFF,nel)
576 1 pm, lbuf%VOL, lbuf%RHO, lbuf%EINT,
577 2 divde, flux(1,nf1),flu1(nf1), voln,
578 3 dvol, ngl, mxt, off,
579 4 0, gbuf%TAG22, voldp(1,ip),lbuf%VOL0DP,
580 5 amu, gbuf%OFF, nel, mtn,
581 6 jale, ismstr, jeul, jlag)
582
583 IF (ismstr == 12.AND.ism12_11==0.AND.idtmin(1)==3) THEN
585 . e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z,offg0)
586!
587
588
589
590 ENDIF
592 1 lbuf%SIG,s1, s2, s3,
593 2 s4, s5, s6, wxx,
594 3 wyy, wzz, nel,
595 4 ismstr)
596
597
598
600 1 gbuf%OFF, off, wxx, wyy,
601 2 wzz, wxxg, wyyg, wzzg,
602 3 wip(ip,npt),nel, ismstr, jlag)
603
604 IF(jthe < 0 ) THEN
605 DO i=lft,llt
606 tempel(i)= zero
607 ENDDO
608 IF(isolnod == 10) THEN
609 DO j = 1,10
610 DO i=lft,llt
611 tempel(i)= tempel(i) + nx(i,j,ip)*temp(nc(i,j))
612 ENDDO
613 ENDDO
614 ELSEIF(isolnod == 4) THEN
615 DO j = 1,4
616 DO i=lft,llt
617 tempel(i)= tempel(i) + nxt4(i,j,ip)*temp(nc(i,j))
618 ENDDO
619 ENDDO
620 ENDIF
621 ENDIF
622
623
624
625 IF ((itask==0).AND.(imon_mat==1))
CALL startime(timers,35)
626
627 IF(iboltp /= 0)
CALL boltst(
628 . ip, bpreld, lbuf%SIG,tt,
629 . nel ,npt ,sensors%NSENSOR,sensors%SENSOR_TAB)
630
631 CALL mmain(timers, output,
632 1 elbuf_tab, ng, pm, geo,
633 2 ale_connect, ixs, iparg,
634 3 v, tf, npf, bufmat,
635 4 sti, x, dt2t, neltst,
636 5 ityptst, offset, nel, w,
637 6 off, ngeo, mxt, ngl,
638 7 voln, vd2, dvol, deltax,
639 8 vis, qvis, cxx, s1,
640 9 s2, s3, s4, s5,
641 a s6, dxx, dyy, dzz,
642 b d4, d5, d6, wxx,
643 c wyy, wzz, rx, ry,
644 d rz, sx, sy, sz,
645 e vdx, vdy, vdz, muvoid,
646 f ssp_eq, aire, sigy, et,
647 g r1_free, lbuf%PLA, r3_free, amu,
648 h mfxx(1,ip), mfxy(1,ip), mfxz(1,ip), mfyx(1,ip),
649 i mfyy(1,ip), mfyz(1,ip), mfzx(1,ip), mfzy(1,ip),
650 j mfzz(1,ip), ipm, gama, bid,
651 k bid, bid, bid, bid,
652 l bid, bid, istrain, tempel,
653 m die, iexpan, ilay, mssa,
654 n dmels, iptr, ipts, iptt,
655 o table, bid, bid, bid,
656 p bid, iparg(1,ng), igeo, conde,
657 q itask, nloc_dmg, varnl, mat_elem,
658 r h3d_strain, jplasol, jsph, mvsiz,
659 * snpc, stf, sbufmat, glob_therm,
660 s svis, sz_ix, iresp,
661 t n2d, th_strain, ngroup, tt,
662 . dt1, ntable, numelq, nummat,
663 . numgeo, numnod, numels,
664 . idel7nok, idtmin, maxfunc,
665 . imon_mat, userl_avail, impl_s,
666 . idyna, dt, fheat ,sensors)
667
668 IF ((itask==0).AND.(imon_mat==1))
CALL stoptime(timers,35)
669
670 IF (ismstr == 12.AND.ism12_11==0.AND.idtmin(1)==3) THEN
672 . e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z,offg0)
673
674!
675
676
677 IF (istrain == 1) THEN
678 CALL sordef12(lft,llt,dxx, dxy, dxz,
679 . d4, d5, d6,
680 . e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z,offg0)
681 ENDIF
682 ENDIF
683 IF (istrain == 1)
CALL sstra3(
684 1 dxx, dyy, dzz, d4,
685 2 d5, d6, lbuf%STRA,wxx,
686 3 wyy, wzz, off, nel,
687 4 jcvt)
688
689 iflag=mod(ncycle,ncpri)
690 IF(ioutprt>0)THEN
691 CALL s10bilan(partsav,lbuf%EINT,lbuf%RHO,lbuf%RK,lbuf%VOL,
692 . vx, vy, vz,nx(1,1,ip),voln,iparts,
693 . gresav,grth,igrth,iexpan,lbuf%EINTTH,
694 . gbuf%FILL,xx,yy,zz,itask,iparg(1,ng),gbuf%OFF,sensors,
695 . nel, elbuf_tab(ng)%BUFLY(ilay)%L_WPLA, lbuf%WPLA)
696 ENDIF
697
698 IF (cns2>zero)
700 . dyy ,dzz ,d4 ,d5 ,d6 ,
701 . lbuf%VOL,rho0_1,sti ,nel ,svis )
702
703
704
706 1 lbuf%SIG, px(1,1,ip), py(1,1,ip), pz(1,1,ip),
707 2 fx, fy, fz, voln,
708 3 qvis, sti, stig, lbuf%EINT,
709 4 lbuf%RHO, lbuf%QVIS, lbuf%PLA, lbuf%EPSD,
710 5 gbuf%EPSD, gbuf%SIG, gbuf%EINT, gbuf%RHO,
711 6 gbuf%QVIS, gbuf%PLA, wip(ip,npt),gbuf%G_PLA,
712 7 nel, conde, condeg, gbuf%G_EPSD,
713 8 israt, svis ,glob_therm%NODADT_THERM)
714
715 DO i=lft,llt
716 IF (lbuf%OFF(i) > one .AND. gbuf%OFF(i) == one) THEN
717
718 offs(i)=
min(lbuf%OFF(i),offs(i))
719 ioffs =1
720 END IF
721 ENDDO
722
723 IF (jthe < 0 .AND. isolnod == 10) THEN
724 imat = mxt(1)
725 IF (mat_elem%MAT_PARAM(imat)%HEAT_FLAG == 1) THEN
727 1 pm, imat, nc, voln,
728 2 px(1,1,ip),py(1,1,ip),pz(1,1,ip),nx(1,1,ip),
729 3 dt1, temp, tempel, fheat,
730 4 them, gbuf%OFF, lbuf%OFF, nel,
731 5 glob_therm%THEACCFACT)
732 ELSE
734 1 pm, imat, nc, voln,
735 2 px(1,1,ip),py(1,1,ip),pz(1,1,ip),nx(1,1,ip),
736 3 dt1, temp, tempel, die,
737 4 them, gbuf%OFF, lbuf%OFF, nel,
738 5 glob_therm%THEACCFACT)
739 END IF
740 ENDIF
741
742 ENDDO
743
744 IF (jthe < 0 .AND. isolnod == 4) THEN
745 imat = mxt(1)
746 IF (mat_elem%MAT_PARAM(imat)%HEAT_FLAG == 1) THEN
748 . xx ,yy ,zz ,dt1 ,fheat ,
749 . temp ,them ,gbuf%OFF ,lbuf%OFF,
750 . glob_therm%THEACCFACT)
751 ELSE
753 . xx ,yy ,zz ,dt1 ,die ,
754 . temp ,them ,gbuf%OFF ,lbuf%OFF,
755 . glob_therm%THEACCFACT)
756 END IF
757 ENDIF
758
759 IF (jlag+jale+jeul /= 0) THEN
760
761
762
764 1 gbuf%SMSTR,gbuf%OFF, wxxg, wyyg,
765 2 wzzg, nel, ismstr, jlag)
766 IF (ioffs == 1)THEN
767 DO i=lft,llt
768
769 IF (offs(i)<=two) gbuf%OFF(i) = offs(i)
770 END DO
771
772 ipts = 1
773 iptt = 1
774 ilay = 1
775 DO ip=1,npt
776 iptr = ip
777 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(iptr,ipts,iptt)
778 DO i=lft,llt
779 IF (gbuf%OFF(i) > one) lbuf%OFF(i)=gbuf%OFF(i)
780 END DO
781 END DO
782 END IF
783
784 itet=1
785 CALL s10mallgeo3(ngl,gbuf%OFF ,volg ,deltax, gbuf%VOL ,
786 . rx , ry , rz ,
787 . sx , sy , sz ,
788 . tx , ty , tz ,deltax4,geo(1,ngeo(1)),
789 . nel,npt,ismstr,isrot,dt)
790 rbid(lft:llt)=zero
791 CALL sgeodel3(ngl,gbuf%OFF,volg,deltax4,gbuf%VOL,geo(1,ngeo(1)),rbid,dt,nel,idel7nok)
792 CALL smallb3(gbuf%OFF,off,nel,ismstr)
793 CALL smallgeo3(ngl, gbuf%OFF ,volg ,deltax4, gbuf%VOL ,itet, nel, ismstr,dt)
794
795 IF (ismstr == 12.AND.idtmin(1)==3) THEN
796 ioffs =0
797 DO i=lft,llt
798 IF(gbuf%OFF(i)/=offg0(i).AND.abs(gbuf%OFF(i)) > one ) ioffs=1
799 ENDDO
800 IF (ioffs == 1) THEN
802 1 gbuf%OFF, offg0, gbuf%SMSTR,nc,
803 2 xx, yy, zz, nel)
804 IF (ism12_11>0 .AND. isorth == 0) THEN
806 1 elbuf_tab(ng),gbuf%OFF, offg0, nc,
807 2 xx, yy, zz, nel,
808 3 npt)
809 END IF
810 ipts = 1
811 iptt = 1
812 ilay = 1
813 DO ip=1,npt
814 iptr = ip
815 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(iptr,ipts,iptt)
816 DO i=lft,llt
817 IF (abs(gbuf%OFF(i)) > one) lbuf%OFF(i)=gbuf%OFF(i)
818 END DO
819 END DO
820 END IF
821 END IF
822
823
824
825 IF (isctl > 0) THEN
826 offg(1:nel) =
min(off(1:nel),abs(gbuf%OFF(1:nel)))
827 CALL sdistor_ini(
828 1 nel ,sti_c ,npropm ,nummat ,
829 2 ismstr ,mxt ,istab ,pm ,
830 3 gbuf%SIG ,gbuf%RHO ,cxx ,offg ,
831 4 gbuf%OFF ,ll ,voln ,fld ,
832 5 cns2 ,fqmax )
833 IF (ismstr>=11)
835 1 x, xdp, dr, numnod,
836 2 xx, yy, zz, nc,
837 3 isrot, iresp, nel )
838 IF (ismstr<10)
839 * CALL s10get_x0(
840 1 nel, numnod, x, xdp,
841 2 d, xx0, yy0, zz0,
842 3 nc)
844 . stig, fld , sti_c,
845 . xx , yy , zz ,
846 . vx , vy , vz ,
847 . fx , fy , fz ,
848 . xx0, yy0, zz0,
849 . cns2, istab, ll ,
850 . fqmax, nel ,gbuf%EINT_DISTOR,
851 . dt1)
852 ENDIF
853
855 1 npe, gbuf%FILL,stig, fx,
856 2 fy, fz, nel)
857
858 IF (iparit == 0) THEN
860 1 gbuf%OFF, a, nc, stifn,
861 2 stig, fx, fy, fz,
862 3 deltax2, them, fthe, ar,
863 4 x, stifr, gbuf%SMSTR,condn,
864 5 condeg, itagdn, nel, ismstr,
865 6 jthe, isrot ,glob_therm%NODADT_THERM)
866 ELSE
868 1 gbuf%OFF, stig, fsky, fsky,
869 2 iads, fx, fy, fz,
870 3 deltax2, iads10, nc, them,
871 4 fthesky, ar, x, gbuf%SMSTR,
872 5 condnsky, condeg, itagdn, nel,
873 6 nft, ismstr, jthe, isrot,glob_therm%NODADT_THERM)
874 ENDIF
875
876 ENDIF
877
878 RETURN
subroutine boltst(ip, bpreld, sig, tt, nel, npt, nsensor, sensor_tab)
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 nsvis_sm12(offg, mu, ssp, vol, d1, d2, d3, d4, d5, d6, vol0, rho0, sti, nel, svis)
subroutine s10_icp(offg, jacg, facp, nu, dxx, dxy, dxz, dyx, dyy, dyz, dzx, dzy, dzz, vol0, voln, vol0dp, voldp, nel, ismstr)
subroutine s10bilan(partsav, eint, rho, rk, vol, vx, vy, vz, nx, vnew, iparts, gresav, grth, igrth, iexpan, eintth, fill, x, y, z, itask, iparg, offg, sensors, nel, l_wpla, wpla)
subroutine s10cumu3(offg, a, nc, stifn, sti, fx, fy, fz, deltax2, them, fthe, ar, x, stifr, sav, condn, conde, itagdn, nel, ismstr, jthe, isrot, nodadt_therm)
subroutine s10cumu3p(offg, sti, fsky, fskyv, iads, fx, fy, fz, deltax2, iads10, nc, them, fthesky, ar, x, sav, condnsky, conde, itagdn, nel, nft, ismstr, jthe, isrot, nodadt_therm)
subroutine s10defo3(px, py, pz, vx, vy, vz, dxx, dxy, dxz, dyx, dyy, dyz, dzx, dzy, dzz, d4, d5, d6, wxx, wyy, wzz, volp, voln, rho, rhoo, nel, jhbe, isrot)
subroutine s10defot3(px, py, pz, vx, vy, vz, dxx, dxy, dxz, dyx, dyy, dyz, dzx, dzy, dzz, nel)
subroutine s10derit3(vol, deltax, deltax2, xx, yy, zz, px, py, pz, nx, rx, ry, rz, sx, sy, sz, tx, ty, tz, wip, alph, beta, voln, volg, voldp, nel, offg, npt)
subroutine s10divde12(dvm, divde, facp, offg, nel)
subroutine s10dvm12(px, py, pz, vx, vy, vz, dvm, offg, npt, nel)
subroutine s10fint3(sig, px, py, pz, fx, fy, fz, vol, qvis, sti, stig, eint, rho, q, eplas, epsd, epsdg, sigg, eintg, rhog, qg, eplasg, wip, g_pla, nel, conde, condeg, g_epsd, israt, svis, nodadt_therm)
subroutine s10for_distor(sti, fld, sti_c, xx, yy, zz, vx, vy, vz, fx, fy, fz, xx0, yy0, zz0, mu, istab, ll, fqmax, nel, e_distor, dt1)
subroutine s10get_x3(x, xdp, dr, numnod, xx, yy, zz, nc, isrot, iresp, nel)
subroutine s10malla3(offg, off, wxx, wyy, wzz, wxxg, wyyg, wzzg, wip, nel, ismstr, jlag)
subroutine s10mallb3(sav, offg, wxx, wyy, wzz, nel, ismstr, jlag)
subroutine s10mallgeo3(ngl, offg, volg, deltax, volg0, rx, ry, rz, sx, sy, sz, tx, ty, tz, lc, geo, nel, npt, ismstr, isrot, dt)
subroutine s10nx3(nx, nel, npt)
subroutine s10nxt4(nx, nel)
subroutine s10pijto3(px, py, pz, pij, nel)
subroutine s10rcoor12(off, x, xdp, nc, r11, r12, r13, r21, r22, r23, r31, r32, r33, nel)
subroutine s10sav12(offg, offg0, sav, nc, xx, yy, zz, nel)
subroutine s10sav3(offg, sav, nc, xx, yy, zz, nel)
subroutine s10sigp3(sig, e0, defp, fac, g_pla, nel)
subroutine s10therm(pm, imat, nc, vol, px, py, pz, ni, dt1, tempnc, tel, heat, fphi, offg, off, nel, theaccfact)
subroutine s10upd11t12(elbuf_tab, offg, offg0, nc, xx, yy, zz, nel, npt)
subroutine s4therm_itet1(pm, imat, nc, nel, xx, yy, zz, dt1, heat, temp, fphi, offg, off, theaccfact)
subroutine s8e_sigp(elbuf_tab, sigp, nel)
subroutine sgcoor10(xx, yy, zz, x, xdp, x0, y0, z0, vx0, vy0, vz0, sav, nc, d, off, off0, nel, mtn, ismstr)
subroutine sgeodel3(ngl, offg, volg, deltax, volg0, geo, l_max, dt, nel, idel7nok)
subroutine smallb3(offg, off, nel, ismstr)
subroutine smallgeo3(ngl, offg, volg, deltax, volg0, itet, nel, ismstr, dt)
subroutine sordef12(jft, jlt, dxx, dyy, dzz, d4, d5, d6, g1x, g1y, g1z, g2x, g2y, g2z, g3x, g3y, g3z, off)
subroutine sordeft12(jft, jlt, mxx, mxy, mxz, myx, myy, myz, mzx, mzy, mzz, g1x, g1y, g1z, g2x, g2y, g2z, g3x, g3y, g3z, off)
subroutine sorthdir3(rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, gama0, gama, nel, irep)
subroutine srota3(sig, s1, s2, s3, s4, s5, s6, wxx, wyy, wzz, nel, mtn, ismstr)
subroutine sroto12_sig(jft, jlt, sig, nel, g1x, g1y, g1z, g2x, g2y, g2z, g3x, g3y, g3z, off)
subroutine sstra3(dxx, dyy, dzz, d4, d5, d6, strain, wxx, wyy, wzz, off, nel, jcvt)
subroutine s10coor3(x, v, ixs, ixs10, xx, yy, zz, vx, vy, vz, nc, ngl, mxt, ngeo, mass, dtelem, sti, sigg, eintg, rhog, qg, temp0, temp, sav, nel, nintemp)
subroutine s10deri3(vol, ngl, xx, yy, zz, px, py, pz, nx, rx, ry, rz, sx, sy, sz, tx, ty, tz, volu, voln, elbuf_str, volg)
subroutine s10len3(vol, ngl, deltax, deltax2, px, py, pz, volu, voln, volg, rx, ry, rz, sx, sy, sz, tx, ty, tz, nel, mxt, pm, v_piter, iint)
subroutine sreploc3(rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
subroutine srho3(pm, volo, rhon, eint, dxx, dyy, dzz, voln, dvol, mat)
subroutine startime(event, itask)
subroutine stoptime(event, itask)
subroutine sxfillopt(npe, fill, sti, fx, fy, fz, nel)
1.15.0