OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
initia.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com08_c.inc"
#include "com04_c.inc"
#include "com_xfem1.inc"
#include "sphcom.inc"
#include "vect01_c.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "scr03_c.inc"
#include "scr14_c.inc"
#include "scr17_c.inc"
#include "scr23_c.inc"
#include "tablen_c.inc"
#include "lagmult.inc"
#include "scr12_c.inc"
#include "fxbcom.inc"
#include "userlib.inc"
#include "sms_c.inc"
#include "boltpr_c.inc"
#include "titr_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine initia (iparg, elbuf, ms, in, v, x, ixs, ixq, ixc, ixt, ixp, ixr, detonators, geo, pm, rby, npby, lpby, npc, npts, pld, veul, ale_connectivity, skew, fill, ipart, itab, sensors, skvol, ixtg, thk, nloc_dmg, group_param_tab, glob_therm, igrnod, igrsurf, bufsf, vr, bufmat, xlas, las, dtelem, mss, msq, msc, mst, msp, msr, mstg, ptg, inc, nod2eltg, knod2eltg, inp, inr, intg, index, itri, kxx, ixx, xelemwa, iwa, nod2elq, knod2elq, nod2els, knod2els, kxsp, ixsp, nod2sp, ispcond, icode, iskew, iskn, ispsym, xframe, isptag, spbuf, mssx, nsigi, npbyl, lpbyl, rbyl, msnf, mssf, nsigsh, igeo, ipm, nsigs, nsigsph, vns, vnsx, stc, stt, stp, str, sttg, stur, bns, bnsx, volnod, bvolnod, etnod, nshnod, stifint, fxbdep, fxbvit, fxbacc, fxbipm, fxbrpm, fxbelm, fxbsig, fxbmod, ins, ptshel, ptsh3n, ptsol, ptquad, wma, ptsph, fxbnod, mbufel, mdepl, fxani, numel, nsigrs, sh4tree, sh3tree, mcp, temp, imerge2, iadmerge2, slnrbm, nslnrbm, rmstifn, rmstifr, ms_layer, zi_layer, itag, itagel, mcpc, mcptg, xrefc, xreftg, xrefs, mssa, msrt, irbe2, lrbe2, inivol, kvol, nbsubmat, ixs10, ixs16, ixs20, totaddmas, ipmas, stifn, msz2, itagn, sitage, itage, ixr_kj, elbuf_tab, nom_opt, ptr_nopt_rbe2, ptr_nopt_adm, ptr_nopt_fun, sol2sph, irst, sh3trim, xfem_tab, kxig3d, ixig3d, msig3d, knot, nctrlmax, wige, stack, rnoise, drape, sh4ang, sh3ang, geo_stack, igeo_stack, stifintr, strc, strp, strr, strtg, perturb, itagnd, nativ_sms, iloadp, facload, ptspri, nsigbeam, ptbeam, nsigtruss, pttruss, multi_fvm, sigi, sigsh, sigsp, sigsph, sigrs, sigbeam, sigtruss, strsglob, straglob, orthoglob, isigsh, iyldini, ksigsh3, fail_ini, iusolyld, iuser, iddlevel, inimap1d, inimap2d, func2d, fvm_inivel, tagprt_sms, igrbric, igrquad, igrsh4n, igrsh3n, igrpart, totmas, knotlocpc, knotlocel, vnige, bnige, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxb_matrix, fxb_matrix_add, fxb_last_adress, ptr_nopt_fxb, r_skew, knod2el1d, nod2el1d, ebcs_tab, rby_iniaxis, alea, knod2elc, nod2elc, dr, slrbody, drapeg, ipari, intbuf_tab, interfaces, mat_param, npreload_a, preload_a, fail_fractal, fail_brokmann, defaults, ndamp_freq_range, dampr, ibeam_vector, rbeam_vector, ikine)
subroutine chekmp2 (numel, ipart, ipartel, ix, nix, ne, emat, epid, ipm, igeo, elem)
subroutine checkmp (numel, ix, nix, ng, ne, emat, epid, ipm, igeo, elem, ipartel)
subroutine outpart (partsav, ipart, npart)
subroutine sgsavref (npe, xref, sav, nel)
subroutine sgsavinieref (npe, straglob, sigsp, nsigi, ptsol, sav, offg, nel)
subroutine sgsavinierefq (npe, straglob, sigsp, nsigi, ptsol, sav, offg, ixs, dr, ndr, nel)
subroutine outpart5 (group_param_tab, ipart, iparts, iparg, igeo, geo, pm)

Function/Subroutine Documentation

◆ checkmp()

subroutine checkmp ( integer numel,
integer, dimension(nix,*) ix,
integer nix,
integer ng,
integer ne,
integer, dimension(0:*) emat,
integer, dimension(0:*) epid,
integer, dimension(npropmi,*) ipm,
integer, dimension(npropgi,*) igeo,
character *(*) elem,
integer, dimension(*) ipartel )

Definition at line 2444 of file initia.F.

2445C-----------------------------------------------
2446C M o d u l e s
2447C-----------------------------------------------
2448 USE message_mod
2449 USE names_and_titles_mod , ONLY : nchartitle
2450C-----------------------------------------------
2451C I m p l i c i t T y p e s
2452C-----------------------------------------------
2453#include "implicit_f.inc"
2454C-----------------------------------------------
2455C C o m m o n B l o c k s
2456C-----------------------------------------------
2457#include "param_c.inc"
2458#include "scr17_c.inc"
2459#include "com01_c.inc"
2460C-----------------------------------------------
2461C D u m m y A r g u m e n t s
2462C-----------------------------------------------
2463 INTEGER NUMEL,NIX,NG,NE,CPT
2464 INTEGER IX(NIX,*),EMAT(0:*),EPID(0:*), IGEO(NPROPGI,*),IPM(NPROPMI,*),IPARTEL(*)
2465 CHARACTER *(*) ELEM
2466C-----------------------------------------------
2467C L o c a l V a r i a b l e s
2468C-----------------------------------------------
2469 INTEGER I, MT, IG
2470 CHARACTER(LEN=NCHARTITLE)::TITR,TITR2
2471C-----------------------------------------------
2472C P r e - C o n d i t i o n s
2473C-----------------------------------------------
2474 IF(elem=='SHELL3N' .AND. n2d>0)RETURN
2475 IF(elem=='TRIA' .AND. n2d==0)RETURN
2476C-----------------------------------------------
2477C S o u r c e L i n e s
2478C-----------------------------------------------
2479 IF(elem == 'SPRING')THEN
2480 DO i=1,numel
2481 ig=ix(ng,i)
2482 IF(ig<=0)THEN
2483 CALL ancmsg(msgid=59,
2484 . msgtype=msgerror,
2485 . anmode=aninfo_blind_2,
2486 . i1=ig,
2487 . c1=elem,
2488 . i2=ix(ne,i),
2489 . prmod=msg_cumu)
2490 ELSEIF(epid(igeo(11,ig)) == 0)THEN
2491 CALL fretitl2(titr2,igeo(npropgi-ltitr+1,ig),ltitr)
2492 CALL ancmsg(msgid=60,
2493 . msgtype=msgerror,
2494 . anmode=aninfo_blind_2,
2495 . i1=igeo(1,ig),
2496 . c1=elem,
2497 . i2=igeo(11,ig),
2498 . i3=ix(ne,i),
2499 . prmod=msg_cumu)
2500 ENDIF
2501 ENDDO
2502 CALL ancmsg(msgid=59,
2503 . msgtype=msgerror,
2504 . anmode=aninfo_blind_2,
2505 . c1=elem,
2506 . prmod=msg_print)
2507 CALL ancmsg(msgid=60,
2508 . msgtype=msgerror,
2509 . anmode=aninfo_blind_2,
2510 . c1=elem,
2511 . prmod=msg_print)
2512 ELSEIF(elem == 'BRICK'.OR.elem == 'QUAD'.OR.elem == 'TRIA')THEN
2513 DO i=1,numel
2514 mt=ix(1,i)
2515 ig=ix(ng,i)
2516 IF(mt<=0)THEN
2517 CALL ancmsg(msgid=61,
2518 . msgtype=msgerror,
2519 . anmode=aninfo,
2520 . i1=mt,
2521 . c1=elem,
2522 . i2=ix(ne,i),
2523 . prmod=msg_cumu)
2524 ENDIF
2525 IF (ig<=0) THEN
2526 CALL ancmsg(msgid=59,
2527 . msgtype=msgerror,
2528 . anmode=aninfo_blind_2,
2529 . i1=ig,
2530 . c1=elem,
2531 . i2=ix(ne,i),
2532 . prmod=msg_cumu)
2533 ELSEIF(ig/=0) THEN
2534 IF (epid(igeo(11,ig)) == 0)THEN
2535 CALL fretitl2(titr2,igeo(npropgi-ltitr+1,ig),ltitr)
2536 CALL ancmsg(msgid=60,
2537 . msgtype=msgerror,
2538 . anmode=aninfo_blind_2,
2539 . i1=igeo(1,ig),
2540 . c1=elem,
2541 . i2=igeo(11,ig),
2542 . i3=ix(ne,i),
2543 . prmod=msg_cumu)
2544 ENDIF
2545 ENDIF
2546 ENDDO
2547 CALL ancmsg(msgid=59,
2548 . msgtype=msgerror,
2549 . anmode=aninfo_blind_2,
2550 . c1=elem,
2551 . prmod=msg_print)
2552 CALL ancmsg(msgid=60,
2553 . msgtype=msgerror,
2554 . anmode=aninfo_blind_2,
2555 . c1=elem,
2556 . prmod=msg_print)
2557 CALL ancmsg(msgid=61,
2558 . msgtype=msgerror,
2559 . anmode=aninfo_blind_2,
2560 . c1=elem,
2561 . prmod=msg_print)
2562
2563 ELSEIF(elem == 'SPHCEL')THEN
2564 DO i=1,numel
2565 mt=ix(1,i)
2566 ig=ix(ng,i)
2567 IF(mt<=0)THEN
2568 CALL ancmsg(msgid=61,
2569 . msgtype=msgerror,
2570 . anmode=aninfo,
2571 . i1=mt,
2572 . c1=elem,
2573 . i2=ix(ne,i),
2574 . prmod=msg_cumu)
2575 ENDIF
2576 IF(ig/=0.AND.epid(igeo(11,ig)) == 0)THEN
2577 CALL fretitl2(titr2,igeo(npropgi-ltitr+1,ig),ltitr)
2578 CALL ancmsg(msgid=60,
2579 . msgtype=msgerror,
2580 . anmode=aninfo_blind_2,
2581 . i1=igeo(1,ig),
2582 . c1=elem,
2583 . i2=igeo(11,ig),
2584 . i3=ix(ne,i),
2585 . prmod=msg_cumu)
2586 ENDIF
2587 ENDDO
2588 CALL ancmsg(msgid=60,
2589 . msgtype=msgerror,
2590 . anmode=aninfo_blind_2,
2591 . c1=elem,
2592 . prmod=msg_print)
2593 CALL ancmsg(msgid=61,
2594 . msgtype=msgerror,
2595 . anmode=aninfo_blind_2,
2596 . c1=elem,
2597 . prmod=msg_print)
2598 ELSEIF(elem == 'BEAM')THEN
2599 DO i=1,numel
2600 mt=ix(1,i)
2601 ig=ix(ng,i)
2602c IGTYP=IGEO(11,IG)
2603 IF(mt<=0)THEN
2604 CALL ancmsg(msgid=61,
2605 . msgtype=msgerror,
2606 . anmode=aninfo,
2607 . i1=mt,
2608 . c1=elem,
2609 . i2=ix(ne,i),
2610 . prmod=msg_cumu)
2611 ENDIF
2612 IF(ig<=0)THEN
2613 CALL ancmsg(msgid=59,
2614 . msgtype=msgerror,
2615 . anmode=aninfo_blind_2,
2616 . i1=ig,
2617 . c1=elem,
2618 . i2=ix(ne,i),
2619 . prmod=msg_cumu)
2620 ELSEIF(epid(igeo(11,ig)) == 0)THEN
2621 CALL fretitl2(titr2,igeo(npropgi-ltitr+1,ig),ltitr)
2622 CALL ancmsg(msgid=60,
2623 . msgtype=msgerror,
2624 . anmode=aninfo_blind_2,
2625 . i1=igeo(1,ig),
2626 . c1=elem,
2627 . i2=igeo(11,ig),
2628 . i3=ix(ne,i),
2629 . prmod=msg_cumu)
2630 ENDIF
2631
2632 IF((igeo(11,ig) == 3.AND.ipm(2,mt) == 36).OR.
2633 . (igeo(11,ig) == 18.AND.ipm(2,mt) == 1)) THEN
2634 CALL fretitl2(titr,
2635 . igeo(npropgi-ltitr+1,ig),ltitr)
2636 CALL ancmsg(msgid=745,
2637 . msgtype=msgerror,
2638 . anmode=aninfo_blind_2,
2639 . i1=ix(ne,i),
2640 . c1=titr,
2641 . i2=igeo(1,ig),
2642 . i3=ipm(2,mt))
2643 ENDIF
2644 ENDDO
2645 CALL ancmsg(msgid=59,
2646 . msgtype=msgerror,
2647 . anmode=aninfo_blind_2,
2648 . c1=elem,
2649 . prmod=msg_print)
2650 CALL ancmsg(msgid=60,
2651 . msgtype=msgerror,
2652 . anmode=aninfo_blind_2,
2653 . c1=elem,
2654 . prmod=msg_print)
2655 CALL ancmsg(msgid=61,
2656 . msgtype=msgerror,
2657 . anmode=aninfo_blind_2,
2658 . c1=elem,
2659 . prmod=msg_print)
2660 ELSE
2661 DO i=1,numel
2662 mt=ix(1,i)
2663 ig=ix(ng,i)
2664
2665 IF(ipartel(i) == 0)THEN
2666 CALL ancmsg(msgid=1125,
2667 . msgtype=msgerror,
2668 . anmode=aninfo_blind,
2669 . c1=elem,
2670 . i1=ix(ne,i),
2671 . prmod=msg_cumu)
2672 ELSEIF(mt<=0)THEN
2673 CALL ancmsg(msgid=61,
2674 . msgtype=msgerror,
2675 . anmode=aninfo,
2676 . i1=mt,
2677 . c1=elem,
2678 . i2=ix(ne,i),
2679 . prmod=msg_cumu)
2680 ENDIF
2681 IF(ipartel(i) == 0)THEN
2682 CONTINUE
2683 ELSEIF(ig<=0)THEN
2684 CALL ancmsg(msgid=59,
2685 . msgtype=msgerror,
2686 . anmode=aninfo_blind_2,
2687 . i1=ig,
2688 . c1=elem,
2689 . i2=ix(ne,i),
2690 . prmod=msg_cumu)
2691 ELSEIF(epid(igeo(11,ig)) == 0)THEN
2692 CALL fretitl2(titr2,igeo(npropgi-ltitr+1,ig),ltitr)
2693 CALL ancmsg(msgid=60,
2694 . msgtype=msgerror,
2695 . anmode=aninfo_blind_2,
2696 . i1=igeo(1,ig),
2697 . c1=elem,
2698 . i2=igeo(11,ig),
2699 . i3=ix(ne,i),
2700 . prmod=msg_cumu)
2701 ENDIF
2702 IF((igeo(11,ig) == 9).AND.(ipm(2,mt) == 25).AND.
2703 . (ipm(10,mt) == 1)) THEN
2704 CALL ancmsg(msgid=561,
2705 . msgtype=msgerror,
2706 . anmode=aninfo_blind_2,
2707 . c1=elem,
2708 . i1=ix(ne,i))
2709 ENDIF
2710 ENDDO
2711 CALL ancmsg(msgid=59,
2712 . msgtype=msgerror,
2713 . anmode=aninfo_blind_2,
2714 . c1=elem,
2715 . prmod=msg_print)
2716 CALL ancmsg(msgid=60,
2717 . msgtype=msgerror,
2718 . anmode=aninfo_blind_2,
2719 . c1=elem,
2720 . prmod=msg_print)
2721 CALL ancmsg(msgid=61,
2722 . msgtype=msgerror,
2723 . anmode=aninfo_blind_2,
2724 . c1=elem,
2725 . prmod=msg_print)
2726 CALL ancmsg(msgid=1125,
2727 . msgtype=msgerror,
2728 . anmode=aninfo_blind,
2729 . c1=elem,
2730 . prmod=msg_print)
2731 ENDIF
2732C
2733 RETURN
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
ancmsg
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)
Definition message.F:889
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804

◆ chekmp2()

subroutine chekmp2 ( integer numel,
integer, dimension(lipart1,*) ipart,
integer, dimension(*) ipartel,
integer, dimension(nix,*) ix,
integer nix,
integer ne,
integer, dimension(0:*) emat,
integer, dimension(0:*) epid,
integer, dimension(npropmi,*) ipm,
integer, dimension(npropgi,*) igeo,
character *(*) elem )

Definition at line 2206 of file initia.F.

2209C-----------------------------------------------
2210C M o d u l e s
2211C-----------------------------------------------
2212 USE message_mod
2213 USE names_and_titles_mod , ONLY : nchartitle
2214C-----------------------------------------------
2215C I m p l i c i t T y p e s
2216C-----------------------------------------------
2217#include "implicit_f.inc"
2218C-----------------------------------------------
2219C C o m m o n B l o c k s
2220C-----------------------------------------------
2221#include "param_c.inc"
2222#include "scr17_c.inc"
2223C-----------------------------------------------
2224C D u m m y A r g u m e n t s
2225C-----------------------------------------------
2226 INTEGER NUMEL,NIX,NE
2227 INTEGER IPART(LIPART1,*),IPARTEL(*),IX(NIX,*),EMAT(0:*),EPID(0:*),
2228 . IGEO(NPROPGI,*), IPM(NPROPMI,*)
2229C REAL
2230c my_real
2231c . PM(NPROPM,*)
2232 CHARACTER *(*) ELEM
2233 CHARACTER(LEN=NCHARTITLE)::TITR2
2234C-----------------------------------------------
2235C L o c a l V a r i a b l e s
2236C-----------------------------------------------
2237 INTEGER I, MT, IG, IPRT
2238C
2239 IF(elem == 'SPRING')THEN
2240 DO i=1,numel
2241 iprt=ipartel(i)
2242 ig =ipart(2,iprt)
2243 IF(ig<=0)THEN
2244C
2245C WRITE(IOUT,*)' **ERROR INVALID PROPERTY NUMBER',IG
2246C WRITE(IOUT,*)' FOR ',ELEM,IX(NE,I)
2247 CALL ancmsg(msgid=59, msgtype=msgerror,anmode=aninfo_blind_2,
2248 . i1=ig,
2249 . c1=elem,
2250 . i2=ix(ne,i),
2251 . prmod=msg_cumu)
2252 ELSEIF(epid(igeo(11,ig)) == 0)THEN
2253C WRITE(IOUT,*)' **ERROR INVALID PROPERTY TYPE',IGEO(11,IG)
2254C WRITE(IOUT,*)' FOR ',ELEM,IX(NE,I)
2255 CALL fretitl2(titr2,igeo(npropgi-ltitr+1,ig),ltitr)
2256 CALL ancmsg(msgid=60,
2257 . msgtype=msgerror,
2258 . anmode=aninfo_blind_2,
2259 . i1=igeo(1,ig),
2260 . c1=elem,
2261 . i2=igeo(11,ig),
2262 . i3=ix(ne,i),
2263 . prmod=msg_cumu)
2264 ENDIF
2265 ENDDO
2266 CALL ancmsg(msgid=59,
2267 . msgtype=msgerror,
2268 . anmode=aninfo_blind_2,
2269 . c1=elem,
2270 . prmod=msg_print)
2271 CALL ancmsg(msgid=60,
2272 . msgtype=msgerror,
2273 . anmode=aninfo_blind_2,
2274 . c1=elem,
2275 . prmod=msg_print)
2276
2277 ELSEIF(elem == 'BRICK'.OR.elem == 'QUAD')THEN
2278 DO i=1,numel
2279 iprt=ipartel(i)
2280 mt =ipart(1,iprt)
2281 ig =ipart(2,iprt)
2282 IF(mt<=0)THEN
2283C WRITE(IOUT,*)' **ERROR INVALID MATERIAL NUMBER',MT
2284C WRITE(IOUT,*)' FOR ',ELEM,IX(NE,I)
2285 CALL ancmsg(msgid=61,
2286 . msgtype=msgerror,
2287 . anmode=aninfo_blind_2,
2288 . i1=mt,
2289 . c1=elem,
2290 . i2=ix(ne,i),
2291 . prmod=msg_cumu)
2292 ENDIF
2293 IF (ig<=0) THEN
2294 CALL ancmsg(msgid=59,
2295 . msgtype=msgerror,
2296 . anmode=aninfo_blind_2,
2297 . i1=ig,
2298 . c1=elem,
2299 . i2=ix(ne,i),
2300 . prmod=msg_cumu)
2301 ELSEIF(ig/=0.AND.epid(igeo(11,ig)) == 0)THEN
2302 CALL fretitl2(titr2,igeo(npropgi-ltitr+1,ig),ltitr)
2303 CALL ancmsg(msgid=60,
2304 . msgtype=msgerror,
2305 . anmode=aninfo_blind_2,
2306 . i1=igeo(1,ig),
2307 . c1=elem,
2308 . i2=igeo(11,ig),
2309 . i3=ix(ne,i),
2310 . prmod=msg_cumu)
2311 ENDIF
2312 ENDDO
2313 CALL ancmsg(msgid=59,
2314 . msgtype=msgerror,
2315 . anmode=aninfo_blind_2,
2316 . c1=elem,
2317 . prmod=msg_print)
2318 CALL ancmsg(msgid=60,
2319 . msgtype=msgerror,
2320 . anmode=aninfo_blind_2,
2321 . c1=elem,
2322 . prmod=msg_print)
2323 CALL ancmsg(msgid=61,
2324 . msgtype=msgerror,
2325 . anmode=aninfo_blind_2,
2326 . c1=elem,
2327 . prmod=msg_print)
2328C
2329 ELSEIF(elem == 'SPHCEL')THEN
2330 DO i=1,numel
2331 iprt=ipartel(i)
2332 mt =ipart(1,iprt)
2333 ig =ipart(2,iprt)
2334 IF(mt<=0)THEN
2335C IERR = IERR + 1
2336C WRITE(IOUT,*)' **ERROR INVALID MATERIAL NUMBER',MT
2337C WRITE(IOUT,*)' FOR ',ELEM,IX(NE,I)
2338 CALL ancmsg(msgid=61,
2339 . msgtype=msgerror,
2340 . anmode=aninfo_blind_2,
2341 . i1=mt,
2342 . c1=elem,
2343 . i2=ix(ne,i),
2344 . prmod=msg_cumu)
2345 ENDIF
2346 IF(ig/=0.AND.epid(igeo(11,ig)) == 0)THEN
2347C IERR = IERR + 1
2348C WRITE(IOUT,*)' **ERROR INVALID PROPERTY TYPE',IGEO(11,IG)
2349C WRITE(IOUT,*)' FOR ',ELEM,IX(NE,I)
2350 CALL fretitl2(titr2,igeo(npropgi-ltitr+1,ig),ltitr)
2351 CALL ancmsg(msgid=60,
2352 . msgtype=msgerror,
2353 . anmode=aninfo_blind_2,
2354 . i1=igeo(1,ig),
2355 . c1=elem,
2356 . i2=igeo(11,ig),
2357 . i3=ix(ne,i),
2358 . prmod=msg_cumu)
2359 ENDIF
2360 ENDDO
2361 CALL ancmsg(msgid=60,
2362 . msgtype=msgerror,
2363 . anmode=aninfo_blind_2,
2364 . c1=elem,
2365 . prmod=msg_print)
2366 CALL ancmsg(msgid=61,
2367 . msgtype=msgerror,
2368 . anmode=aninfo_blind_2,
2369 . c1=elem,
2370 . prmod=msg_print)
2371 ELSE
2372 DO i=1,numel
2373 iprt=ipartel(i)
2374 mt =ipart(1,iprt)
2375 ig =ipart(2,iprt)
2376 IF(mt<=0)THEN
2377C
2378C WRITE(IOUT,*)' **ERROR INVALID MATERIAL NUMBER',MT
2379C WRITE(IOUT,*)' FOR ',ELEM,IX(NE,I)
2380 CALL ancmsg(msgid=61,
2381 . msgtype=msgerror,
2382 . anmode=aninfo_blind_2,
2383 . i1=mt,
2384 . c1=elem,
2385 . i2=ix(ne,i),
2386 . prmod=msg_cumu)
2387 ENDIF
2388 IF(ig<=0)THEN
2389C
2390C WRITE(IOUT,*)' **ERROR INVALID PROPERTY NUMBER',IG
2391C WRITE(IOUT,*)' FOR ',ELEM,IX(NE,I)
2392 CALL ancmsg(msgid=59,
2393 . msgtype=msgerror,
2394 . anmode=aninfo_blind_2,
2395 . i1=ig,
2396 . c1=elem,
2397 . i2=ix(ne,i),
2398 . prmod=msg_cumu)
2399 ELSEIF(epid(igeo(11,ig)) == 0)THEN
2400C
2401C WRITE(IOUT,*)' **ERROR INVALID PROPERTY TYPE',IGEO(11,IG)
2402C WRITE(IOUT,*)' FOR ',ELEM,IX(NE,I)
2403 CALL fretitl2(titr2,igeo(npropgi-ltitr+1,ig),ltitr)
2404 CALL ancmsg(msgid=60,
2405 . msgtype=msgerror,
2406 . anmode=aninfo_blind_2,
2407 . i1=igeo(1,ig),
2408 . c1=elem,
2409 . i2=igeo(11,ig),
2410 . i3=ix(ne,i),
2411 . prmod=msg_cumu)
2412 ENDIF
2413 ENDDO
2414 CALL ancmsg(msgid=59,
2415 . msgtype=msgerror,
2416 . anmode=aninfo_blind_2,
2417 . c1=elem,
2418 . prmod=msg_print)
2419 CALL ancmsg(msgid=60,
2420 . msgtype=msgerror,
2421 . anmode=aninfo_blind_2,
2422 . c1=elem,
2423 . prmod=msg_print)
2424 CALL ancmsg(msgid=61,
2425 . msgtype=msgerror,
2426 . anmode=aninfo_blind_2,
2427 . c1=elem,
2428 . prmod=msg_print)
2429 ENDIF
2430C
2431 RETURN

