198
199
200
202 USE matparam_def_mod
205 USE multi_fvm_mod
213 USE group_param_mod
217 USE ebcs_mod
220 USE interfaces_mod
221 USE intbufdef_mod
222 USE init_seatbelt_rbodies_mod
223 USE bcs_mod
224 USE sensor_mod
225 USE random_walk_def_mod
226 USE defaults_mod
228 USE elbufdef_mod
229 USE multimat_param_mod , ONLY : m51_lc0max, m51_ssp0max, m51_tcp_ref, m51_lset_iflg6, m51_iflg6, m51_iloop_nrf
230 USE brokmann_random_def_mod
231 USE glob_therm_mod
232 USE damping_range_init_mod
233 USE eikonal_solver_mod, ONLY : eikonal_solver
234 USE detonation_times_printout_mod , ONLY : detonation_times_printout
235 USE s6zinit3_mod
236 USE init_bcs_wall_mod , ONLY : init_bcs_wall
237 USE init_bcs_nrf_mod , ONLY : init_bcs_nrf
238 use init_inivol_mod , only : init_inivol
239 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
240 use init_rwall_penalty_mod , only : init_rwall_penalty
241
242
243
244#include "implicit_f.inc"
245
246
247
248#include "mvsiz_p.inc"
249
250
251
252#include "com01_c.inc"
253#include "com08_c.inc"
254#include "com04_c.inc"
255#include "com_xfem1.inc"
256#include "sphcom.inc"
257#include "vect01_c.inc"
258#include "units_c.inc"
259#include "param_c.inc"
260#include "scr03_c.inc"
261#include "scr14_c.inc"
262#include "scr17_c.inc"
263#include "scr23_c.inc"
264#include "tablen_c.inc"
265#include "lagmult.inc"
266#include "scr12_c.inc"
267#include "fxbcom.inc"
268#include "userlib.inc"
269#include "sms_c.inc"
270#include "boltpr_c.inc"
271#include "titr_c.inc"
272#include "tabsiz_c.inc"
273#include "scry_c.inc"
274
275
276
277 INTEGER,INTENT(IN) :: SKVOL
278 INTEGER IPARG(NPARG,NGROUP), IXS(NIXS,*), IXQ(NIXQ,*),IXC(NIXC,*),
279 . IGEO(NPROPGI,*), IXT(NIXT,*),IXP(NIXP,*), IXR(NIXR,*),
280 . NPBY(NNPBY,*),LPBY(*),NPBYL(NNPBY,*),LPBYL(*),NPC(*),
281 . ITAB(*), IPART(*),
282 . LAS(*),
283 . IXTG(NIXTG,*),INDEX(*),ITRI(*),IWA(*),KXX(NIXX,*),IXX(*),
284 . KXSP(*) ,IXSP(*) ,NOD2SP(*),ISPCOND(*),ISPSYM(*),ISPTAG(*),
285 . ICODE(*),ISKEW(*),ISKN(LISKN,*), IPM(NPROPMI,*), NSHNOD(*),
286 . PTSHEL(*),PTSH3N(*),PTSOL(*),PTQUAD(*),PTSPH(*),
287 . IXS10(*) ,IXS20(*) ,IXS16(*), SH4TREE(*), SH3TREE(*),
288 . IMERGE2(NUMNOD+1),IADMERGE2(NUMNOD+1),
289 . SLNRBM(*) ,NSLNRBM(*),ITAG(*),ITAGEL(*),IRBE2(*) ,LRBE2(*),
290 . ITAGN(*),
291 . IXR_KJ(5,*), SOL2SPH(*), IRST(*),SH3TRIM(*),KXIG3D(NIXIG3D,*),
292 . IXIG3D(*),IGEO_STACK(*),PERTURB(NPERTURB),
293 . NATIV_SMS(*),PTSPRI(*),PTBEAM(*),PTTRUSS(*),STRSGLOB(*),
294 . STRAGLOB(*),ORTHOGLOB(*),ISIGSH,IYLDINI,KSIGSH3,FAIL_INI(5),
295 . IUSOLYLD,IUSER,IDDLEVEL,NBSUBMAT, TAGPRT_SMS(*),SITAGE,FXB_MATRIX_ADD(4,*),
296 . FXB_LAST_ADRESS(*),PTR_NOPT_FXB,R_SKEW(*), NPTS,KNOD2EL1D(*) ,NOD2EL1D(*),
297 . KNOD2ELC(*),NOD2ELC(*)
298 TYPE(T_EBCS_TAB), INTENT(INOUT) :: EBCS_TAB
299 INTEGER,TARGET :: ITAGE(*)
300 INTEGER,POINTER :: ptr_ITAGE
301 INTEGER NSIGI,NSIGSH,
302 . NSIGS, NSIGSPH, FXBIPM(NBIPM,*), FXBELM(*),NSIGRS,
303 . NUMEL,STAT,
304 . NCTRLMAX,NSIGBEAM,NSIGTRUSS
305 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*),SLRBODY
306 INTEGER,INTENT(IN) :: IPARI(NPARI,NINTER)
307 my_real,
INTENT(IN) :: facload(lfacload,*)
309 . elbuf(*), ms(*), in(*), v(*), x(*), geo(*),pm(npropm,*),
310 . rby(nrby,*),pld(*),veul(*),skew(lskew,*),fill(*),
311 . thk(*),bufsf(*), vr(3,*),bufmat(*),ptg(3,*),xlas(*),
312 . dtelem(*),mss(*), msq(*),msc(*),mst(*),msp(*),msr(*),
313 . mstg(*),inc(*),rbyl(nrby,*),
314 . inp(*),inr(*),intg(*),
315 . xelemwa(*),
316 . xframe(nxframe,*),spbuf(*),mssx(*),msnf(*),
317 . mssf(*), wma(*),
318 . vns(*) ,vnsx(*) ,stc(*) ,stt(*) ,stp(*) ,str(*) ,
319 . sttg(*) ,stur(*) ,bns(*) ,bnsx(*) ,
320 . volnod(*) ,bvolnod(*) , etnod(*), stifint(*), fxbdep(*),
321 . fxbvit(*), fxbacc(*), fxbrpm(*), fxbsig(*), fxbmod(*),
322 . ins(*), mcp(*),temp(*),rmstifn(*), rmstifr(*),
323 . ms_layer(*),zi_layer(*), mcpc(*), mcptg(*),
324 . mbufel(lbufel,*), mdepl(3*numnod,*),
325 . xrefc(4,3,*),xreftg(3,3,*),xrefs(8,3,*), mssa(*), msrt(*),
326 . kvol(nbsubmat,*),totaddmas,msz2(*),
327 . msig3d(*),knot(*),wige(*),rnoise(*),
328 . sh4ang(*),sh3ang(*),geo_stack(*),stifintr(*),
329 . strc(*),
strr(*),strp(*),strtg(*),sigi(nsigs,*),sigsh(
max(1,nsigsh),*),
330 . sigsp(nsigi,*),sigsph(nsigsph,*),sigrs(nsigrs,*),sigbeam(nsigbeam,*),
331 . sigtruss(nsigtruss,*),totmas, knotlocpc(*),knotlocel(*),vnige(*),bnige(*),
332 . fxbglm(*),fxbcpm(*),fxbcps(*),fxblm(*),fxbfls(*),fxbdls(*),fxb_matrix(*),
333 . rby_iniaxis(7,*),alea(*),dr(sdr)
334
335 my_real,
DIMENSION(NUMNOD*2),
TARGET :: stifn
336 my_real ,
DIMENSION(:),
POINTER :: stifr
337
338 INTEGER NOM_OPT(LNOPT1,*),PTR_NOPT_RBE2,PTR_NOPT_ADM,PTR_NOPT_FUN,IOPT
339 INTEGER FXBNOD(*), FXANI(2,*),ITAGND(*)
340 INTEGER,INTENT(IN) :: NPRELOAD_A
341 INTEGER,INTENT(IN) :: NDAMP_FREQ_RANGE
342 my_real,
INTENT(IN) :: dampr(nrdamp,ndamp)
343 INTEGER,INTENT(IN) :: IBEAM_VECTOR(NUMELP)
344 my_real,
INTENT(IN) :: rbeam_vector(3,numelp)
345 INTEGER,INTENT(IN) :: IKINE(3*NUMNOD)
346 INTEGER,INTENT(IN) :: LSIGI
347 INTEGER,INTENT(IN) :: LSIGSP
348 INTEGER,INTENT(IN) :: SRNOISE
349
350 INTEGER,INTENT(IN) :: SLN_PEN
351 INTEGER, DIMENSION(NNPRW*NRWALL),INTENT(IN) :: NPRW
352 INTEGER, DIMENSION(SLPRW),INTENT(IN) :: LPRW
353 my_real,
DIMENSION(SLN_PEN),
INTENT(INOUT) :: rwstif_pen
354
355 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
356 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP,NXEL) :: XFEM_TAB
357 TYPE (STACK_PLY) :: STACK
358 TYPE () :: MULTI_FVM
359 TYPE (INIMAP1D_STRUCT), DIMENSION(NINIMAP1D), INTENT(INOUT) :: INIMAP1D
360 TYPE (INIMAP2D_STRUCT), DIMENSION(NINIMAP2D), INTENT(INOUT) :: INIMAP2D
361 TYPE (FUNC2D_STRUCT), DIMENSION(NFUNC2D), INTENT(IN) :: FUNC2D
362 TYPE (FVM_INIVEL_STRUCT), INTENT(IN) :: FVM_INIVEL(*)
363 TYPE (NLOCAL_STR_) :: NLOC_DMG
364 TYPE (GROUP_PARAM_), DIMENSION(NGROUP) :: GROUP_PARAM_TAB
365 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
366
367 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
368 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
369 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
370 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
371 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
372 TYPE (GROUP_) , DIMENSION(NGRPART) :: IGRPART
373 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
374 TYPE (ADMAS_) , DIMENSION(NODMAS) :: IPMAS
375 TYPE (INIVOL_STRUCT_) , DIMENSION(NUM_INIVOL) :: INIVOL
376 TYPE (DETONATORS_STRUCT_) :: DETONATORS
377 TYPE (DRAPE_) , DIMENSION(NUMELC_DRAPE + NUMELTG_DRAPE):: DRAPE
378 TYPE (DRAPEG_) :: DRAPEG
379 TYPE (t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
380 TYPE (INTBUF_STRUCT_) , INTENT(IN ) :: INTBUF_TAB()
381 TYPE (INTERFACES_) , INTENT(INOUT ) :: INTERFACES
382 TYPE (PREL1D_) , INTENT(IN) ,DIMENSION(NPRELOAD_A) :: PRELOAD_A
383 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
384 TYPE (FAIL_FRACTAL_) ,INTENT(IN) :: FAIL_FRACTAL
385 TYPE (FAIL_BROKMANN_) ,INTENT(IN) :: FAIL_BROKMANN
386 TYPE (DEFAULTS_) ,INTENT(IN) :: DEFAULTS
387 type (glob_therm_) ,intent(inout) ::
388
389
390
391
392
393 INTEGER (KIND=8), DIMENSION(:,:), ALLOCATABLE :: I8MI
394 INTEGER NG, NEL, NVC, K, N, M, NSL, NN1, NN2, NN3, I, K0,NV46,
395 . ISPH, J, IG, OFFSET,ISOLNOD,IPROP,IGTYP,
396 . I15A,I15B,I15C,I15D,I15E,I15F,I15G,I15H,I15I,I15J,I15K,I15ATH,
397 . I15L,NC1_OLD, NC2_OLD, NC3_OLD, NC4_OLD,
398 . NC5_OLD, NC6_OLD, NC7_OLD, NC8_OLD,
399 . NC1, NC2, NC3, NC4, NC5, NC6, NC7, NC8,
400 . IINT, ISENS,ITHK, IHBE, JHBE, ILEV,ISH3N,
401 . KK1, KK2, KK3,IADUIX,IADUX ,IADUV ,IADUVR,IADUMS,
402 . IADUIN,IADUSM,IADUSR,IADUMV,IADURV, NUVAR,ICNOD, RBYID,
403 . ADRRPM,ALM,ASIG,NELS,NELC,NELTG,AMOD,NBNO,NME,NML,ARPM,LVSIG,
404 . IFILE,IRCS,NELT,NELP,FXBID, ANOD, IRCM, NSNI, NSN, NMANI, IMIN, IMAX,
405 . NELEMR,CPT_ELTENS,IXFEM,ITG,ISUBSTACK,NCTRL, ITETRA10, KK,PX,PY,PZ,IPID
406
407 INTEGER SOLMAT(0:MAXLAW), COQMAT(0:MAXLAW), TRUMAT(0:MAXLAW),
408 . POUMAT(0:MAXLAW),SPHMAT(0:MAXLAW),
409 . RESMAT(0:MAXLAW),RESPID(0:50), SPHPID(0:50),
410 . SOLPID(0:50), COQPID(0:52), TRUPID(0:50), POUPID(0:50)
411 INTEGER II,NINDX,FLAG_KJ
412
413 INTEGER IBOLTP
414 my_real dt2s, b1, b2, b3, b6, b5, b9, xg, yg, zg, xx, yy, zz, xy, xz, yz,
dtnoda,fill_ratio
415 my_real,
DIMENSION(:),
ALLOCATABLE ::
416 . mbufel_tmp, mdepl_tmp,partsav,mcps,mcpsx,
417 . ms_layerc,zi_layerc, msz2c,zply,partsav1_pon,mcpp
418
419 INTEGER, DIMENSION(:), ALLOCATABLE :: IRIG_NODE, CONNEC
420 my_real,
DIMENSION(:),
ALLOCATABLE :: part_area,ele_area
421
423 INTEGER ID,ISTOT, NF1,NNOD,NSROT,IDRAPE,ICPRE
424 CHARACTER(LEN=NCHARTITLE)::TITR
425 LOGICAL :: ERROR_THROWN
426 INTEGER,INTENT(IN) :: NOD2ELTG(3*NUMELTG)
427 INTEGER,INTENT(IN) :: NOD2ELQ(3*NUMELQ)
428 INTEGER,INTENT(IN) :: NOD2ELS(3*NUMELS)
429 INTEGER,INTENT(IN) :: KNOD2ELTG(NUMNOD+1)
430 INTEGER,INTENT(IN) :: KNOD2ELQ(NUMNOD+1)
431 INTEGER,INTENT(IN) :: KNOD2ELS(NUMNOD+1)
432
433
434
435 TYPE(G_BUFEL_) ,POINTER :: GBUF
436 TYPE(BUF_MAT_) ,POINTER :: MBUF
437
439 INTEGER UEL2SYS
440
442 integer*8 i8_deuxp43
443 data i8_deuxp43 /'80000000000'x/
444 r8_deuxm43 = 1.d00 / i8_deuxp43
445
446
447 DATA solpid/1,0,0,0,0,0,1,0,0,0,0,
448 1 0,0,0,1,1,0,0,0,0,1,
449 2 1,1,0,0,0,0,0,0,1,0,
450 3 0,0,0,0,0,0,0,0,0,0,
451 4 0,0,1,0,0,0,0,0,0,0/
452 DATA coqpid/1,1,0,0,0,0,0,1,0,1,1,
453 1 1,0,0,0,0,1,1,0,1,0,
454 2 0,0,0,0,0,0,0,0,0,0,
455 3 0,0,0,0,0,0,0,0,0,0,
456 4 0,0,0,0,0,0,0,0,0,0,
457 5 1,1/
458 DATA trupid/0,0,1,0,0,0,0,0,0,0,0,
459 1
460 2 0,0,0,0,0,0,0,0,0,0,
461 3 0,0,0,0,0,0,0,0,0,0,
462 4 0,0,0,0,0,0,0,0,0,0/
463 DATA poupid/0,0,0,1,0,0,0,0,0,0,0,
464 1 0,0,0,0,0,0,0,1,0,0,
465 2 0,0,0,0,0,0,0,0,0,0,
466 3 0,0,0,0,0,0,0,0,0,0,
467 4 0,0,0,0,0,0,0,0,0,0/
468 DATA respid/0,0,0,0,1,0,0,0,1,0,0,
469 1 0,1,1,0,0,0,0,0,0,0,
470 2 0,0,1,0,1,1,1,0,1,1,
471 3 1,1,1,0,1,1,0,0,0,0,
472 4 0,0,0,1,1,1,0,0,0,0/
473 DATA sphpid/0,0,0,0,0,0,0,0,0,0,0,
474 1 0,0,0,0,0,0,0,0,0,0,
475 2 0,0,0,0,0,0,0,0,0,0,
476 3 0,0,0,1,0,0,0,0,0,0,
477 4 0,0,0,0,0,0,0,0,0,0/
478
479
480 m51_iloop_nrf = 0
481 nvc = 0
482 stat = 0
483
484 IF(ipari0==3)THEN
485 ALLOCATE (i8mi(6,numnod) ,stat=stat)
486 ELSE
487 ALLOCATE (i8mi(6,1) ,stat=stat)
488 ENDIF
489
490 ALLOCATE (partsav(20*npart) ,stat=stat)
491
492 stifr => stifn(numnod+1:numnod*2)
493 ALLOCATE (partsav1_pon(npart) ,stat=stat)
494
495 IF(npreload > 0) THEN
496 ALLOCATE (vpreload(7*numels) ,stat=stat)
497 ENDIF
498
499 IF (npart > 0) partsav= zero
500 IF (npart > 0) partsav1_pon=zero
501 IF (npreload > 0 .AND. numels > 0) vpreload = zero
502
503 itg = 0
504 IF(icrack3d > 0)itg = 1 + numelc
505
506
507 error_thrown = .false.
508
509 anim_m=0
510 DO i=1,mx_ani
511 anim_n(i)=0
512 anim_v(i)=0
513 anim_ce(i)=0
514 anim_ct(i)=0
515 anim_se(i)=0
516 anim_st(i)=0
517 anim_fe(i)=0
518 anim_ft(i)=0
519 ENDDO
520 nn_ani=0
521 nv_ani=0
522 nce_ani=0
523 nct_ani=0
524 nse_ani=0
525 nst_ani=0
526 nfe_ani=0
527 nindx = 0
528
529 IF(irigid_mat > 0 ) THEN
530 nelemr = numelc + numels10 + numels8 + numeltg
531 ALLOCATE(irig_node(numnod))
532 ALLOCATE(connec(nelemr*10))
533 irig_node = 0
534 connec = 0
535 ELSE
536 ALLOCATE(connec(0),irig_node(0))
537 ENDIF
538
539
540
541 IF(iplyxfem> 0 ) THEN
542 ALLOCATE(ms_layerc(nplymax*numelc))
543 ALLOCATE(zi_layerc(nplymax*numelc))
544 ALLOCATE(msz2c(numelc))
545 ALLOCATE(zply(nplymax))
546 ms_layerc = zero
547 zi_layerc = zero
548 msz2c = zero
549 zply = zero
550 ELSE
551 ALLOCATE(ms_layerc(0))
552 ALLOCATE(zi_layerc(0))
553 ALLOCATE(msz2c(0))
554 ALLOCATE(zply(0))
555 ENDIF
556
557
558
559 IF(ipari0 == 3)THEN
560 DO n=1,numnod
561 i8mi(1,n) = 0
562 i8mi(2,n) = 0
563 i8mi(3,n) = 0
564 i8mi(4,n) = 0
565 i8mi(5,n) = 0
566 i8mi(6,n) = 0
567 ENDDO
568 ENDIF
569 DO n=0,maxlaw
570 solmat(n) = 1
571 coqmat(n) = 0
572 trumat(n) = 0
573 poumat(n) = 0
574 sphmat(n) = 0
575 resmat(n) = 0
576 ENDDO
577 DO n=51,maxlaw
578 solmat(n) = 0
579 ENDDO
580 solmat(15) = 0
581 solmat(19) = 0
582 solmat(25) = 1
583 solmat(27) = 0
584 solmat(32) = 0
585 solmat(43) = 0
586
587
588 solmat(53) = 1
589 solmat(51) = 1
590 solmat(52) = 1
591 solmat(56) = 1
592 solmat(59) = 1
593 solmat(60) = 1
594 solmat(61) = 0
595 solmat(62) = 1
596 solmat(65) = 1
597 solmat(66) = 1
598 solmat(67) = 1
599 solmat(68) = 1
600 solmat(69) = 1
601 solmat(70) = 1
602 solmat(71) = 1
603 solmat(72) = 1
604 solmat(74) = 1
605 solmat(75) = 1
606 solmat(76) = 1
607 solmat(77) = 1
608 solmat(78) = 1
609 solmat(79) = 1
610 solmat(80) = 1
611 solmat(81) = 1
612 solmat(82) = 1
613 solmat(83) = 1
614 solmat(84) = 1
615 solmat(88) = 1
616 solmat(92) = 1
617 solmat(90) = 1
618 solmat(93) = 1
619 solmat(94) = 1
620 solmat(95) = 1
621 solmat(96) = 1
622 solmat(97) = 1
623 solmat(99) = 1
624 solmat(100)= 1
625 solmat(101)= 1
626 solmat(102)= 1
627 solmat(103)= 1
628 solmat(104)= 1
629 solmat(105)= 1
630 solmat(106)= 1
631 solmat(107)= 1
632 solmat(109)= 1
633 solmat(111)= 1
634 solmat(112)= 1
635 solmat(115)= 1
636 solmat(116)= 1
637 solmat(117)= 1
638 solmat(120)= 1
639 solmat(121)= 1
640 solmat(122)= 1
641 solmat(124)= 1
642 solmat(125)= 1
643 solmat(127)= 1
644 solmat(134)= 1
645 solmat(151)= 1
646 solmat(187)= 1
647 solmat(190)= 1
648 solmat(200)= 1
649
650 coqmat(0) = 1
651 coqmat(1) = 1
652 coqmat(2) = 1
653 coqmat(7 ) = 1
654 coqmat(13) = 1
655 coqmat(15) = 1
656 coqmat(19) = 1
657 coqmat(22) = 1
658 coqmat(25) = 1
659 coqmat(27) = 1
660 coqmat(29) = 1
661 coqmat(30) = 1
662 coqmat(31) = 1
663 coqmat(32) = 1
664 coqmat(34) = 1
665 coqmat(35) = 1
666 coqmat(36) = 1
667 coqmat(42) = 1
668 coqmat(43) = 1
669 coqmat(44) = 1
670 coqmat(45) = 1
671 coqmat(48) = 1
672 coqmat(52) = 1
673 coqmat(55) = 1
674 coqmat(56) = 1
675 coqmat(57) = 1
676 coqmat(58) = 1
677 coqmat(60) = 1
678 coqmat(62) = 1
679 coqmat(63) = 1
680 coqmat(64) = 1
681 coqmat(65) = 1
682 coqmat(66) = 1
683 coqmat(69) = 1
684 coqmat(71) = 1
685 coqmat(72) = 1
686 coqmat(73) = 1
687 coqmat(76) = 1
688 coqmat(78) = 1
689 coqmat(80) = 1
690 coqmat(82) = 1
691 coqmat(85) = 1
692 coqmat(86) = 1
693 coqmat(87) = 1
694 coqmat(88) = 1
695 coqmat(91) = 1
696 coqmat(92) = 0
697 coqmat(93) = 1
698 coqmat(94) = 0
699 coqmat(96) = 1
700 coqmat(98) = 1
701 coqmat(99) = 1
702 coqmat(104) = 1
703 coqmat(107) = 1
704 coqmat(109) = 1
705 coqmat(110) = 1
706 coqmat(112) = 1
707 coqmat(119) = 1
708 coqmat(121) = 1
709 coqmat(122) = 1
710 coqmat(125) = 1
711 coqmat(151) = 1
712 coqmat(158) = 1
713 coqmat(200) = 1
714
715 trumat(0) = 1
716 trumat(1) = 1
717 trumat(2) = 1
718 trumat(34) = 1
719 trumat(44) = 1
720
721 poumat(0) = 1
722 poumat(1) = 1
723 poumat(2) = 1
724 poumat(34) = 1
725 poumat(36) = 1
726 poumat(44) = 1
727 poumat(71) = 1
728
729 sphmat(1) = 1
730 sphmat(2) = 1
731 sphmat(3) = 1
732 sphmat(4) = 1
733 sphmat(5) = 1
734 sphmat(6) = 1
735 sphmat(10) = 1
736 sphmat(12) = 1
737 sphmat(18) = 1
738 sphmat(21) = 1
739 sphmat(22) = 1
740 sphmat(23) = 1
741 sphmat(24) = 1
742 sphmat(28) = 1
743 sphmat(29) = 1
744 sphmat(30) = 1
745 sphmat(31) = 1
746 sphmat(32) = 1
747 sphmat(33) = 1
748 sphmat(34) = 1
749 sphmat(35) = 1
750 sphmat(36) = 1
751 sphmat(38) = 1
752 sphmat(40) = 1
753 sphmat(41) = 1
754 sphmat(42) = 1
755 sphmat(49) = 1
756 sphmat(50) = 1
757 sphmat(53) = 1
758
759 sphmat(66) = 1
760 sphmat(70) = 1
761 sphmat(72) = 1
762 sphmat(75) = 1
763 sphmat(76) = 1
764 sphmat(79) = 1
765 sphmat(81) = 1
766 sphmat(88) = 1
767 sphmat(90) = 1
768 sphmat(92) = 1
769 sphmat(93) = 1
770 sphmat(94) = 1
771 sphmat(97) = 1
772 sphmat(102)= 1
773 sphmat(103)= 1
774 sphmat(111)= 1
775 sphmat(105)= 1
776 resmat(54) = 1
777
778 i15ath = 1+lipart1*npart+lipart1*nthpart
779 i15a = i15ath+2*9*npart+2*9*nthpart
780 i15b = i15a+numels
781 i15c = i15b+numelq
782 i15d = i15c+numelc
783 i15e = i15d+numelt
784 i15f = i15e+numelp
785 i15g = i15f+numelr
786 i15h = i15g
787 i15i = i15h+numeltg
788 i15j = i15i+numelx
789 i15k = i15j+numsph
790 i15l = i15k+numelig3d
791
792
793
794
795 CALL checkmp(numels,ixs,nixs,nixs-1,nixs,solmat,solpid,ipm,igeo,'brick
' ,IPART(I15A))
796 CALL CHECKMP(NUMELQ,IXQ,NIXQ,NIXQ-1,NIXQ,SOLMAT,SOLPID,IPM,IGEO,'quad' ,IPART(I15B))
797 CALL CHECKMP(NUMELC,IXC,NIXC,NIXC-1,NIXC,COQMAT,COQPID,IPM,IGEO,'shell' ,IPART(I15C))
798 CALL CHECKMP(NUMELTG,IXTG,NIXTG,NIXTG-1,NIXTG,COQMAT,COQPID,IPM,IGEO,'shell3n',IPART(I15H))
799 CALL CHECKMP(NUMELT,IXT,NIXT,NIXT-1,NIXT,TRUMAT,TRUPID,IPM,IGEO,'truss' ,IPART(I15D))
800 CALL CHECKMP(NUMELP,IXP,NIXP,NIXP-1,NIXP,POUMAT,POUPID,IPM,IGEO,'beam' ,IPART(I15E))
801 CALL CHECKMP(NUMELR,IXR,NIXR, 1,NIXR,-1 ,RESPID,IPM,IGEO,'spring' ,IPART(I15F))
802 CALL CHEKMP2(NUMSPH,IPART ,IPART(I15J),KXSP,NISP,NISP,SPHMAT,SPHPID,IPM,IGEO,'sphcel')
803
804
805
806
807 IF(BCS%NUM_WALL > 0)THEN
808 CALL INIT_BCS_WALL(IGRNOD,NGRNOD,NUMNOD,ALE_CONNECTIVITY,MULTI_FVM,
809 . IXS,NIXS,NUMELS, IXQ,NIXQ,NUMELQ, IXTG,NIXTG,NUMELTG, N2D,
810 . NGROUP,NPARG,IPARG,IPRI)
811 ENDIF
812
813
814
815 IF(BCS%NUM_NRF > 0)THEN
816 CALL INIT_BCS_NRF(IGRNOD,NGRNOD,NUMNOD,MULTI_FVM,
817 . IXS,NIXS,NUMELS, IXQ,NIXQ,NUMELQ, IXTG,NIXTG,NUMELTG, N2D,
818 . NGROUP,NPARG,IPARG,IPRI,ITAB,NUMMAT, MAT_PARAM)
819 ENDIF
820
821
822
823 IF (NPRELOAD > 0) THEN
824 CALL INIBOLTPREL(IXS,IPRELOAD ,PRELOAD ,VPRELOAD, IFLAG_BPRELOAD)
825 ENDIF
826
827
828
829
830.AND. IF (NUMSPH/=0NSPCOND/=0)
831 . CALL INSPCND(ISPCOND ,IGRNOD ,KXSP ,IXSP ,
832 . NOD2SP ,ITAB ,ICODE ,ISKEW ,ISKN ,
833 . SKEW ,XFRAME ,X ,ISPSYM ,ISPTAG ,
834 . PM ,GEO ,IPART ,IPART(I15J))
835
836
837
838 IF (N_SEATBELT > 0) CALL INI_SEATBELT(IPARG,ELBUF_TAB,KNOD2EL1D,NOD2EL1D,IXR,
839 . X,ITAB,IPM,ALEA,KNOD2ELC,
840 . NOD2ELC,IXC)
841
842
843
844
845
846
847
848 IF (GLOB_THERM%ITHERM_FE > 0 ) THEN
849 ALLOCATE(MCPS(8*NUMELS))
850 MCPS = ZERO
851.OR..OR. IF(NUMELS10 > 0NUMELS16 > 0 NUMELS20 > 0)THEN
852 ALLOCATE(MCPSX(12*NUMELS))
853 MCPSX = ZERO
854 ENDIF
855 ALLOCATE(MCPP(NUMELP))
856 MCPP = ZERO
857 ELSE
858 ALLOCATE(MCPSX(0), MCPS(0), MCPP(0))
859 ENDIF
860
861.OR. IF ((IMASADD > 0)(NLOC_DMG%IMOD > 0)) THEN
862 ALLOCATE(PART_AREA(NPART) ,STAT=stat)
863 PART_AREA(1:NPART) = ZERO
864 ALLOCATE(ELE_AREA(NUMELC+NUMELTG) ,STAT=stat)
865 ELE_AREA(1:NUMELC+NUMELTG) = ZERO
866 ELSE
867 ALLOCATE(PART_AREA(1),ELE_AREA(1))
868 END IF
869
870 WRITE(IOUT,'(//)')
871 DT2S=1.E6
872 CPT_ELTENS = 0
873
874 DO NG=1,NGROUP
875 MTN=IPARG(1,NG)
876 NEL=IPARG(2,NG)
877 NFT=IPARG(3,NG)
878 IAD=IPARG(4,NG)
879 ITY=IPARG(5,NG)
880 NPT=IPARG(6,NG)
881 JALE=IPARG(7,NG)
882 ISMSTR=IPARG(9,NG)
883 JEUL =IPARG(11,NG)
884 JTUR =IPARG(12,NG)
885 JTHE =IPARG(13,NG)
886 JLAG =IPARG(14,NG)
887 ISH3N =IPARG(23,NG)
888 JMULT =IPARG(20,NG)
889 JPOR =IPARG(27,NG)
890 ISOLNOD = IPARG(28,NG)
891 USER_GRP_DOMAIN = IPARG(32,NG)+1
892 IGTYP = IPARG(38,NG)
893 ISRAT = IPARG(40,NG)
894 ISORTH = IPARG(42,NG)
895 ISROT = IPARG(41,NG)
896 IDRAPE = IPARG(92,NG)
897 IF(ISOLNOD == 10) ISROT = IPARG(74,NG)
898 IEXPAN = IPARG(49,NG)
899 ISHXFEM_PLY = IPARG(50,NG)
900 IF (ICRACK3D == 0) THEN
901 IPARG(54,NG) = 0
902 END IF
903 IXFEM = IPARG(54,NG)
904 ISUBSTACK = IPARG(71,NG)
905 IBOLTP = IPARG(72,NG)
906 IFORMDT = IPARG(73,NG)
907 JCLOS=0
908 ISTOT = 0
909.AND..AND. IF (ITY==1(ISMSTR>=10ISMSTR<=12)) ISTOT = 1
910.OR. IF (ITY == 3ITY == 7) THEN
911
912 NC1_OLD = 0
913 NC2_OLD = 0
914 NC3_OLD = 0
915 NC4_OLD = 0
916 ELSEIF (ITY == 1) THEN
917
918 NC1_OLD = 0
919 NC2_OLD = 0
920 NC3_OLD = 0
921 NC4_OLD = 0
922 NC5_OLD = 0
923 NC6_OLD = 0
924 NC7_OLD = 0
925 NC8_OLD = 0
926.AND..OR. IF((ISOLNOD == 4 ISROT==2)
927.AND..OR. . (ISOLNOD == 10ISROT==1)
928.AND. . (ISOLNOD == 10ISROT==3))THEN
929 ISROT = 0
930 IPARG(41,NG) = 0
931 ENDIF
932 ENDIF
933.AND. IF((NUMELS/=0) (N2D/=0))THEN
934 CALL ANCMSG(MSGID=603, MSGTYPE=MSGERROR, ANMODE=ANINFO_BLIND_2)
935 END IF
936
937
938
939
940
941.AND..AND..or. IF ((MTN == 0 IGTYP /= 52 IGTYP /= 51)
942.and..or..or. . (IGTYP == 0 (ITY == 1 ITY == 3 ITY == 7)) ) THEN
943 LFT=1
944 LLT=NEL
945 NFT = IPARG(3,NG)
946 IHBE=IPARG(23,NG)
947 ISOLNOD = IPARG(28,NG)
948 ILEV=IPARG(45,NG)
949
950 CALL INIVOID(ELBUF_TAB(NG),
951 1 IXC ,IXS ,IXTG ,X ,V ,
952 2 PM ,GEO ,MS ,IN ,PTG ,
953 3 MSC ,MSS ,MSTG ,INC ,INTG ,
954 4 THK(1+NFT) ,THK(1+NFT+NUMELC),PARTSAV,IPART(I15A),
955 5 IPART(I15C),IPART(I15H),VEUL ,DTELEM ,IHBE ,
956 6 ISOLNOD ,NVC ,I8MI ,MSNF ,MSSF ,
957 7 IGEO ,ETNOD ,NSHNOD ,STC ,STTG ,
958 8 WMA ,SH4TREE ,SH3TREE ,MCP ,MCPC ,
959 9 TEMP ,MCPS ,XREFC ,XREFTG ,XREFS ,
960 A MSSA ,VOLNOD ,BVOLNOD ,VNS ,BNS ,
961 B SH3TRIM ,ISUBSTACK ,STACK ,RNOISE ,PERTURB ,
962 C ELE_AREA ,PART_AREA ,IPART(I15D),IXT ,IPART(I15E),
963 D IXP ,MST ,MSP ,STT ,STP ,
964 E STRP ,INP ,STIFINT ,MCPP ,INR ,
965 F MSR ,MSRT ,STR ,IPART(I15F),ITAB ,
966 G IXR , IMERGE2 ,IADMERGE2 ,NEL ,DEFAULTS ,
967 H GLOB_THERM,IBEAM_VECTOR,RBEAM_VECTOR)
968
969 ELSEIF( MTN == 13) THEN
970
971 LFT=1
972 LLT=NEL
973 NFT = IPARG(3,NG)
974 IHBE=IPARG(23,NG)
975 ISOLNOD = IPARG(28,NG)
976 ILEV=IPARG(45,NG)
977
978 CALL INIRIG_MAT(
979 1 IXC ,IXS ,IXTG ,IXS10 ,X ,
980 2 V ,PM ,GEO ,MS ,IN ,
981 3 PTG ,MSC ,MSS ,MSTG ,INC ,
982 4 INTG ,THK(1+NFT) ,THK(1+NFT+NUMELC),PARTSAV,IPART(I15A),
983 5 IPART(I15C),IPART(I15H),VEUL ,DTELEM ,IHBE ,
984 6 ISOLNOD ,NVC ,I8MI ,MSNF ,MSSF ,
985 7 IGEO ,ETNOD ,NSHNOD ,STC ,STTG ,
986 8 WMA ,SH4TREE ,SH3TREE ,MCP ,MCPC ,
987 9 TEMP ,MCPS ,MSSX ,MCPSX ,INS ,
988 A STIFN ,STIFR ,CONNEC ,IRIG_NODE ,NELEMR ,
989 B NINDX ,XREFC ,XREFTG ,XREFS ,MSSA ,
990 C SH3TRIM ,ISUBSTACK ,BUFMAT ,IPM ,STACK ,
991 D RNOISE ,STRC ,STRTG ,PERTURB ,NEL ,
992 E GROUP_PARAM_TAB(NG) ,IGTYP ,DEFAULTS ,GLOB_THERM)
993
994 ELSE
995
996 LFT=1
997 LLT=NEL
998 OFFSET=0
999 NFT = IPARG(3,NG)
1000 JSPH=0
1001 JCVT=0
1002 NF1 = NFT + 1
1003 !----------------------------------------!
1004 ! ITY == 1 3D-SOLIDS !
1005 !----------------------------------------!
1006 IF (ITY == 1) THEN
1007 GBUF => ELBUF_TAB(NG)%GBUF
1008 IF (IUSOLYLD == 1 ) THEN
1009 CALL SCALEINI(
1010 . ELBUF_TAB(NG), IXS , SIGSP ,SIGI , NSIGI,
1011 . NEL ,LFT , LLT ,NFT , NSIGS,
1012 . PTSOL ,IGEO )
1013 ENDIF
1014.AND..OR. IF (ISOLNOD == 4(ISROT==0ISROT==3))THEN
1015 IF (MULTI_FVM%IS_USED) THEN
1016 CALL MULTIFLUID_INIT3T(ELBUF_TAB(NG),
1017 . NEL, NSIGS, NSIGI, IXS, IGEO, IPM, IPARG, ALE_CONNECTIVITY, IPART(I15A), PTSOL,
1018 . NPC, IPART, ILOADP,
1019 . XREFS, GEO, PM, FACLOAD, PLD, SKEW, SIGI, BUFMAT, X,
1020 . WMA, PARTSAV, MS, V, MSS, MSSF, MSSA, MSNF, MCPS, ERROR_THROWN, DETONATORS,
1021 . DEFAULTS, MAT_PARAM,GLOB_THERM%NINTEMP)
1022 ELSE
1023 IF (ISTOT == 1) THEN
1024 CALL SGSAVINI(ISOLNOD,X,IXS(1,NFT+1),GBUF%SMSTR,NEL)
1025 IF (NSIGI > 0 ) THEN
1026 CALL SGSAVINIEREF(ISOLNOD,STRAGLOB(NF1),SIGSP,NSIGI,PTSOL(NF1),
1027 . GBUF%SMSTR,GBUF%OFF,NEL)
1028 END IF
1029 ENDIF
1030 CALL S4INIT3(
1031 1 ELBUF_TAB(NG),MS ,IXS ,PM ,X ,
1032 2 DETONATORS ,GEO ,VEUL ,ALE_CONNECTIVITY ,IPARG(1,NG),
1033 3 DTELEM ,SIGI ,NEL ,SKEW ,IGEO ,
1034 4 STIFN ,PARTSAV ,V ,IPART(I15A),MSS ,
1035 5 IPART ,MSNF ,IPARG ,
1036 6 MSSF ,IPM ,NSIGS ,VOLNOD ,BVOLNOD ,
1037 7 VNS ,BNS ,WMA ,PTSOL ,BUFMAT ,
1038 8 MCP ,MCPS ,TEMP ,NPC ,PLD ,
1039 9 IUSER ,SIGSP ,NSIGI ,MSSA ,XREFS ,
1040 A STRSGLOB(NF1),STRAGLOB(NF1),FAIL_INI ,SPBUF ,SOL2SPH ,
1041 B ILOADP ,FACLOAD ,RNOISE ,PERTURB ,MAT_PARAM ,
1042 C DEFAULTS%SOLID,GLOB_THERM%NINTEMP )
1043.AND..AND. IF (NXREF > 0 JLAG/=0 JSPH==0)THEN
1044 CALL S4REFSTA3(
1045 1 ELBUF_TAB(NG),IXS ,PM ,GEO ,IPARG(1,NG),
1046 2 IPM ,IGEO ,SKEW ,X ,XREFS ,
1047 3 NEL ,IPART(I15A),IPART ,BUFMAT ,MAT_PARAM ,
1048 4 NPC ,PLD ,NUMMAT )
1049
1050 IF (ISTOT == 1) THEN
1051 CALL SGSAVREF(ISOLNOD,XREFS(1,1,NFT+1),GBUF%SMSTR,NEL)
1052 END IF
1053 ENDIF
1054 IF (NSIGI > 0 ) THEN
1055.OR. IF (NXREF > 0 ISMSTR == 1)
1056 . CALL SGSAVINIEREF(ISOLNOD,STRAGLOB(NF1),SIGSP,NSIGI,PTSOL(NF1),
1057 . GBUF%SMSTR,GBUF%OFF,NEL)
1058 END IF
1059 ENDIF
1060
1061.AND..OR. ELSEIF( (ISOLNOD == 6) (IGTYP == 14 IGTYP == 6))THEN
1062 !for the moment, there is no orthotropic penta solid element (IGTYP == 6)
1063 JHBE = IPARG(23,NG)
1064 NFT = IPARG(3,NG)
1065 IPROP = IXS(10,NFT+1)
1066 IF (JHBE /= 24) THEN
1067 CALL ANCMSG(
1068 . MSGID=3107,
1069 . MSGTYPE=MSGERROR,
1070 . ANMODE=ANINFO_BLIND_1,
1071 . I1=IGEO(1,IPROP),
1072 . I2=IPART(LIPART1*(IPART(I15A)-1)+4),
1073 . PRMOD=MSG_CUMU)
1074 ENDIF
1075 CALL S6ZINIT3(
1076 . ELBUF_TAB(NG),NIXS ,NUMELS ,IXS ,NUMNOD ,MS ,
1077 . NPROPM ,NUMMAT ,PM ,X ,DETONATORS,NPROPG ,
1078 . NUMGEO ,GEO ,ALE_CONNECTIVITY ,NPARG ,
1079 . IPARG(1,NG),NEL ,DTELEM ,NSIGS ,LSIGI ,SIGI ,
1080 . LSKEW ,NUMSKW ,SKEW ,NPROPGI ,IGEO ,STIFN ,
1081 . NPSAV ,NPART ,PARTSAV ,V ,IPART(I15A),MSS ,
1082 . LIPART1 ,IPART ,GLOB_THERM,NSIGI ,LSIGSP ,SIGSP ,
1083 . NPROPMI ,IPM ,IUSER ,VOLNOD ,BVOLNOD ,VNS ,
1084 . BNS ,PTSOL ,SBUFMAT ,BUFMAT ,MCP ,MCPS ,
1085 . TEMP ,SNPC ,NPC ,STF ,PLD ,STRSGLOB(NF1),
1086 . STRAGLOB(NF1),MSSA ,FAIL_INI ,SIZLOADP ,NLOADP ,ILOADP ,
1087 . LFACLOAD ,FACLOAD ,NPERTURB ,SRNOISE ,RNOISE ,PERTURB ,
1088 . MAT_PARAM,DEFAULTS%SOLID ,NUMSOL ,I7STIFS ,ISORTH ,
1089 . ISTRAIN ,JTHE ,MTN ,NFT )
1090.OR..AND. ELSEIF(ISOLNOD == 10 (ISOLNOD == 4 ISROT == 1))THEN
1091 KK1=1+NUMELS*NIXS
1092 CALL S10INIT3(ELBUF_TAB(NG),
1093 1 MS ,IXS ,PM ,X ,
1094 2 DETONATORS ,GEO ,VEUL ,ALE_CONNECTIVITY ,IPARG(1,NG),
1095 3 DTELEM ,SIGI ,NEL ,SKEW ,IGEO ,
1096 4 STIFN ,PARTSAV ,V ,IPART(I15A),MSS ,
1097 5 IXS10 ,IPART ,GLOB_THERM,
1098 7 MSSX ,SIGSP ,NSIGI ,IPM ,
1099 8 IUSER ,NSIGS ,VOLNOD ,BVOLNOD ,VNS ,
1100 9 BNS ,VNSX ,BNSX ,PTSOL ,BUFMAT ,
1101 A MCP ,MCPS ,MCPSX ,TEMP ,NPC ,
1102 B PLD ,IN ,STIFR ,INS ,MSSA ,
1103 C STRSGLOB(NF1),STRAGLOB(NF1),FAIL_INI,ILOADP ,FACLOAD ,
1104 D PERTURB ,RNOISE ,MAT_PARAM,DEFAULTS%SOLID)
1105 IF (NSIGI > 0 ) THEN
1106 NNOD = 10
1107 NSROT = 0
1108.AND. IF(ISOLNOD == 4 ISROT == 1) NSROT = 4
1109 CALL SGSAVINIEREFQ(NNOD,STRAGLOB(NF1),SIGSP,NSIGI,PTSOL(NF1),
1110 . GBUF%SMSTR,GBUF%OFF,IXS(1,NF1),DR,NSROT,NEL)
1111.OR. IF (ISMSTR==10ISMSTR==12)
1112 . CALL S10JACI3(ELBUF_TAB(NG),GBUF%SMSTR,NPT,NEL)
1113 END IF
1114.AND. ELSEIF(ITY==1ISOLNOD==20)THEN
1115 KK1=1+NUMELS*NIXS+NUMELS10*6
1116 CALL S20INIT3(
1117 1 ELBUF_TAB(NG),MS ,IXS ,PM ,X ,
1118 2 DETONATORS ,GEO ,VEUL ,ALE_CONNECTIVITY ,IPARG(1,NG),
1119 3 DTELEM ,SIGI ,NEL ,SKEW ,IGEO ,
1120 4 STIFN ,PARTSAV ,V ,IPART(I15A),MSS ,
1121 5 IXS20 ,IPART ,MSSX ,SIGSP ,NSIGI ,
1122 7 IPM , IUSER ,NSIGS ,VOLNOD ,BVOLNOD ,
1123 8 VNS ,BNS ,VNSX ,BNSX ,PTSOL ,
1124 9 BUFMAT ,MCP ,MCPS ,MCPSX ,TEMP ,
1125 A NPC ,PLD ,STRSGLOB(NF1),STRAGLOB(NF1),FAIL_INI ,
1126 B ILOADP ,FACLOAD ,PERTURB,RNOISE ,MAT_PARAM ,
1127 C GLOB_THERM )
1128.AND. ELSEIF(ITY==1ISOLNOD==16)THEN
1129 KK1=1+NUMELS*NIXS+NUMELS10*6+NUMELS20*12
1130 CALL S16INIT3(
1131 1 ELBUF_TAB(NG),MS ,IXS ,PM ,X ,
1132 2 DETONATORS ,GEO ,VEUL ,ALE_CONNECTIVITY ,IPARG(1,NG),
1133 3 DTELEM ,SIGI ,NEL ,SKEW ,IGEO ,
1134 4 STIFN ,PARTSAV ,V ,IPART(I15A),MSS ,
1135 5 IXS16 ,IPART ,MSSX ,SIGSP ,NSIGI ,
1136 6 IPM ,IUSER ,NSIGS ,VOLNOD ,BVOLNOD ,
1137 7 VNS ,BNS ,VNSX ,BNSX ,PTSOL ,
1138 8 BUFMAT ,MCP ,MCPS ,MCPSX ,TEMP ,
1139 9 NPC ,PLD ,STRSGLOB(NF1),STRAGLOB(NF1),FAIL_INI ,
1140 A ILOADP ,FACLOAD ,PERTURB ,RNOISE ,MAT_PARAM ,
1141 B GLOB_THERM )
1142 ELSE
1143 JHBE=IPARG(23,NG)
1144 JCLOS=IPARG(33,NG)
1145 IINT =IPARG(36,NG)
1146.OR..OR..OR. IF (JHBE==1JHBE==2JHBE==12JHBE==16) THEN
1147 JCVT=0
1148 ELSE
1149 JCVT=1
1150 ENDIF
1151 IPROP = IXS(10,NFT+1)
1152 IGTYP = NINT(GEO(NPROPG*(IPROP-1)+12))
1153 NUVAR = NINT(GEO(NPROPG*(IPROP-1)+25))
1154 ISTRAIN = IPARG(44,NG)
1155 IF (JHBE == 15) THEN
1156 !Thick shells PA6 / HQEPH
1157 IF (ISOLNOD == 6)THEN
1158 CALL S6CINIT3(
1159 . ELBUF_TAB(NG),MS ,IXS ,PM ,X ,
1160 . DETONATORS ,GEO ,VEUL ,ALE_CONNECTIVITY ,IPARG(1,NG),
1161 . DTELEM ,SIGI ,NEL ,SKEW ,IGEO ,
1162 . STIFN ,PARTSAV ,V ,IPART(I15A),MSS,
1163 . IPART ,GLOB_THERM,
1164 . SIGSP ,NSIGI ,IPM ,IUSER ,NSIGS ,
1165 . VOLNOD ,BVOLNOD ,VNS ,BNS ,PTSOL ,
1166 . BUFMAT ,MCP ,MCPS ,MCPSX ,TEMP ,
1167 . NPC ,PLD ,STRSGLOB(NF1),STRAGLOB(NF1),MSSA ,
1168 . ORTHOGLOB ,FAIL_INI ,ILOADP ,FACLOAD ,PERTURB ,
1169 . RNOISE ,MAT_PARAM,DEFAULTS%SOLID)
1170 ELSE
1171 CALL SCINIT3(ELBUF_TAB(NG),
1172 . MS ,IXS ,PM ,X ,MSS ,
1173 . DETONATORS ,GEO ,VEUL ,ALE_CONNECTIVITY ,IPARG(1,NG),
1174 . DTELEM ,SIGI ,NEL ,SKEW ,IGEO ,
1175 . STIFN ,PARTSAV ,V ,IPART(I15A) ,IPART ,
1176 . SIGSP ,NSIGI ,MSNF ,MSSF ,IPM ,
1177 . IUSER ,NSIGS ,VOLNOD ,BVOLNOD ,VNS ,
1178 . BNS ,WMA ,PTSOL ,BUFMAT ,MCP ,
1179 . MCPS ,TEMP ,NPC ,PLD ,MSSA ,
1180 . STRSGLOB(NF1),STRAGLOB(NF1),ORTHOGLOB ,FAIL_INI ,ILOADP ,
1181 . FACLOAD ,RNOISE ,PERTURB ,GLOB_THERM, MAT_PARAM)
1182 ENDIF
1183.AND. ELSEIF (JHBE == 14
1184.OR..OR. . (IGTYP == 20 IGTYP == 21 IGTYP == 22)) THEN
1185 !HA8 thick shell
1186 GBUF => ELBUF_TAB(NG)%GBUF
1187 CALL S8CINIT3(
1188 . ELBUF_TAB(NG),MS ,IXS ,PM ,X ,
1189 . DETONATORS,GEO ,VEUL ,ALE_CONNECTIVITY,IPARG(1,NG),
1190 . DTELEM ,SIGI ,NEL ,SKEW ,IGEO ,
1191 . STIFN ,PARTSAV ,V ,IPART(I15A),MSS,
1192 . IPART ,SIGSP ,NSIGI ,MSNF ,MSSF ,IPM ,
1193 . IUSER ,NSIGS ,VOLNOD ,BVOLNOD ,VNS ,
1194 . BNS ,WMA ,PTSOL ,BUFMAT ,MCP ,
1195 . MCPS ,TEMP ,NPC ,PLD ,XREFS ,
1196 . MSSA ,STRSGLOB,STRSGLOB(NF1),STRAGLOB(NF1),FAIL_INI,
1197 . ILOADP ,FACLOAD ,PERTURB ,RNOISE ,MAT_PARAM,GLOB_THERM)
1198 IF (ISTOT == 1) THEN
1199 CALL SGSAVINI(ISOLNOD,X,IXS(1,NFT+1),GBUF%SMSTR,NEL)
1200 ENDIF
1201 IF (NSIGI > 0 ) THEN
1202 CALL SGSAVINIEREF(ISOLNOD,STRAGLOB(NF1),SIGSP,NSIGI,PTSOL(NF1),
1203 . GBUF%SMSTR,GBUF%OFF,NEL)
1204 END IF
1205.OR..OR. ELSEIF (JHBE == 14 JHBE == 222 JHBE == 17) THEN
1206 !HA8 and H8E solid
1207 GBUF => ELBUF_TAB(NG)%GBUF
1208 IF (ISTOT == 1) THEN
1209 CALL SGSAVINI(ISOLNOD,X,IXS(1,NFT+1),GBUF%SMSTR,NEL)
1210 IF (NSIGI > 0 ) THEN
1211 CALL SGSAVINIEREF(ISOLNOD,STRAGLOB(NF1),SIGSP,NSIGI,PTSOL(NF1),
1212 . GBUF%SMSTR,GBUF%OFF,NEL)
1213 END IF
1214.AND. IF (NXREF > 0 JHBE == 17 ) THEN
1215 CALL SREFSTA3(
1216 1 ELBUF_TAB(NG),IXS ,PM ,GEO ,IPARG(1,NG),
1217 2 IPM ,IGEO ,SKEW ,X ,XREFS ,
1218 3 NEL ,IPART(I15A),IPART ,BUFMAT ,MAT_PARAM,
1219 6 NPC ,PLD ,NUMMAT )
1220 CALL SGSAVREF(ISOLNOD,XREFS(1,1,NFT+1),GBUF%SMSTR,NEL)
1221 END IF
1222 END IF
1223 CALL S8ZINIT3(
1224 . ELBUF_TAB(NG),MS ,IXS ,PM ,X ,
1225 . DETONATORS,GEO ,VEUL ,ALE_CONNECTIVITY,IPARG(1,NG),
1226 . DTELEM,SIGI ,NEL ,SKEW ,IGEO ,
1227 . STIFN ,PARTSAV ,V ,IPART(I15A),MSS,
1228 . IPART ,GLOB_THERM,
1229 . SIGSP ,NSIGI ,MSNF ,MSSF ,IPM ,
1230 . IUSER ,NSIGS ,VOLNOD ,BVOLNOD ,VNS ,
1231 . BNS ,WMA ,PTSOL ,BUFMAT ,MCP ,
1232 . MCPS ,TEMP ,NPC ,PLD ,XREFS ,
1233 . MSSA ,STRSGLOB(NF1),STRAGLOB(NF1),FAIL_INI,SPBUF ,
1234 . KXSP ,IPART(I15J) ,NOD2SP ,SOL2SPH ,IRST,
1235 . ILOADP ,FACLOAD ,PERTURB ,RNOISE ,MAT_PARAM)
1236.AND. IF (NSIGI > 0 ISMSTR == 1) THEN
1237 CALL SGSAVINIEREF(ISOLNOD,STRAGLOB(NF1),SIGSP,NSIGI,PTSOL(NF1),
1238 . GBUF%SMSTR,GBUF%OFF,NEL)
1239 END IF
1240 ELSEIF (IGTYP>=29) THEN
1241 CALL SUINIT3(ELBUF_TAB(NG),MS ,IXS ,PM ,X ,
1242 . DETONATORS ,GEO ,VEUL ,ALE_CONNECTIVITY ,IPARG(1,NG),
1243 . DTELEM,SIGI ,NEL ,SKEW ,IGEO ,
1244 . STIFN ,PARTSAV ,V ,IPART(I15A),MSS,
1245 . IPART ,SIGSP ,GLOB_THERM,TEMP ,
1246 . NSIGI ,IN ,VR ,IPM ,NSIGS ,
1247 . VOLNOD ,BVOLNOD ,VNS ,BNS ,PTSOL ,
1248 . BUFMAT ,NPC ,PLD ,FAIL_INI ,INS ,
1249 . ILOADP ,FACLOAD ,PERTURB,RNOISE ,MAT_PARAM)
1250 ELSE
1251 GBUF => ELBUF_TAB(NG)%GBUF
1252.AND. IF (NPT == 1 ISTOT == 1) THEN
1253 CALL SGSAVINI(ISOLNOD,X,IXS(1,NFT+1),GBUF%SMSTR,NEL)
1254 IF (NSIGI > 0 ) THEN
1255 CALL SGSAVINIEREF(ISOLNOD,STRAGLOB(NF1),SIGSP,NSIGI,PTSOL(NF1),
1256 . GBUF%SMSTR,GBUF%OFF,NEL)
1257 END IF
1258 ENDIF
1259 IF (JMULT == 0) THEN
1260 CALL SINIT3(
1261 1 ELBUF_TAB(NG),MS ,IXS ,PM ,X ,
1262 2 DETONATORS ,GEO ,VEUL ,ALE_CONNECTIVITY ,IPARG(1,NG),
1263 3 DTELEM ,SIGI ,NEL ,SKEW ,IGEO ,
1264 4 STIFN ,PARTSAV ,V ,IPART(I15A),MSS ,
1265 5 IPART ,SIGSP ,NG ,IPARG ,
1266 7 NSIGI ,MSNF ,NVC ,MSSF ,IPM ,
1267 8 IUSER ,NSIGS ,VOLNOD ,BVOLNOD ,VNS ,
1268 9 BNS ,IN ,VR ,INS ,WMA ,
1269 A PTSOL ,BUFMAT ,MCP ,MCPS ,TEMP ,
1270 B XREFS ,NPC ,PLD ,MSSA ,STRSGLOB(NF1),
1271 C STRAGLOB(NF1),FAIL_INI ,SPBUF ,KXSP ,IPART(I15J),
1272 D NOD2SP ,SOL2SPH ,IRST ,ILOADP ,FACLOAD ,
1273 E RNOISE ,PERTURB ,MAT_PARAM,GLOB_THERM)
1274.AND. ELSE IF (JMULT > 0 MTN == 151) THEN
1275 !Multifluid law
1276 CALL MULTIFLUID_INIT3 (
1277 1 ELBUF_TAB(NG),MS ,IXS ,PM ,X ,
1278 2 GEO ,ALE_CONNECTIVITY ,IPARG(1,NG),
1279 3 DTELEM ,SIGI ,NEL ,SKEW ,IGEO ,
1280 4 STIFN ,PARTSAV ,V ,IPART(I15A),MSS ,
1281 5 IPART ,SIGSP ,NG ,IPARG ,GLOB_THERM ,
1282 7 NSIGI ,MSNF ,NVC ,MSSF ,IPM ,
1283 8 IUSER ,NSIGS ,VOLNOD ,BVOLNOD ,VNS ,
1284 9 BNS ,IN ,VR ,INS ,WMA ,
1285 A PTSOL ,BUFMAT ,MCP ,MCPS ,TEMP ,
1286 B XREFS ,NPC ,PLD ,MSSA ,STRSGLOB(NF1),
1287 C STRAGLOB(NF1),FAIL_INI ,SPBUF ,KXSP ,IPART(I15J),
1288 D NOD2SP ,SOL2SPH ,IRST ,ILOADP ,FACLOAD ,
1289 E MULTI_FVM, ERROR_THROWN,DETONATORS, MAT_PARAM)
1290 ENDIF
1291
1292 CALL SREFSTA3(
1293 1 ELBUF_TAB(NG),IXS ,PM ,GEO ,IPARG(1,NG),
1294 2 IPM ,IGEO ,SKEW ,X ,XREFS ,
1295 3 NEL ,IPART(I15A),IPART ,BUFMAT ,MAT_PARAM,
1296 6 NPC ,PLD ,NUMMAT )
1297
1298
1299.AND..AND. IF (NXREF > 0 (NPT == 1 ISTOT == 1) ) THEN
1300 CALL SGSAVREF(ISOLNOD,XREFS(1,1,NFT+1),GBUF%SMSTR,NEL)
1301 END IF
1302 IF (NSIGI > 0 ) THEN
1303.OR. IF (NXREF > 0 ISMSTR == 1 )
1304 . CALL SGSAVINIEREF(ISOLNOD,STRAGLOB(NF1),SIGSP,NSIGI,PTSOL(NF1),
1305 . GBUF%SMSTR,GBUF%OFF,NEL)
1306 END IF
1307 NC1 = NVC / 128
1308 NC2 = (NVC-NC1*128) / 64
1309 NC3 = (NVC-NC1*128-NC2*64) / 32
1310 NC4 = (NVC-NC1*128-NC2*64-NC3*32)/16
1311 NC5 = (NVC-NC1*128-NC2*64-NC3*32-NC4*16)/8
1312 NC6 = (NVC-NC1*128-NC2*64-NC3*32-NC4*16-NC5*8)/4
1313 NC7 = (NVC-NC1*128-NC2*64-NC3*32-NC4*16-NC5*8-NC6*4)/2
1314 NC8 = (NVC-NC1*128-NC2*64-NC3*32-NC4*16-NC5*8-NC6*4-NC7*2)
1315 IF (NC1 == 1) NC1_OLD = 1
1316 IF (NC2 == 1) NC2_OLD = 1
1317 IF (NC3 == 1) NC3_OLD = 1
1318 IF (NC4 == 1) NC4_OLD = 1
1319 IF (NC5 == 1) NC5_OLD = 1
1320 IF (NC6 == 1) NC6_OLD = 1
1321 IF (NC7 == 1) NC7_OLD = 1
1322 IF (NC8 == 1) NC8_OLD = 1
1323 IPARG(19,NG) = NC1_OLD*128+NC2_OLD*64+NC3_OLD*32+NC4_OLD*16+NC5_OLD*8+NC6_OLD*4+NC7_OLD*2+NC8
1324 ENDIF
1325 ENDIF
1326 !----------------------------------------!
1327 ! ITY == 2 QUAD !
1328 !----------------------------------------!
1329 ELSEIF(ITY == 2)THEN
1330 IHBE =IPARG(23,NG)
1331 IF (JMULT == 0) THEN
1332.OR..AND. IF (IHBE == 17 (N2D == 1IHBE == 22)) THEN
1333 CALL Q4INIT2(ELBUF_TAB(NG),MS ,IXQ,PM,X,
1334 2 DETONATORS,GEO,VEUL,ALE_CONNECTIVITY,IPARG(1,NG),
1335 3 DTELEM,SIGI,IGEO ,
1336 4 NEL ,SKEW , MSQ ,IPART ,IPART(I15B),
1337 5 IPM ,NSIGS ,WMA ,PTQUAD ,BUFMAT ,
1338 6 NPC ,PLD ,IPARG ,ILOADP ,FACLOAD ,
1339 7 PARTSAV,V ,MAT_PARAM)
1340 ELSE
1341 CALL QINIT2(
1342 . ELBUF_TAB(NG),MS,IXQ ,PM ,X ,
1343 . DETONATORS,GEO,VEUL,ALE_CONNECTIVITY,IPARG(1,NG),
1344 . DTELEM,SIGI,IGEO ,
1345 . NEL ,SKEW, MSQ, IPART, IPART(I15B),
1346 . IPM ,NSIGS ,
1347 . WMA ,PTQUAD ,BUFMAT ,NPC ,PLD,
1348 . IPARG ,ILOADP ,FACLOAD ,PARTSAV,V, MAT_PARAM)
1349 ENDIF
1350 ELSE ! JMULT > 0
1351 IF (MTN == 20) THEN
1352 CALL BINIT2(
1353 . ELBUF_TAB(NG),MS ,IXQ ,PM ,X ,
1354 . DETONATORS ,VEUL ,ALE_CONNECTIVITY ,IPARG(1,NG) ,FILL ,
1355 . SIGI ,BUFMAT ,NEL ,MAT_PARAM ,
1356 . SKEW ,MSQ ,IPART ,IPART(I15B) ,
1357 . GEO ,IGEO ,IPM ,
1358 . NSIGS ,WMA ,PTQUAD ,NPC ,PLD ,
1359 . IPARG ,ILOADP ,FACLOAD ,PARTSAV ,V )
1360 ELSE IF (MTN == 151) THEN
1361
1362 CALL MULTIFLUID_INIT2(NEL, NSIGS,
1363 . IPARG, IXQ, IPM, ALE_CONNECTIVITY, IGEO, IPART, IPART(I15B), NPC,
1364 . PTQUAD, ILOADP, X, PM,
1365 . GEO, SIGI, SKEW, PLD, BUFMAT, FACLOAD, ELBUF_TAB(NG), ERROR_THROWN,DETONATORS,
1366 . MAT_PARAM)
1367 ELSE
1368 CALL ARRET(2)
1369 ENDIF
1370 ENDIF
1371 !----------------------------------------!
1372 ! ITY == 3 SHELL !
1373 !----------------------------------------!
1374 ELSEIF (ITY == 3)THEN
1375 ISTRAIN =IPARG(44,NG)
1376 IHBE =IPARG(23,NG)
1377 ITHK =IPARG(28,NG)
1378 ILEV =IPARG(45,NG)
1379 IXFEM =IPARG(54,NG)
1380 DT2=DT2S
1381.AND. IF (IHBE>10IHBE<29) THEN
1382 NULLIFY(ptr_ITAGE)
1383 IF (SITAGE>0) ptr_ITAGE=>ITAGE(1)
1384 CALL CBAINIT3(ELBUF_TAB(NG),
1385 1 IXC,PM ,X ,GEO ,
1386 2 MS ,IN ,NVC ,DTELEM,IGRSH4N ,
1387 3 XREFC ,NEL ,ITHK ,IHBE ,IGRSH3N ,
1388 4 THK(1+NFT),ISIGSH,SIGSH ,STIFN ,STIFR ,
1389 5 PARTSAV ,V ,IPART(I15C) ,MSC,INC ,
1390 6 SKEW ,I8MI ,NSIGSH ,IGEO ,
1391 7 IPM ,IUSER ,ETNOD ,NSHNOD ,STC ,
1392 8 PTSHEL ,BUFMAT ,SH4TREE ,MCP ,MCPC ,
1393 9 TEMP ,MS_LAYER, ZI_LAYER ,ITAG ,ITAGEL ,
1394 A IPARG(1,NG),MS_LAYERC,ZI_LAYERC,PART_AREA,CPT_ELTENS,
1395 B MSZ2C ,ZPLY ,ITAGN ,ptr_ITAGE ,IXFEM ,
1396 C NPC ,PLD ,XFEM_TAB,ISUBSTACK ,STACK ,
1397 D RNOISE ,DRAPE ,SH4ANG ,IDDLEVEL,GEO_STACK,
1398 E IGEO_STACK ,STRC ,PERTURB ,IYLDINI ,ELE_AREA,
1399 F NLOC_DMG ,NG ,GROUP_PARAM_TAB(NG),IDRAPE,DRAPEG,
1400 G MAT_PARAM ,FAIL_FRACTAL,FAIL_BROKMANN,GLOB_THERM)
1401 ELSE
1402 NULLIFY(ptr_ITAGE)
1403 IF (SITAGE>0) ptr_ITAGE => ITAGE(1)
1404 CALL CINIT3(ELBUF_TAB(NG),
1405 1 IXC ,PM ,X ,GEO ,
1406 2 MS ,IN ,NVC ,DTELEM ,IGRSH4N ,
1407 3 XREFC ,NEL ,ITHK ,IHBE ,IGRSH3N ,
1408 4 THK(1+NFT),ISIGSH ,SIGSH ,STIFN ,STIFR ,
1409 5 PARTSAV ,V ,IPART(I15C),MSC ,INC ,
1410 8 SKEW ,IPARG(1,NG),I8MI ,NSIGSH ,IGEO ,
1411 9 IUSER ,ETNOD ,NSHNOD ,STC ,PTSHEL ,
1412 A IPM ,BUFMAT ,SH4TREE ,MCP ,MCPC ,
1413 B TEMP ,CPT_ELTENS ,PART_AREA ,ITAGN ,ptr_ITAGE ,
1414 C IXFEM ,NPC ,PLD ,XFEM_TAB,ISUBSTACK,
1415 D STACK ,RNOISE ,DRAPE ,SH4ANG ,IDDLEVEL ,
1416 E GEO_STACK,IGEO_STACK ,STRC ,PERTURB ,IYLDINI ,
1417 F ELE_AREA ,NG ,GROUP_PARAM_TAB(NG) ,NLOC_DMG ,
1418 G IDRAPE ,DRAPEG ,MAT_PARAM ,FAIL_FRACTAL,FAIL_BROKMANN,
1419 H GLOB_THERM)
1420 ENDIF
1421 NC1 = NVC / 8
1422 NC2 = (NVC-NC1*8) / 4
1423 NC3 = (NVC-NC1*8-NC2*4) / 2
1424 NC4 = NVC-NC1*8-NC2*4-NC3*2
1425 IF (NC1 == 1) NC1_OLD = 1
1426 IF (NC2 == 1) NC2_OLD = 1
1427 IF (NC3 == 1) NC3_OLD = 1
1428 IF (NC4 == 1) NC4_OLD = 1
1429 IPARG(19,NG)=NC1_OLD*8+NC2_OLD*4+NC3_OLD*2+NC4_OLD
1430 DT2S=DT2
1431 DT2=0.
1432 !----------------------------------------!
1433 ! ITY == 4 TRUSS !
1434 !----------------------------------------!
1435 ELSEIF (ITY == 4) THEN
1436 CALL TINIT3(ELBUF_TAB(NG),
1437 1 IXT ,PM ,X ,GEO ,MS ,
1438 2 DTELEM ,NFT ,NEL ,STIFN ,PARTSAV,
1439 3 V ,IPART(I15D),MST ,STIFINT,STT ,
1440 4 IGEO ,NSIGTRUSS ,SIGTRUSS ,PTTRUSS,
1441 5 PRELOAD_A,IBOLTP ,NPRELOAD_A )
1442 !----------------------------------------!
1443 ! ITY == 5 BEAM !
1444 !----------------------------------------!
1445 ELSEIF (ITY == 5) THEN
1446 CALL PINIT3(ELBUF_TAB(NG),
1447 1 STP ,IXP ,PM ,X ,GEO ,
1448 2 DTELEM ,NFT ,NEL ,
1449 3 STIFN ,STIFR ,PARTSAV ,V ,IPART(I15E),
1450 4 MSP ,INP ,IGEO ,STRP ,
1451 5 NSIGBEAM ,SIGBEAM ,PTBEAM ,IUSER ,
1452 6 MCPP ,TEMP ,PRELOAD_A,IBOLTP ,NPRELOAD_A ,
1453 7 GLOB_THERM ,IBEAM_VECTOR,RBEAM_VECTOR)
1454 !----------------------------------------!
1455 ! ITY == 6 SPRING !
1456 !----------------------------------------!
1457 ELSEIF (ITY == 6) THEN
1458 IOPT = PTR_NOPT_FUN + 1
1459 CALL RINIT3(ELBUF_TAB(NG),
1460 1 IXR ,X ,GEO ,MS ,NPC ,
1461 2 PLD ,IN ,SKEW ,DTELEM ,NEL ,
1462 3 STIFN ,STIFR ,PARTSAV ,V ,IPART(I15F),
1463 4 ITAB ,MSR ,
1464 5 INR ,STIFINT ,STR(NFT+1),IGEO ,SIGRS ,
1465 6 NSIGRS ,IMERGE2 ,IADMERGE2 ,MSRT(NFT+1),IXR_KJ ,
1466 7 NOM_OPT(1,IOPT),STRR ,PTSPRI ,IPM , PM ,
1467 8 BUFMAT ,R_SKEW ,PRELOAD_A ,IBOLTP ,NPRELOAD_A,
1468 9 IKINE)
1469 !----------------------------------------!
1470 ! ITY == 7 SH3N or TRIA !
1471 !----------------------------------------!
1472.OR. ELSEIF(ITY == 7 ITY == 8)THEN
1473 ISTRAIN =IPARG(44,NG)
1474 ITHK =IPARG(28,NG)
1475 ISH3N =IPARG(23,NG)
1476 ICNOD =IPARG(11,NG)
1477.AND. IF (ISH3N == 30 ICNOD == 6) ISH3N = 0
1478 ILEV =IPARG(45,NG)
1479 DT2=DT2S
1480 IF (ISH3N == 30) THEN
1481 CALL CDKINIT3(ELBUF_TAB(NG),GROUP_PARAM_TAB(NG),
1482 1 IXTG ,PM ,X ,GEO ,
1483 2 MS ,IN ,NVC ,DTELEM,
1484 3 XREFTG ,OFFSET,NEL ,ITHK ,THK(1+NFT+NUMELC),
1485 4 ISIGSH ,SIGSH(1,KSIGSH3),STIFN,STIFR, PARTSAV ,
1486 5 V ,IPART(I15H) ,MSTG ,INTG , PTG ,
1487 8 SKEW ,ISH3N ,NSIGSH ,IGEO ,IPM ,
1488 9 IUSER ,ETNOD ,NSHNOD ,STTG ,PTSH3N ,
1489 A BUFMAT ,SH3TREE,MCP ,MCPTG , TEMP ,
1490 B IPARG(1,NG),CPT_ELTENS,PART_AREA ,NPC ,PLD ,
1491 C SH3TRIM ,ISUBSTACK,STACK ,RNOISE,
1492 D DRAPE,SH3ANG ,GEO_STACK,IGEO_STACK,STRTG,
1493 E PERTURB,IYLDINI ,ELE_AREA,NLOC_DMG,
1494 F IDRAPE, DRAPEG,MAT_PARAM,GLOB_THERM)
1495.OR. ELSEIF (MTN == 151 N2D > 0) THEN
1496 CALL MULTIFLUID_INIT2T(ELBUF_TAB(NG), NEL, NSIGS, NVC, IPARG, IXTG, ALE_CONNECTIVITY,
1497 . IGEO, IPART, IPART(I15H), IPM, PTSH3N, NPC, ILOADP,
1498 . X, PM, GEO, SIGI, SKEW, PLD, BUFMAT, FACLOAD, MULTI_FVM, ERROR_THROWN, DETONATORS,
1499 . MAT_PARAM)
1500 ELSE
1501 NULLIFY(ptr_ITAGE)
1502 IF (SITAGE > 0) ptr_ITAGE => ITAGE(NUMELC+1)
1503 CALL C3INIT3(ELBUF_TAB(NG),
1504 1 IXTG ,PM ,X ,GEO ,IGRSH4N,
1505 2 MS ,IN ,NVC ,DTELEM,IGRSH3N ,
1506 3 XREFTG ,OFFSET,NEL ,ITHK ,THK(1+NFT+NUMELC),
1507 4 ISIGSH ,SIGSH(1,KSIGSH3),STIFN,STIFR,PARTSAV ,
1508 5 V ,IPART(I15H),MSTG,INTG ,PTG ,
1509 8 SKEW,IPARG(1,NG) , NSIGSH ,IGEO,IUSER ,
1510 9 ETNOD ,NSHNOD ,STTG ,PTSH3N ,IPM ,
1511 A BUFMAT ,SH3TREE ,MCP ,MCPTG , TEMP ,
1512 B CPT_ELTENS,PART_AREA,ptr_ITAGE,ITAGN,IXFEM ,
1513 C NPC ,PLD ,SH3TRIM ,XFEM_TAB,
1514 D ISUBSTACK , STACK,RNOISE ,
1515 E DRAPE ,SH3ANG,IDDLEVEL,GEO_STACK,IGEO_STACK,STRTG,
1516 F PERTURB ,ISH3N,IYLDINI ,ELE_AREA,
1517 G NLOC_DMG,NG,GROUP_PARAM_TAB(NG),IDRAPE,
1518 H DRAPEG,MAT_PARAM,FAIL_FRACTAL,FAIL_BROKMANN,GLOB_THERM)
1519 ENDIF
1520 NC1 = NVC / 8
1521 NC2 = (NVC-NC1*8) / 4
1522 NC3 = (NVC-NC1*8-NC2*4) / 2
1523 IF (NC1 == 1) NC1_OLD = 1
1524 IF (NC2 == 1) NC2_OLD = 1
1525 IF (NC3 == 1) NC3_OLD = 1
1526 IPARG(19,NG)=NC1_OLD*8+NC2_OLD*4+NC3_OLD*2
1527 DT2S=DT2
1528 DT2=0.
1529 !----------------------------------------!
1530 ! ITY == 51 SPH !
1531 !----------------------------------------!
1532 ELSEIF(ITY == 51)THEN
1533
1534 JSPH=1
1535 ISPH2SOL=IPARG(69,NG)
1536 CALL SPINIT3(ITY ,SPBUF ,KXSP ,X ,GEO ,
1537 2 MS ,NPC ,PLD ,IN ,SKEW ,
1538 3 DTELEM ,NEL ,STIFN ,STIFR ,IGEO ,
1539 4 PARTSAV ,V ,IPART(I15J),BUFMAT,
1540 5 PM ,ITAB ,MSR ,INR ,IXSP ,
1541 6 NOD2SP ,IPARG(1,NG),ALE_CONNECTIVITY ,DETONATORS ,
1542 7 SIGSPH ,ISPTAG ,IPART ,
1543 8 IPM ,NSIGSPH ,PTSPH ,NPC ,
1544 9 PLD ,ELBUF_TAB(NG),MCP,TEMP ,ILOADP,
1545 A FACLOAD ,STIFINT ,I7STIFS,GLOB_THERM , MAT_PARAM)
1546 !----------------------------------------------------------!
1547 ! ITY == 100 Pulley PID28 + User elements PID 29-30-31 !
1548 !----------------------------------------------------------!
1549 ELSEIF(ITY == 100)THEN
1550 IADUIX=1
1551 IADUX =IADUIX+MAXNX
1552 IADUV =IADUX +3*MAXNX
1553 IADUVR=IADUV +3*MAXNX
1554 IADUMS=IADUVR+3*MAXNX
1555 IADUIN=IADUMS+MAXNX
1556 IADUSM=IADUIN+MAXNX
1557 IADUSR=IADUSM+MAXNX
1558 IADUMV=IADUSR+MAXNX
1559 IADURV=IADUMV+MAXNX
1560 CALL XINIT3(ELBUF_TAB(NG),KXX,IXX ,X ,V ,
1561 2 VR ,MS ,IN ,
1562 3 SKEW ,DTELEM ,NEL ,STIFN ,STIFR ,
1563 4 PARTSAV ,IPART(I15I),GEO ,
1564 5 ITAB ,XELEMWA(IADUIX) ,XELEMWA(IADUX) ,XELEMWA(IADUV) ,
1565 6 XELEMWA(IADUVR) ,XELEMWA(IADUMS) ,XELEMWA(IADUIN) ,
1566 7 XELEMWA(IADUSM) ,XELEMWA(IADUSR) ,XELEMWA(IADUMV) ,
1567 8 XELEMWA(IADURV) ,IGEO, NFT)
1568
1569 !----------------------------------------!
1570 ! ITY == 101 IGE3D !
1571 !----------------------------------------!
1572 ELSEIF (ITY == 101) THEN
1573 NCTRL = IPARG(75,NG)
1574 PX = IGEO(41,IPARG(62,NG))
1575 PY = IGEO(42,IPARG(62,NG))
1576 PZ = IGEO(43,IPARG(62,NG))
1577 CALL IG3DINIT3(ELBUF_TAB(NG),MS ,KXIG3D ,IXIG3D ,PM ,X,
1578 . DETONATORS ,GEO ,VEUL ,ALE_CONNECTIVITY,IPARG(1,NG),
1579 . DTELEM,SIGI ,NEL ,SKEW ,IGEO ,
1580 . STIFN ,PARTSAV ,V ,IPART(I15K),MSS,
1581 . IPART ,SIGSP ,
1582 . NSIGI ,IN ,VR ,IPM ,NSIGS ,
1583 . VNIGE ,BNIGE ,PTSOL ,
1584 . BUFMAT ,NPC ,PLD ,FAIL_INI,NCTRL,
1585 . MSIG3D ,KNOT ,NCTRLMAX,WIGE ,PX,PY,PZ,
1586 . KNOTLOCPC,KNOTLOCEL,MAT_PARAM)
1587 ENDIF
1588
1589 IF (ITY == 3) THEN
1590 WRITE(IOUT,'(a,i10,a,i5)')' shell group',NG, ' vectorization code =',IPARG(19,NG)
1591 ELSEIF (ITY == 7) THEN
1592 WRITE(IOUT,'(a,i10,a,i5)')' triangular shell group',NG, ' vectorization code =',IPARG(19,NG)
1593 ELSEIF (ITY == 1) THEN
1594 WRITE(IOUT,'(a,i10,a,i5)')' brick group',NG,' vectorization code =',IPARG(19,NG)
1595 ENDIF
1596
1597 ENDIF
1598 END DO ! End loop on element group NG
1599!
1600 !<-----------------------------------------------------------------------
1601 !< Print /PENTA6 error message if any
1602 !<-----------------------------------------------------------------------
1603 CALL ANCMSG(MSGID=3107,
1604 . MSGTYPE=MSGERROR,
1605 . ANMODE=ANINFO_BLIND_1,
1606 . PRMOD=MSG_PRINT)
1607 !<-----------------------------------------------------------------------
1608!
1609
1610!DETONATION TIMES WITH SHADOWING EFFECTS
1611!FAST MARCHING METHOD
1612 CALL EIKONAL_SOLVER(ixq , nixq , numelq ,
1613 . ixs , nixs , numels ,
1614 . ixtg , nixtg , numeltg ,
1615 . x , numnod , titre(55),
1616 . elbuf_tab, ngroup , nparg ,
1617 . nod2eltg , knod2eltg,
1618 . nod2elq , knod2elq ,
1619 . nod2els , knod2els ,
1620 . iparg , ale_connectivity, npropm, nummat, pm, n2d, detonators,
1621 . npropmi , ipm )
1622
1623
1624 CALL MULTIFLUID_GLOBAL_TDET(IPARG,ELBUF_TAB,MULTI_FVM,IPM)
1625! DETONATION TIMES PRINTOUT
1626
1627! + DEFAULT INITIALIZATION TO 0.0 IN CASE OF NO DETONATOR
1628 CALL DETONATION_TIMES_PRINTOUT(NPARG,NGROUP,IPARG,N2D,IPRI,ELBUF_TAB,
1629 . NIXS,NIXQ,NIXTG,NUMELS,NUMELQ,NUMELTG,IXS,IXQ,IXTG)
1630
1631 !loop over material initialisation done.
1632 !IF NRF outlet, print its automatic characteristic
1633.AND. IF(M51_IFLG6==1 M51_lSET_IFLG6==1)THEN
1634 !first initialization of group whose MAT=51 + iform=6
1635 WRITE (IOUT,1001)M51_LC0MAX,M51_SSP0MAX,M51_TCP_REF
1636 ENDIF
1637
1638 1001 FORMAT(
1639 .//
1640 .' non reflecting frontiers (/mat/law51) '/
1641 .' ------------------------------------- '/
1642 & 5X,'initialization of global parameters ',/
1643 & 5X,'characteristic length. . . . . . . . . .=',E12.4/
1644 & 5X,'reference sound speed. . . . . . . . . =',E12.4/
1645 & 5X,'characteristic time. . . . . . . . . . .=',E12.4//)
1646
1647
1648 CALL ANCMSG(MSGID=1228,MSGTYPE=MSGERROR,ANMODE=ANINFO_BLIND_1,PRMOD=MSG_PRINT)
1649
1650 USER_GRP_DOMAIN = 0
1651
1652
1653
1654
1655 ISFEM=0
1656 DO NG = 1, NGROUP
1657 ITY =IPARG(5,NG)
1658 ISOLNOD = IPARG(28,NG)
1659 ISROT = IPARG(41,NG)
1660 ICPRE = IPARG(10,NG)
1661 IF(ITY /= 1)CYCLE
1662 IF(IPARG(8, NG) == 1) CYCLE
1663.AND. IF(ISOLNOD /= 4 ISOLNOD /= 10) CYCLE
1664.AND. IF(ISOLNOD==4ISROT == 3) ISFEM=1
1665.AND..OR..AND. IF(ICPRE>0(ISOLNOD==10(ISOLNOD==4ISROT == 1))) ISFEM=1
1666 ENDDO
1667
1668
1669
1670 IF (CPT_ELTENS /= 0) THEN
1671 CALL ANCMSG(MSGID=863,MSGTYPE=MSGWARNING,ANMODE=ANINFO_BLIND_1,I1=CPT_ELTENS)
1672 ENDIF
1673
1674
1675
1676 ADDEDMS(1:NPART) = ZERO
1677 IF(IMASADD > 0)THEN
1678 CALL SPMD_PARTSAV_PON(
1679 1 IXS ,IXS10 ,IXS20 ,IXS16 ,IXQ ,
1680 2 IXC ,IXT ,IXP ,IXR ,IXTG ,
1681 3 MSS ,MSSX ,MSQ ,MSC ,
1682 4 MST ,MSP ,MSR ,MSTG ,
1683 5 INDEX ,ITRI ,GEO ,PARTSAV1_PON ,IPART(I15A) ,
1684 6 IPART(I15B),IPART(I15C),IPART(I15D),IPART(I15E) ,IPART(I15F) ,
1685 7 IPART(I15H),IPART )
1686 CALL ADDMASPART(IPART,IPMAS,PARTSAV,
1687 . PART_AREA,PM,ADDEDMS,NOM_OPT(1,PTR_NOPT_ADM+1),
1688 . PARTSAV1_PON)
1689 CALL SPMD_MSIN_ADDMASS(
1690 1 IXS ,IXS10 ,IXS20 ,IXS16 ,IXQ ,
1691 2 IXC ,IXT ,IXP ,IXR ,IXTG ,
1692 3 MSS ,MSSX ,MSQ ,MSC ,
1693 4 MST ,MSP ,MSR ,MSTG ,
1694 5 PTG ,MS ,INDEX ,ITRI ,
1695 6 GEO ,SH4TREE ,SH3TREE ,PARTSAV ,IPMAS ,
1696 7 IPART(I15A),IPART(I15B),IPART(I15C),IPART(I15D),
1697 8 IPART(I15E),IPART(I15F),IPART(I15H),TOTADDMAS ,
1698 9 IPART ,THK ,PM ,PART_AREA ,
1699 A ADDEDMS ,ITAB ,PARTSAV1_PON,ELE_AREA )
1700 END IF
1701
1702
1703
1704 KK1=1+NUMELS*NIXS
1705 KK2=KK1+NUMELS10*6
1706 KK3=KK2+NUMELS20*12
1707 CALL SPMD_MSIN(
1708 1 IXS ,IXQ ,IXC ,IXT ,IXP ,
1709 2 IXR ,IXTG ,MSS ,MSQ ,
1710 3 MSC ,MST ,MSP ,MSR ,MSTG ,
1711 4 INC ,INP ,INR ,INTG ,
1712 5 INDEX ,ITRI ,MS ,IN ,
1713 6 PTG ,GEO ,IXS10 ,IXS20 ,
1714 7 IXS16 ,MSSX ,MSNF ,MSSF ,VNS ,
1715 8 VNSX ,STC ,STT ,STP ,STR ,
1716 9 STTG ,STUR ,BNS ,BNSX ,VOLNOD ,
1717 A BVOLNOD ,ETNOD ,STIFINT ,INS ,MCPC ,
1718 B MCP ,MCPS ,MCPSX ,MCPTG,SH4TREE,
1719 C SH3TREE ,MS_LAYERC, ZI_LAYERC , MS_LAYER,
1720 D ZI_LAYER,MSZ2C, MSZ2,ZPLY ,
1721 E KXIG3D ,IXIG3D ,MSIG3D,NCTRLMAX,STRC ,
1722 F STRP,STRR,STRTG,STIFINTR,NSHNOD,VNIGE,BNIGE,
1723 G MCPP ,GLOB_THERM%ITHERM_FE)
1724 IF(I7STIFS/=0)CALL ASSTIFI(VOLNOD,BVOLNOD,ETNOD,NSHNOD,STIFINT)
1725
1726
1727
1728
1729 IF(INTERFACES%PARAMETERS%ISTIF_DT > 0) THEN
1730 CALL ININTMASS( IPARI, INTBUF_TAB,MS , INTERFACES%PARAMETERS%ISTIF_DT )
1731 ENDIF
1732 INTERFACES%PARAMETERS%DT_STIFINT = ZERO
1733 IF(INTERFACES%PARAMETERS%ISTIF_DT > 0) THEN
1734 CALL DTNODA_STIFINT( MS ,STIFN ,INTERFACES%PARAMETERS%DT_STIFINT)
1735 ENDIF
1736!--------------------------------------------
1737! RWALL penalty stiffness initialization
1738!--------------------------------------------
1739 IF (SLN_PEN>0) THEN
1740 CALL INIT_RWALL_PENALTY(ELBUF_TAB,
1741 1 numnod, nparg, ngroup, iparg, nummat,
1742 2 nrwall, nnprw, nprw, lprw, slprw,
1743 3 numelc,numeltg, numels,numels8, numels10,
1744 4 numels16,numels20, ixc, ixtg, ixs,
1745 5 ixs10, ixs16, ixs20, ixt, ixp,
1746 6 ixr, numelt, numelp, numelr, stifn,
1747 7 mat_param,SLN_PEN,RWSTIF_PEN)
1748 END IF
1749
1750
1751
1752 IF(NLASER/=0)THEN
1753 CALL LASER10(LAS,XLAS,X,IXQ,IPARG)
1754 ENDIF
1755
1756
1757
1758
1759.AND. IF(N2D == 0 IMULTI_FVM /= 1)THEN
1760 DO NG=1,NGROUP
1761 ITY=IPARG(5,NG)
1762 JEUL =IPARG(11,NG)
1763.AND. IF(ITY == 1 JEUL /= 0 )THEN
1764 MTN=IPARG(1,NG)
1765 NEL=IPARG(2,NG)
1766 NFT=IPARG(3,NG)
1767 IAD=IPARG(4,NG)
1768 NPT=IPARG(6,NG)
1769 JALE=IPARG(7,NG)
1770 ISMSTR=IPARG(9,NG)
1771 JTUR=IPARG(12,NG)
1772 JTHE=IPARG(13,NG)
1773 JLAG=IPARG(14,NG)
1774 JMULT=IPARG(20,NG)
1775 JPOR=IPARG(27,NG)
1776 CALL EPORIN3(IXS,VEUL,ALE_CONNECTIVITY,GEO,NFT,NEL)
1777 ENDIF
1778 ENDDO ! next element group NG
1779 ENDIF
1780
1781
1782
1783 CALL INIT_INIVOL( NUM_INIVOL, inivol, nsurf, igrsurf,
1784 . nparg , ngroup, iparg, numnod, npart,
1785 . numels , nixs, ixs, igrnod, ngrnod,
1786 . numeltg , nixtg, ixtg,
1787 . numelq , nixq, ixq,
1788 . x , nbsubmat, kvol,
1789 . elbuf_tab, numels8, xrefs, glob_therm,
1790 . n2d ,multi_fvm, sipart, ipart ,
1791 . i15a ,i15b , i15h, sbufmat, bufmat,
1792 . npropmi ,nummat , ipm, sbufsf, bufsf,
1793 . npropg ,numgeo , geo, mvsiz , skvol,
1794 . itab ,mat_param)
1795
1796
1797
1798 IF (NINIGRAV>0)THEN
1799 NV46=4
1800 IF(N2D==0)NV46 = 6
1801 CALL INIGRAV_LOAD(
1802 1 ELBUF_TAB , IPART , IGRPART , IPARG , IPART(I15H),
1803 2 IPART(I15A) , IPART(I15B), X , IXS , IXQ ,
1804 3 IXTG , PM , IPM , BUFMAT , MULTI_FVM ,
1805 4 ALE_CONNECTIVITY, NV46 , IGRSURF , ITAB , EBCS_TAB ,
1806 5 NPC , PLD , MAT_PARAM)
1807 ENDIF
1808
1809
1810
1811 IF (NINIMAP1D > 0) THEN
1812 WRITE(ISTDO, '(a)') TITRE(53)
1813 CALL INI_INIMAP1D(INIMAP1D ,ELBUF_TAB ,IPART ,IPARG ,IPART(I15A),
1814 . IPART(I15B) ,X ,V ,IXS ,IXQ ,
1815 . IXTG ,PM ,IPM ,BUFMAT ,MULTI_FVM ,
1816 . PLD ,NPC ,IGRBRIC ,IGRQUAD ,IGRSH3N ,
1817 . NPTS ,MAT_PARAM ,SNPC ,STF)
1818 ENDIF
1819
1820
1821
1822 IF (NINIMAP2D > 0) THEN
1823 WRITE(ISTDO, '(a)') TITRE(53)
1824 CALL INI_INIMAP2D(INIMAP2D ,ELBUF_TAB ,IPART ,IPARG ,IPART(I15A),
1825 . IPART(I15B) ,X ,V ,IXS ,IXQ ,
1826 . IXTG ,PM ,IPM ,BUFMAT ,MULTI_FVM ,
1827 . FUNC2D ,IGRBRIC ,IGRQUAD ,IGRSH3N ,NPC,
1828 . PLD ,MAT_PARAM)
1829 ENDIF
1830
1831
1832
1833.AND. IF (MULTI_FVM%IS_USED NINVEL > 0) THEN
1834 CALL INI_FVMINIVEL(FVM_INIVEL ,MULTI_FVM ,IGRBRIC ,IGRQUAD ,IGRSH3N)
1835 ENDIF
1836
1837
1838
1839 IF (ISMS_SELEC >= 1) THEN
1840 CALL SMS_AUTO_DT(DTELEM,NATIV_SMS,
1841 . IXS ,IXQ ,IXC ,IXT ,IXP ,
1842 . IXR ,IXTG ,IXS10 ,IXS16 ,IXS20 ,
1843 . IPART(I15A) ,IPART(I15B) ,IPART(I15C) ,IPART(I15D) ,IPART(I15E),
1844 . IPART(I15F) ,IPART(I15H) ,IPART(I15I) ,IPART ,
1845 . IPARG ,ELBUF_TAB ,IGEO ,IDDLEVEL ,TAGPRT_SMS )
1846 ENDIF
1847
1848 IF(ILAG+IALE+IEULER == 0)THEN
1849 DEALLOCATE(I8MI)
1850 RETURN
1851 ENDIF
1852
1853
1854
1855 B1=ZERO
1856 B2=ZERO
1857 B3=ZERO
1858 B6=ZERO
1859 B5=ZERO
1860 B9=ZERO
1861 TOTMAS=ZERO
1862 XG=ZERO
1863 YG=ZERO
1864 ZG=ZERO
1865
1866 IF(NRBYKIN>0)THEN
1867 RBYID=0
1868 DO I=1,NUMNOD
1869 IWA(I)=0
1870 ENDDO
1871 DO N=1,NRBYKIN
1872 M=NPBY(1,N)
1873 NSL=NPBY(2,N)
1874 ISPH=NPBY(5,N)
1875 RBYID= NPBY(6,N)
1876 ISENS=NPBY(4,N)
1877 ID=NOM_OPT(1,N)
1878 CALL FRETITL2(TITR,NOM_OPT(LNOPT1-LTITR+1,N),LTITR)
1879 IF(ISENS == 0)THEN
1880 CALL INIRBY(N ,RBY ,M ,LPBY ,
1881 . MS,IN ,X ,ITAB ,SKEW ,
1882 . B1,B2 ,B3 ,B5 ,B6 ,
1883 . B9,ISPH ,TOTMAS ,XG ,YG ,
1884 . ZG,STIFN ,STIFR ,NPBY ,RBYID ,
1885 . V ,VR ,ID ,TITR ,ITAGND,
1886 . RBY_INIAXIS)
1887 IWA(M)=N
1888 ENDIF
1889 ENDDO
1890
1891
1892
1893
1894 DO N=1,NRBYKIN
1895 M=NPBY(1,N)
1896 NSL=NPBY(2,N)
1897 ISPH=NPBY(5,N)
1898 ISENS=NPBY(4,N)
1899 RBYID= NPBY(6,N)
1900 ID=NOM_OPT(1,N)
1901 CALL FRETITL2(TITR,NOM_OPT(LNOPT1-LTITR+1,N),LTITR)
1902 IF(ISENS/=0)THEN
1903 CALL INIRBYS(N ,RBY ,M ,LPBY ,
1904 . MS,IN ,X ,ITAB ,SKEW,
1905 . B1,B2 ,B3 ,B5 ,B6 ,
1906 . B9,ISPH ,TOTMAS ,XG ,YG ,
1907 . ZG,NPBY ,IWA ,V ,VR ,
1908 . RBYID,ID ,TITR ,ITAGND,RBY_INIAXIS)
1909 ENDIF
1910 ENDDO
1911 ENDIF
1912
1913
1914
1915 IF(NRBYLAG/=0)
1916 . CALL LGMINI_RBY(NPBYL ,LPBYL ,RBYL ,MS ,IN ,X ,V ,VR ,ITAB ,NOM_OPT)
1917
1918
1919
1920 IF (NRBMERGE > 0) THEN
1921 CALL RETRIRBY(NPBY ,LPBY ,RBY ,NOM_OPT)
1922 ENDIF
1923
1924
1925
1926 IF (N_SEATBELT > 0) CALL INIT_SEATBELT_RBODIES(NNPBY,NRBODY,NPBY,SLRBODY,LPBY,SICODE,ICODE,NSLIPRING)
1927
1928
1929
1930 IF(IRIGID_MAT > 0)THEN
1931 CALL ININODE_RM(CONNEC ,IRIG_NODE, SLNRBM , NSLNRBM ,NRBYM ,
1932 . NGSLNRBYM,STIFN ,STIFR,RMSTIFN, RMSTIFR ,
1933 . NELEMR,NINDX )
1934 ENDIF
1935
1936
1937
1938 CALL INISRF(X,V,VR,NPBY,RBY,IGRSURF,BUFSF)
1939
1940
1941
1942 CALL RCHECKMASS(IXR ,GEO ,PM ,MSR ,INR ,
1943 . MS ,IN ,ITAB ,IGEO ,IPM ,
1944 . BUFMAT ,IPART ,IPART(I15F),NPBY ,LPBY )
1945
1946
1947
1948 IF (NFXBODY>0) THEN
1949
1950
1951
1952 CALL INI_FXBODY(FXBIPM, FXBRPM, FXBNOD, FXBGLM,FXBCPM,
1953 . FXBCPS, FXBLM, FXBFLS, FXBDLS,FXBMOD,
1954 . ITAB, X ,MS, IN, FXB_MATRIX,
1955 . FXB_MATRIX_ADD,FXB_LAST_ADRESS,ICODE,NOM_OPT(1,PTR_NOPT_FXB+1))
1956
1957 ALLOCATE(MBUFEL_TMP(LBUFEL), MDEPL_TMP(3*NUMNOD))
1958
1959 NMANI=0
1960 DO I=1,LENVAR
1961 FXBDEP(I)=ZERO
1962 FXBVIT(I)=ZERO
1963 FXBACC(I)=ZERO
1964 ENDDO
1965 CALL FXBVINI(FXBIPM, FXBVIT, FXBRPM, V, VR)
1966 IRCS=0
1967 DO I=1,NFXBODY
1968 ALM=FXBIPM(19,I)
1969 ASIG=FXBIPM(20,I)
1970 AMOD=FXBIPM(7,I)
1971 ARPM=FXBIPM(14,I)
1972 NBNO=FXBIPM(3,I)
1973 NME=FXBIPM(17,I)
1974 NML=FXBIPM(4,I)
1975 NELS=FXBIPM(21,I)
1976 NELC=FXBIPM(22,I)
1977 NELT=FXBIPM(34,I)
1978 NELP=FXBIPM(35,I)
1979 NELTG=FXBIPM(23,I)
1980 LVSIG=NELS*7+NELC*10+NELT*2+NELP*8+NELTG*10
1981 IFILE=FXBIPM(29,I)
1982 IF (IFILE == 0) THEN
1983 AMOD=AMOD+NME*NBNO*6
1984 ELSEIF (IFILE == 1) THEN
1985 AMOD=AMOD+NME*FXBIPM(18,I)*6
1986 ENDIF
1987 FXBIPM(31,I)=IRCS
1988 CALL FXBSINI(
1989 . FXBELM(ALM) , FXBSIG(ASIG), NELS, NELC, NELTG,
1990 . X , IPARG , PM , FXBMOD(AMOD), NML ,
1991 . NBNO , IXS , IXC , IXTG , GEO ,
1992 . FXBRPM(ARPM), I , FXBIPM(29,I), LVSIG ,FXBIPM(18,I),
1993 . NME , IRCS, FXBIPM(30,I), NELT, NELP ,
1994 . IXT , IXP ,IBEAM_VECTOR,RBEAM_VECTOR)
1995
1996 FXBIPM(33,I)=IRCS
1997 ADRRPM=FXBIPM(14,I)
1998 FXBRPM(ADRRPM+10)=ZERO
1999 FXBRPM(ADRRPM+11)=ZERO
2000
2001
2002 IF (FXBIPM(36,I) == 1) THEN
2003 FXBID=FXBIPM(1,I)
2004 ANOD=FXBIPM(6,I)
2005 IFILE=FXBIPM(29,I)
2006 IRCM=FXBIPM(30,I)
2007 IRCS=FXBIPM(31,I)
2008 NSNI=FXBIPM(18,I)
2009 NSN=FXBIPM(3,I)
2010 IRCM=IRCM+(NSN-NSNI)*FXBIPM(17,I)
2011 IMIN=FXBIPM(37,I)
2012 IMAX=FXBIPM(38,I)
2013
2014 DO J=1,FXBIPM(4,I)
2015 DO K=1,3*NUMNOD
2016 MDEPL_TMP(K)=ZERO
2017 ENDDO
2018 DO K=1,LBUFEL
2019 MBUFEL_TMP(K)=ELBUF(K)
2020 ENDDO
2021
2022 CALL MODDEPL(
2023 . FXBNOD(ANOD), FXBMOD(AMOD), MDEPL_TMP , IFILE, IRCM,
2024 . NSNI, NSN, AMOD )
2025
2026 CALL MODBUFEL(
2027 . FXBELM(ALM), FXBSIG(ASIG), MBUFEL_TMP, NELS, NELC,
2028 . NELT, NELP, NELTG, FXBRPM(ARPM), LBUFEL,
2029 . ASIG , IFILE, IRCS , LVSIG )
2030
2031.AND. IF (J>=IMINJ<=IMAX) THEN
2032 NMANI=NMANI+1
2033 FXANI(1,NMANI)=FXBID
2034 FXANI(2,NMANI)=J
2035 DO K=1,3*NUMNOD
2036 MDEPL(K,NMANI)=MDEPL_TMP(K)
2037 ENDDO
2038 DO K=1,LBUFEL
2039 MBUFEL(K,NMANI)=MBUFEL_TMP(K)
2040 ENDDO
2041 ENDIF
2042 ENDDO
2043 ENDIF
2044 ENDDO
2045
2046 DEALLOCATE(MBUFEL_TMP, MDEPL_TMP)
2047 ENDIF ! end flexible bodies
2048
2049
2050
2051 CALL INIRBE2(IRBE2 ,LRBE2 ,ITAB ,X ,MS ,
2052 . IN ,STIFN ,STIFR ,TOTMAS,XG ,
2053 . YG ,ZG ,B1 ,B2 ,B3 ,
2054 . B5 ,B6 ,B9 ,
2055 . NOM_OPT(1,PTR_NOPT_RBE2+1),ITAGND)
2056
2057
2058
2059 FLAG_KJ = 0
2060 DO NG=1,NGROUP
2061 NEL = IPARG(2,NG)
2062 ITY = IPARG(5,NG)
2063 NFT = IPARG(3,NG)
2064 IAD = IPARG(4,NG)
2065 LFT = 1
2066 LLT = NEL
2067 IF (ITY == 6) THEN
2068 IPROP=IXR(1,1+NFT)
2069 IGTYP = NINT(GEO(NPROPG*(IPROP-1)+12))
2070 GBUF => ELBUF_TAB(NG)%GBUF
2071 IF (IGTYP==33) THEN
2072 NUVAR = NINT(GEO(NPROPG*(IPROP-1)+25))
2073 CALL RINI33_RB(NEL,NUVAR,IPROP,IXR,NPBY,
2074 . LPBY,RBY,STIFR,GBUF%VAR,ITAB,
2075 . IGEO(1,IPROP),IXR_KJ,GBUF%MASS)
2076 ELSEIF (IGTYP==45) THEN
2077 IF (FLAG_KJ==0) WRITE(IOUT,1500)
2078 FLAG_KJ = 1
2079 NUVAR = NINT(GEO(NPROPG*(IPROP-1)+25))
2080 CALL RINI45_RB(NEL,NUVAR,IPROP,IXR,NPBY,
2081 . LPBY,RBY,STIFR,GBUF%VAR,ITAB,
2082 . IGEO(1,IPROP),IXR_KJ,GBUF%MASS,MS,IN)
2083 ENDIF
2084 ENDIF
2085 ENDDO
2086
2087
2088
2089 IF (NDAMP_FREQ_RANGE > 0) THEN
2090 call damping_range_init(ndamp,nrdamp,dampr,ngroup,nparg,iparg,elbuf_tab)
2091 ENDIF
2092
2093
2094 IF(IPRI>=2) THEN
2095 WRITE(IOUT,1000)
2096 WRITE(IOUT,'(5(i10,1x,1pg20.13))') (ITAB(I),MS(I),I=1,NUMNOD)
2097 IF (GLOB_THERM%ITHERM_FE > 0) THEN
2098 WRITE(IOUT,1600)
2099 WRITE(IOUT,'(5(i10,1x,1pg20.13))') (ITAB(I),TEMP(I),I=1,NUMNOD)
2100 WRITE(IOUT,1700)
2101 WRITE(IOUT,'(5(i10,1x,1pg20.13))') (ITAB(I),MCP(I),I=1,NUMNOD)
2102 ENDIF
2103 ENDIF
2104
2105
2106
2107 CALL OUTPART(PARTSAV,IPART,NPART)
2108
2109
2110
2111 CALL OUTPART5(GROUP_PARAM_TAB,IPART,IPART(I15A),IPARG,IGEO,GEO ,PM )
2112
2113
2114
2115 IF(IPARI0 == 3)THEN
2116 DO N=1,NUMNOD
2117 MS(N) = MS(N) +
2118 . I8MI(1,N) + r8_deuxm43 * (
2119 . I8MI(2,N) + r8_deuxm43 * I8MI(3,N))
2120 ENDDO
2121 IF(IRODDL/=0)THEN
2122 DO N=1,NUMNOD
2123 IN(N) = IN(N) +
2124 . I8MI(4,N) + r8_deuxm43 * (
2125 . I8MI(5,N) + r8_deuxm43 * I8MI(6,N))
2126 ENDDO
2127 ENDIF
2128 ENDIF
2129
2130
2131
2132 IF (NS10E >0) THEN
2133 DO N=1,NUMNOD
2134 IF (ITAGND(N)/=0) CYCLE
2135 NN3=3*N
2136 NN2=NN3-1
2137 NN1=NN2-1
2138 TOTMAS=TOTMAS+MS(N)
2139 XG=XG+MS(N)*X(NN1)
2140 YG=YG+MS(N)*X(NN2)
2141 ZG=ZG+MS(N)*X(NN3)
2142
2143 XX=(X(NN1))**2
2144 YY=(X(NN2))**2
2145 ZZ=(X(NN3))**2
2146 XY=(X(NN1))*(X(NN2))
2147 XZ=(X(NN1))*(X(NN3))
2148 YZ=(X(NN2))*(X(NN3))
2149
2150 B1=B1+(YY+ZZ)*MS(N)
2151 B5=B5+(XX+ZZ)*MS(N)
2152 B9=B9+(XX+YY)*MS(N)
2153 B2=B2-XY*MS(N)
2154 B6=B6-YZ*MS(N)
2155 B3=B3-XZ*MS(N)
2156 ENDDO
2157 ELSE
2158 DO N=1,NUMNOD
2159 NN3=3*N
2160 NN2=NN3-1
2161 NN1=NN2-1
2162 TOTMAS=TOTMAS+MS(N)
2163 XG=XG+MS(N)*X(NN1)
2164 YG=YG+MS(N)*X(NN2)
2165 ZG=ZG+MS(N)*X(NN3)
2166
2167 XX=(X(NN1))**2
2168 YY=(X(NN2))**2
2169 ZZ=(X(NN3))**2
2170 XY=(X(NN1))*(X(NN2))
2171 XZ=(X(NN1))*(X(NN3))
2172 YZ=(X(NN2))*(X(NN3))
2173
2174 B1=B1+(YY+ZZ)*MS(N)
2175 B5=B5+(XX+ZZ)*MS(N)
2176 B9=B9+(XX+YY)*MS(N)
2177 B2=B2-XY*MS(N)
2178 B6=B6-YZ*MS(N)
2179 B3=B3-XZ*MS(N)
2180 ENDDO
2181 END IF
2182
2183 IF(IRODDL/=0)THEN
2184 DO N=1,NUMNOD
2185 B1=B1+IN(N)
2186 B5=B5+IN(N)
2187 B9=B9+IN(N)
2188 ENDDO
2189 ENDIF
2190
2191 XG=XG/MAX(TOTMAS,EM20)
2192 YG=YG/MAX(TOTMAS,EM20)
2193 ZG=ZG/MAX(TOTMAS,EM20)
2194 WRITE(IOUT,1100)
2195 WRITE(IOUT,'(5x,1pg20.13,3(1x,g20.13))')
2196 . TOTMAS,XG,YG,ZG
2197
2198 XX=XG**2
2199 YY=YG**2
2200 ZZ=ZG**2
2201 XY=XG*YG
2202 XZ=XG*ZG
2203 YZ=YG*ZG
2204
2205 B1=B1-(YY+ZZ)*TOTMAS
2206 B5=B5-(XX+ZZ)*TOTMAS
2207 B9=B9-(XX+YY)*TOTMAS
2208 B2=B2+XY*TOTMAS
2209 B6=B6+YZ*TOTMAS
2210 B3=B3+XZ*TOTMAS
2211 WRITE(IOUT,1200)
2212 WRITE(IOUT,'(4x,3(1x,1pg20.13),3(1x,g20.13))')
2213 . B1,B5,B9,B2,B6,B3
2214
2215
2216
2217 WRITE(IOUT,'(//)')
2218 WRITE(IOUT,1300)
2219 WRITE(IOUT,1400) TOTADDMAS
2220
2221
2222
2223
2224 CALL NLOC_DMG_INIT(ELBUF_TAB,NLOC_DMG ,IPARG ,IXC ,
2225 . IXS ,IXTG ,ELE_AREA ,DTELEM ,
2226 . NUMEL ,IPM ,X ,XREFS ,
2227 . XREFC ,XREFTG ,MAT_PARAM)
2228
2229
2230
2231 IF (GLOB_THERM%ITHERM_FE > 0 ) THEN
2232 DEALLOCATE(MCPS,MCPP)
2233.OR..OR. IF(NUMELS10 > 0NUMELS16 > 0 NUMELS20 > 0)
2234 . DEALLOCATE(MCPSX)
2235 ENDIF
2236
2237 DEALLOCATE (PARTSAV)
2238
2239 DEALLOCATE(MS_LAYERC,ZI_LAYERC,MSZ2C,ZPLY)
2240 DEALLOCATE (PARTSAV1_PON)
2241
2242 DEALLOCATE(CONNEC,IRIG_NODE)
2243 IF(ALLOCATED(PART_AREA))DEALLOCATE(PART_AREA)
2244 DEALLOCATE(I8MI)
2245 IF(ALLOCATED(VPRELOAD)) DEALLOCATE (VPRELOAD)
2246 IF(ALLOCATED(ELE_AREA))DEALLOCATE(ELE_AREA)
2247
2248 RETURN
2249
2250 1000 FORMAT(//
2251 . 5X,'nodal masses',/
2252 . 5X,'------------',/
2253 . 5X,' node mass',22X,'node mass',22X,'node mass',22X,'node mass',
2254 .22X,'node mass'/)
2255 1100 FORMAT(//
2256 . 5X,'total mass and mass center',/
2257 . 5X,'--------------------------',/
2258 . 5X,' mass',20X,'x',20X,'y',20X,'z'/)
2259 1200 FORMAT(//
2260 . 5X,'total inertia',/
2261 . 5X,'-------------',/
2262 .22X,'ixx',18X,'iyy',18X,'izz',18X,'ixy',18X,'iyz',18X,'izx')
2263 1300 FORMAT(
2264 . 5X,' added nodal non-structural masses ' /
2265 . 5X,'-----------------------------------' /)
2266 1400 FORMAT(5X,' total added mass = ',1PG20.13//)
2267 1500 FORMAT(//
2268 . 5X,'kjoint2 spring definition',/
2269 . 5X,'------------------------'/)
2270 1600 FORMAT(//
2271 . 5X,'initial nodal temperatures',/
2272 . 5X,'------------------',/
2273 . 6X,5('node temperature',15X),'node temperature'/)
2274 1700 FORMAT(//
2275 . 5X,'initial nodal mcp ',/
2276 . 5X,'--------------------------',/
2277 . 6X,5('node mcp ',15X),'node mcp '/)
2278 RETURN
subroutine dtnoda(nodft, nodlt, neltst, ityptst, itab, ms, in, stifn, stifr, dt2t, dmast, dinert, adt, adm, imsch, weight, a, ar, igrnod, nodadt_therm, adi, rbym, arby, arrby, weight_md, mcp, mcp_off, condn, nale, h3d_data)
subroutine checkmp(numel, ix, nix, ng, ne, emat, epid, ipm, igeo, elem, ipartel)
integer function uel2sys(iu, ksysusr, numel)
1.15.0