◆ initia()

subroutine initia ( integer, dimension(nparg,ngroup) iparg,
elbuf,
ms,
in,
v,
x,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
type (detonators_struct_) detonators,
geo,
pm,
rby,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer, dimension(*) npc,
integer npts,
pld,
veul,
type (t_ale_connectivity), intent(inout) ale_connectivity,
skew,
fill,
integer, dimension(*) ipart,
integer, dimension(*) itab,
type (sensors_), intent(in) sensors,
integer, intent(in) skvol,
integer, dimension(nixtg,*) ixtg,
thk,
type (nlocal_str_) nloc_dmg,
type (group_param_), dimension(ngroup) group_param_tab,
type (glob_therm_), intent(inout) glob_therm,
type (group_), dimension(ngrnod) igrnod,
type (surf_), dimension(nsurf) igrsurf,
bufsf,
vr,
bufmat,
xlas,
integer, dimension(*) las,
dtelem,
mss,
msq,
msc,
mst,
msp,
msr,
mstg,
ptg,
inc,
integer, dimension(3*numeltg), intent(in) nod2eltg,
integer, dimension(numnod+1), intent(in) knod2eltg,
inp,
inr,
intg,
integer, dimension(*) index,
integer, dimension(*) itri,
integer, dimension(nixx,*) kxx,
integer, dimension(*) ixx,
xelemwa,
integer, dimension(*) iwa,
integer, dimension(3*numelq), intent(in) nod2elq,
integer, dimension(numnod+1), intent(in) knod2elq,
integer, dimension(3*numels), intent(in) nod2els,
integer, dimension(numnod+1), intent(in) knod2els,
integer, dimension(*) kxsp,
integer, dimension(*) ixsp,
integer, dimension(*) nod2sp,
integer, dimension(*) ispcond,
integer, dimension(*) icode,
integer, dimension(*) iskew,
integer, dimension(liskn,*) iskn,
integer, dimension(*) ispsym,
xframe,
integer, dimension(*) isptag,
spbuf,
mssx,
integer nsigi,
integer, dimension(nnpby,*) npbyl,
integer, dimension(*) lpbyl,
rbyl,
msnf,
mssf,
integer nsigsh,
integer, dimension(npropgi,*) igeo,
integer, dimension(npropmi,*) ipm,
integer nsigs,
integer nsigsph,
vns,
vnsx,
stc,
stt,
stp,
str,
sttg,
stur,
bns,
bnsx,
volnod,
bvolnod,
etnod,
integer, dimension(*) nshnod,
stifint,
fxbdep,
fxbvit,
fxbacc,
integer, dimension(nbipm,*) fxbipm,
fxbrpm,
integer, dimension(*) fxbelm,
fxbsig,
fxbmod,
ins,
integer, dimension(*) ptshel,
integer, dimension(*) ptsh3n,
integer, dimension(*) ptsol,
integer, dimension(*) ptquad,
wma,
integer, dimension(*) ptsph,
integer, dimension(*) fxbnod,
mbufel,
mdepl,
integer, dimension(2,*) fxani,
integer numel,
integer nsigrs,
integer, dimension(*) sh4tree,
integer, dimension(*) sh3tree,
mcp,
temp,
integer, dimension(numnod+1) imerge2,
integer, dimension(numnod+1) iadmerge2,
integer, dimension(*) slnrbm,
integer, dimension(*) nslnrbm,
rmstifn,
rmstifr,
ms_layer,
zi_layer,
integer, dimension(*) itag,
integer, dimension(*) itagel,
mcpc,
mcptg,
xrefc,
xreftg,
xrefs,
mssa,
msrt,
integer, dimension(*) irbe2,
integer, dimension(*) lrbe2,
type (inivol_struct_), dimension(num_inivol) inivol,
kvol,
integer nbsubmat,
integer, dimension(*) ixs10,
integer, dimension(*) ixs16,
integer, dimension(*) ixs20,
totaddmas,
type (admas_), dimension(nodmas) ipmas,
target stifn,
msz2,
integer, dimension(*) itagn,
integer sitage,
integer, dimension(*), target itage,
integer, dimension(5,*) ixr_kj,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(lnopt1,*) nom_opt,
integer ptr_nopt_rbe2,
integer ptr_nopt_adm,
integer ptr_nopt_fun,
integer, dimension(*) sol2sph,
integer, dimension(*) irst,
integer, dimension(*) sh3trim,
type (elbuf_struct_), dimension(ngroup,nxel), target xfem_tab,
integer, dimension(nixig3d,*) kxig3d,
integer, dimension(*) ixig3d,
msig3d,
knot,
integer nctrlmax,
wige,
type (stack_ply) stack,
rnoise,
type (drape_), dimension(numelc_drape + numeltg_drape) drape,
sh4ang,
sh3ang,
geo_stack,
integer, dimension(*) igeo_stack,
stifintr,
strc,
strp,
strr,
strtg,
integer, dimension(nperturb) perturb,
integer, dimension(*) itagnd,
integer, dimension(*) nativ_sms,
integer, dimension(sizloadp,*), intent(in) iloadp,
dimension(lfacload,*), intent(in) facload,
integer, dimension(*) ptspri,
integer nsigbeam,
integer, dimension(*) ptbeam,
integer nsigtruss,
integer, dimension(*) pttruss,
type (multi_fvm_struct) multi_fvm,
sigi,
sigsh,
sigsp,
sigsph,
sigrs,
sigbeam,
sigtruss,
integer, dimension(*) strsglob,
integer, dimension(*) straglob,
integer, dimension(*) orthoglob,
integer isigsh,
integer iyldini,
integer ksigsh3,
integer, dimension(5) fail_ini,
integer iusolyld,
integer iuser,
integer iddlevel,
type (inimap1d_struct), dimension(ninimap1d), intent(inout) inimap1d,
type (inimap2d_struct), dimension(ninimap2d), intent(inout) inimap2d,
type (func2d_struct), dimension(nfunc2d), intent(in) func2d,
type (fvm_inivel_struct), dimension(*), intent(in) fvm_inivel,
integer, dimension(*) tagprt_sms,
type (group_), dimension(ngrbric) igrbric,
type (group_), dimension(ngrquad) igrquad,
type (group_), dimension(ngrshel) igrsh4n,
type (group_), dimension(ngrsh3n) igrsh3n,
type (group_), dimension(ngrpart) igrpart,
totmas,
knotlocpc,
knotlocel,
vnige,
bnige,
fxbglm,
fxbcpm,
fxbcps,
fxblm,
fxbfls,
fxbdls,
fxb_matrix,
integer, dimension(4,*) fxb_matrix_add,
integer, dimension(*) fxb_last_adress,
integer ptr_nopt_fxb,
integer, dimension(*) r_skew,
integer, dimension(*) knod2el1d,
integer, dimension(*) nod2el1d,
type(t_ebcs_tab), intent(inout) ebcs_tab,
rby_iniaxis,
alea,
integer, dimension(*) knod2elc,
integer, dimension(*) nod2elc,
dr,
integer, intent(in) slrbody,
type (drapeg_) drapeg,
integer, dimension(npari,ninter), intent(in) ipari,
type (intbuf_struct_), dimension(ninter), intent(in) intbuf_tab,
type (interfaces_), intent(inout) interfaces,
type (matparam_struct_), dimension(nummat), intent(inout) mat_param,
integer, intent(in) npreload_a,
type (prel1d_), dimension(npreload_a), intent(in) preload_a,
type (fail_fractal_), intent(in) fail_fractal,
type (fail_brokmann_), intent(in) fail_brokmann,
type (defaults_), intent(in) defaults,
integer, intent(in) ndamp_freq_range,
dimension(nrdamp,ndamp), intent(in) dampr,
integer, dimension(numelp), intent(in) ibeam_vector,
dimension(3,numelp), intent(in) rbeam_vector,
integer, dimension(3*numnod), intent(in) ikine )

Definition at line 129 of file initia.F.

188C-----------------------------------------------
189C M o d u l e s
190C-----------------------------------------------
191 USE submodel_mod
192 USE matparam_def_mod
193 USE message_mod
194 USE stack_mod
195 USE multi_fvm_mod
196 USE bpreload_mod
197 USE inimap1d_mod
198 USE inimap2d_mod
199 USE func2d_mod
200 USE groupdef_mod
201 USE optiondef_mod
202 USE nlocal_reg_mod
203 USE group_param_mod
204 USE detonators_mod
205 USE drape_mod
206 USE inivol_def_mod , ONLY : inivol_struct_, num_inivol
207 USE ebcs_mod
208 USE ale_connectivity_mod
209 USE array_mod
210 USE interfaces_mod
211 USE intbufdef_mod
212 USE init_seatbelt_rbodies_mod
213 USE bcs_mod
214 USE sensor_mod
215 USE random_walk_def_mod
216 USE defaults_mod
217 USE names_and_titles_mod , ONLY : nchartitle
218 USE elbufdef_mod
219 USE multimat_param_mod , ONLY : m51_lc0max, m51_ssp0max, m51_tcp_ref, m51_lset_iflg6, m51_iflg6, m51_iloop_nrf
220 USE brokmann_random_def_mod
221 USE glob_therm_mod
222 USE damping_range_init_mod
223 USE eikonal_solver_mod, ONLY : eikonal_solver
224 USE detonation_times_printout_mod , ONLY : detonation_times_printout
225C-----------------------------------------------
226C I m p l i c i t T y p e s
227C-----------------------------------------------
228#include "implicit_f.inc"
229C-----------------------------------------------
230C G l o b a l P a r a m e t e r s
231C-----------------------------------------------
232#include "mvsiz_p.inc"
233C-----------------------------------------------
234C C o m m o n B l o c k s
235C-----------------------------------------------
236#include "com01_c.inc"
237#include "com08_c.inc"
238#include "com04_c.inc"
239#include "com_xfem1.inc"
240#include "sphcom.inc"
241#include "vect01_c.inc"
242#include "units_c.inc"
243#include "param_c.inc"
244#include "scr03_c.inc"
245#include "scr14_c.inc"
246#include "scr17_c.inc"
247#include "scr23_c.inc"
248#include "tablen_c.inc"
249#include "lagmult.inc"
250#include "scr12_c.inc"
251#include "fxbcom.inc"
252#include "userlib.inc"
253#include "sms_c.inc"
254#include "boltpr_c.inc"
255#include "titr_c.inc"
256#include "tabsiz_c.inc"
257C-----------------------------------------------
258C D u m m y A r g u m e n t s
259C-----------------------------------------------
260 INTEGER,INTENT(IN) :: SKVOL
261 INTEGER IPARG(NPARG,NGROUP), IXS(NIXS,*), IXQ(NIXQ,*),IXC(NIXC,*),
262 . IGEO(NPROPGI,*), IXT(NIXT,*),IXP(NIXP,*), IXR(NIXR,*),
263 . NPBY(NNPBY,*),LPBY(*),NPBYL(NNPBY,*),LPBYL(*),NPC(*),
264 . ITAB(*), IPART(*),
265 . LAS(*),
266 . IXTG(NIXTG,*),INDEX(*),ITRI(*),IWA(*),KXX(NIXX,*),IXX(*),
267 . KXSP(*) ,IXSP(*) ,NOD2SP(*),ISPCOND(*),ISPSYM(*),ISPTAG(*),
268 . ICODE(*),ISKEW(*),ISKN(LISKN,*), IPM(NPROPMI,*), NSHNOD(*),
269 . PTSHEL(*),PTSH3N(*),PTSOL(*),PTQUAD(*),PTSPH(*),
270 . IXS10(*) ,IXS20(*) ,IXS16(*), SH4TREE(*), SH3TREE(*),
271 . IMERGE2(NUMNOD+1),IADMERGE2(NUMNOD+1),
272 . SLNRBM(*) ,NSLNRBM(*),ITAG(*),ITAGEL(*),IRBE2(*) ,LRBE2(*),
273 . ITAGN(*),
274 . IXR_KJ(5,*), SOL2SPH(*), IRST(*),SH3TRIM(*),KXIG3D(NIXIG3D,*),
275 . IXIG3D(*),IGEO_STACK(*),PERTURB(NPERTURB),
276 . NATIV_SMS(*),PTSPRI(*),PTBEAM(*),PTTRUSS(*),STRSGLOB(*),
277 . STRAGLOB(*),ORTHOGLOB(*),ISIGSH,IYLDINI,KSIGSH3,FAIL_INI(5),
278 . IUSOLYLD,IUSER,IDDLEVEL,NBSUBMAT, TAGPRT_SMS(*),SITAGE,FXB_MATRIX_ADD(4,*),
279 . FXB_LAST_ADRESS(*),PTR_NOPT_FXB,R_SKEW(*), NPTS,KNOD2EL1D(*) ,NOD2EL1D(*),
280 . KNOD2ELC(*),NOD2ELC(*)
281 TYPE(T_EBCS_TAB), INTENT(INOUT) :: EBCS_TAB
282 INTEGER,TARGET :: ITAGE(*)
283 INTEGER,POINTER :: ptr_ITAGE
284 INTEGER NSIGI,NSIGSH,
285 . NSIGS, NSIGSPH, FXBIPM(NBIPM,*), FXBELM(*),NSIGRS,
286 . NUMEL,STAT,
287 . NCTRLMAX,NSIGBEAM,NSIGTRUSS
288 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*),SLRBODY
289 INTEGER,INTENT(IN) :: IPARI(NPARI,NINTER)
290 my_real,INTENT(IN) :: facload(lfacload,*)
291 my_real
292 . elbuf(*), ms(*), in(*), v(*), x(*), geo(*),pm(npropm,*),
293 . rby(nrby,*),pld(*),veul(*),skew(lskew,*),fill(*),
294 . thk(*),bufsf(*), vr(3,*),bufmat(*),ptg(3,*),xlas(*),
295 . dtelem(*),mss(*), msq(*),msc(*),mst(*),msp(*),msr(*),
296 . mstg(*),inc(*),rbyl(nrby,*),
297 . inp(*),inr(*),intg(*),
298 . xelemwa(*),
299 . xframe(nxframe,*),spbuf(*),mssx(*),msnf(*),
300 . mssf(*), wma(*),
301 . vns(*) ,vnsx(*) ,stc(*) ,stt(*) ,stp(*) ,str(*) ,
302 . sttg(*) ,stur(*) ,bns(*) ,bnsx(*) ,
303 . volnod(*) ,bvolnod(*) , etnod(*), stifint(*), fxbdep(*),
304 . fxbvit(*), fxbacc(*), fxbrpm(*), fxbsig(*), fxbmod(*),
305 . ins(*), mcp(*),temp(*),rmstifn(*), rmstifr(*),
306 . ms_layer(*),zi_layer(*), mcpc(*), mcptg(*),
307 . mbufel(lbufel,*), mdepl(3*numnod,*),
308 . xrefc(4,3,*),xreftg(3,3,*),xrefs(8,3,*), mssa(*), msrt(*),
309 . kvol(nbsubmat,*),totaddmas,msz2(*),
310 . msig3d(*),knot(*),wige(*),rnoise(*),
311 . sh4ang(*),sh3ang(*),geo_stack(*),stifintr(*),
312 . strc(*),strr(*),strp(*),strtg(*),sigi(nsigs,*),sigsh(max(1,nsigsh),*),
313 . sigsp(nsigi,*),sigsph(nsigsph,*),sigrs(nsigrs,*),sigbeam(nsigbeam,*),
314 . sigtruss(nsigtruss,*),totmas, knotlocpc(*),knotlocel(*),vnige(*),bnige(*),
315 . fxbglm(*),fxbcpm(*),fxbcps(*),fxblm(*),fxbfls(*),fxbdls(*),fxb_matrix(*),
316 . rby_iniaxis(7,*),alea(*),dr(sdr)
317
318 my_real, DIMENSION(NUMNOD*2), TARGET :: stifn
319 my_real , DIMENSION(:), POINTER :: stifr
320C
321 INTEGER NOM_OPT(LNOPT1,*),PTR_NOPT_RBE2,PTR_NOPT_ADM,PTR_NOPT_FUN,IOPT
322 INTEGER FXBNOD(*), FXANI(2,*),ITAGND(*)
323 INTEGER,INTENT(IN) :: NPRELOAD_A
324 INTEGER,INTENT(IN) :: NDAMP_FREQ_RANGE
325 my_real,INTENT(IN) :: dampr(nrdamp,ndamp)
326 INTEGER,INTENT(IN) :: IBEAM_VECTOR(NUMELP)
327 my_real,INTENT(IN) :: rbeam_vector(3,numelp)
328 INTEGER,INTENT(IN) :: IKINE(3*NUMNOD)
329C
330 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
331 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP,NXEL) :: XFEM_TAB
332 TYPE (STACK_PLY) :: STACK
333 TYPE (MULTI_FVM_STRUCT) :: MULTI_FVM
334 TYPE (INIMAP1D_STRUCT), DIMENSION(NINIMAP1D), INTENT(INOUT) :: INIMAP1D
335 TYPE (INIMAP2D_STRUCT), DIMENSION(NINIMAP2D), INTENT(INOUT) :: INIMAP2D
336 TYPE (FUNC2D_STRUCT), DIMENSION(NFUNC2D), INTENT(IN) :: FUNC2D
337 TYPE (FVM_INIVEL_STRUCT), INTENT(IN) :: FVM_INIVEL(*)
338 TYPE (NLOCAL_STR_) :: NLOC_DMG
339 TYPE (GROUP_PARAM_), DIMENSION(NGROUP) :: GROUP_PARAM_TAB
340 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
341C-----------------------------------------------
342 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
343 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
344 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
345 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
346 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
347 TYPE (GROUP_) , DIMENSION(NGRPART) :: IGRPART
348 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
349 TYPE (ADMAS_) , DIMENSION(NODMAS) :: IPMAS
350 TYPE (INIVOL_STRUCT_) , DIMENSION(NUM_INIVOL) :: INIVOL
351 TYPE (DETONATORS_STRUCT_) :: DETONATORS
352 TYPE (DRAPE_) , DIMENSION(NUMELC_DRAPE + NUMELTG_DRAPE):: DRAPE
353 TYPE (DRAPEG_) :: DRAPEG
354 TYPE (t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
355 TYPE (INTBUF_STRUCT_) , INTENT(IN ) :: INTBUF_TAB(NINTER)
356 TYPE (INTERFACES_) , INTENT(INOUT ) :: INTERFACES
357 TYPE (PREL1D_) , INTENT(IN) ,DIMENSION(NPRELOAD_A) :: PRELOAD_A
358 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
359 TYPE (FAIL_FRACTAL_) ,INTENT(IN) :: FAIL_FRACTAL
360 TYPE (FAIL_BROKMANN_) ,INTENT(IN) :: FAIL_BROKMANN
361 TYPE (DEFAULTS_) ,INTENT(IN) :: DEFAULTS
362 type (glob_therm_) ,intent(inout) :: glob_therm
363C-----------------------------------------------
364C L o c a l V a r i a b l e s
365C-----------------------------------------------
366C remove automatic allocation to reduce stack consumption
367C INTEGER *8 I8MI(6,NUMNOD)
368 INTEGER (KIND=8), DIMENSION(:,:), ALLOCATABLE :: I8MI
369 INTEGER NG, NEL, NVC, K, N, M, NSL, NN1, NN2, NN3, I, K0,NV46,
370 . ISPH, J, IG, OFFSET,ISOLNOD,IPROP,IGTYP,
371 . I15A,I15B,I15C,I15D,I15E,I15F,I15G,I15H,I15I,I15J,I15K,I15ATH,
372 . I15L,NC1_OLD, NC2_OLD, NC3_OLD, NC4_OLD,
373 . NC5_OLD, NC6_OLD, NC7_OLD, NC8_OLD,
374 . NC1, NC2, NC3, NC4, NC5, NC6, NC7, NC8,
375 . IINT, ISENS,ITHK, IHBE, JHBE, ILEV,ISH3N,
376 . KK1, KK2, KK3,IADUIX,IADUX ,IADUV ,IADUVR,IADUMS,
377 . IADUIN,IADUSM,IADUSR,IADUMV,IADURV, NUVAR,ICNOD, RBYID,
378 . ADRRPM,ALM,ASIG,NELS,NELC,NELTG,AMOD,NBNO,NME,NML,ARPM,LVSIG,
379 . IFILE,IRCS,NELT,NELP,FXBID, ANOD, IRCM, NSNI, NSN, NMANI, IMIN, IMAX,
380 . NELEMR,CPT_ELTENS,IXFEM,ITG,ISUBSTACK,NCTRL, ITETRA10, KK,PX,PY,PZ,IPID
381
382 INTEGER SOLMAT(0:MAXLAW), COQMAT(0:MAXLAW), TRUMAT(0:MAXLAW),
383 . POUMAT(0:MAXLAW),SPHMAT(0:MAXLAW),
384 . RESMAT(0:MAXLAW),RESPID(0:50), SPHPID(0:50),
385 . SOLPID(0:50), COQPID(0:52), TRUPID(0:50), POUPID(0:50)
386 INTEGER II,NINDX,FLAG_KJ
387
388 INTEGER IBOLTP !Bolt preloading
389 my_real dt2s, b1, b2, b3, b6, b5, b9, xg, yg, zg, xx, yy, zz, xy, xz, yz,dtnoda,fill_ratio
390 my_real, DIMENSION(:), ALLOCATABLE ::
391 . mbufel_tmp, mdepl_tmp,partsav,mcps,mcpsx,
392 . ms_layerc,zi_layerc, msz2c,zply,partsav1_pon,mcpp
393
394 INTEGER, DIMENSION(:), ALLOCATABLE :: IRIG_NODE, CONNEC
395 my_real, DIMENSION(:), ALLOCATABLE :: part_area,ele_area
396
397 my_real addedms(npart)
398 INTEGER ID,ISTOT, NF1,NNOD,NSROT,IDRAPE,ICPRE
399 CHARACTER(LEN=NCHARTITLE)::TITR
400 LOGICAL :: ERROR_THROWN
401 INTEGER,INTENT(IN) :: NOD2ELTG(3*NUMELTG)
402 INTEGER,INTENT(IN) :: NOD2ELQ(3*NUMELQ)
403 INTEGER,INTENT(IN) :: NOD2ELS(3*NUMELS)
404 INTEGER,INTENT(IN) :: KNOD2ELTG(NUMNOD+1)
405 INTEGER,INTENT(IN) :: KNOD2ELQ(NUMNOD+1)
406 INTEGER,INTENT(IN) :: KNOD2ELS(NUMNOD+1)
407C-----------------------------------------------
408C D e r i v e d T y p e D e f i n i t i o n s
409C-----------------------------------------------
410 TYPE(G_BUFEL_) ,POINTER :: GBUF
411 TYPE(BUF_MAT_) ,POINTER :: MBUF
412C-----------------------------------------------
413 EXTERNAL uel2sys
414 INTEGER UEL2SYS
415c___________________________________________________
416 my_real r8_deuxm43
417 integer*8 i8_deuxp43
418 data i8_deuxp43 /'80000000000'x/
419 r8_deuxm43 = 1.d00 / i8_deuxp43
420c___________________________________________________
421C 1 2 3 4 5 6 7 8 9 10
422 DATA solpid/1,0,0,0,0,0,1,0,0,0,0,
423 1 0,0,0,1,1,0,0,0,0,1,
424 2 1,1,0,0,0,0,0,0,1,0,
425 3 0,0,0,0,0,0,0,0,0,0,
426 4 0,0,1,0,0,0,0,0,0,0/
427 DATA coqpid/1,1,0,0,0,0,0,1,0,1,1,
428 1 1,0,0,0,0,1,1,0,1,0,
429 2 0,0,0,0,0,0,0,0,0,0,
430 3 0,0,0,0,0,0,0,0,0,0,
431 4 0,0,0,0,0,0,0,0,0,0,
432 5 1,1/
433 DATA trupid/0,0,1,0,0,0,0,0,0,0,0,
434 1 0,0,0,0,0,0,0,0,0,0,
435 2 0,0,0,0,0,0,0,0,0,0,
436 3 0,0,0,0,0,0,0,0,0,0,
437 4 0,0,0,0,0,0,0,0,0,0/
438 DATA poupid/0,0,0,1,0,0,0,0,0,0,0,
439 1 0,0,0,0,0,0,0,1,0,0,
440 2 0,0,0,0,0,0,0,0,0,0,
441 3 0,0,0,0,0,0,0,0,0,0,
442 4 0,0,0,0,0,0,0,0,0,0/
443 DATA respid/0,0,0,0,1,0,0,0,1,0,0,
444 1 0,1,1,0,0,0,0,0,0,0,
445 2 0,0,1,0,1,1,1,0,1,1,
446 3 1,1,1,0,1,1,0,0,0,0,
447 4 0,0,0,1,1,1,0,0,0,0/
448 DATA sphpid/0,0,0,0,0,0,0,0,0,0,0,
449 1 0,0,0,0,0,0,0,0,0,0,
450 2 0,0,0,0,0,0,0,0,0,0,
451 3 0,0,0,1,0,0,0,0,0,0,
452 4 0,0,0,0,0,0,0,0,0,0/
453C=======================================================================
454
455 m51_iloop_nrf = 0
456 nvc = 0
457 stat = 0
458
459 IF(ipari0==3)THEN
460 ALLOCATE (i8mi(6,numnod) ,stat=stat)
461 ELSE
462 ALLOCATE (i8mi(6,1) ,stat=stat)
463 ENDIF
464
465 ALLOCATE (partsav(20*npart) ,stat=stat)
466
467 stifr => stifn(numnod+1:numnod*2)
468 ALLOCATE (partsav1_pon(npart) ,stat=stat)
469C
470 IF(npreload > 0) THEN
471 ALLOCATE (vpreload(7*numels) ,stat=stat)
472 ENDIF
473C
474 IF (npart > 0) partsav= zero
475 IF (npart > 0) partsav1_pon=zero
476 IF (npreload > 0 .AND. numels > 0) vpreload = zero
477C xfem
478 itg = 0
479 IF(icrack3d > 0)itg = 1 + numelc
480
481 ! To avoid thwrowing ngroup times the same error
482 error_thrown = .false.
483
484 anim_m=0
485 DO i=1,mx_ani
486 anim_n(i)=0
487 anim_v(i)=0
488 anim_ce(i)=0
489 anim_ct(i)=0
490 anim_se(i)=0
491 anim_st(i)=0
492 anim_fe(i)=0
493 anim_ft(i)=0
494 ENDDO
495 nn_ani=0
496 nv_ani=0
497 nce_ani=0
498 nct_ani=0
499 nse_ani=0
500 nst_ani=0
501 nfe_ani=0
502 nindx = 0
503C ---
504 IF(irigid_mat > 0 ) THEN
505 nelemr = numelc + numels10 + numels8 + numeltg
506 ALLOCATE(irig_node(numnod))
507 ALLOCATE(connec(nelemr*10))
508 irig_node = 0
509 connec = 0
510 ELSE
511 ALLOCATE(connec(0),irig_node(0))
512 ENDIF
513C
514C ply xfem
515C
516 IF(iplyxfem> 0 ) THEN
517 ALLOCATE(ms_layerc(nplymax*numelc))
518 ALLOCATE(zi_layerc(nplymax*numelc))
519 ALLOCATE(msz2c(numelc))
520 ALLOCATE(zply(nplymax))
521 ms_layerc = zero
522 zi_layerc = zero
523 msz2c = zero
524 zply = zero
525 ELSE
526 ALLOCATE(ms_layerc(0))
527 ALLOCATE(zi_layerc(0))
528 ALLOCATE(msz2c(0))
529 ALLOCATE(zply(0))
530 ENDIF
531C-------------------------------------
532C MASS + INERTIA IPARITH = 4
533C-------------------------------------
534 IF(ipari0 == 3)THEN
535 DO n=1,numnod
536 i8mi(1,n) = 0
537 i8mi(2,n) = 0
538 i8mi(3,n) = 0
539 i8mi(4,n) = 0
540 i8mi(5,n) = 0
541 i8mi(6,n) = 0
542 ENDDO
543 ENDIF
544 DO n=0,maxlaw
545 solmat(n) = 1
546 coqmat(n) = 0
547 trumat(n) = 0
548 poumat(n) = 0
549 sphmat(n) = 0
550 resmat(n) = 0
551 ENDDO
552 DO n=51,maxlaw
553 solmat(n) = 0
554 ENDDO
555 solmat(15) = 0
556 solmat(19) = 0
557 solmat(25) = 1
558 solmat(27) = 0
559 solmat(32) = 0
560 solmat(43) = 0
561C
562C solids
563 solmat(53) = 1
564 solmat(51) = 1
565 solmat(52) = 1
566 solmat(56) = 1
567 solmat(59) = 1
568 solmat(60) = 1
569 solmat(61) = 0
570 solmat(62) = 1
571 solmat(65) = 1
572 solmat(66) = 1
573 solmat(67) = 1
574 solmat(68) = 1
575 solmat(69) = 1
576 solmat(70) = 1
577 solmat(71) = 1
578 solmat(72) = 1
579 solmat(74) = 1
580 solmat(75) = 1
581 solmat(76) = 1
582 solmat(77) = 1
583 solmat(78) = 1
584 solmat(79) = 1
585 solmat(80) = 1
586 solmat(81) = 1
587 solmat(82) = 1
588 solmat(83) = 1
589 solmat(84) = 1
590 solmat(88) = 1
591 solmat(92) = 1
592 solmat(90) = 1
593 solmat(93) = 1
594 solmat(94) = 1
595 solmat(95) = 1
596 solmat(96) = 1
597 solmat(97) = 1
598 solmat(99) = 1
599 solmat(100)= 1
600 solmat(101)= 1
601 solmat(102)= 1
602 solmat(103)= 1
603 solmat(104)= 1
604 solmat(105)= 1
605 solmat(106)= 1
606 solmat(107)= 1
607 solmat(109)= 1
608 solmat(111)= 1
609 solmat(112)= 1
610 solmat(115)= 1
611 solmat(116)= 1
612 solmat(117)= 1
613 solmat(120)= 1
614 solmat(121)= 1
615 solmat(122)= 1
616 solmat(124)= 1
617 solmat(125)= 1
618 solmat(127)= 1
619 solmat(134)= 1
620 solmat(151)= 1
621 solmat(187)= 1
622 solmat(190)= 1
623 solmat(200)= 1
624C shells
625 coqmat(0) = 1
626 coqmat(1) = 1
627 coqmat(2) = 1
628 coqmat(7 ) = 1
629 coqmat(13) = 1
630 coqmat(15) = 1
631 coqmat(19) = 1
632 coqmat(22) = 1
633 coqmat(25) = 1
634 coqmat(27) = 1
635 coqmat(29) = 1
636 coqmat(30) = 1
637 coqmat(31) = 1
638 coqmat(32) = 1
639 coqmat(34) = 1
640 coqmat(35) = 1
641 coqmat(36) = 1
642 coqmat(42) = 1
643 coqmat(43) = 1
644 coqmat(44) = 1
645 coqmat(45) = 1
646 coqmat(48) = 1
647 coqmat(52) = 1
648 coqmat(55) = 1
649 coqmat(56) = 1
650 coqmat(57) = 1
651 coqmat(58) = 1
652 coqmat(60) = 1
653 coqmat(62) = 1
654 coqmat(63) = 1
655 coqmat(64) = 1
656 coqmat(65) = 1
657 coqmat(66) = 1
658 coqmat(69) = 1
659 coqmat(71) = 1
660 coqmat(72) = 1
661 coqmat(73) = 1
662 coqmat(76) = 1
663 coqmat(78) = 1
664 coqmat(80) = 1
665 coqmat(82) = 1
666 coqmat(85) = 1
667 coqmat(86) = 1
668 coqmat(87) = 1
669 coqmat(88) = 1
670 coqmat(91) = 1
671 coqmat(92) = 0 ! is not available
672 coqmat(93) = 1
673 coqmat(94) = 0 ! is not available
674 coqmat(96) = 1
675 coqmat(98) = 1
676 coqmat(99) = 1
677 coqmat(104) = 1
678 coqmat(107) = 1
679 coqmat(109) = 1
680 coqmat(110) = 1
681 coqmat(112) = 1
682 coqmat(119) = 1
683 coqmat(121) = 1
684 coqmat(122) = 1
685 coqmat(125) = 1
686 coqmat(151) = 1
687 coqmat(158) = 1
688 coqmat(200) = 1
689C truss
690 trumat(0) = 1
691 trumat(1) = 1
692 trumat(2) = 1
693 trumat(34) = 1
694 trumat(44) = 1
695C beam
696 poumat(0) = 1
697 poumat(1) = 1
698 poumat(2) = 1
699 poumat(34) = 1
700 poumat(36) = 1
701 poumat(44) = 1
702 poumat(71) = 1
703C sph
704 sphmat(1) = 1
705 sphmat(2) = 1
706 sphmat(3) = 1
707 sphmat(4) = 1
708 sphmat(5) = 1
709 sphmat(6) = 1
710 sphmat(10) = 1
711 sphmat(12) = 1
712 sphmat(18) = 1
713 sphmat(21) = 1
714 sphmat(22) = 1
715 sphmat(23) = 1
716 sphmat(24) = 1
717 sphmat(28) = 1
718 sphmat(29) = 1
719 sphmat(30) = 1
720 sphmat(31) = 1
721 sphmat(32) = 1
722 sphmat(33) = 1
723 sphmat(34) = 1
724 sphmat(35) = 1
725 sphmat(36) = 1
726 sphmat(38) = 1
727 sphmat(40) = 1
728 sphmat(41) = 1
729 sphmat(42) = 1
730 sphmat(49) = 1
731 sphmat(50) = 1
732 sphmat(53) = 1
733
734 sphmat(66) = 1
735 sphmat(70) = 1
736 sphmat(72) = 1
737 sphmat(75) = 1
738 sphmat(76) = 1
739 sphmat(79) = 1
740 sphmat(81) = 1
741 sphmat(88) = 1
742 sphmat(90) = 1 ! not tested
743 sphmat(92) = 1 ! not tested
744 sphmat(93) = 1 ! not tested
745 sphmat(94) = 1 ! not tested
746 sphmat(97) = 1
747 sphmat(102)= 1
748 sphmat(103)= 1
749 sphmat(111)= 1 ! is not tested
750 sphmat(105)= 1
751 resmat(54) = 1
752
753 i15ath = 1+lipart1*npart+lipart1*nthpart
754 i15a = i15ath+2*9*npart+2*9*nthpart
755 i15b = i15a+numels
756 i15c = i15b+numelq
757 i15d = i15c+numelc
758 i15e = i15d+numelt
759 i15f = i15e+numelp
760 i15g = i15f+numelr
761 i15h = i15g
762 i15i = i15h+numeltg
763 i15j = i15i+numelx
764 i15k = i15j+numsph
765 i15l = i15k+numelig3d
766
767C-----------------------------------------------------
768C VERIFICATION DES MATERIAUX ET PID
769C-----------------------------------------------------
770 CALL checkmp(numels,ixs,nixs,nixs-1,nixs,solmat,solpid,ipm,igeo,'BRICK' ,ipart(i15a))
771 CALL checkmp(numelq,ixq,nixq,nixq-1,nixq,solmat,solpid,ipm,igeo,'QUAD' ,ipart(i15b))
772 CALL checkmp(numelc,ixc,nixc,nixc-1,nixc,coqmat,coqpid,ipm,igeo,'SHELL' ,ipart(i15c))
773 CALL checkmp(numeltg,ixtg,nixtg,nixtg-1,nixtg,coqmat,coqpid,ipm,igeo,'SHELL3N',ipart(i15h))
774 CALL checkmp(numelt,ixt,nixt,nixt-1,nixt,trumat,trupid,ipm,igeo,'TRUSS' ,ipart(i15d))
775 CALL checkmp(numelp,ixp,nixp,nixp-1,nixp,poumat,poupid,ipm,igeo,'BEAM' ,ipart(i15e))
776 CALL checkmp(numelr,ixr,nixr, 1,nixr,-1 ,respid,ipm,igeo,'SPRING' ,ipart(i15f))
777 CALL chekmp2(numsph,ipart ,ipart(i15j),kxsp,nisp,nisp,sphmat,sphpid,ipm,igeo,'SPHCEL')
778
779C--------------------------------------------
780C Initialisation of Wall_Boundary Conditions
781C--------------------------------------------
782 IF(bcs%NUM_WALL > 0)THEN
783 CALL init_bcs_wall(igrnod,ngrnod,numnod,ale_connectivity,multi_fvm,
784 . ixs,nixs,numels, ixq,nixq,numelq, ixtg,nixtg,numeltg, n2d,
785 . ngroup,nparg,iparg,ipri)
786 ENDIF
787C---------------------------------------------------------
788C Tri du vecteur de bolt Preloading
789C---------------------------------------------------------
790 IF (npreload > 0) THEN
791 CALL iniboltprel(ixs,ipreload ,preload ,vpreload, iflag_bpreload)
792 ENDIF
793C-----------------------------------------------------
794C PREPARATION DU CALCUL DES MASSES PAR PARTICULE SI CONDITION(S) DE
795C SYMETRIE
796C-----------------------------------------------------
797 IF (numsph/=0.AND.nspcond/=0)
798 . CALL inspcnd(ispcond ,igrnod ,kxsp ,ixsp ,
799 . nod2sp ,itab ,icode ,iskew ,iskn ,
800 . skew ,xframe ,x ,ispsym ,isptag ,
801 . pm ,geo ,ipart ,ipart(i15j))
802C--------------------------------------------
803C Seat belts initialization :
804C--------------------------------------------
805 IF (n_seatbelt > 0) CALL ini_seatbelt(iparg,elbuf_tab,knod2el1d,nod2el1d,ixr,
806 . x,itab,ipm,alea,knod2elc,
807 . nod2elc,ixc)
808C-----------------------------------------------------
809C INITIALISATION DES BUFFERS DES ELEMENTS
810C INITIALISATION DES MASSES ET DES INERTIES
811C-----------------------------------------------------
812C
813C for heat transfer
814C
815 IF (glob_therm%ITHERM_FE > 0 ) THEN
816 ALLOCATE(mcps(8*numels))
817 mcps = zero
818 IF(numels10 > 0.OR.numels16 > 0 .OR.numels20 > 0)THEN
819 ALLOCATE(mcpsx(12*numels))
820 mcpsx = zero
821 ENDIF
822 ALLOCATE(mcpp(numelp))
823 mcpp = zero
824 ELSE
825 ALLOCATE(mcpsx(0), mcps(0), mcpp(0))
826 ENDIF
827C---
828 IF ((imasadd > 0).OR.(nloc_dmg%IMOD > 0)) THEN
829 ALLOCATE(part_area(npart) ,stat=stat)
830 part_area(1:npart) = zero
831 ALLOCATE(ele_area(numelc+numeltg) ,stat=stat)
832 ele_area(1:numelc+numeltg) = zero
833 ELSE
834 ALLOCATE(part_area(1),ele_area(1))
835 END IF
836C---
837 WRITE(iout,'(//)')
838 dt2s=1.e6
839 cpt_eltens = 0
840C
841 DO ng=1,ngroup
842 mtn=iparg(1,ng)
843 nel=iparg(2,ng)
844 nft=iparg(3,ng)
845 iad=iparg(4,ng)
846 ity=iparg(5,ng)
847 npt=iparg(6,ng)
848 jale=iparg(7,ng)
849 ismstr=iparg(9,ng)
850 jeul =iparg(11,ng)
851 jtur =iparg(12,ng)
852 jthe =iparg(13,ng)
853 jlag =iparg(14,ng)
854 ish3n =iparg(23,ng)
855 jmult =iparg(20,ng)
856 jpor =iparg(27,ng)
857 isolnod = iparg(28,ng)
858 user_grp_domain = iparg(32,ng)+1
859 igtyp = iparg(38,ng)
860 israt = iparg(40,ng)
861 isorth = iparg(42,ng)
862 isrot = iparg(41,ng)
863 idrape = iparg(92,ng)
864 IF(isolnod == 10) isrot = iparg(74,ng)
865 iexpan = iparg(49,ng)
866 ishxfem_ply = iparg(50,ng)
867 IF (icrack3d == 0) THEN
868 iparg(54,ng) = 0
869 END IF
870 ixfem = iparg(54,ng)
871 isubstack = iparg(71,ng)
872 iboltp = iparg(72,ng)
873 iformdt = iparg(73,ng)
874 jclos=0
875 istot = 0
876 IF (ity==1.AND.(ismstr>=10.AND.ismstr<=12)) istot = 1
877 IF (ity == 3.OR.ity == 7) THEN
878C Initialize vectorization flags to zero for 3 and 4 nodes shell
879 nc1_old = 0
880 nc2_old = 0
881 nc3_old = 0
882 nc4_old = 0
883 ELSEIF (ity == 1) THEN
884C Initialize vectorization flags to zero for solid elements
885 nc1_old = 0
886 nc2_old = 0
887 nc3_old = 0
888 nc4_old = 0
889 nc5_old = 0
890 nc6_old = 0
891 nc7_old = 0
892 nc8_old = 0
893 IF((isolnod == 4 .AND.isrot==2).OR.
894 . (isolnod == 10.AND.isrot==1).OR.
895 . (isolnod == 10.AND.isrot==3))THEN
896 isrot = 0
897 iparg(41,ng) = 0
898 ENDIF
899 ENDIF
900 IF((numels/=0) .AND. (n2d/=0))THEN
901 CALL ancmsg(msgid=603, msgtype=msgerror, anmode=aninfo_blind_2)
902 END IF
903C------------------------------------------------------------------------------
904C Warning : for a new element type perform the computation of mass and inertia
905C in parallel arithmetic in subroutine SPMD_MSIN
906C------------------------------------------------------------------------------
907C
908 IF ((mtn == 0 .AND. igtyp /= 52 .AND. igtyp /= 51) .or.
909 . (igtyp == 0 .and. (ity == 1 .or. ity == 3 .or. ity == 7)) ) THEN
910 lft=1
911 llt=nel
912 nft = iparg(3,ng)
913 ihbe=iparg(23,ng)
914 isolnod = iparg(28,ng)
915 ilev=iparg(45,ng)
916C
917 CALL inivoid(elbuf_tab(ng),
918 1 ixc ,ixs ,ixtg ,x ,v ,
919 2 pm ,geo ,ms ,in ,ptg ,
920 3 msc ,mss ,mstg ,inc ,intg ,
921 4 thk(1+nft) ,thk(1+nft+numelc),partsav,ipart(i15a),
922 5 ipart(i15c),ipart(i15h),veul ,dtelem ,ihbe ,
923 6 isolnod ,nvc ,i8mi ,msnf ,mssf ,
924 7 igeo ,etnod ,nshnod ,stc ,sttg ,
925 8 wma ,sh4tree ,sh3tree ,mcp ,mcpc ,
926 9 temp ,mcps ,xrefc ,xreftg ,xrefs ,
927 a mssa ,volnod ,bvolnod ,vns ,bns ,
928 b sh3trim ,isubstack ,stack ,rnoise ,perturb ,
929 c ele_area ,part_area ,ipart(i15d),ixt ,ipart(i15e),
930 d ixp ,mst ,msp ,stt ,stp ,
931 e strp ,inp ,stifint ,mcpp ,inr ,
932 f msr ,msrt ,str ,ipart(i15f),itab ,
933 g ixr , imerge2 ,iadmerge2 ,nel ,defaults ,
934 h glob_therm,ibeam_vector,rbeam_vector)
935C
936 ELSEIF( mtn == 13) THEN
937C Rigid material
938 lft=1
939 llt=nel
940 nft = iparg(3,ng)
941 ihbe=iparg(23,ng)
942 isolnod = iparg(28,ng)
943 ilev=iparg(45,ng)
944C
945 CALL inirig_mat(
946 1 ixc ,ixs ,ixtg ,ixs10 ,x ,
947 2 v ,pm ,geo ,ms ,in ,
948 3 ptg ,msc ,mss ,mstg ,inc ,
949 4 intg ,thk(1+nft) ,thk(1+nft+numelc),partsav,ipart(i15a),
950 5 ipart(i15c),ipart(i15h),veul ,dtelem ,ihbe ,
951 6 isolnod ,nvc ,i8mi ,msnf ,mssf ,
952 7 igeo ,etnod ,nshnod ,stc ,sttg ,
953 8 wma ,sh4tree ,sh3tree ,mcp ,mcpc ,
954 9 temp ,mcps ,mssx ,mcpsx ,ins ,
955 a stifn ,stifr ,connec ,irig_node ,nelemr ,
956 b nindx ,xrefc ,xreftg ,xrefs ,mssa ,
957 c sh3trim ,isubstack ,bufmat ,ipm ,stack ,
958 d rnoise ,strc ,strtg ,perturb ,nel ,
959 e group_param_tab(ng) ,igtyp ,defaults ,glob_therm)
960C
961 ELSE
962C Element types
963 lft=1
964 llt=nel
965 offset=0
966 nft = iparg(3,ng)
967 jsph=0
968 jcvt=0
969 nf1 = nft + 1
970 !----------------------------------------!
971 ! ITY == 1 3D-SOLIDS !
972 !----------------------------------------!
973 IF (ity == 1) THEN
974 gbuf => elbuf_tab(ng)%GBUF
975 IF (iusolyld == 1 ) THEN
976 CALL scaleini(
977 . elbuf_tab(ng), ixs , sigsp ,sigi , nsigi,
978 . nel ,lft , llt ,nft , nsigs,
979 . ptsol ,igeo )
980 ENDIF
981 IF (isolnod == 4.AND.(isrot==0.OR.isrot==3))THEN
982 IF (multi_fvm%IS_USED) THEN
983 CALL multifluid_init3t(elbuf_tab(ng),
984 . nel, nsigs, nsigi, ixs, igeo, ipm, iparg, ale_connectivity, ipart(i15a), ptsol,
985 . npc, ipart, iloadp,
986 . xrefs, geo, pm, facload, pld, skew, sigi, bufmat, x,
987 . wma, partsav, ms, v, mss, mssf, mssa, msnf, mcps, error_thrown, detonators,
988 . defaults, mat_param,glob_therm%NINTEMP)
989 ELSE
990 IF (istot == 1) THEN
991 CALL sgsavini(isolnod,x,ixs(1,nft+1),gbuf%SMSTR,nel)
992 IF (nsigi > 0 ) THEN
993 CALL sgsavinieref(isolnod,straglob(nf1),sigsp,nsigi,ptsol(nf1),
994 . gbuf%SMSTR,gbuf%OFF,nel)
995 END IF
996 ENDIF
997 CALL s4init3(
998 1 elbuf_tab(ng),ms ,ixs ,pm ,x ,
999 2 detonators ,geo ,veul ,ale_connectivity ,iparg(1,ng),
1000 3 dtelem ,sigi ,nel ,skew ,igeo ,
1001 4 stifn ,partsav ,v ,ipart(i15a),mss ,
1002 5 ipart ,msnf ,iparg ,
1003 6 mssf ,ipm ,nsigs ,volnod ,bvolnod ,
1004 7 vns ,bns ,wma ,ptsol ,bufmat ,
1005 8 mcp ,mcps ,temp ,npc ,pld ,
1006 9 iuser ,sigsp ,nsigi ,mssa ,xrefs ,
1007 a strsglob(nf1),straglob(nf1),fail_ini ,spbuf ,sol2sph ,
1008 b iloadp ,facload ,rnoise ,perturb ,mat_param ,
1009 c defaults%SOLID,glob_therm%NINTEMP )
1010 IF (nxref > 0 .AND. jlag/=0 .AND. jsph==0)THEN
1011 CALL s4refsta3(
1012 1 elbuf_tab(ng),ixs ,pm ,geo ,iparg(1,ng),
1013 2 ipm ,igeo ,skew ,x ,xrefs ,
1014 3 nel ,ipart(i15a),ipart ,bufmat ,mat_param ,
1015 4 npc ,pld ,nummat )
1016C Case total strain
1017 IF (istot == 1) THEN
1018 CALL sgsavref(isolnod,xrefs(1,1,nft+1),gbuf%SMSTR,nel)
1019 END IF
1020 ENDIF
1021 IF (nsigi > 0 ) THEN
1022 IF (nxref > 0 .OR. ismstr == 1)
1023 . CALL sgsavinieref(isolnod,straglob(nf1),sigsp,nsigi,ptsol(nf1),
1024 . gbuf%SMSTR,gbuf%OFF,nel)
1025 END IF
1026 ENDIF
1027 ELSEIF(isolnod == 10 .OR.(isolnod == 4 .AND.isrot == 1))THEN
1028 kk1=1+numels*nixs
1029 CALL s10init3(elbuf_tab(ng),
1030 1 ms ,ixs ,pm ,x ,
1031 2 detonators ,geo ,veul ,ale_connectivity ,iparg(1,ng),
1032 3 dtelem ,sigi ,nel ,skew ,igeo ,
1033 4 stifn ,partsav ,v ,ipart(i15a),mss ,
1034 5 ixs10 ,ipart ,glob_therm,
1035 7 mssx ,sigsp ,nsigi ,ipm ,
1036 8 iuser ,nsigs ,volnod ,bvolnod ,vns ,
1037 9 bns ,vnsx ,bnsx ,ptsol ,bufmat ,
1038 a mcp ,mcps ,mcpsx ,temp ,npc ,
1039 b pld ,in ,stifr ,ins ,mssa ,
1040 c strsglob(nf1),straglob(nf1),fail_ini,iloadp ,facload ,
1041 d perturb ,rnoise ,mat_param,defaults%SOLID)
1042 IF (nsigi > 0 ) THEN
1043 nnod = 10
1044 nsrot = 0
1045 IF(isolnod == 4 .AND.isrot == 1) nsrot = 4
1046 CALL sgsavinierefq(nnod,straglob(nf1),sigsp,nsigi,ptsol(nf1),
1047 . gbuf%SMSTR,gbuf%OFF,ixs(1,nf1),dr,nsrot,nel)
1048 IF (ismstr==10.OR.ismstr==12)
1049 . CALL s10jaci3(elbuf_tab(ng),gbuf%SMSTR,npt,nel)
1050 END IF
1051 ELSEIF(ity==1.AND.isolnod==20)THEN
1052 kk1=1+numels*nixs+numels10*6
1053 CALL s20init3(
1054 1 elbuf_tab(ng),ms ,ixs ,pm ,x ,
1055 2 detonators ,geo ,veul ,ale_connectivity ,iparg(1,ng),
1056 3 dtelem ,sigi ,nel ,skew ,igeo ,
1057 4 stifn ,partsav ,v ,ipart(i15a),mss ,
1058 5 ixs20 ,ipart ,mssx ,sigsp ,nsigi ,
1059 7 ipm , iuser ,nsigs ,volnod ,bvolnod ,
1060 8 vns ,bns ,vnsx ,bnsx ,ptsol ,
1061 9 bufmat ,mcp ,mcps ,mcpsx ,temp ,
1062 a npc ,pld ,strsglob(nf1),straglob(nf1),fail_ini ,
1063 b iloadp ,facload ,perturb,rnoise ,mat_param ,
1064 c glob_therm )
1065 ELSEIF(ity==1.AND.isolnod==16)THEN
1066 kk1=1+numels*nixs+numels10*6+numels20*12
1067 CALL s16init3(
1068 1 elbuf_tab(ng),ms ,ixs ,pm ,x ,
1069 2 detonators ,geo ,veul ,ale_connectivity ,iparg(1,ng),
1070 3 dtelem ,sigi ,nel ,skew ,igeo ,
1071 4 stifn ,partsav ,v ,ipart(i15a),mss ,
1072 5 ixs16 ,ipart ,mssx ,sigsp ,nsigi ,
1073 6 ipm ,iuser ,nsigs ,volnod ,bvolnod ,
1074 7 vns ,bns ,vnsx ,bnsx ,ptsol ,
1075 8 bufmat ,mcp ,mcps ,mcpsx ,temp ,
1076 9 npc ,pld ,strsglob(nf1),straglob(nf1),fail_ini ,
1077 a iloadp ,facload ,perturb ,rnoise ,mat_param ,
1078 b glob_therm )
1079 ELSEIF(ity==1)THEN
1080 jhbe=iparg(23,ng)
1081 jclos=iparg(33,ng)
1082 iint =iparg(36,ng)
1083 IF (jhbe==1.OR.jhbe==2.OR.jhbe==12.OR.jhbe==16) THEN
1084 jcvt=0
1085 ELSE
1086 jcvt=1
1087 ENDIF
1088 iprop = ixs(10,nft+1)
1089 igtyp = nint(geo(npropg*(iprop-1)+12))
1090 nuvar = nint(geo(npropg*(iprop-1)+25))
1091 istrain = iparg(44,ng)
1092 IF (jhbe == 15) THEN
1093 !Thick shells PA6 / HQEPH
1094 IF (isolnod == 6)THEN
1095 CALL s6cinit3(
1096 . elbuf_tab(ng),ms ,ixs ,pm ,x ,
1097 . detonators ,geo ,veul ,ale_connectivity ,iparg(1,ng),
1098 . dtelem ,sigi ,nel ,skew ,igeo ,
1099 . stifn ,partsav ,v ,ipart(i15a),mss,
1100 . ipart ,glob_therm,
1101 . sigsp ,nsigi ,ipm ,iuser ,nsigs ,
1102 . volnod ,bvolnod ,vns ,bns ,ptsol ,
1103 . bufmat ,mcp ,mcps ,mcpsx ,temp ,
1104 . npc ,pld ,strsglob(nf1),straglob(nf1),mssa ,
1105 . orthoglob ,fail_ini ,iloadp ,facload ,perturb ,
1106 . rnoise ,mat_param,defaults%SOLID)
1107 ELSE
1108 CALL scinit3(elbuf_tab(ng),
1109 . ms ,ixs ,pm ,x ,mss ,
1110 . detonators ,geo ,veul ,ale_connectivity ,iparg(1,ng),
1111 . dtelem ,sigi ,nel ,skew ,igeo ,
1112 . stifn ,partsav ,v ,ipart(i15a) ,ipart ,
1113 . sigsp ,nsigi ,msnf ,mssf ,ipm ,
1114 . iuser ,nsigs ,volnod ,bvolnod ,vns ,
1115 . bns ,wma ,ptsol ,bufmat ,mcp ,
1116 . mcps ,temp ,npc ,pld ,mssa ,
1117 . strsglob(nf1),straglob(nf1),orthoglob ,fail_ini ,iloadp ,
1118 . facload ,rnoise ,perturb ,glob_therm)
1119 ENDIF
1120 ELSEIF (jhbe == 14 .AND.
1121 . (igtyp == 20 .OR. igtyp == 21 .OR. igtyp == 22)) THEN
1122 !HA8 thick shell
1123 gbuf => elbuf_tab(ng)%GBUF
1124 CALL s8cinit3(
1125 . elbuf_tab(ng),ms ,ixs ,pm ,x ,
1126 . detonators,geo ,veul ,ale_connectivity,iparg(1,ng),
1127 . dtelem ,sigi ,nel ,skew ,igeo ,
1128 . stifn ,partsav ,v ,ipart(i15a),mss,
1129 . ipart ,sigsp ,nsigi ,msnf ,mssf ,ipm ,
1130 . iuser ,nsigs ,volnod ,bvolnod ,vns ,
1131 . bns ,wma ,ptsol ,bufmat ,mcp ,
1132 . mcps ,temp ,npc ,pld ,xrefs ,
1133 . mssa ,strsglob,strsglob(nf1),straglob(nf1),fail_ini,
1134 . iloadp ,facload ,perturb ,rnoise ,mat_param,glob_therm)
1135 IF (istot == 1) THEN
1136 CALL sgsavini(isolnod,x,ixs(1,nft+1),gbuf%SMSTR,nel)
1137 ENDIF
1138 IF (nsigi > 0 ) THEN
1139 CALL sgsavinieref(isolnod,straglob(nf1),sigsp,nsigi,ptsol(nf1),
1140 . gbuf%SMSTR,gbuf%OFF,nel)
1141 END IF
1142 ELSEIF (jhbe == 14 .OR. jhbe == 222 .OR. jhbe == 17) THEN
1143 !HA8 and H8E solid
1144 gbuf => elbuf_tab(ng)%GBUF
1145 IF (istot == 1) THEN
1146 CALL sgsavini(isolnod,x,ixs(1,nft+1),gbuf%SMSTR,nel)
1147 IF (nsigi > 0 ) THEN
1148 CALL sgsavinieref(isolnod,straglob(nf1),sigsp,nsigi,ptsol(nf1),
1149 . gbuf%SMSTR,gbuf%OFF,nel)
1150 END IF
1151 IF (nxref > 0 .AND. jhbe == 17 ) THEN
1152 CALL srefsta3(
1153 1 elbuf_tab(ng),ixs ,pm ,geo ,iparg(1,ng),
1154 2 ipm ,igeo ,skew ,x ,xrefs ,
1155 3 nel ,ipart(i15a),ipart ,bufmat ,mat_param,
1156 6 npc ,pld ,nummat )
1157 CALL sgsavref(isolnod,xrefs(1,1,nft+1),gbuf%SMSTR,nel)
1158 END IF
1159 END IF
1160 CALL s8zinit3(
1161 . elbuf_tab(ng),ms ,ixs ,pm ,x ,
1162 . detonators,geo ,veul ,ale_connectivity,iparg(1,ng),
1163 . dtelem,sigi ,nel ,skew ,igeo ,
1164 . stifn ,partsav ,v ,ipart(i15a),mss,
1165 . ipart ,glob_therm,
1166 . sigsp ,nsigi ,msnf ,mssf ,ipm ,
1167 . iuser ,nsigs ,volnod ,bvolnod ,vns ,
1168 . bns ,wma ,ptsol ,bufmat ,mcp ,
1169 . mcps ,temp ,npc ,pld ,xrefs ,
1170 . mssa ,strsglob(nf1),straglob(nf1),fail_ini,spbuf ,
1171 . kxsp ,ipart(i15j) ,nod2sp ,sol2sph ,irst,
1172 . iloadp ,facload ,perturb ,rnoise ,mat_param)
1173 IF (nsigi > 0 .AND. ismstr == 1) THEN
1174 CALL sgsavinieref(isolnod,straglob(nf1),sigsp,nsigi,ptsol(nf1),
1175 . gbuf%SMSTR,gbuf%OFF,nel)
1176 END IF
1177 ELSEIF (igtyp>=29) THEN
1178 CALL suinit3(elbuf_tab(ng),ms ,ixs ,pm ,x ,
1179 . detonators ,geo ,veul ,ale_connectivity ,iparg(1,ng),
1180 . dtelem,sigi ,nel ,skew ,igeo ,
1181 . stifn ,partsav ,v ,ipart(i15a),mss,
1182 . ipart ,sigsp ,glob_therm,temp ,
1183 . nsigi ,in ,vr ,ipm ,nsigs ,
1184 . volnod ,bvolnod ,vns ,bns ,ptsol ,
1185 . bufmat ,npc ,pld ,fail_ini ,ins ,
1186 . iloadp ,facload ,perturb,rnoise ,mat_param)
1187 ELSE
1188 gbuf => elbuf_tab(ng)%GBUF
1189 IF (npt == 1 .AND. istot == 1) THEN
1190 CALL sgsavini(isolnod,x,ixs(1,nft+1),gbuf%SMSTR,nel)
1191 IF (nsigi > 0 ) THEN
1192 CALL sgsavinieref(isolnod,straglob(nf1),sigsp,nsigi,ptsol(nf1),
1193 . gbuf%SMSTR,gbuf%OFF,nel)
1194 END IF
1195 ENDIF
1196 IF (jmult == 0) THEN
1197 CALL sinit3(
1198 1 elbuf_tab(ng),ms ,ixs ,pm ,x ,
1199 2 detonators ,geo ,veul ,ale_connectivity ,iparg(1,ng),
1200 3 dtelem ,sigi ,nel ,skew ,igeo ,
1201 4 stifn ,partsav ,v ,ipart(i15a),mss ,
1202 5 ipart ,sigsp ,ng ,iparg ,
1203 7 nsigi ,msnf ,nvc ,mssf ,ipm ,
1204 8 iuser ,nsigs ,volnod ,bvolnod ,vns ,
1205 9 bns ,in ,vr ,ins ,wma ,
1206 a ptsol ,bufmat ,mcp ,mcps ,temp ,
1207 b xrefs ,npc ,pld ,mssa ,strsglob(nf1),
1208 c straglob(nf1),fail_ini ,spbuf ,kxsp ,ipart(i15j),
1209 d nod2sp ,sol2sph ,irst ,iloadp ,facload ,
1210 e rnoise ,perturb ,mat_param,glob_therm)
1211 ELSE IF (jmult > 0 .AND. mtn == 151) THEN
1212 !Multifluid law
1213 CALL multifluid_init3 (
1214 1 elbuf_tab(ng),ms ,ixs ,pm ,x ,
1215 2 geo ,ale_connectivity ,iparg(1,ng),
1216 3 dtelem ,sigi ,nel ,skew ,igeo ,
1217 4 stifn ,partsav ,v ,ipart(i15a),mss ,
1218 5 ipart ,sigsp ,ng ,iparg ,glob_therm ,
1219 7 nsigi ,msnf ,nvc ,mssf ,ipm ,
1220 8 iuser ,nsigs ,volnod ,bvolnod ,vns ,
1221 9 bns ,in ,vr ,ins ,wma ,
1222 a ptsol ,bufmat ,mcp ,mcps ,temp ,
1223 b xrefs ,npc ,pld ,mssa ,strsglob(nf1),
1224 c straglob(nf1),fail_ini ,spbuf ,kxsp ,ipart(i15j),
1225 d nod2sp ,sol2sph ,irst ,iloadp ,facload ,
1226 e multi_fvm, error_thrown,detonators, mat_param)
1227 ENDIF
1228
1229 CALL srefsta3(
1230 1 elbuf_tab(ng),ixs ,pm ,geo ,iparg(1,ng),
1231 2 ipm ,igeo ,skew ,x ,xrefs ,
1232 3 nel ,ipart(i15a),ipart ,bufmat ,mat_param,
1233 6 npc ,pld ,nummat )
1234C
1235C Case total strain: conf_ref <- XREF
1236 IF (nxref > 0 .AND. (npt == 1 .AND. istot == 1) ) THEN
1237 CALL sgsavref(isolnod,xrefs(1,1,nft+1),gbuf%SMSTR,nel)
1238 END IF
1239 IF (nsigi > 0 ) THEN
1240 IF (nxref > 0 .OR. ismstr == 1 )
1241 . CALL sgsavinieref(isolnod,straglob(nf1),sigsp,nsigi,ptsol(nf1),
1242 . gbuf%SMSTR,gbuf%OFF,nel)
1243 END IF
1244 nc1 = nvc / 128
1245 nc2 = (nvc-nc1*128) / 64
1246 nc3 = (nvc-nc1*128-nc2*64) / 32
1247 nc4 = (nvc-nc1*128-nc2*64-nc3*32)/16
1248 nc5 = (nvc-nc1*128-nc2*64-nc3*32-nc4*16)/8
1249 nc6 = (nvc-nc1*128-nc2*64-nc3*32-nc4*16-nc5*8)/4
1250 nc7 = (nvc-nc1*128-nc2*64-nc3*32-nc4*16-nc5*8-nc6*4)/2
1251 nc8 = (nvc-nc1*128-nc2*64-nc3*32-nc4*16-nc5*8-nc6*4-nc7*2)
1252 IF (nc1 == 1) nc1_old = 1
1253 IF (nc2 == 1) nc2_old = 1
1254 IF (nc3 == 1) nc3_old = 1
1255 IF (nc4 == 1) nc4_old = 1
1256 IF (nc5 == 1) nc5_old = 1
1257 IF (nc6 == 1) nc6_old = 1
1258 IF (nc7 == 1) nc7_old = 1
1259 IF (nc8 == 1) nc8_old = 1
1260 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
1261 ENDIF
1262 ENDIF
1263 !----------------------------------------!
1264 ! ITY == 2 QUAD !
1265 !----------------------------------------!
1266 ELSEIF(ity == 2)THEN
1267 ihbe =iparg(23,ng)
1268 IF (jmult == 0) THEN
1269 IF (ihbe == 17 .OR. (n2d == 1.AND.ihbe == 22)) THEN
1270 CALL q4init2(elbuf_tab(ng),ms ,ixq,pm,x,
1271 2 detonators,geo,veul,ale_connectivity,iparg(1,ng),
1272 3 dtelem,sigi,igeo ,
1273 4 nel ,skew , msq ,ipart ,ipart(i15b),
1274 5 ipm ,nsigs ,wma ,ptquad ,bufmat ,
1275 6 npc ,pld ,iparg ,iloadp ,facload ,
1276 7 partsav,v )
1277 ELSE
1278 CALL qinit2(
1279 . elbuf_tab(ng),ms,ixq ,pm ,x ,
1280 . detonators,geo,veul,ale_connectivity,iparg(1,ng),
1281 . dtelem,sigi,igeo ,
1282 . nel ,skew, msq, ipart, ipart(i15b),
1283 . ipm ,nsigs ,
1284 . wma ,ptquad ,bufmat ,npc ,pld,
1285 . iparg ,iloadp ,facload ,partsav,v)
1286 ENDIF
1287 ELSE ! JMULT > 0
1288 IF (mtn == 20) THEN
1289 CALL binit2(
1290 . elbuf_tab(ng),ms ,ixq ,pm ,x ,
1291 . detonators ,veul ,ale_connectivity ,iparg(1,ng) ,fill ,
1292 . sigi ,bufmat ,nel ,mat_param ,
1293 . skew ,msq ,ipart ,ipart(i15b) ,
1294 . geo ,igeo ,ipm ,
1295 . nsigs ,wma ,ptquad ,npc ,pld ,
1296 . iparg ,iloadp ,facload ,partsav ,v )
1297 ELSE IF (mtn == 151) THEN
1298C 2D multifluid law
1299 CALL multifluid_init2(nel, nsigs,
1300 . iparg, ixq, ipm, ale_connectivity, igeo, ipart, ipart(i15b), npc,
1301 . ptquad, iloadp, x, pm,
1302 . geo, sigi, skew, pld, bufmat, facload, elbuf_tab(ng), error_thrown,detonators,
1303 . mat_param)
1304 ELSE
1305 CALL arret(2)
1306 ENDIF
1307 ENDIF
1308 !----------------------------------------!
1309 ! ITY == 3 SHELL !
1310 !----------------------------------------!
1311 ELSEIF (ity == 3)THEN
1312 istrain =iparg(44,ng)
1313 ihbe =iparg(23,ng)
1314 ithk =iparg(28,ng)
1315 ilev =iparg(45,ng)
1316 ixfem =iparg(54,ng)
1317 dt2=dt2s
1318 IF (ihbe>10.AND.ihbe<29) THEN
1319 NULLIFY(ptr_itage)
1320 IF (sitage>0) ptr_itage=>itage(1)
1321 CALL cbainit3(elbuf_tab(ng),
1322 1 ixc,pm ,x ,geo ,
1323 2 ms ,in ,nvc ,dtelem,igrsh4n ,
1324 3 xrefc ,nel ,ithk ,ihbe ,igrsh3n ,
1325 4 thk(1+nft),isigsh,sigsh ,stifn ,stifr ,
1326 5 partsav ,v ,ipart(i15c) ,msc,inc ,
1327 6 skew ,i8mi ,nsigsh ,igeo ,
1328 7 ipm ,iuser ,etnod ,nshnod ,stc ,
1329 8 ptshel ,bufmat ,sh4tree ,mcp ,mcpc ,
1330 9 temp ,ms_layer, zi_layer ,itag ,itagel ,
1331 a iparg(1,ng),ms_layerc,zi_layerc,part_area,cpt_eltens,
1332 b msz2c ,zply ,itagn ,ptr_itage ,ixfem ,
1333 c npc ,pld ,xfem_tab,isubstack ,stack ,
1334 d rnoise ,drape ,sh4ang ,iddlevel,geo_stack,
1335 e igeo_stack ,strc ,perturb ,iyldini ,ele_area,
1336 f nloc_dmg ,ng ,group_param_tab(ng),idrape,drapeg,
1337 g mat_param ,fail_fractal,fail_brokmann,glob_therm)
1338 ELSE
1339 NULLIFY(ptr_itage)
1340 IF (sitage>0) ptr_itage => itage(1)
1341 CALL cinit3(elbuf_tab(ng),
1342 1 ixc ,pm ,x ,geo ,
1343 2 ms ,in ,nvc ,dtelem ,igrsh4n ,
1344 3 xrefc ,nel ,ithk ,ihbe ,igrsh3n ,
1345 4 thk(1+nft),isigsh ,sigsh ,stifn ,stifr ,
1346 5 partsav ,v ,ipart(i15c),msc ,inc ,
1347 8 skew ,iparg(1,ng),i8mi ,nsigsh ,igeo ,
1348 9 iuser ,etnod ,nshnod ,stc ,ptshel ,
1349 a ipm ,bufmat ,sh4tree ,mcp ,mcpc ,
1350 b temp ,cpt_eltens ,part_area ,itagn ,ptr_itage ,
1351 c ixfem ,npc ,pld ,xfem_tab,isubstack,
1352 d stack ,rnoise ,drape ,sh4ang ,iddlevel ,
1353 e geo_stack,igeo_stack ,strc ,perturb ,iyldini ,
1354 f ele_area ,ng ,group_param_tab(ng) ,nloc_dmg ,
1355 g idrape ,drapeg ,mat_param ,fail_fractal,fail_brokmann,
1356 h glob_therm)
1357 ENDIF
1358 nc1 = nvc / 8
1359 nc2 = (nvc-nc1*8) / 4
1360 nc3 = (nvc-nc1*8-nc2*4) / 2
1361 nc4 = nvc-nc1*8-nc2*4-nc3*2
1362 IF (nc1 == 1) nc1_old = 1
1363 IF (nc2 == 1) nc2_old = 1
1364 IF (nc3 == 1) nc3_old = 1
1365 IF (nc4 == 1) nc4_old = 1
1366 iparg(19,ng)=nc1_old*8+nc2_old*4+nc3_old*2+nc4_old
1367 dt2s=dt2
1368 dt2=0.
1369 !----------------------------------------!
1370 ! ITY == 4 TRUSS !
1371 !----------------------------------------!
1372 ELSEIF (ity == 4) THEN
1373 CALL tinit3(elbuf_tab(ng),
1374 1 ixt ,pm ,x ,geo ,ms ,
1375 2 dtelem ,nft ,nel ,stifn ,partsav,
1376 3 v ,ipart(i15d),mst ,stifint,stt ,
1377 4 igeo ,nsigtruss ,sigtruss ,pttruss,
1378 5 preload_a,iboltp ,npreload_a )
1379 !----------------------------------------!
1380 ! ITY == 5 BEAM !
1381 !----------------------------------------!
1382 ELSEIF (ity == 5) THEN
1383 CALL pinit3(elbuf_tab(ng),
1384 1 stp ,ixp ,pm ,x ,geo ,
1385 2 dtelem ,nft ,nel ,
1386 3 stifn ,stifr ,partsav ,v ,ipart(i15e),
1387 4 msp ,inp ,igeo ,strp ,
1388 5 nsigbeam ,sigbeam ,ptbeam ,iuser ,
1389 6 mcpp ,temp ,preload_a,iboltp ,npreload_a ,
1390 7 glob_therm ,ibeam_vector,rbeam_vector)
1391 !----------------------------------------!
1392 ! ITY == 6 SPRING !
1393 !----------------------------------------!
1394 ELSEIF (ity == 6) THEN
1395 iopt = ptr_nopt_fun + 1
1396 CALL rinit3(elbuf_tab(ng),
1397 1 ixr ,x ,geo ,ms ,npc ,
1398 2 pld ,in ,skew ,dtelem ,nel ,
1399 3 stifn ,stifr ,partsav ,v ,ipart(i15f),
1400 4 itab ,msr ,
1401 5 inr ,stifint ,str(nft+1),igeo ,sigrs ,
1402 6 nsigrs ,imerge2 ,iadmerge2 ,msrt(nft+1),ixr_kj ,
1403 7 nom_opt(1,iopt),strr ,ptspri ,ipm , pm ,
1404 8 bufmat ,r_skew ,preload_a ,iboltp ,npreload_a,
1405 9 ikine)
1406 !----------------------------------------!
1407 ! ITY == 7 SH3N or TRIA !
1408 !----------------------------------------!
1409 ELSEIF(ity == 7 .OR. ity == 8)THEN
1410 istrain =iparg(44,ng)
1411 ithk =iparg(28,ng)
1412 ish3n =iparg(23,ng)
1413 icnod =iparg(11,ng)
1414 IF (ish3n == 30 .AND. icnod == 6) ish3n = 0
1415 ilev =iparg(45,ng)
1416 dt2=dt2s
1417 IF (ish3n == 30) THEN
1418 CALL cdkinit3(elbuf_tab(ng),group_param_tab(ng),
1419 1 ixtg ,pm ,x ,geo ,
1420 2 ms ,in ,nvc ,dtelem,
1421 3 xreftg ,offset,nel ,ithk ,thk(1+nft+numelc),
1422 4 isigsh ,sigsh(1,ksigsh3),stifn,stifr, partsav ,
1423 5 v ,ipart(i15h) ,mstg ,intg , ptg ,
1424 8 skew ,ish3n ,nsigsh ,igeo ,ipm ,
1425 9 iuser ,etnod ,nshnod ,sttg ,ptsh3n ,
1426 a bufmat ,sh3tree,mcp ,mcptg , temp ,
1427 b iparg(1,ng),cpt_eltens,part_area ,npc ,pld ,
1428 c sh3trim ,isubstack,stack ,rnoise,
1429 d drape,sh3ang ,geo_stack,igeo_stack,strtg,
1430 e perturb,iyldini ,ele_area,nloc_dmg,
1431 f idrape, drapeg,mat_param,glob_therm)
1432 ELSEIF (mtn == 151 .OR. n2d > 0) THEN
1433 CALL multifluid_init2t(elbuf_tab(ng), nel, nsigs, nvc, iparg, ixtg, ale_connectivity,
1434 . igeo, ipart, ipart(i15h), ipm, ptsh3n, npc, iloadp,
1435 . x, pm, geo, sigi, skew, pld, bufmat, facload, multi_fvm, error_thrown, detonators,
1436 . mat_param)
1437 ELSE
1438 NULLIFY(ptr_itage)
1439 IF (sitage > 0) ptr_itage => itage(numelc+1)
1440 CALL c3init3(elbuf_tab(ng),
1441 1 ixtg ,pm ,x ,geo ,igrsh4n,
1442 2 ms ,in ,nvc ,dtelem,igrsh3n ,
1443 3 xreftg ,offset,nel ,ithk ,thk(1+nft+numelc),
1444 4 isigsh ,sigsh(1,ksigsh3),stifn,stifr,partsav ,
1445 5 v ,ipart(i15h),mstg,intg ,ptg ,
1446 8 skew,iparg(1,ng) , nsigsh ,igeo,iuser ,
1447 9 etnod ,nshnod ,sttg ,ptsh3n ,ipm ,
1448 a bufmat ,sh3tree ,mcp ,mcptg , temp ,
1449 b cpt_eltens,part_area,ptr_itage,itagn,ixfem ,
1450 c npc ,pld ,sh3trim ,xfem_tab,
1451 d isubstack , stack,rnoise ,
1452 e drape ,sh3ang,iddlevel,geo_stack,igeo_stack,strtg,
1453 f perturb ,ish3n,iyldini ,ele_area,
1454 g nloc_dmg,ng,group_param_tab(ng),idrape,
1455 h drapeg,mat_param,fail_fractal,fail_brokmann,glob_therm)
1456 ENDIF
1457 nc1 = nvc / 8
1458 nc2 = (nvc-nc1*8) / 4
1459 nc3 = (nvc-nc1*8-nc2*4) / 2
1460 IF (nc1 == 1) nc1_old = 1
1461 IF (nc2 == 1) nc2_old = 1
1462 IF (nc3 == 1) nc3_old = 1
1463 iparg(19,ng)=nc1_old*8+nc2_old*4+nc3_old*2
1464 dt2s=dt2
1465 dt2=0.
1466 !----------------------------------------!
1467 ! ITY == 51 SPH !
1468 !----------------------------------------!
1469 ELSEIF(ity == 51)THEN
1470C SPH cells
1471 jsph=1
1472 isph2sol=iparg(69,ng)
1473 CALL spinit3(ity ,spbuf ,kxsp ,x ,geo ,
1474 2 ms ,npc ,pld ,in ,skew ,
1475 3 dtelem ,nel ,stifn ,stifr ,igeo ,
1476 4 partsav ,v ,ipart(i15j),bufmat,
1477 5 pm ,itab ,msr ,inr ,ixsp ,
1478 6 nod2sp ,iparg(1,ng),ale_connectivity ,detonators ,
1479 7 sigsph ,isptag ,ipart ,
1480 8 ipm ,nsigsph ,ptsph ,npc ,
1481 9 pld ,elbuf_tab(ng),mcp,temp ,iloadp,
1482 a facload ,stifint ,i7stifs,glob_therm)
1483 !----------------------------------------------------------!
1484 ! ITY == 100 Pulley PID28 + User elements PID 29-30-31 !
1485 !----------------------------------------------------------!
1486 ELSEIF(ity == 100)THEN
1487 iaduix=1
1488 iadux =iaduix+maxnx
1489 iaduv =iadux +3*maxnx
1490 iaduvr=iaduv +3*maxnx
1491 iadums=iaduvr+3*maxnx
1492 iaduin=iadums+maxnx
1493 iadusm=iaduin+maxnx
1494 iadusr=iadusm+maxnx
1495 iadumv=iadusr+maxnx
1496 iadurv=iadumv+maxnx
1497 CALL xinit3(elbuf_tab(ng),kxx,ixx ,x ,v ,
1498 2 vr ,ms ,in ,
1499 3 skew ,dtelem ,nel ,stifn ,stifr ,
1500 4 partsav ,ipart(i15i),geo ,
1501 5 itab ,xelemwa(iaduix) ,xelemwa(iadux) ,xelemwa(iaduv) ,
1502 6 xelemwa(iaduvr) ,xelemwa(iadums) ,xelemwa(iaduin) ,
1503 7 xelemwa(iadusm) ,xelemwa(iadusr) ,xelemwa(iadumv) ,
1504 8 xelemwa(iadurv) ,igeo, nft)
1505c
1506 !----------------------------------------!
1507 ! ITY == 101 IGE3D !
1508 !----------------------------------------!
1509 ELSEIF (ity == 101) THEN
1510 nctrl = iparg(75,ng)
1511 px = igeo(41,iparg(62,ng))
1512 py = igeo(42,iparg(62,ng))
1513 pz = igeo(43,iparg(62,ng))
1514 CALL ig3dinit3(elbuf_tab(ng),ms ,kxig3d ,ixig3d ,pm ,x,
1515 . detonators ,geo ,veul ,ale_connectivity,iparg(1,ng),
1516 . dtelem,sigi ,nel ,skew ,igeo ,
1517 . stifn ,partsav ,v ,ipart(i15k),mss,
1518 . ipart ,sigsp ,
1519 . nsigi ,in ,vr ,ipm ,nsigs ,
1520 . vnige ,bnige ,ptsol ,
1521 . bufmat ,npc ,pld ,fail_ini,nctrl,
1522 . msig3d ,knot ,nctrlmax,wige ,px,py,pz,
1523 . knotlocpc,knotlocel)
1524 ENDIF
1525C
1526 IF (ity == 3) THEN
1527 WRITE(iout,'(A,I10,A,I5)')' SHELL GROUP',ng, ' VECTORIZATION CODE =',iparg(19,ng)
1528 ELSEIF (ity == 7) THEN
1529 WRITE(iout,'(A,I10,A,I5)')' TRIANGULAR SHELL GROUP',ng, ' VECTORIZATION CODE =',iparg(19,ng)
1530 ELSEIF (ity == 1) THEN
1531 WRITE(iout,'(A,I10,A,I5)')' BRICK GROUP',ng,' VECTORIZATION CODE =',iparg(19,ng)
1532 ENDIF
1533C
1534 ENDIF
1535 END DO ! End loop on element group NG
1536
1537
1538C-----------
1539!DETONATION TIMES WITH SHADOWING EFFECTS
1540!FAST MARCHING METHOD
1541 CALL eikonal_solver(ixq , nixq , numelq ,
1542 . ixs , nixs , numels ,
1543 . ixtg , nixtg , numeltg ,
1544 . x , numnod , titre(55),
1545 . elbuf_tab, ngroup , nparg ,
1546 . nod2eltg , knod2eltg,
1547 . nod2elq , knod2elq ,
1548 . nod2els , knod2els ,
1549 . iparg , ale_connectivity, npropm, nummat, pm, n2d, detonators,
1550 . npropmi , ipm )
1551C---------------------------------------------------
1552C Initialization of global detonation times (Law151)
1553 CALL multifluid_global_tdet(iparg,elbuf_tab,multi_fvm,ipm)
1554! DETONATION TIMES PRINTOUT
1555C---------------------------------------------------
1556! + DEFAULT INITIALIZATION TO 0.0 IN CASE OF NO DETONATOR
1557 CALL detonation_times_printout(nparg,ngroup,iparg,n2d,ipri,elbuf_tab,
1558 . nixs,nixq,nixtg,numels,numelq,numeltg,ixs,ixq,ixtg)
1559C-----------
1560 !loop over material initialisation done.
1561 !IF NRF outlet, print its automatic characteristic
1562 IF(m51_iflg6==1 .AND. m51_lset_iflg6==1)THEN
1563 !first initialization of group whose MAT=51 + iform=6
1564 WRITE (iout,1001)m51_lc0max,m51_ssp0max,m51_tcp_ref
1565 ENDIF
1566
1567 1001 FORMAT(
1568 .//
1569 .' NON REFLECTING FRONTIERS (/MAT/LAW51) '/
1570 .' ------------------------------------- '/
1571 & 5x,'INITIALIZATION OF GLOBAL PARAMETERS ',/
1572 & 5x,'CHARACTERISTIC LENGTH. . . . . . . . . .=',e12.4/
1573 & 5x,'REFERENCE SOUND SPEED. . . . . . . . . =',e12.4/
1574 & 5x,'CHARACTERISTIC TIME. . . . . . . . . . .=',e12.4//)
1575
1576C Add error message when y < zero and N2D=1
1577 CALL ancmsg(msgid=1228,msgtype=msgerror,anmode=aninfo_blind_1,prmod=msg_print)
1578
1579 user_grp_domain = 0
1580C-------------------------------------------------
1581C Tetrahedron : Smooth finite element formulations
1582C Option ITETRA==3 - set general Flag
1583C-------------------------------------------------
1584 isfem=0
1585 DO ng = 1, ngroup
1586 ity =iparg(5,ng)
1587 isolnod = iparg(28,ng)
1588 isrot = iparg(41,ng)
1589 icpre = iparg(10,ng)
1590 IF(ity /= 1)cycle
1591 IF(iparg(8, ng) == 1) cycle
1592 IF(isolnod /= 4 .AND. isolnod /= 10) cycle
1593 IF(isolnod==4.AND.isrot == 3) isfem=1
1594 IF(icpre>0.AND.(isolnod==10.OR.(isolnod==4.AND.isrot == 1))) isfem=1
1595 ENDDO
1596C--------------------------------------------
1597C Warning : Elements initially in tension
1598C--------------------------------------------
1599 IF (cpt_eltens /= 0) THEN
1600 CALL ancmsg(msgid=863,msgtype=msgwarning,anmode=aninfo_blind_1,i1=cpt_eltens)
1601 ENDIF
1602C---------------------------------------------------------------
1603C Additional nodal mass from added part mass : /ADMAS option
1604C---------------------------------------------------------------
1605 addedms(1:npart) = zero
1606 IF(imasadd > 0)THEN
1607 CALL spmd_partsav_pon(
1608 1 ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
1609 2 ixc ,ixt ,ixp ,ixr ,ixtg ,
1610 3 mss ,mssx ,msq ,msc ,
1611 4 mst ,msp ,msr ,mstg ,
1612 5 index ,itri ,geo ,partsav1_pon ,ipart(i15a) ,
1613 6 ipart(i15b),ipart(i15c),ipart(i15d),ipart(i15e) ,ipart(i15f) ,
1614 7 ipart(i15h),ipart )
1615 CALL addmaspart(ipart,ipmas,partsav,
1616 . part_area,pm,addedms,nom_opt(1,ptr_nopt_adm+1),
1617 . partsav1_pon)
1618 CALL spmd_msin_addmass(
1619 1 ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
1620 2 ixc ,ixt ,ixp ,ixr ,ixtg ,
1621 3 mss ,mssx ,msq ,msc ,
1622 4 mst ,msp ,msr ,mstg ,
1623 5 ptg ,ms ,index ,itri ,
1624 6 geo ,sh4tree ,sh3tree ,partsav ,ipmas ,
1625 7 ipart(i15a),ipart(i15b),ipart(i15c),ipart(i15d),
1626 8 ipart(i15e),ipart(i15f),ipart(i15h),totaddmas ,
1627 9 ipart ,thk ,pm ,part_area ,
1628 a addedms ,itab ,partsav1_pon,ele_area )
1629 END IF
1630C---------------------------------------------------------------
1631C Parallel arithmetic : initialisation of nodal mass and inertia
1632C---------------------------------------------------------------
1633 kk1=1+numels*nixs
1634 kk2=kk1+numels10*6
1635 kk3=kk2+numels20*12
1636 CALL spmd_msin(
1637 1 ixs ,ixq ,ixc ,ixt ,ixp ,
1638 2 ixr ,ixtg ,mss ,msq ,
1639 3 msc ,mst ,msp ,msr ,mstg ,
1640 4 inc ,inp ,inr ,intg ,
1641 5 index ,itri ,ms ,in ,
1642 6 ptg ,geo ,ixs10 ,ixs20 ,
1643 7 ixs16 ,mssx ,msnf ,mssf ,vns ,
1644 8 vnsx ,stc ,stt ,stp ,str ,
1645 9 sttg ,stur ,bns ,bnsx ,volnod ,
1646 a bvolnod ,etnod ,stifint ,ins ,mcpc ,
1647 b mcp ,mcps ,mcpsx ,mcptg,sh4tree,
1648 c sh3tree ,ms_layerc, zi_layerc , ms_layer,
1649 d zi_layer,msz2c, msz2,zply ,
1650 e kxig3d ,ixig3d ,msig3d,nctrlmax,strc ,
1651 f strp,strr,strtg,stifintr,nshnod,vnige,bnige,
1652 g mcpp ,glob_therm%ITHERM_FE)
1653 IF(i7stifs/=0)CALL asstifi(volnod,bvolnod,etnod,nshnod,stifint)
1654C---------------------------------------------------------------
1655C Contact Stiffness based on mass and time step :
1656C Initial time step estimation in starter
1657C---------------------------------------------------------------
1658 IF(interfaces%PARAMETERS%ISTIF_DT > 0) THEN
1659 CALL inintmass( ipari, intbuf_tab,ms , interfaces%PARAMETERS%ISTIF_DT )
1660 ENDIF
1661 interfaces%PARAMETERS%DT_STIFINT = zero
1662 IF(interfaces%PARAMETERS%ISTIF_DT > 0) THEN
1663 CALL dtnoda_stifint( ms ,stifn ,interfaces%PARAMETERS%DT_STIFINT)
1664 ENDIF
1665C--------------------------------------------
1666C Laser impact
1667C--------------------------------------------
1668 IF(nlaser/=0)THEN
1669 CALL laser10(las,xlas,x,ixq,iparg)
1670 ENDIF
1671C-----------------------------------------------------
1672C Porous elements
1673C Modification of volumes and normals
1674C-----------------------------------------------------
1675 IF(n2d == 0 .AND. imulti_fvm /= 1)THEN
1676 DO ng=1,ngroup
1677 ity=iparg(5,ng)
1678 jeul =iparg(11,ng)
1679 IF(ity == 1 .AND. jeul /= 0 )THEN
1680 mtn=iparg(1,ng)
1681 nel=iparg(2,ng)
1682 nft=iparg(3,ng)
1683 iad=iparg(4,ng)
1684 npt=iparg(6,ng)
1685 jale=iparg(7,ng)
1686 ismstr=iparg(9,ng)
1687 jtur=iparg(12,ng)
1688 jthe=iparg(13,ng)
1689 jlag=iparg(14,ng)
1690 jmult=iparg(20,ng)
1691 jpor=iparg(27,ng)
1692 CALL eporin3(ixs,veul,ale_connectivity,geo,nft,nel)
1693 ENDIF
1694 ENDDO ! next element group NG
1695 ENDIF
1696C-----------------------------------------------------
1697C Option /INIVOL
1698C-----------------------------------------------------
1699 CALL init_inivol( num_inivol, inivol, nsurf, igrsurf,
1700 . nparg , ngroup, iparg, numnod, npart,
1701 . numels , nixs, ixs, igrnod, ngrnod,
1702 . numeltg , nixtg, ixtg,
1703 . numelq , nixq, ixq,
1704 . x , nbsubmat, kvol,
1705 . elbuf_tab, numels8, xrefs, glob_therm,
1706 . n2d ,multi_fvm, sipart, ipart ,
1707 . i15a ,i15b , i15h, sbufmat, bufmat,
1708 . npropmi ,nummat , ipm, sbufsf, bufsf,
1709 . npropg ,numgeo , geo, mvsiz , skvol,
1710 . itab ,mat_param)
1711C---------------------------------
1712C Gravity (after INIVOL)
1713C---------------------------------
1714 IF (ninigrav>0)THEN
1715 nv46=4
1716 IF(n2d==0)nv46 = 6
1717 CALL inigrav_load(
1718 1 elbuf_tab , ipart , igrpart , iparg , ipart(i15h),
1719 2 ipart(i15a) , ipart(i15b), x , ixs , ixq ,
1720 3 ixtg , pm , ipm , bufmat , multi_fvm ,
1721 4 ale_connectivity, nv46 , igrsurf , itab , ebcs_tab ,
1722 5 npc , pld , mat_param)
1723 ENDIF
1724C---------------------------------
1725C Initialization on 1D curves
1726C---------------------------------
1727 IF (ninimap1d > 0) THEN
1728 WRITE(istdo, '(A)') titre(53)
1729 CALL ini_inimap1d(inimap1d ,elbuf_tab ,ipart ,iparg ,ipart(i15a),
1730 . ipart(i15b) ,x ,v ,ixs ,ixq ,
1731 . ixtg ,pm ,ipm ,bufmat ,multi_fvm ,
1732 . pld ,npc ,igrbric ,igrquad ,igrsh3n ,
1733 . npts ,mat_param ,snpc ,stf)
1734 ENDIF
1735C---------------------------------
1736C Initialization on 2D functions
1737C---------------------------------
1738 IF (ninimap2d > 0) THEN
1739 WRITE(istdo, '(a)') TITRE(53)
1740 CALL INI_INIMAP2D(INIMAP2D ,ELBUF_TAB ,IPART ,IPARG ,IPART(I15A),
1741 . IPART(I15B) ,X ,V ,IXS ,IXQ ,
1742 . IXTG ,PM ,IPM ,BUFMAT ,MULTI_FVM ,
1743 . FUNC2D ,IGRBRIC ,IGRQUAD ,IGRSH3N )
1744 ENDIF
1745C---------------------------------
1746C Initialization of FVM velocities
1747C---------------------------------
1748.AND. IF (MULTI_FVM%IS_USED NINVEL > 0) THEN
1749 CALL INI_FVMINIVEL(FVM_INIVEL ,MULTI_FVM ,IGRBRIC ,IGRQUAD ,IGRSH3N)
1750 ENDIF
1751C------------------------------------------------------------------
1752C SMS : Initialization of GBUF%ISMS and automatic element selection
1753C------------------------------------------------------------------
1754 IF (ISMS_SELEC >= 1) THEN
1755 CALL SMS_AUTO_DT(DTELEM,NATIV_SMS,
1756 . IXS ,IXQ ,IXC ,IXT ,IXP ,
1757 . IXR ,IXTG ,IXS10 ,IXS16 ,IXS20 ,
1758 . IPART(I15A) ,IPART(I15B) ,IPART(I15C) ,IPART(I15D) ,IPART(I15E),
1759 . IPART(I15F) ,IPART(I15H) ,IPART(I15I) ,IPART ,
1760 . IPARG ,ELBUF_TAB ,IGEO ,IDDLEVEL ,TAGPRT_SMS )
1761 ENDIF
1762C
1763 IF(ILAG+IALE+IEULER == 0)THEN
1764 DEALLOCATE(I8MI)
1765 RETURN
1766 ENDIF
1767C-------------------------------------
1768C Initialization of rigid bodies
1769C-------------------------------------
1770 B1=ZERO
1771 B2=ZERO
1772 B3=ZERO
1773 B6=ZERO
1774 B5=ZERO
1775 B9=ZERO
1776 TOTMAS=ZERO
1777 XG=ZERO
1778 YG=ZERO
1779 ZG=ZERO
1780C
1781 IF(NRBYKIN>0)THEN
1782 RBYID=0
1783 DO I=1,NUMNOD
1784 IWA(I)=0
1785 ENDDO
1786 DO N=1,NRBYKIN
1787 M=NPBY(1,N)
1788 NSL=NPBY(2,N)
1789 ISPH=NPBY(5,N)
1790 RBYID= NPBY(6,N)
1791 ISENS=NPBY(4,N)
1792 ID=NOM_OPT(1,N)
1793 CALL FRETITL2(TITR,NOM_OPT(LNOPT1-LTITR+1,N),LTITR)
1794 IF(ISENS == 0)THEN
1795 CALL INIRBY(N ,RBY ,M ,LPBY ,
1796 . MS,IN ,X ,ITAB ,SKEW ,
1797 . B1,B2 ,B3 ,B5 ,B6 ,
1798 . B9,ISPH ,TOTMAS ,XG ,YG ,
1799 . ZG,STIFN ,STIFR ,NPBY ,RBYID ,
1800 . V ,VR ,ID ,TITR ,ITAGND,
1801 . RBY_INIAXIS)
1802 IWA(M)=N
1803 ENDIF
1804 ENDDO
1805C
1806C-------------------------------------------
1807C Initialization of rigid bodies with sensor
1808C-------------------------------------------
1809 DO N=1,NRBYKIN
1810 M=NPBY(1,N)
1811 NSL=NPBY(2,N)
1812 ISPH=NPBY(5,N)
1813 ISENS=NPBY(4,N)
1814 RBYID= NPBY(6,N)
1815 ID=NOM_OPT(1,N)
1816 CALL FRETITL2(TITR,NOM_OPT(LNOPT1-LTITR+1,N),LTITR)
1817 IF(ISENS/=0)THEN
1818 CALL INIRBYS(N ,RBY ,M ,LPBY ,
1819 . MS,IN ,X ,ITAB ,SKEW,
1820 . B1,B2 ,B3 ,B5 ,B6 ,
1821 . B9,ISPH ,TOTMAS ,XG ,YG ,
1822 . ZG,NPBY ,IWA ,V ,VR ,
1823 . RBYID,ID ,TITR ,ITAGND,RBY_INIAXIS)
1824 ENDIF
1825 ENDDO
1826 ENDIF
1827C----------------------------------------------------------
1828C Initialization of rigid bodies using Lagrange multipliers
1829C----------------------------------------------------------
1830 IF(NRBYLAG/=0)
1831 . CALL LGMINI_RBY(NPBYL ,LPBYL ,RBYL ,MS ,IN ,X ,V ,VR ,ITAB ,NOM_OPT)
1832C-------------------------------------
1833C Sorting of rigid bodies structures
1834C-------------------------------------
1835 IF (NRBMERGE > 0) THEN
1836 CALL RETRIRBY(NPBY ,LPBY ,RBY ,NOM_OPT)
1837 ENDIF
1838C--------------------------------------------
1839C Seat belts initialization :
1840C--------------------------------------------
1841 IF (N_SEATBELT > 0) CALL INIT_SEATBELT_RBODIES(NNPBY,NRBODY,NPBY,SLRBODY,LPBY,SICODE,ICODE,NSLIPRING)
1842C-------------------------------------
1843C Initialization of rigid materials
1844C-------------------------------------
1845 IF(IRIGID_MAT > 0)THEN
1846 CALL ININODE_RM(CONNEC ,IRIG_NODE, SLNRBM , NSLNRBM ,NRBYM ,
1847 . NGSLNRBYM,STIFN ,STIFR,RMSTIFN, RMSTIFR ,
1848 . NELEMR,NINDX )
1849 ENDIF
1850C-----------------------------------------------------------
1851C Verification of imposed motion to surfaces by rigid bodies
1852C-----------------------------------------------------------
1853 CALL INISRF(X,V,VR,NPBY,RBY,IGRSURF,BUFSF)
1854C-----------------------------------------------------
1855C Check for springs with stiffness but no nodal mass
1856C-----------------------------------------------------
1857 CALL RCHECKMASS(IXR ,GEO ,PM ,MSR ,INR ,
1858 . MS ,IN ,ITAB ,IGEO ,IPM ,
1859 . BUFMAT ,IPART ,IPART(I15F),NPBY ,LPBY )
1860C-------------------------------------
1861C Initialization of flexible bodies
1862C-------------------------------------
1863 IF (NFXBODY>0) THEN
1864C
1865C-- Automatic setting of fxbody from pch files
1866C
1867 CALL INI_FXBODY(FXBIPM, FXBRPM, FXBNOD, FXBGLM,FXBCPM,
1868 . FXBCPS, FXBLM, FXBFLS, FXBDLS,FXBMOD,
1869 . ITAB, X ,MS, IN, FXB_MATRIX,
1870 . FXB_MATRIX_ADD,FXB_LAST_ADRESS,ICODE,NOM_OPT(1,PTR_NOPT_FXB+1))
1871C
1872 ALLOCATE(MBUFEL_TMP(LBUFEL), MDEPL_TMP(3*NUMNOD))
1873C
1874 NMANI=0
1875 DO I=1,LENVAR
1876 FXBDEP(I)=ZERO
1877 FXBVIT(I)=ZERO
1878 FXBACC(I)=ZERO
1879 ENDDO
1880 CALL FXBVINI(FXBIPM, FXBVIT, FXBRPM, V, VR)
1881 IRCS=0
1882 DO I=1,NFXBODY
1883 ALM=FXBIPM(19,I)
1884 ASIG=FXBIPM(20,I)
1885 AMOD=FXBIPM(7,I)
1886 ARPM=FXBIPM(14,I)
1887 NBNO=FXBIPM(3,I)
1888 NME=FXBIPM(17,I)
1889 NML=FXBIPM(4,I)
1890 NELS=FXBIPM(21,I)
1891 NELC=FXBIPM(22,I)
1892 NELT=FXBIPM(34,I)
1893 NELP=FXBIPM(35,I)
1894 NELTG=FXBIPM(23,I)
1895 LVSIG=NELS*7+NELC*10+NELT*2+NELP*8+NELTG*10
1896 IFILE=FXBIPM(29,I)
1897 IF (IFILE == 0) THEN
1898 AMOD=AMOD+NME*NBNO*6
1899 ELSEIF (IFILE == 1) THEN
1900 AMOD=AMOD+NME*FXBIPM(18,I)*6
1901 ENDIF
1902 FXBIPM(31,I)=IRCS
1903 CALL FXBSINI(
1904 . FXBELM(ALM) , FXBSIG(ASIG), NELS, NELC, NELTG,
1905 . X , IPARG , PM , FXBMOD(AMOD), NML ,
1906 . NBNO , IXS , IXC , IXTG , GEO ,
1907 . FXBRPM(ARPM), I , FXBIPM(29,I), LVSIG ,FXBIPM(18,I),
1908 . NME , IRCS, FXBIPM(30,I), NELT, NELP ,
1909 . IXT , IXP ,IBEAM_VECTOR,RBEAM_VECTOR)
1910C
1911 FXBIPM(33,I)=IRCS
1912 ADRRPM=FXBIPM(14,I)
1913 FXBRPM(ADRRPM+10)=ZERO
1914 FXBRPM(ADRRPM+11)=ZERO
1915C
1916C Animation output of flexible body local modes
1917 IF (FXBIPM(36,I) == 1) THEN
1918 FXBID=FXBIPM(1,I)
1919 ANOD=FXBIPM(6,I)
1920 IFILE=FXBIPM(29,I)
1921 IRCM=FXBIPM(30,I)
1922 IRCS=FXBIPM(31,I)
1923 NSNI=FXBIPM(18,I)
1924 NSN=FXBIPM(3,I)
1925 IRCM=IRCM+(NSN-NSNI)*FXBIPM(17,I)
1926 IMIN=FXBIPM(37,I)
1927 IMAX=FXBIPM(38,I)
1928C
1929 DO J=1,FXBIPM(4,I)
1930 DO K=1,3*NUMNOD
1931 MDEPL_TMP(K)=ZERO
1932 ENDDO
1933 DO K=1,LBUFEL
1934 MBUFEL_TMP(K)=ELBUF(K)
1935 ENDDO
1936C
1937 CALL MODDEPL(
1938 . FXBNOD(ANOD), FXBMOD(AMOD), MDEPL_TMP , IFILE, IRCM,
1939 . NSNI, NSN, AMOD )
1940C
1941 CALL MODBUFEL(
1942 . FXBELM(ALM), FXBSIG(ASIG), MBUFEL_TMP, NELS, NELC,
1943 . NELT, NELP, NELTG, FXBRPM(ARPM), LBUFEL,
1944 . ASIG , IFILE, IRCS , LVSIG )
1945C
1946.AND. IF (J>=IMINJ<=IMAX) THEN
1947 NMANI=NMANI+1
1948 FXANI(1,NMANI)=FXBID
1949 FXANI(2,NMANI)=J
1950 DO K=1,3*NUMNOD
1951 MDEPL(K,NMANI)=MDEPL_TMP(K)
1952 ENDDO
1953 DO K=1,LBUFEL
1954 MBUFEL(K,NMANI)=MBUFEL_TMP(K)
1955 ENDDO
1956 ENDIF
1957 ENDDO
1958 ENDIF
1959 ENDDO
1960C
1961 DEALLOCATE(MBUFEL_TMP, MDEPL_TMP)
1962 ENDIF ! end flexible bodies
1963C-----------------------------------------------------
1964C Initialization and check of rigid bodies type /RBE2 :
1965C-----------------------------------------------------
1966 CALL INIRBE2(IRBE2 ,LRBE2 ,ITAB ,X ,MS ,
1967 . IN ,STIFN ,STIFR ,TOTMAS,XG ,
1968 . YG ,ZG ,B1 ,B2 ,B3 ,
1969 . B5 ,B6 ,B9 ,
1970 . NOM_OPT(1,PTR_NOPT_RBE2+1),ITAGND)
1971C------------------------------------------------------
1972C Initialization of joint type spring (PID33 and PID45)
1973C------------------------------------------------------
1974 FLAG_KJ = 0
1975 DO NG=1,NGROUP
1976 NEL = IPARG(2,NG)
1977 ITY = IPARG(5,NG)
1978 NFT = IPARG(3,NG)
1979 IAD = IPARG(4,NG)
1980 LFT = 1
1981 LLT = NEL
1982 IF (ITY == 6) THEN
1983 IPROP=IXR(1,1+NFT)
1984 IGTYP = NINT(GEO(NPROPG*(IPROP-1)+12))
1985 GBUF => ELBUF_TAB(NG)%GBUF
1986 IF (IGTYP==33) THEN
1987 NUVAR = NINT(GEO(NPROPG*(IPROP-1)+25))
1988 CALL RINI33_RB(NEL,NUVAR,IPROP,IXR,NPBY,
1989 . LPBY,RBY,STIFR,GBUF%VAR,ITAB,
1990 . IGEO(1,IPROP),IXR_KJ,GBUF%MASS)
1991 ELSEIF (IGTYP==45) THEN
1992 IF (FLAG_KJ==0) WRITE(IOUT,1500)
1993 FLAG_KJ = 1
1994 NUVAR = NINT(GEO(NPROPG*(IPROP-1)+25))
1995 CALL RINI45_RB(NEL,NUVAR,IPROP,IXR,NPBY,
1996 . LPBY,RBY,STIFR,GBUF%VAR,ITAB,
1997 . IGEO(1,IPROP),IXR_KJ,GBUF%MASS,MS,IN)
1998 ENDIF
1999 ENDIF
2000 ENDDO
2001C------------------------------------------------------
2002C Initialization of joint type spring (PID33 and PID45)
2003C------------------------------------------------------
2004 IF (NDAMP_FREQ_RANGE > 0) THEN
2005 call damping_range_init(ndamp,nrdamp,dampr,ngroup,nparg,iparg,elbuf_tab)
2006 ENDIF
2007C
2008C----------------------------------------------------------------
2009 IF(IPRI>=2) THEN
2010 WRITE(IOUT,1000)
2011 WRITE(IOUT,'(5(i10,1x,1pg20.13))') (ITAB(I),MS(I),I=1,NUMNOD)
2012 IF (GLOB_THERM%ITHERM_FE > 0) THEN
2013 WRITE(IOUT,1600)
2014 WRITE(IOUT,'(5(i10,1x,1pg20.13))') (ITAB(I),TEMP(I),I=1,NUMNOD)
2015 WRITE(IOUT,1700)
2016 WRITE(IOUT,'(5(i10,1x,1pg20.13))') (ITAB(I),MCP(I),I=1,NUMNOD)
2017 ENDIF
2018 ENDIF
2019C-------------------------------------
2020C Mass and Inertia by parts
2021C-------------------------------------
2022 CALL OUTPART(PARTSAV,IPART,NPART)
2023C-------------------------------------
2024C INFO supp in PROP&MAT / PARTS
2025C-------------------------------------
2026 CALL OUTPART5(GROUP_PARAM_TAB,IPART,IPART(I15A),IPARG,IGEO,GEO ,PM )
2027C-------------------------------------
2028C Mass and inertia parallel arithmetic
2029C-------------------------------------
2030 IF(IPARI0 == 3)THEN
2031 DO N=1,NUMNOD
2032 MS(N) = MS(N) +
2033 . I8MI(1,N) + r8_deuxm43 * (
2034 . I8MI(2,N) + r8_deuxm43 * I8MI(3,N))
2035 ENDDO
2036 IF(IRODDL/=0)THEN
2037 DO N=1,NUMNOD
2038 IN(N) = IN(N) +
2039 . I8MI(4,N) + r8_deuxm43 * (
2040 . I8MI(5,N) + r8_deuxm43 * I8MI(6,N))
2041 ENDDO
2042 ENDIF
2043 ENDIF
2044C-------------------------------------
2045C Total mass and total inertia
2046C-------------------------------------
2047 IF (NS10E >0) THEN
2048 DO N=1,NUMNOD
2049 IF (ITAGND(N)/=0) CYCLE
2050 NN3=3*N
2051 NN2=NN3-1
2052 NN1=NN2-1
2053 TOTMAS=TOTMAS+MS(N)
2054 XG=XG+MS(N)*X(NN1)
2055 YG=YG+MS(N)*X(NN2)
2056 ZG=ZG+MS(N)*X(NN3)
2057c
2058 XX=(X(NN1))**2
2059 YY=(X(NN2))**2
2060 ZZ=(X(NN3))**2
2061 XY=(X(NN1))*(X(NN2))
2062 XZ=(X(NN1))*(X(NN3))
2063 YZ=(X(NN2))*(X(NN3))
2064C
2065 B1=B1+(YY+ZZ)*MS(N)
2066 B5=B5+(XX+ZZ)*MS(N)
2067 B9=B9+(XX+YY)*MS(N)
2068 B2=B2-XY*MS(N)
2069 B6=B6-YZ*MS(N)
2070 B3=B3-XZ*MS(N)
2071 ENDDO
2072 ELSE
2073 DO N=1,NUMNOD
2074 NN3=3*N
2075 NN2=NN3-1
2076 NN1=NN2-1
2077 TOTMAS=TOTMAS+MS(N)
2078 XG=XG+MS(N)*X(NN1)
2079 YG=YG+MS(N)*X(NN2)
2080 ZG=ZG+MS(N)*X(NN3)
2081c
2082 XX=(X(NN1))**2
2083 YY=(X(NN2))**2
2084 ZZ=(X(NN3))**2
2085 XY=(X(NN1))*(X(NN2))
2086 XZ=(X(NN1))*(X(NN3))
2087 YZ=(X(NN2))*(X(NN3))
2088C
2089 B1=B1+(YY+ZZ)*MS(N)
2090 B5=B5+(XX+ZZ)*MS(N)
2091 B9=B9+(XX+YY)*MS(N)
2092 B2=B2-XY*MS(N)
2093 B6=B6-YZ*MS(N)
2094 B3=B3-XZ*MS(N)
2095 ENDDO
2096 END IF
2097C
2098 IF(IRODDL/=0)THEN
2099 DO N=1,NUMNOD
2100 B1=B1+IN(N)
2101 B5=B5+IN(N)
2102 B9=B9+IN(N)
2103 ENDDO
2104 ENDIF
2105C----- substraction of middle node S10+Itet=2
2106 XG=XG/MAX(TOTMAS,EM20)
2107 YG=YG/MAX(TOTMAS,EM20)
2108 ZG=ZG/MAX(TOTMAS,EM20)
2109 WRITE(IOUT,1100)
2110 WRITE(IOUT,'(5x,1pg20.13,3(1x,g20.13))')
2111 . TOTMAS,XG,YG,ZG
2112C
2113 XX=XG**2
2114 YY=YG**2
2115 ZZ=ZG**2
2116 XY=XG*YG
2117 XZ=XG*ZG
2118 YZ=YG*ZG
2119C
2120 B1=B1-(YY+ZZ)*TOTMAS
2121 B5=B5-(XX+ZZ)*TOTMAS
2122 B9=B9-(XX+YY)*TOTMAS
2123 B2=B2+XY*TOTMAS
2124 B6=B6+YZ*TOTMAS
2125 B3=B3+XZ*TOTMAS
2126 WRITE(IOUT,1200)
2127 WRITE(IOUT,'(4x,3(1x,1pg20.13),3(1x,g20.13))')
2128 . B1,B5,B9,B2,B6,B3
2129C
2130C Print out the total additional nonstructural nodal mass
2131C
2132 WRITE(IOUT,'(//)')
2133 WRITE(IOUT,1300)
2134 WRITE(IOUT,1400) TOTADDMAS
2135C
2136C-----------------------------------------------------------------------------------
2137C Initialization of non-local variable regularization structure for damage models
2138C-----------------------------------------------------------------------------------
2139 CALL NLOC_DMG_INIT(ELBUF_TAB,NLOC_DMG ,IPARG ,IXC ,
2140 . IXS ,IXTG ,ELE_AREA ,DTELEM ,
2141 . NUMEL ,IPM ,X ,XREFS ,
2142 . XREFC ,XREFTG ,BUFMAT ,PM )
2143c
2144c-----------------------------------------------------------------------------------
2145
2146 IF (GLOB_THERM%ITHERM_FE > 0 ) THEN
2147 DEALLOCATE(MCPS,MCPP)
2148.OR..OR. IF(NUMELS10 > 0NUMELS16 > 0 NUMELS20 > 0)
2149 . DEALLOCATE(MCPSX)
2150 ENDIF
2151C
2152 DEALLOCATE (PARTSAV)
2153
2154 DEALLOCATE(MS_LAYERC,ZI_LAYERC,MSZ2C,ZPLY)
2155 DEALLOCATE (PARTSAV1_PON)
2156C
2157 DEALLOCATE(CONNEC,IRIG_NODE)
2158 IF(ALLOCATED(PART_AREA))DEALLOCATE(PART_AREA)
2159 DEALLOCATE(I8MI)
2160 IF(ALLOCATED(VPRELOAD)) DEALLOCATE (VPRELOAD)
2161 IF(ALLOCATED(ELE_AREA))DEALLOCATE(ELE_AREA)
2162c-----------
2163 RETURN
2164c-----------
2165 1000 FORMAT(//
2166 . 5X,'nodal masses',/
2167 . 5X,'------------',/
2168 . 5X,' node mass',22X,'node mass',22X,'node mass',22X,'node mass',
2169 .22X,'node mass'/)
2170 1100 FORMAT(//
2171 . 5X,'total mass and mass center',/
2172 . 5X,'--------------------------',/
2173 . 5X,' mass',20X,'x',20X,'y',20X,'z'/)
2174 1200 FORMAT(//
2175 . 5X,'total inertia',/
2176 . 5X,'-------------',/
2177 .22X,'ixx',18X,'iyy',18X,'izz',18X,'ixy',18X,'iyz',18X,'izx')
2178 1300 FORMAT(
2179 . 5X,' added nodal non-structural masses ' /
2180 . 5X,'-----------------------------------' /)
2181 1400 FORMAT(5X,' total added mass = ',1PG20.13//)
2182 1500 FORMAT(//
2183 . 5X,'kjoint2 spring definition',/
2184 . 5X,'------------------------'/)
2185 1600 FORMAT(//
2186 . 5X,'initial nodal temperatures',/
2187 . 5x,'--------------------------',/
2188 . 6x,5('NODE TEMPERATURE',15x),'NODE TEMPERATURE'/)
2189 1700 FORMAT(//
2190 . 5x,'INITIAL NODAL MCP ',/
2191 . 5x,'--------------------------',/
2192 . 6x,5('NODE MCP ',15x),'NODE MCP '/)
2193 RETURN
addmaspart
subroutine addmaspart(ipart, ipmas, partsav, part_area, pm, addedms, nom_opt, partsav_pon)
Definition addmaspart.F:35
asstifi
subroutine asstifi(volnod, bvolnod, etnod, nshnod, stifint)
Definition asstifi.F:29
binit2
subroutine binit2(elbuf_str, ms, ixq, pm, x, detonators, veul, ale_connectivity, iparg, fill, sigi, bufmat, nel, mat_param, skew, msq, ipart, ipartq, geo, igeo, ipm, nsigs, wma, ptquad, npf, tf, ipargg, iloadp, facload, partsav, v)
Definition binit2.F:48
c3init3
subroutine c3init3(elbuf_str, ixtg, pm, x, geo, igrsh4n, xmas, in, nvc, dtelem, igrsh3n, xreftg, offset, nel, ithk, thk, isigsh, sigsh, stifn, stifr, partsav, v, ipart, mstg, intg, ptg, skew, iparg, nsigsh, igeo, iuser, etnod, nshnod, sttg, ptsh3n, ipm, bufmat, sh3tree, mcp, mcptg, temp, cpt_eltens, part_area, itage, itagn, ixfem, npf, tf, sh3trim, xfem_str, isubstack, stack, rnoise, drape, sh3ang, iddlevel, geo_stack, igeo_stack, strtg, perturb, ish3n, iyldini, ele_area, nloc_dmg, ng, group_param, idrape, drapeg, mat_param, fail_fractal, fail_brokmann, glob_therm)
Definition c3init3.F:79
cbainit3
subroutine cbainit3(elbuf_str, ixc, pm, x, geo, xmas, in, nvc, dtelem, igrsh4n, xrefc, nel, ithk, ihbe, igrsh3n, thke, isigsh, sigsh, stifn, stifr, partsav, v, ipart, msc, inc, skew, i8mi, nsigsh, igeo, ipm, iuser, etnod, nshnod, stc, ptshel, bufmat, sh4tree, mcp, mcps, temp, ms_layer, zi_layer, itag, itagel, iparg, ms_layerc, zi_layerc, part_area, cpt_eltens, msz2c, zply, itagn, itage, ixfem, npf, tf, xfem_str, isubstack, stack, rnoise, drape, sh4ang, iddlevel, geo_stack, igeo_stack, strc, perturb, iyldini, ele_area, nloc_dmg, ng, group_param, idrape, drapeg, mat_param, fail_fractal, fail_brokmann, glob_therm)
Definition cbainit3.F:81
cdkinit3
subroutine cdkinit3(elbuf_str, group_param, ixtg, pm, x, geo, xmas, in, nvc, dtelem, xreftg, offset, nel, ithk, thk, isigsh, sigsh, stifn, stifr, partsav, v, ipart, mstg, intg, ptg, skew, ish3n, nsigsh, igeo, ipm, iuser, etnod, nshnod, sttg, ptsh3n, bufmat, sh3tree, mcp, mcps, temp, iparg, cpt_eltens, part_area, npf, tf, sh3trim, isubstack, stack, rnoise, drape, sh3ang, geo_stack, igeo_stack, strtg, perturb, iyldini, ele_area, nloc_dmg, idrape, drapeg, mat_param, glob_therm)
Definition cdkinit3.F:67
cinit3
subroutine cinit3(elbuf_str, ixc, pm, x, geo, xmas, in, nvc, dtelem, igrsh4n, xrefc, nel, ithk, ihbe, igrsh3n, thk, isigsh, sigsh, stifn, stifr, partsav, v, ipart, msc, inc, skew, iparg, i8mi, nsigsh, igeo, iuser, etnod, nshnod, stc, ptshel, ipm, bufmat, sh4tree, mcp, mcps, temp, cpt_eltens, part_area, itagn, itage, ixfem, npf, tf, xfem_str, isubstack, stack, rnoise, drape, sh4ang, iddlevel, geo_stack, igeo_stack, strc, perturb, iyldini, ele_area, ng, group_param, nloc_dmg, idrape, drapeg, mat_param, fail_fractal, fail_brokmann, glob_therm)
Definition cinit3.F:79
my_real
#define my_real
Definition cppsort.cpp:32
dtnoda
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)
Definition dtnoda.F:42
dtnoda_stifint
subroutine dtnoda_stifint(ms, stifn, dt_stifint)
Definition dtnoda_stifint.F:31
eporin3
subroutine eporin3(ixs, veul, ale_connectivity, geo, nft, nel)
Definition eporin3.F:30
fail_brokmann
subroutine fail_brokmann(nel, nuparam, nuvar, time, timestep, uparam, ngl, signxx, signyy, signxy, uvar, off, ipt, nindxf, indxf, tdel)
Definition fail_brokmann.F:37
ig3dinit3
subroutine ig3dinit3(elbuf_str, ms, kxig3d, ixig3d, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, ipartig3d, mss, ipart, sigsp, nsigi, in, vr, ipm, nsigs, vnige, bnige, ptsol, bufmat, npf, tf, fail_ini, nctrl, msig3d, knot, nctrlmax, wige, px, py, pz, knotlocpc, knotlocel)
Definition ig3dinit3.F:49
ini_inimap1d
subroutine ini_inimap1d(inimap1d, elbuf_tab, ipart, iparg, iparts, ipartq, xgrid, vel, ixs, ixq, ixtg, pm, ipm, bufmat, multi_fvm, pld, npc, igrbric, igrquad, igrsh3n, npts, mat_param, snpc, stf)
Definition ini_inimap1d.F:40
ini_seatbelt
subroutine ini_seatbelt(iparg, elbuf_tab, knod2el1d, nod2el1d, ixr, x, itab, ipm, alea, knod2elc, nod2elc, ixc)
Definition ini_seatbelt.F:38
iniboltprel
subroutine iniboltprel(ixs, ipreload, preload, vpreload, iflag_bpreload)
Definition iniboltprel.F:34
inigrav_load
subroutine inigrav_load(elbuf_tab, ipart, igrpart, iparg, iparttg, iparts, ipartq, x, ixs, ixq, ixtg, pm, ipm, bufmat, multi_fvm, ale_connectivity, nv46, igrsurf, itab, ebcs_tab, npf, tf, mat_param)
Definition inigrav_load.F:43
inintmass
subroutine inintmass(ipari, intbuf_tab, ms, istif_dt)
Definition inintmass.F:31
inirig_mat
subroutine inirig_mat(ixc, ixs, ixtg, ixs10, x, v, pm, geo, ms, in, ptg, msc, mss, mstg, inc, intg, thkc, thkt, partsav, iparts, ipartc, ipartt, veul, dtelem, ihbe, isolnod, nvc, i8mi, msnf, mssf, igeo, etnod, nshnod, stc, sttg, wma, sh4tree, sh3tree, mcp, mcpc, temp, mcps, mssx, mcpsx, ins, stifn, stifr, connec, irig_node, numel, nindx, xrefc, xreftg, xrefs, mssa, sh3trim, isubstack, bufmat, ipm, stack, rnoise, strc, strtg, perturb, nel, group_param, igtyp, defaults, glob_therm)
Definition inirig_mat.F:69
sgsavinieref
subroutine sgsavinieref(npe, straglob, sigsp, nsigi, ptsol, sav, offg, nel)
Definition initia.F:2869
sgsavref
subroutine sgsavref(npe, xref, sav, nel)
Definition initia.F:2817
sgsavinierefq
subroutine sgsavinierefq(npe, straglob, sigsp, nsigi, ptsol, sav, offg, ixs, dr, ndr, nel)
Definition initia.F:2936
checkmp
subroutine checkmp(numel, ix, nix, ng, ne, emat, epid, ipm, igeo, elem, ipartel)
Definition initia.F:2445
chekmp2
subroutine chekmp2(numel, ipart, ipartel, ix, nix, ne, emat, epid, ipm, igeo, elem)
Definition initia.F:2209
inivoid
subroutine inivoid(elbuf_str, ixc, ixs, ixtg, x, v, pm, geo, ms, in, ptg, msc, mss, mstg, inc, intg, thkc, thkt, partsav, iparts, ipartc, ipartt, veul, dtelem, ihbe, isolnod, nvc, i8mi, msnf, mssf, igeo, etnod, nshnod, stc, sttg, wma, sh4tree, sh3tree, mcp, mcpc, temp, mcps, xrefc, xreftg, xrefs, mssa, volnod, bvolnod, vns, bns, sh3trim, isubstack, stack, rnoise, perturb, ele_area, part_area, iparttr, ixt, ipartp, ixp, mst, msp, stt, stp, strp, inp, stifint, mcpp, inr, msr, msrt, str, ipartr, itab, ixr, imerge2, iadmerge2, nel, defaults, glob_therm, ibeam_vector, rbeam_vector)
Definition inivoid.F:76
inspcnd
subroutine inspcnd(ispcond, igrnod, kxsp, ixsp, nod2sp, itab, icode, iskew, iskn, skew, xframe, x, ispsym, isptag, pm, geo, ipart, ipartsp)
Definition inspcnd.F:39
laser10
subroutine laser10(las, xlas, x, ixq, iparg)
Definition laser10.F:31
max
#define max(a, b)
Definition macros.h:21
multifluid_global_tdet
subroutine multifluid_global_tdet(iparg, elbuf_tab, multi_fvm, ipm)
Definition multifluid_global_tdet.F:31
multifluid_init2
subroutine multifluid_init2(nel, nsigs, iparg, ixq, ipm, ale_connectivity, igeo, ipart, ipartq, npf, ptquad, iloadp, x, pm, geo, sigi, skew, tf, bufmat, facload, elbuf_str, error_thrown, detonators, mat_param)
Definition multifluid_init2.F:43
multifluid_init2t
subroutine multifluid_init2t(elbuf_str, nel, nsigs, nvc, iparg, ixtg, ale_connectivity, igeo, ipart, iparttg, ipm, ptsh3n, npf, iloadp, xgrid, pm, geo, sigi, skew, tf, bufmat, facload, multi_fvm, error_thrown, detonators, mat_param)
Definition multifluid_init2t.F:40
multifluid_init3
subroutine multifluid_init3(elbuf_str, mas, ixs, pm, x, geo, ale_connectivity, iparg_gr, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, sigsp, ng, iparg, glob_therm, nsigi, msnf, nvc, mssf, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, in, vr, ins, wma, ptsol, bufmat, mcp, mcps, temp, xrefs, npf, tf, mssa, strsglob, straglob, fail_ini, spbuf, kxsp, ipartsp, nod2sp, sol2sph, irst, iloadp, facload, multi_fvm, error_thrown, detonators, mat_param)
Definition multifluid_init3.F:60
multifluid_init3t
subroutine multifluid_init3t(elbuf_str, nel, nsigs, nsigi, ixs, igeo, ipm, iparg, ale_connectivity, iparts, ptsol, npf, ipart, iloadp, xrefs, geo, pm, facload, tf, skew, sigi, bufmat, x, wma, partsav, mas, v, mss, mssf, mssa, msnf, mcps, error_thrown, detonators, defaults, mat_param, nintemp)
Definition multifluid_init3t.F:44
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
array_mod
Definition array_mod.F:51
bpreload_mod
Definition bpreload_mod.F:40
bpreload_mod::iflag_bpreload
integer, dimension(:), allocatable iflag_bpreload
Definition bpreload_mod.F:48
bpreload_mod::ipreload
integer, dimension(:), allocatable ipreload
Definition bpreload_mod.F:46
detonators_mod
Definition detonators_mod.F:79
drape_mod
Definition drape_mod.F:54
func2d_mod
Definition func2d_mod.F:35
groupdef_mod
Definition groupdef_mod.F:662
inimap1d_mod
Definition inimap1d_mod.F:35
inimap2d_mod
Definition inimap2d_mod.F:35
inivol_def_mod
Definition inivol_mod.F:45
inivol_def_mod::inivol
type(inivol_struct_), dimension(:), allocatable inivol
Definition inivol_mod.F:84
inivol_def_mod::skvol
integer skvol
Definition inivol_mod.F:86
inivol_def_mod::num_inivol
integer num_inivol
Definition inivol_mod.F:85
nlocal_reg_mod
Definition nlocal_reg_mod.F:117
optiondef_mod
Definition optiondef_mod.F:90
stack_mod
Definition stack_mod.F:72
submodel_mod
Definition submodel_mod.F:712
pinit3
subroutine pinit3(elbuf_str, stp, ic, pm, x, geo, dtelem, nft, nel, stifn, stifr, partsav, v, ipart, msp, inp, igeo, strp, nsigbeam, sigbeam, ptbeam, iuser, mcpp, temp, preload_a, ipreld, npreload_a, glob_therm, ibeam_vector, rbeam_vector)
Definition pinit3.F:48
q4init2
subroutine q4init2(elbuf_str, ms, ixq, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, igeo, nel, skew, msq, ipart, ipartq, ipm, nsigs, wma, ptquad, bufmat, npf, tf, ipargg, iloadp, facload, partsav, v)
Definition q4init2.F:53
qinit2
subroutine qinit2(elbuf_str, ms, ixq, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, igeo, nel, skew, msq, ipart, ipartq, ipm, nsigs, wma, ptquad, bufmat, npf, tf, ipargg, iloadp, facload, partsav, v)
Definition qinit2.F:52
rinit3
subroutine rinit3(elbuf_str, ixr, x, geo, xmas, npc, pld, xin, skew, dtelem, nel, stifn, stifr, partsav, v, ipart, itab, msr, inr, stifint, str, igeo, sigrs, nsigrs, imerge2, iadmerge2, msrt, ixr_kj, nom_opt, strr, ptspri, ipm, pm, uparam, r_skew, preload_a, ipreld, npreload_a, ikine)
Definition rinit3.F:67
s10init3
subroutine s10init3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ixs10, ipart, glob_therm, mssx, sigsp, nsigi, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, vnsx, bnsx, ptsol, bufmat, mcp, mcps, mcpsx, temp, npf, tf, in, stifr, ins, mssa, strsglob, straglob, fail_ini, iloadp, facload, rnoise, perturb, mat_param, defaults_solid)
Definition s10init3.F:63
s10jaci3
subroutine s10jaci3(elbuf_str, sav, npt, nel)
Definition s10jaci3.F:33
s16init3
subroutine s16init3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ixs16, ipart, mssx, sigsp, nsigi, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, vnsx, bnsx, ptsol, bufmat, mcp, mcps, mcpsx, temp, npf, tf, strsglob, straglob, fail_ini, iloadp, facload, rnoise, perturb, mat_param, glob_therm)
Definition s16init3.F:59
s20init3
subroutine s20init3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ixs20, ipart, mssx, sigsp, nsigi, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, vnsx, bnsx, ptsol, bufmat, mcp, mcps, mcpsx, temp, npf, tf, strsglob, straglob, fail_ini, iloadp, facload, rnoise, perturb, mat_param, glob_therm)
Definition s20init3.F:59
s4init3
subroutine s4init3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg_gr, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, msnf, iparg, mssf, ipm, nsigs, volnod, bvolnod, vns, bns, wma, ptsol, bufmat, mcp, mcps, temp, npf, tf, iuser, sigsp, nsigi, mssa, xrefs, strsglob, straglob, fail_ini, spbuf, sol2sph, iloadp, facload, rnoise, perturb, mat_param, defaults_solid, nintemp)
Definition s4init3.F:66
s4refsta3
subroutine s4refsta3(elbuf_str, ixs, pm, geo, iparg, ipm, igeo, skew, x, xrefs, nel, iparts, ipart, bufmat, mat_param, npf, tf, nummat)
Definition s4refsta3.F:49
s6cinit3
subroutine s6cinit3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, glob_therm, sigsp, nsigi, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, ptsol, bufmat, mcp, mcps, mcpsx, temp, npf, tf, strsglob, straglob, mssa, orthoglob, fail_ini, iloadp, facload, rnoise, perturb, mat_param, defaults_solid)
Definition s6cinit3.F:60
s8cinit3
subroutine s8cinit3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, sigsp, nsigi, msnf, mssf, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, wma, ptsol, bufmat, mcp, mcps, temp, npf, tf, xrefs, mssa, strsglob, straglob, orthoglob, fail_ini, iloadp, facload, rnoise, perturb, mat_param, glob_therm)
Definition s8cinit3.F:60
s8zinit3
subroutine s8zinit3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, glob_therm, sigsp, nsigi, msnf, mssf, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, wma, ptsol, bufmat, mcp, mcps, temp, npf, tf, xrefs, mssa, strsglob, straglob, fail_ini, spbuf, kxsp, ipartsp, nod2sp, sol2sph, irst, iloadp, facload, perturb, rnoise, mat_param)
Definition s8zinit3.F:70
scaleini
subroutine scaleini(elbuf_str, ixs, sigsp, sigi, nsigi, nel, lft, llt, nft, nsigs, pt, igeo)
Definition scaleini.F:37
scinit3
subroutine scinit3(elbuf_str, mas, ixs, pm, x, mss, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, ipart, sigsp, nsigi, msnf, mssf, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, wma, ptsol, bufmat, mcp, mcps, temp, npf, tf, mssa, strsglob, straglob, orthoglob, fail_ini, iloadp, facload, rnoise, perturb, glob_therm)
Definition scinit3.F:59
sinit3
subroutine sinit3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg_gr, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, sigsp, ng, iparg, nsigi, msnf, nvc, mssf, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, in, vr, ins, wma, ptsol, bufmat, mcp, mcps, temp, xrefs, npf, tf, mssa, strsglob, straglob, fail_ini, spbuf, kxsp, ipartsp, nod2sp, sol2sph, irst, iloadp, facload, rnoise, perturb, mat_param, glob_therm)
Definition sinit3.F:75
spinit3
subroutine spinit3(igrtyp, spbuf, kxsp, x, geo, xmas, npc, pld, xin, skew, dtelem, nel, stifn, stifr, igeo, partsav, v, ipartsp, bufmat, pm, itab, msr, inr, ixsp, nod2sp, iparg, ale_connectivity, detonators, sigsph, isptag, ipart, ipm, nsigsph, ptsph, npf, tf, elbuf_str, mcp, temp, iloadp, facload, stifint, i7stifs, glob_therm)
Definition spinit3.F:52
spmd_msin
subroutine spmd_msin(ixs, ixq, ixc, ixt, ixp, ixr, ixtg, mss, msq, msc, mst, msp, msr, mstg, inc, inp, inr, intg, index, itri, ms, in, ptg, geo, ixs10, ixs20, ixs16, mssx, msnf, mssf, vns, vnsx, stc, stt, stp, str, sttg, stur, bns, bnsx, volnod, bvolnod, etnod, stifint, ins, mcpc, mcp, mcps, mcpsx, mcptg, sh4tree, sh3tree, ms_layerc, zi_layerc, ms_layer, zi_layer, msz2c, msz2, zply, kxig3d, ixig3d, msig3d, nctrlmax, strc, strp, strr, strtg, stifintr, nshnod, vnige, bnige, mcpp, itherm_fe)
Definition spmd_msin.F:46
spmd_partsav_pon
subroutine spmd_partsav_pon(ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, mss, mssx, msq, msc, mst, msp, msr, mstg, index, itri, geo, partsav1_pon, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipart)
Definition spmd_msin_addmass.F:501
spmd_msin_addmass
subroutine spmd_msin_addmass(ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, mss, mssx, msq, msc, mst, msp, msr, mstg, ptg, ms, index, itri, geo, sh4tree, sh3tree, partsav, ipmas, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, totaddmas, ipart, thk, pm, part_area, addedms, itab, partsav1_pon, ele_area)
Definition spmd_msin_addmass.F:41
srefsta3
subroutine srefsta3(elbuf_str, ixs, pm, geo, iparg, ipm, igeo, skew, x, xrefs, nel, iparts, ipart, bufmat, mat_param, npf, tf, nummat)
Definition srefsta3.F:49
sgsavini
subroutine sgsavini(npe, x, ixs, sav, nel)
Definition scoor3.F:363
arret
subroutine arret(nn)
Definition arret.F:87
strr
character *8 function strr(y)
Definition strr.F:34
inivol_def_mod::inivol_struct_
Definition inivol_mod.F:70
suinit3
subroutine suinit3(elbuf_str, ms, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, sigsp, glob_therm, temp, nsigi, in, vr, ipm, nsigs, volnod, bvolnod, vns, bns, ptsol, bufmat, npf, tf, fail_ini, ins, iloadp, facload, rnoise, perturb, mat_param)
Definition suinit3.F:54
tinit3
subroutine tinit3(elbuf_str, ic, pm, x, geo, xmas, dtelem, nft, nel, stifn, partsav, v, ipart, mst, stifint, stt, igeo, nsigtruss, sigtruss, pttruss, preload_a, ipreld, npreload_a)
Definition tinit3.F:45
xinit3
subroutine xinit3(elbuf_str, kxx, ixx, x, v, vr, xmas, xin, skew, dtelem, nel, stifn, stifr, partsav, ipartx, geo, itab, uix, xusr, vusr, vrusr, umass, uiner, ustifm, ustifr, uvism, uvisr, igeo, nft)
Definition xinit3.F:46
uel2sys
integer function uel2sys(iu, ksysusr, numel)
Definition yctrl.F:408

◆ outpart()

subroutine outpart ( partsav,
integer, dimension(lipart1,*) ipart,
integer npart )

Definition at line 2744 of file initia.F.

2745C-----------------------------------------------
2746C M o d u l e s
2747C-----------------------------------------------
2748 USE names_and_titles_mod , ONLY : nchartitle
2749C-----------------------------------------------
2750C I m p l i c i t T y p e s
2751C-----------------------------------------------
2752#include "implicit_f.inc"
2753C-----------------------------------------------
2754C C o m m o n B l o c k s
2755C-----------------------------------------------
2756#include "units_c.inc"
2757#include "scr17_c.inc"
2758C-----------------------------------------------
2759C D u m m y A r g u m e n t s
2760C-----------------------------------------------
2761 INTEGER NPART,IPART(LIPART1,*)
2762 my_real partsav(20,*)
2763C-----------------------------------------------
2764C L o c a l V a r i a b l e s
2765C-----------------------------------------------
2766 INTEGER I,J
2767 my_real mas,sm,xx,yy,zz,xy,yz,zx,xg,yg,zg,ixx,ixy,iyy,iyz,izz,izx,ek,vx,vy,vz
2768 CHARACTER(LEN=NCHARTITLE) :: TEXT
2769C======================================================================|
2770C
2771 WRITE(iout,'(//,A)')'PART MASS & INERTIA'
2772 WRITE(iout,'(A,/)') '-------------------'
2773C
2774 DO i=1,npart
2775 mas = partsav(1,i)
2776 sm = 1./max(mas,em20)
2777 xg = partsav(2,i) * sm
2778 yg = partsav(3,i) * sm
2779 zg = partsav(4,i) * sm
2780 xx = xg*xg
2781 xy = xg*yg
2782 yy = yg*yg
2783 yz = yg*zg
2784 zz = zg*zg
2785 zx = zg*xg
2786 ixx = partsav(5,i) - (yy+zz)*mas
2787 iyy = partsav(6,i) - (zz+xx)*mas
2788 izz = partsav(7,i) - (xx+yy)*mas
2789 ixy = partsav(8,i) + xy*mas
2790 iyz = partsav(9,i) + yz*mas
2791 izx = partsav(10,i)+ zx*mas
2792 vx = partsav(11,i) * sm
2793 vy = partsav(12,i) * sm
2794 vz = partsav(13,i) * sm
2795 ek = partsav(14,i)
2796 CALL fretitl2(text,ipart(lipart1-ltitr+1,i),ltitr)
2797 WRITE(iout,'(/,A,I10,A,A)')'PART : ',ipart(4,i),', ',trim(text)
2798C WRITE(IOUT,'(A)') '----'
2799 WRITE(iout,'(2A)')
2800 . ' Mass Ixx Iyy Izz',
2801 . ' Ixy Iyz Izx'
2802 WRITE(iout,'(1P7ES16.8)')mas,ixx,iyy,izz,ixy,iyz,izx
2803 WRITE(iout,'(2A)')
2804 . ' X Y Z Kin. Energy',
2805 . ' Vx Vy Vz'
2806 WRITE(iout,'(1P7ES16.8)')xg,yg,zg,ek,vx,vy,vz
2807 ENDDO
2808C
2809 RETURN

◆ outpart5()

subroutine outpart5 ( type(group_param_), dimension(ngroup) group_param_tab,
integer, dimension(lipart1,*) ipart,
integer, dimension(numels), intent(in) iparts,
integer, dimension(nparg,*) iparg,
integer, dimension(npropgi,*) igeo,
geo,
pm )

Definition at line 3003 of file initia.F.

3004C-----------------------------------------------
3005C M o d u l e s
3006C-----------------------------------------------
3007 USE group_param_mod
3008 USE names_and_titles_mod , ONLY : nchartitle
3009C-----------------------------------------------
3010C I m p l i c i t T y p e s
3011C-----------------------------------------------
3012#include "implicit_f.inc"
3013C-----------------------------------------------
3014C C o m m o n B l o c k s
3015C-----------------------------------------------
3016#include "units_c.inc"
3017#include "scr17_c.inc"
3018#include "param_c.inc"
3019#include "com01_c.inc"
3020#include "com04_c.inc"
3021C-----------------------------------------------
3022C D u m m y A r g u m e n t s
3023C-----------------------------------------------
3024 INTEGER , DIMENSION(NUMELS), INTENT(IN) :: IPARTS
3025 INTEGER IPART(LIPART1,*),IPARG(NPARG,*),IGEO(NPROPGI,*)
3026 my_real
3027 . geo(npropg,*),pm(npropm,*)
3028 TYPE(GROUP_PARAM_) , DIMENSION(NGROUP) :: GROUP_PARAM_TAB
3029C-----------------------------------------------
3030C L o c a l V a r i a b l e s
3031C-----------------------------------------------
3032 INTEGER I,J,NG,IPID,IMID,MID,PID,ITY,IGTYP,ETY,N_NOD,ISOLNOD,
3033 . IHBE,ISMSTR,ICPRE,JCVT,IINT,IHKT,ITET4,ITET10,IMATVIS,NPT,NLY,
3034 . ICSTR,IDRIL,ITHK,IPLAS,I2GEO(NUMGEO),NG2,NG1,NG0,JG,ETYE,
3035 . IH4,IH3,IGMAT,I2GEO1(NUMGEO),I2GEO2(NUMGEO),IHBE0,
3036 . IP,NFT,IP2NG1(NPART),IP2NG2(NPART),LST,ICONTROL,IPOS
3037 my_real
3038 . mas,sm,xx,yy,zz,xy,yz,zx,xg,yg,zg,
3039 . ixx,ixy,iyy,iyz,izz,izx,ek,vx,vy,vz,hm,hr,hf,dn,qa,qb,qh,
3040 . ns_a,ns_b,dm,qf,qm,qr,df
3041 CHARACTER(LEN=NCHARTITLE) TEXT
3042 CHARACTER(LEN=23), DIMENSION(27) :: EL_TYP
3043 DATA el_typ / 'SOLID-HEXA ',
3044 . 'TETRA4 ',
3045 . 'TETRA10 ',
3046 . 'BRIC20 ',
3047 . 'ELEM-USER ',
3048 . 'SOLID-IGE ',
3049 . 'THICK-SHELL HEXA ' ,
3050 . 'THICK-SHELL PENTA ' ,
3051 . 'THICK-SHELL SHEL16' ,
3052 . 'THICK-SHELL BRIC20' ,
3053 . 'SHELL-4nodes ' ,
3054 . 'SHELL-3nodes ' ,
3055 . 'QUAD-2D ' ,
3056 . 'TRUSS ' ,
3057 . 'BEAM ' ,
3058 . 'SPRING ' ,
3059 . 'SPH ' ,
3060 . 'SHELL-(3nodes+4nodes)' ,
3061 . 'THICK-SHELL HEXA+PENTA ',
3062 . 'THICK-SHELL S16+S20 ' ,
3063 . 'solid-(hexa+tetra4)' ,
3064 . 'solid-(hexa+tetra10)' ,
3065 . 'tetra4+tetra10 ' ,
3066 . 'hexa+tetra4+tetra10 ' ,
3067 . 'multi-strand ' ,
3068 . 'kjoint ' ,
3069 . 'n/a ' /
3070C======================================================================|
3071c IPART(1,I)=IMID id sys
3072c IPART(2,I)=IPID id sys
3073c IPART(3,I)=ISID
3074c IPART(4,I)=ID
3075c IPART(5,I)=MID id user
3076c IPART(6,I)=PID id user
3077c IPART(7,I)=SID
3078c IPART(8,I)=ITH
3079C
3080 ETYE =27
3081 I2GEO(1:NUMGEO) = 0
3082 I2GEO1(1:NUMGEO) = 0
3083 I2GEO2(1:NUMGEO) = 0
3084 IP2NG1(1:NPART) = 0
3085 IP2NG2(1:NPART) = 0
3086C Up to 3 different elements using same PID (tetra4,tetra10,hexa)
3087C Only solid and shell have initialized surely IPARG(62,NG)
3088 DO NG=1,NGROUP
3089.OR. IF (IPARG(8,NG)==1IPARG(62,NG)==0) CYCLE
3090 ITY = IPARG(5,NG)
3091 IF (ITY ==1) THEN
3092 ISOLNOD = IPARG(28,NG)
3093 NFT=IPARG(3,NG)+1
3094 LST=IPARG(3,NG)+IPARG(2,NG)
3095 IP = IPARTS(NFT)
3096 IF (IP2NG1(IP)==0) THEN
3097 IP2NG1(IP) = NG
3098.AND. ELSEIF (IP2NG2(IP)==0IPARG(28,IP2NG1(IP)) /= ISOLNOD) THEN
3099 IP2NG2(IP) = NG
3100 ELSEIF(IP2NG2(IP)>0) THEN
3101C-------3 elem types in the same part 4+10+8
3102 N_NOD = ISOLNOD+IPARG(28,IP2NG1(IP))+IPARG(28,IP2NG2(IP))
3103 IF(N_NOD==22) THEN
3104 IF (IPARG(28,IP2NG1(IP))==8) THEN
3105 IP2NG2(IP) = -IP2NG1(IP)
3106 ELSEIF (IPARG(28,IP2NG2(IP))==8) THEN
3107 IP2NG2(IP) = -IP2NG2(IP)
3108 ELSE
3109 IP2NG2(IP) = -NG
3110 END IF
3111 END IF
3112 END IF
3113C-----case 2 parts in same groupe
3114 IF (IPARTS(LST)/=IP) THEN
3115 IP = IPARTS(LST)
3116 IF (IP2NG1(IP)==0) THEN
3117 IP2NG1(IP) = NG
3118.AND. ELSEIF (IP2NG2(IP)==0IPARG(28,IP2NG1(IP)) /= ISOLNOD) THEN
3119 IP2NG2(IP) = NG
3120 ELSEIF(IP2NG2(IP)>0) THEN
3121 N_NOD = ISOLNOD+IPARG(28,IP2NG1(IP))+IPARG(28,IP2NG2(IP))
3122 IF(N_NOD==22) THEN
3123 IF (IPARG(28,IP2NG1(IP))==8) THEN
3124 IP2NG2(IP) = -IP2NG1(IP)
3125 ELSEIF (IPARG(28,IP2NG2(IP))==8) THEN
3126 IP2NG2(IP) = -IP2NG2(IP)
3127 ELSE
3128 IP2NG2(IP) = -NG
3129 END IF
3130 END IF
3131 END IF
3132 END IF
3133 END IF
3134 IPID=IPARG(62,NG)
3135 IF (I2GEO(IPID)==0) THEN
3136 I2GEO(IPID) = NG
3137 ELSE
3138C---- check if ITY, ISOLNOD are the same
3139 NG0 = I2GEO(IPID)
3140 IF (NG0>2*NGROUP) CYCLE
3141 IF (NG0>NGROUP) NG0 =-I2GEO1(IPID)
3142 ITY = IPARG(5,NG0)
3143 IGTYP= IPARG(38,NG0)
3144 ISOLNOD = IPARG(28,NG0)
3145C-------ITY : shell
3146 IF (IPARG(5,NG)/= ITY) THEN
3147 I2GEO(IPID) = I2GEO(IPID) + NGROUP
3148.AND. IF (I2GEO1(IPID)==0I2GEO(IPID)>NGROUP) I2GEO1(IPID) = -NG
3149C-------ITY=1 : solid
3150.AND. ELSEIF (ITY==1IPARG(5,NG)==1) THEN
3151 IF (IPARG(28,NG)/=ISOLNOD) I2GEO(IPID) = I2GEO(IPID) + NGROUP
3152.AND. IF (I2GEO1(IPID)==0I2GEO(IPID)>NGROUP) I2GEO1(IPID) = -NG
3153.AND. IF (I2GEO2(IPID)==0I2GEO(IPID)>2*NGROUP) I2GEO2(IPID) = -NG
3154C-------ITY=1 : thick-shell
3155.AND..AND. ELSEIF (IGTYP>=20IGTYP<=22IPARG(38,NG)==IGTYP) THEN
3156 IF (IPARG(28,NG)/=ISOLNOD) I2GEO(IPID) = I2GEO(IPID) + NGROUP
3157.AND. IF (I2GEO1(IPID)==0I2GEO(IPID)>NGROUP) I2GEO1(IPID) = -NG
3158 END IF
3159 END IF
3160 END DO
3161C
3162 WRITE(IOUT,'(//,a)')'part element/material PARAMETER review:'
3163 WRITE(iout,'(A,/)') '-----------------------'
3164C-------We suppose the orders of IPART/IPARG are the same
3165 DO i=1,npart
3166 CALL fretitl2(text,ipart(lipart1-ltitr+1,i),ltitr)
3167 imid=ipart(1,i)
3168 ipid=ipart(2,i)
3169 IF(ipid == 0) cycle
3170 igtyp= igeo(11,ipid)
3171 IF(imid == 0) cycle
3172 mid = nint(pm(19,imid))
3173 npt =igeo(4,ipid)
3174 ihbe0 =igeo(10,ipid)
3175 icontrol = igeo(97,ipid)
3176 ipos = igeo(99,ipid)
3177c MID = IPM(2,IMID)
3178 ng0 = i2geo(ipid)
3179 ng2=0
3180 ng1=0
3181 ng = ng0
3182C---- case 2 elem use same pid 1): shell 3n,4n 2): thick-shell hexa-penda 3): S16-S20
3183C---- 4): solid hexa-tetra4, 5): solid hexa-tetra10,6): solid tetra4-tetra10,
3184C---- case 3 elem use same pid 1): solid hexa-tetra4-tetra10
3185C-----case not-considered : thick-shell hexa-S16 hexa-S20, hexa-S16-S20
3186 ety=etye
3187 IF(ip2ng1(i)>0)THEN
3188 IF (ip2ng2(i)<0) THEN
3189 ng = -ip2ng2(i)
3190 ELSEIF (ip2ng2(i)>0) THEN
3191 IF (iparg(28,ip2ng2(i))==8) THEN
3192 ng = ip2ng2(i)
3193 ELSE
3194 ng = ip2ng1(i)
3195 END IF
3196 ELSE
3197 ng = ip2ng1(i)
3198 END IF
3199 ELSE
3200 IF (ng0>2*ngroup) THEN
3201 IF (i2geo2(ipid)>0) THEN
3202 ng = i2geo2(ipid)
3203 ELSEIF (i2geo1(ipid)>0) THEN
3204 ng = i2geo1(ipid)
3205 i2geo2(ipid)= -i2geo2(ipid)
3206 ELSE
3207 ng = ng-2*ngroup
3208 i2geo1(ipid)= -i2geo1(ipid)
3209 END IF
3210 ELSEIF (ng0>ngroup) THEN
3211 IF (i2geo1(ipid)>0) THEN
3212 ng = i2geo1(ipid)
3213 ELSE
3214 ng = ng-ngroup
3215 i2geo1(ipid)= -i2geo1(ipid)
3216 END IF
3217 END IF
3218 END if!(IP2NG1(I)>0)
3219C-----
3220 IF (ng >0) THEN
3221 ity = iparg(5,ng)
3222 isolnod = iparg(28,ng)
3223 ihbe=iparg(23,ng)
3224 npt =max(npt,iparg(6,ng))
3225 ELSE
3226 ity =0
3227 END IF
3228C------- set ele_type(ETY)
3229 SELECT CASE (igtyp)
3230C-------thick-shell
3231 CASE(20,21,22)
3232 IF (ng0>ngroup.AND.ip2ng2(i)>0) THEN
3233 ng1 = iabs(i2geo1(ipid))
3234 n_nod = iparg(28,ip2ng1(i))+iparg(28,ip2ng2(i))
3235 IF(n_nod==14) THEN
3236 ety = 17+2
3237 ELSEIF(n_nod==36) THEN
3238 ety = 17+3
3239 END IF
3240 ELSEIF (isolnod==8) THEN
3241 ety=7
3242 ELSEIF (isolnod==6) THEN
3243 ety=8
3244 ELSEIF (isolnod==16) THEN
3245 ety=9
3246 ELSEIF (isolnod==20) THEN
3247 ety=10
3248 ELSE
3249 ety=etye
3250 END IF
3251 CASE(2)
3252 ety=14
3253 CASE(3,18)
3254 ety=15
3255 CASE(4,8,12,13,23,25,26,32,35,36,44,45,46)
3256 ety=16
3257 mid = -1
3258 CASE(28)
3259 ety=25
3260 mid = -1
3261 CASE(29,30,31)
3262 ety=5
3263 CASE(33)
3264 ety=26
3265 mid = -1
3266 CASE(34)
3267 ety=17
3268 CASE DEFAULT
3269C---- solid
3270 IF(ity==1)THEN
3271 IF (ng0>2*ngroup.AND.ip2ng2(i)<0) THEN
3272 ety = 17+7
3273 ELSEIF (ng0>ngroup.AND.ip2ng2(i)>0) THEN
3274 ng1 = iabs(i2geo1(ipid))
3275 n_nod = iparg(28,ip2ng1(i))+iparg(28,ip2ng2(i))
3276 IF(n_nod==12) THEN
3277 ety = 17+4
3278 ELSEIF(n_nod==18) THEN
3279 ety = 17+5
3280 ELSEIF(n_nod==14) THEN
3281 ety = 17+6
3282 END IF
3283 ELSEIF (isolnod==8) THEN
3284 ety=1
3285 ELSEIF (isolnod==4) THEN
3286 ety=2
3287 ELSEIF (isolnod==10) THEN
3288 ety=3
3289 ELSEIF (isolnod==20) THEN
3290 ety=4
3291 ELSE
3292 ety=etye
3293 END IF
3294 ELSEIF(ity==2.AND.n2d>0)THEN
3295 ety=13
3296C------ shell
3297 ELSEIF(ity==3.OR.ity==7)THEN
3298 IF (ng0>ngroup) THEN
3299 ety = 17+1
3300 ELSEIF(ity==3)THEN
3301 ety=11
3302 ELSE
3303 ety=12
3304 END IF
3305 ELSEIF(ity==4)THEN
3306 ety=14
3307 ELSEIF(ity==5)THEN
3308 ety=15
3309 ELSEIF(ity==6)THEN
3310 ety=16
3311 ELSEIF(ity==51)THEN
3312 ety=17
3313 ELSEIF(ity==101)THEN
3314 ety=6
3315 ELSE
3316 ety=etye
3317 END IF
3318 END SELECT
3319 IF (mid>0) THEN
3320 WRITE(iout,'(A,I10,1X,A,3X,A,I4,2A)')'Part id,name:',ipart(4,i),text(1:20),'Mat type:',mid,' Elm type: ',el_typ(ety)
3321 ELSEIF (mid==0) THEN
3322 WRITE(iout,'(A,I10,1X,A,3X,A,2A)')'Part id,name:',ipart(4,i),text(1:20),'Mat type: VOID',' Elm type: ',el_typ(ety)
3323C----- spring, KJOINT -----
3324 ELSE
3325 WRITE(iout,'(A,I10,1X,A,16X,2A)')'Part id,name:',ipart(4,i),text(1:20),' Elm type: ',el_typ(ety)
3326 END IF
3327 WRITE(iout,'(A)') '----'
3328C-print in fonction of elem types ITY
3329 SELECT CASE (ity)
3330 CASE(1)
3331 qh =zero
3332 SELECT CASE (isolnod)
3333 CASE(4,10)
3334 ihbe=1
3335 CASE(6)
3336 ihbe=15
3337 CASE(20)
3338 ihbe=16
3339 END SELECT
3340 IF (ihbe<=2.AND.isolnod==8) qh = geo(13,ipid)
3341 qa = geo(14,ipid)
3342 qb = geo(15,ipid)
3343C-------this is done in ENGINE, should be done in Starter
3344 IF (mid==70 .AND.igeo(31,ipid) == 1) THEN
3345 qa = zero
3346 qb = zero
3347 END IF
3348 dn = zero
3349 IF (isolnod==8.AND.(ihbe==24.OR.ihbe==15)) dn = geo(13,ipid)
3350 ns_a = geo(16,ipid)
3351 ns_b = geo(17,ipid)
3352 npt =iparg(6,ng)
3353 iint = iparg(36,ng)
3354 IF (ihbe==17.AND.iint==2) ihbe=18
3355 IF (ihbe==1.AND.iint==3) ihbe=5
3356 ismstr=iparg(9,ng)
3357 icpre = iparg(10,ng)
3358 IF (icpre==0.AND.isolnod==8) icpre=3
3359 jcvt = iparg(37,ng)+1
3360 ihkt = 0
3361 IF (ihbe==24.AND.isolnod==8) ihkt = iint
3362 IF(mid == 68)THEN
3363 itet4 = 0
3364 ELSE
3365 itet4 = iparg(41,ng)
3366 ENDIF
3367 itet10 = iparg(74,ng)
3368 imatvis = iparg(45,ng)
3369 IF (igtyp>=20.AND.igtyp<=22) THEN
3370 IF (ihbe==14 .OR. ihbe==16) THEN
3371 nly = mod(abs(npt)/10,10)
3372 ELSE
3373 nly = npt
3374 ENDIF
3375 IF (icpre==0) icpre=3
3376c-----
3377 IF (igtyp==22.AND.ihbe==14 ) THEN
3378C------ IPARG(6,NG)= NPG after elbuf_ini
3379 npt =max(npt,igeo(4,ipid))
3380 icstr = iparg(17,ng)
3381 SELECT CASE (icstr)
3382 CASE(100)
3383 nly = abs(npt)/100
3384 IF (nly ==0) nly =iint
3385 CASE(10)
3386 nly = mod(abs(npt)/10,10)
3387 IF (nly ==0) nly =iint
3388 CASE(1)
3389 nly = mod(abs(npt),10)
3390 IF (nly ==0) nly =iint
3391 END SELECT
3392 ENDIF
3393 WRITE(iout,'(A)') ' Isolid Ismstr Icpre NPT ICONTROL'
3394 WRITE(iout,'(5I8)')ihbe,ismstr,icpre, nly,icontrol
3395 ELSE
3396c2345678+-------+-------+-------+-------+-------+-------+-------+-------+-------+
3397c---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|
3398 WRITE(iout,'(A)')' Isolid Ismstr Icpre Iframe IHKT Itetra4 Itetra10 IMATVIS ICONTROL'
3399 WRITE(iout,'(9I8)')ihbe,ismstr, icpre, jcvt, ihkt ,itet4, itet10,imatvis,icontrol
3400 END IF
3401 WRITE(iout,'(A)') '-- qa qb lamda_v mu_v h dn'
3402 WRITE(iout,'(6F10.4,/)')qa,qb,ns_a,ns_b,qh,dn
3403C
3404 CASE(2)
3405C----------
3406 jcvt = iparg(37,ng)+1
3407 WRITE(iout,'(A)') ' Isolid Iframe N2D(1:ASY;2:STR-PLANE)'
3408 WRITE(iout,'(3I8,/)')ihbe,jcvt, n2d
3409c--------
3410 CASE(3,7)
3411C-------- shell
3412 ismstr=iparg(9,ng)
3413 idril =iparg(41,ng)
3414 ithk =iparg(28,ng)
3415 iplas =iparg(29,ng)
3416 igmat =igeo(98,ipid)
3417 IF (npt>1 .AND.(mid==1 .OR. mid==91)) npt =0
3418 qf = zero
3419 qm = zero
3420 qr = zero
3421 dn = zero
3422C Ishell Ismstr Ish3n Idril
3423C------ just consisting with manuel
3424 IF (idril==0) idril=2
3425 ih3= 0
3426 ih4= 0
3427 IF (ng0>ngroup) THEN
3428 ng1 = iabs(i2geo1(ipid))
3429C IF(ITY==3)THEN
3430CC------ Ishel=2 -> 0 Ishel=3 -> 2
3431C IH4 = IPARG(23,NG)
3432C IH3 = IPARG(23,NG1)
3433C ELSE
3434C IH3 = IPARG(23,NG)
3435C IH4 = IPARG(23,NG1)
3436C END IF
3437C IF (IH4>4.OR.IH4==2) IH4 =IH4 +1
3438C IF (IH4==0) IH4 =2
3439C MIXED CASE take directly defining in pid
3440 ih3 = igeo(18,ipid)
3441 ih4 = igeo(10,ipid)
3442 WRITE(iout,'(A)') ' Ishell Ish3n Ismstr Idril NPT ITHK IPLAS IPOS'
3443 WRITE(iout,'(8I8)')ih4,ih3,ismstr,idril,npt,ithk,iplas,ipos
3444 ELSEIF(ity==3)THEN
3445 ih4 = iparg(23,ng)
3446 IF (ih4>4.OR.ih4==2) ih4 =ih4 +1
3447 IF (ih4==0) ih4 =2
3448 WRITE(iout,'(A)') ' Ishell Ismstr Idril NPT ITHK IPLAS IPOS'
3449 WRITE(iout,'(7I8)')ih4,ismstr,idril,npt,ithk,iplas,ipos
3450 ELSE
3451 ih3 = iparg(23,ng)
3452 WRITE(iout,'(A)') ' Ish3n Ismstr Idril NPT ITHK IPLAS IPOS'
3453 WRITE(iout,'(7I8)')ih3,ismstr,idril,npt,ithk,iplas,ipos
3454 END IF
3455 IF (ih4>0.AND.ih4<=4) THEN
3456 qf = geo(13,ipid)
3457 qm = geo(14,ipid)
3458 qr = geo(15,ipid)
3459 END IF
3460C--------verify dm in Engine
3461 dm = group_param_tab(ng)%VISC_DM
3462c DM = GEO(16,IPID)
3463C--------verify dn 12, dkt...
3464 IF (ih4==24) dn = geo(13,ipid)
3465 IF (dn==zero.AND.ih4==12) THEN
3466 dn = em03
3467 END IF
3468 IF (dn==zero.AND.ih3==30) dn = em4
3469c DN = GROUP_PARAM_TAB(NG)%VISC_DN
3470 WRITE(iout,'(A)') '-- hm hf hr dm dn'
3471 WRITE(iout,'(5F10.4,/)')qm,qf,qr,dm,dn
3472c
3473 CASE(6)
3474 WRITE(iout,'(A,I5/)') 'Spring type:',igtyp
3475c
3476 CASE DEFAULT
3477c
3478 IF(igtyp==2)THEN
3479C---------- truss, nothing
3480 WRITE(iout,*)
3481 ELSEIF(igtyp==3.OR.igtyp==18)THEN
3482 ismstr=igeo(5,ipid)
3483 dm = geo(16,ipid)
3484 df = geo(17,ipid)
3485 WRITE(iout,'(A)') ' Ismstr dm df'
3486 WRITE(iout,'(I8,2F10.4/)')ismstr,dm,df
3487C----------spring w/ NG=0
3488 ELSEIF(igtyp==4.OR.igtyp==8.OR.igtyp==12.OR.igtyp==13.OR.
3489 . igtyp==32.OR.igtyp==35.OR.igtyp==36 .OR. igtyp == 23)THEN
3490 WRITE(iout,'(A,I5/)') 'Spring type:',igtyp
3491 END IF
3492 END SELECT
3493
3494 ENDDO
3495C
3496 RETURN
if
if(complex_arithmetic) id

◆ sgsavinieref()

subroutine sgsavinieref ( integer npe,
integer, dimension(*) straglob,
sigsp,
integer nsigi,
integer, dimension(*) ptsol,
double precision, dimension(nel,3*(npe-1)) sav,
offg,
integer nel )

Definition at line 2868 of file initia.F.

2869C-----------------------------------------------
2870C I m p l i c i t T y p e s
2871C-----------------------------------------------
2872#include "implicit_f.inc"
2873C-----------------------------------------------
2874C C o m m o n B l o c k s
2875C-----------------------------------------------
2876#include "vect01_c.inc"
2877#include "com01_c.inc"
2878C-----------------------------------------------
2879C D u m m y A r g u m e n t s
2880C-----------------------------------------------
2881 INTEGER NPE,NEL,STRAGLOB(*),PTSOL(*),NSIGI
2882C
2883C-------!!!!! uniforme SAV between Ismstr>=10 and Ismstr=1
2884 double precision
2885 . sav(nel,3*(npe-1))
2886C
2887 my_real
2888 . sigsp(nsigi,*),offg(*)
2889C-----------------------------------------------
2890C L o c a l V a r i a b l e s
2891C-----------------------------------------------
2892 INTEGER I,NPE1,N,JJ,IIS,IIS0,N2
2893C
2894 double precision
2895 . xl(npe),yl(npe),zl(npe)
2896C-----------------------------------------------
2897 npe1=npe-1
2898C
2899 iis0= nusolid+4+nvsolid1 + nvsolid2 + nvsolid3 + nvsolid4 + nvsolid5
2900 DO i=lft,llt
2901 jj=ptsol(i)
2902 IF(straglob(i) == 10.AND.jj>0) THEN
2903 DO n=1,npe
2904 iis= iis0 + (n-1)*3
2905 xl(n)=sigsp(iis+1,jj)
2906 yl(n)=sigsp(iis+2,jj)
2907 zl(n)=sigsp(iis+3,jj)
2908 END DO
2909 IF (ismstr==1) THEN
2910 DO n=1,npe1
2911 n2 = 3*(n -1) +1
2912 sav(i,n2) = xl(n)-xl(npe)
2913 sav(i,n2+1) = yl(n)-yl(npe)
2914 sav(i,n2+2) = zl(n)-zl(npe)
2915 END DO
2916 offg(i) =two
2917 ELSE
2918 DO n=1,npe1
2919 sav(i,n) = xl(n)-xl(npe)
2920 sav(i,n+npe1) = yl(n)-yl(npe)
2921 sav(i,n+2*npe1) = zl(n)-zl(npe)
2922 END DO
2923 END IF
2924 ENDIF
2925 ENDDO
2926C
2927 RETURN

◆ sgsavinierefq()

subroutine sgsavinierefq ( integer npe,
integer, dimension(*) straglob,
sigsp,
integer nsigi,
integer, dimension(*) ptsol,
double precision, dimension(nel,3*npe) sav,
offg,
integer, dimension(nixs,nel) ixs,
dr,
integer ndr,
integer nel )

Definition at line 2934 of file initia.F.

2936C-----------------------------------------------
2937C I m p l i c i t T y p e s
2938C-----------------------------------------------
2939#include "implicit_f.inc"
2940C-----------------------------------------------
2941C C o m m o n B l o c k s
2942C-----------------------------------------------
2943#include "vect01_c.inc"
2944#include "com01_c.inc"
2945#include "tabsiz_c.inc"
2946C-----------------------------------------------
2947C D u m m y A r g u m e n t s
2948C-----------------------------------------------
2949 INTEGER NPE,NEL,STRAGLOB(*),PTSOL(*),NSIGI,NDR
2950 INTEGER IXS(NIXS,NEL)
2951C REAL
2952C-------dim different for quadratic element(historic)
2953 double precision
2954 . sav(nel,3*npe)
2955C REAL
2956 my_real
2957 . sigsp(nsigi,*),offg(*),dr(sdr)
2958C-----------------------------------------------
2959C L o c a l V a r i a b l e s
2960C-----------------------------------------------
2961 INTEGER I,NPE1,N,JJ,IIS,IIS0,NN,NC(NEL,4)
2962C REAL
2963C-----------------------------------------------
2964 iis0= nusolid+4+nvsolid1 + nvsolid2 + nvsolid3 + nvsolid4 + nvsolid5
2965 IF (ndr>0) THEN
2966 DO i=1,nel
2967 nc(i,1) =ixs(2,i)
2968 nc(i,2) =ixs(4,i)
2969 nc(i,3) =ixs(7,i)
2970 nc(i,4) =ixs(6,i)
2971 END DO
2972 END IF
2973 DO i=lft,llt
2974 jj=ptsol(i)
2975 IF(straglob(i) == 10.AND.jj>0) THEN
2976 DO n=1,npe
2977 iis= iis0 + (n-1)*3
2978 sav(i,n) = sigsp(iis+1,jj)
2979 sav(i,n+npe) = sigsp(iis+2,jj)
2980 sav(i,n+2*npe) = sigsp(iis+3,jj)
2981 END DO
2982 DO n=1,ndr
2983 iis= iis0 +(npe+n-1)*3
2984 nn = 3*(nc(i,n)-1)
2985 dr(nn+1) = sigsp(iis+1,jj)
2986 dr(nn+2) = sigsp(iis+2,jj)
2987 dr(nn+3) = sigsp(iis+3,jj)
2988 END DO
2989 IF (ismstr==1) offg(i) =two
2990 ENDIF
2991 ENDDO
2992C
2993 RETURN

◆ sgsavref()

subroutine sgsavref ( integer npe,
xref,
double precision, dimension(nel,3*(npe-1)) sav,
integer nel )

Definition at line 2816 of file initia.F.

2817C-----------------------------------------------
2818C I m p l i c i t T y p e s
2819C-----------------------------------------------
2820#include "implicit_f.inc"
2821C-----------------------------------------------
2822C G l o b a l P a r a m e t e r s
2823C-----------------------------------------------
2824#include "mvsiz_p.inc"
2825C-----------------------------------------------
2826C C o m m o n B l o c k s
2827C-----------------------------------------------
2828#include "vect01_c.inc"
2829C-----------------------------------------------
2830C D u m m y A r g u m e n t s
2831C-----------------------------------------------
2832 INTEGER NPE,NEL
2833C REAL
2834 my_real
2835 . xref(8,3,*)
2836 double precision
2837 . sav(nel,3*(npe-1))
2838C-----------------------------------------------
2839C L o c a l V a r i a b l e s
2840C-----------------------------------------------
2841 INTEGER I,NPE1,N
2842C REAL
2843 my_real
2844 . xl(mvsiz),yl(mvsiz),zl(mvsiz)
2845C-----------------------------------------------
2846 npe1=npe-1
2847C
2848 DO i=lft,llt
2849 xl(i)=xref(npe,1,i)
2850 yl(i)=xref(npe,2,i)
2851 zl(i)=xref(npe,3,i)
2852 ENDDO
2853 DO n=1,npe1
2854 DO i=lft,llt
2855 sav(i,n) = xref(n,1,i)-xl(i)
2856 sav(i,n+npe1) = xref(n,2,i)-yl(i)
2857 sav(i,n+2*npe1) = xref(n,3,i)-zl(i)
2858 ENDDO
2859 ENDDO
2860C
2861 RETURN