OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lectur.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "com09_c.inc"
#include "param_c.inc"
#include "warn_c.inc"
#include "scr02_c.inc"
#include "scr03_c.inc"
#include "scr05_c.inc"
#include "scr06_c.inc"
#include "scr07_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "scr17_c.inc"
#include "scr18_c.inc"
#include "cong1_c.inc"
#include "cong2_c.inc"
#include "scrfs_c.inc"
#include "stati_c.inc"
#include "statr_c.inc"
#include "units_c.inc"
#include "scrcut_c.inc"
#include "scrnoi_c.inc"
#include "parit_c.inc"
#include "chara_c.inc"
#include "task_c.inc"
#include "sphcom.inc"
#include "impl1_c.inc"
#include "tabsiz_c.inc"
#include "remesh_c.inc"
#include "sms_c.inc"
#include "rad2r_c.inc"
#include "inter22.inc"
#include "userlib.inc"
#include "spmd_c.inc"
#include "intstamp_c.inc"
#include "couple_c.inc"
#include "impl2_c.inc"
#include "buckcom.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine lectur (icode, iskew, iskwn, ixtg, ixs, ixq, ixc, ixt, ixp, ixr, itab, itabm1, npc, iparg, igrv, ibgr, ipari, npby, lpby, nnlink, llink, linale, neflsw, nnflsw, icut, inoise, x, v, vr, ms, in, skew, pld, rby, wa, crflsw, xcut, dampr, igrnod, kxsp, weight, fr_rby2, fr_rl, partsav, ipart, pm, monvol, volmon, ipart_state, geo, table, iframe, xframe, elbuf_str, igeo, intbuf_tab, ipm, h3d_data, multi_fvm, igrpart, tag_skins6, icfield, lcfield, tagslv_rby, mds_label, mds_output_table, mds_nmat, max_depvar, mds_ndepsvar, stack, ibcl, iloadp, lloadp, sensors, dynain_data, dt, loads, output, names_and_titles, mat_param, glob_therm, pblast)
subroutine prout_buck (ip, nbuck, ibuck)
subroutine lecimpl

Function/Subroutine Documentation

◆ lecimpl()

subroutine lecimpl

Definition at line 3320 of file lectur.F.

3321C-----------------------------------------------
3322C M o d u l e s
3323C-----------------------------------------------
3324 USE imp_kbcs
3325 USE imp_pcg_proj
3326 USE imp_spbrm
3327 USE message_mod
3328C-----------------------------------------------
3329C I m p l i c i t T y p e s
3330C-----------------------------------------------
3331#include "implicit_f.inc"
3332C-----------------------------------------------
3333C C o m m o n B l o c k s
3334C-----------------------------------------------
3335#include "com01_c.inc"
3336#include "com04_c.inc"
3337#include "com06_c.inc"
3338#include "units_c.inc"
3339#include "task_c.inc"
3340#include "impl1_c.inc"
3341#include "impl2_c.inc"
3342#include "buckcom.inc"
3343C-----------------------------------------------
3344C L o c a l V a r i a b l e s
3345C-----------------------------------------------
3346 INTEGER J,NTY,IPRINT,IBID,ISOL
3347 my_real cs1(2),s
3348 REAL FLMIN
3349 CHARACTER*25 MSG_TYPE(9),MSG_ISOL(9),MSG_INSOL(4),MSG_PRE(5),MSG_BSOL(3)
3350 DATA
3351 . msg_type
3352 . / 'STATIC LINEAR',
3353 . 'STATIC NON-LINEAR',
3354 . 'DYNAMIC NON-LINEAR',
3355 . 'MODAL ANALYSIS',
3356 . 'CHECK',
3357 . 'QUASI-STATIC LINEAR',
3358 . 'QUASI-STATIC NON-LINEAR',
3359 . 'BUCKLING',
3360 . 'RADIOSS-AcuSolve DC-FSI'/,
3361 . msg_isol
3362 . / 'PREC. CONJUGATE GRADIENT',
3363 . 'DIRECT(MUMPS) ',
3364c .'Prec.Lanzos',
3365 . 'DIRECT',
3366 . 'MULTI-LEVEL CONDENSATION',
3367 . 'MIXE SOLVERS: 1 + 3',
3368 . 'MIXE SOLVERS: 1 + 4',
3369 . 'AUTO SELECT SOLVER ',
3370 . 'PCG(GPU) ',
3371 . 'PCGP(PROJECTION) '/,
3372 . msg_insol
3373 . / 'modified newton',
3374 . 'quasi-newton',
3375 . 'sloan elastoplas',
3376 . 'full newton'/,
3377 . MSG_PRE
3378 . / 'none',
3379 . 'diagonal jacobien',
3380 . 'imcomp. cholesky(0)',
3381 . 'stablilized ic(0)',
3382 . 'factored appro. inverses'/,
3383 . msg_bsol
3384 . / 'SUPERLU',
3385 . 'mumps',
3386 . 'multi-level condensation'/
3387C-----------------------------------------------
3388 IPRINT=0
3389C IMPMV>0 isolv/=1 --> IMPMV=0
3390 IF (ISPMD == 0) IPRINT=1
3391 IF (IMP_CHK > 0) THEN
3392 NTY = 5
3393 IF (IPREC /= 5) IPREC=5
3394 IF (ILINE /= 1) ILINE=1
3395 IF (ISOLV /= 1) ISOLV=1
3396 IF (D_TOL /= ZERO) D_TOL = ZERO
3397 ENDIF
3398 IF(ISOLV >= 3 ) THEN
3399 CALL ANCMSG(MSGID=296,ANMODE=ANINFO,I1=ISOLV)
3400 ISOLV = 2
3401 END IF
3402
3403#ifndef MUMPS5
3404.AND. IF(ISOLV == 2 NSPMD > 1) THEN
3405 WRITE(6,*) "Fatal error: MUMPS is required, but not available"
3406 CALL ARRET(5)
3407 ENDIF
3408#endif
3409 IF (NEIG > 0) THEN
3410 ILINE=1
3411 ISPRB=0
3412 IQSTAT=0
3413 IF (NSPMD == 1) THEN
3414 IPREC=1
3415 ELSE
3416 IPREC=5
3417 ENDIF
3418 ENDIF
3419 IF (NBUCK > 0) THEN
3420 ILINE=1
3421C----fix mono w/ BCS solver
3422 IF (NSPMD == 1) ISOLV =2
3423 ENDIF
3424C--------solvers----
3425C machine precision minimum -simple
3426 CALL FLOATMIN(CS1(1),CS1(2),FLMIN)
3427 P_MACH = TWO*SQRT(FLMIN)
3428 IF (NSPMD > 1)CALL SPMD_MAX_S(P_MACH)
3429C AUTO SELECT SOLVER
3430 IF (ISOLV == 7 ) THEN
3431
3432 IF (ILINE == 1) THEN
3433
3434 WRITE(IOUT,*) ' ** warning ** : solver auto SELECT is not ','compatible with linear run '
3435 WRITE(IOUT,*) ' ** resetting to ** : default one '
3436
3437 WRITE(ISTDO,*) ' ** warning ** : solver auto SELECT is not ','compatible with linear run '
3438 WRITE(ISTDO,*) ' ** resetting to ** : default one '
3439
3440 ISOLV = 0
3441
3442 END IF
3443
3444 ENDIF
3445C----- default solver-> MUMPS
3446 IF (ISOLV == 0) ISOLV = 2
3447C-------ISOLV=2 --> use MUMPS anyway
3448 IMUMPSV = 0
3449.AND. IF (ISOLV > 1 ISOLV <9 ) IMUMPSV = 1
3450.OR. IF (ISOLV == 2 ISOLV ==3 ) THEN
3451 IMUMPSV = 1
3452 ISOLV = 3
3453 END IF
3454.OR..AND. IF ((ISOLV == 3ISOLV == 4)INTP_C < 0) THEN
3455 IF(IPRINT==1) THEN
3456 WRITE(IOUT,*) ' ** warning ** : direct solver is not ','compatible with impl/inter/knonl option '
3457 WRITE(IOUT,*) ' ** resetting to ** : mixe one '
3458 ENDIF
3459 ISOLV = ISOLV + 2
3460 ENDIF
3461C-------ISOLV=9 -> PCG w/ Projection
3462 IF (ISOLV == 9) THEN
3463 IF (M_VS ==0) M_VS=20
3464 IF (IPRO_S0 ==0) IPRO_S0=4
3465 END IF
3466 IF (M_VS > 0) THEN
3467C------case /IMPL/PROJV/n w/o /SOLV/9
3468 IF (ISOLV /= 9) THEN
3469 WRITE(IOUT,*) ' ** warning ** : /impl/projv is ','only compatible with pcgp solver '
3470 WRITE(iout,*) ' ** CHANGE TO ** : ISOLV=9 '
3471 isolv = 9
3472 END IF
3473 END IF
3474
3475 IF (nbuck > 0.AND.nspmd == 1.AND.isolv /= 3) THEN
3476 WRITE(iout,*) ' ** WARNING ** : /IMPL/BUCKL IS ','ONLY COMPATIBLE WITH BCS SOLVER '
3477 WRITE(iout,*) ' ** CHANGE TO ** : ISOLV=3 '
3478 isolv = 3
3479 ENDIF
3480
3481 IF (iprec == 0.OR.iprec > 6)iprec=5
3482
3483 IF (isolv == 2) THEN
3484 IF (itol == 0.OR.itol > 1) itol=2
3485 IF (l_tol == zero) l_tol=p_mach
3486 ELSEIF (isolv == 1.OR.isolv>=7) THEN
3487 IF (itol == 0) itol=3
3488 IF (itol > 4) THEN
3489 IF(iprint==1) THEN
3490 WRITE(iout,*) ' ** WARNING ** : WRONG LINEAR STOP ','CRITERION NUMBER, RESET TO DEFAULT ONE ** '
3491 ENDIF
3492 itol=3
3493 ENDIF
3494 IF (l_tol == zero) THEN
3495 IF (itol == 3) THEN
3496 l_tol=p_mach
3497 IF (n_pat > 1.OR.isolv == 9) l_tol=p_mach*em01
3498 ELSE
3499 l_tol=em5
3500 ENDIF
3501 ENDIF
3502C--------direct-----
3503 ELSEIF (isolv == 3.OR.isolv == 4) THEN
3504 iprec=1
3505 IF (nspmd>1) imumpsv = 1
3506C--------MIX-----
3507 ELSEIF (isolv == 5.OR.isolv == 6) THEN
3508 iprec=1
3509 imumpsv = 1
3510 IF (itol == 0) itol=1
3511 IF (itol > 4) THEN
3512 IF(iprint==1) THEN
3513 WRITE(iout,*) ' ** WARNING ** : WRONG LINEAR STOP ','CRITERION NUMBER, RESET TO DEFAULT ONE ** '
3514 ENDIF
3515 itol=3
3516 ENDIF
3517 IF (l_tol == zero) THEN
3518 IF (itol == 3) THEN
3519 l_tol=p_mach*em01
3520 ELSE
3521 l_tol=em5
3522 ENDIF
3523 ENDIF
3524 ELSE
3525 IF (ispmd == 0)THEN
3526 WRITE(iout,*) ' ** WARNING ** : SOLVER NON AVAILABLE '
3527 WRITE(iout,*) ' ** RESETTING TO ** : DEFAULT ONE '
3528 ENDIF
3529 isolv = 1
3530 ENDIF
3531
3532 IF (iprec > 2.AND.iprec /= 5) THEN
3533 IF (ispmd == 0)THEN
3534 WRITE(iout,*) ' ** WARNING ** : ',
3535 . 'THIS PRECONDITION METHOD IS NO MORE SUPPORTED '
3536 WRITE(iout,*) ' ** RESETTING TO ** : DEFAULT ONE '
3537 ENDIF
3538 iprec = 5
3539 ENDIF
3540
3541 IF (n_pat > 1) THEN
3542 IF (n_pat > 4) THEN
3543 IF(iprint==1) THEN
3544 WRITE(iout,*) ' ** WARNING ** : UNAVAILABLE PRECONDITION',' MATRIX PATTERN, RESET TO 4 ** '
3545 ENDIF
3546 n_pat = 4
3547 ENDIF
3548 IF (iprec /= 5) THEN
3549 IF(iprint==1) THEN
3550 WRITE(iout,*) ' ** WARNING ** : INPUT PRECONDITION MATRIX',' PATTERN ONLY AVAILABLE WITH IPREC=5 : IGNORED **'
3551 ENDIF
3552 n_pat = 1
3553 ENDIF
3554 ENDIF
3555
3556 p_mach = two*flmin
3557 IF (nvolu>0 .AND. impmv > 0 .AND. isolv/=1) THEN
3558 IF(iprint==1) THEN
3559 WRITE(iout,*) ' ** WARNING ** : DIRECT SOLVER IS NOT ','COMPATIBLE WITH MONITORED VOLUME TYPE3 '
3560 WRITE(iout,*) ' ** STIFFNESS WILL BE IGNORED ** '
3561 ENDIF
3562 impmv = 0
3563 END IF
3564
3565 IF (iline == 1) THEN
3566 nty=1
3567 IF (iqstat > 0) nty=6
3568 insolv = 0
3569 IF (ilintf > 0) imp_int7 = 2
3570 IF (intp_c < 0) ittoff = 1
3571 IF (ikt > 0) ikt=0
3572 ndtfix = 0
3573 IF (nbuck == 0) ikpres = 0
3574 idtc = 0
3575 IF (iscau > 0) THEN
3576 IF (ismdisp > 0) THEN
3577 IF(iprint==1) THEN
3578 WRITE(iout,*) ' ** WARNING ** : SMALL DISPLACEMENT IS IGNORED',' INCOMPATIBLE WITH CAUCHY STRESS OUTPUT OPTION;'
3579 ENDIF
3580 ismdisp = 0
3581 ENDIF
3582 ELSE
3583 ismdisp = 1
3584 END IF
3585 ELSE
3586C--------nonlinear parametres-----
3587 IF (isprb == 1.AND.idyna > 0) THEN
3588 IF(iprint==1) THEN
3589 WRITE(iout,*) ' ** WARNING ** : DYNAMIC IMPLICIT IS NOT ', 'COMPATIBLE WITH IMPL/SPRBACK OPTION '
3590 WRITE(iout,*) ' ** RESETTING ** : STATIC ONE '
3591 ENDIF
3592 idyna=0
3593 ENDIF
3594 IF (isprb == 1.AND.isigini > 0) THEN
3595 IF(iprint==1) THEN
3596 WRITE(iout,*) ' ** WARNING ** : PRE-STRESSES OPTION IS NOT ', 'COMPATIBLE WITH IMPL/SPRBACK OPTION '
3597 WRITE(iout,*) ' ** DEACTIVATING IT '
3598 ENDIF
3599 isigini=0
3600 ENDIF
3601
3602 IF (iqstat > 1) iqstat=1
3603
3604 IF (idyna > 0) THEN
3605 nty=3
3606 IF (iqstat > 0) THEN
3607 IF(iprint==1) THEN
3608 WRITE(iout,*) ' ** WARNING ** : QUASI-SATIC IMPLICIT IS NOT ','COMPATIBLE WITH DYNAMIC OPTION '
3609 WRITE(iout,*) ' ** RESETTING ** : DYNAMIC ONE '
3610 ENDIF
3611 iqstat=0
3612 END IF
3613 IF (idyna == 2) THEN
3614 IF (newm_a < half) newm_a = half
3615 IF (newm_b < half*newm_a) newm_b = half*newm_a
3616 ELSE
3617 IF (hht_a == zero) THEN
3618 hht_a=-zep05
3619 ELSE
3620 hht_a=min(zero,hht_a)
3621 hht_a=max(-third,hht_a)
3622 ENDIF
3623 ENDIF
3624 nexp = 1
3625 ELSE
3626 nty=2
3627 IF (iqstat > 0) nty=7
3628 END IF !(IDYNA > 0)
3629C--------------Non linear solvers
3630 IF (insolv > 4)THEN
3631 IF(iprint==1) THEN
3632 WRITE(iout,*) ' ** WARNING ** : WRONG NONLINEAR SOLVER '
3633 WRITE(iout,*) ' ** RESETTING TO** : DEFAULT ONE '
3634 ENDIF
3635 insolv = 0
3636 ENDIF
3637 IF (insolv==4)THEN
3638 ikt=4
3639 n_lim=1
3640 IF (isolv==5 .OR. isolv==6) isolv=3
3641 ENDIF
3642
3643 IF (insolv == 0)insolv = 1
3644C--------stop criteria-------
3645 IF (nitol < 12) THEN
3646 IF (nitol > 3) THEN
3647 IF(iprint==1) THEN
3648 WRITE(iout,*) ' ** WARNING ** : WRONG NONLINEAR STOP ',
3649 . 'CRITERION NUMBER, RESET TO DEFAULT ONE ** '
3650 ENDIF
3651 nitol=0
3652 ENDIF
3653 IF (nitol == 0) nitol=2
3654 IF (nitol == 1) THEN
3655 IF (n_tol == zero) n_tol=em3
3656 ELSEIF (nitol == 2) THEN
3657 IF (n_tol == zero) n_tol=five*em3
3658 ELSEIF (nitol == 3) THEN
3659 IF (n_tol == zero) n_tol=em3
3660 ENDIF
3661C IF (N_TOL == ZERO) N_TOL=EM3
3662 ELSEIF (nitol == 12) THEN
3663 IF (n_tole == zero) n_tole=em3
3664 IF (n_tolf == zero) n_tolf=em02
3665 ELSEIF (nitol == 23) THEN
3666 IF (n_tolu == zero) n_tolu=em02
3667 IF (n_tolf == zero) n_tolf=em02
3668 ELSEIF (nitol == 13) THEN
3669 IF (n_tolu == zero) n_tolu=em02
3670 IF (n_tole == zero) n_tole=em3
3671 ELSEIF (nitol == 123) THEN
3672 IF (n_tolu == zero) n_tolu=em02
3673 IF (n_tole == zero) n_tole=em3
3674 IF (n_tolf == zero) n_tolf=em02
3675 ELSE
3676 CALL ancmsg(msgid=132,anmode=aninfo,
3677 . i1=nitol)
3678 CALL arret(2)
3679 END IF !(NITOL < 12) THEN
3680C
3681 IF (idtc == 1) THEN
3682 IF (nl_dtp == 0) nl_dtp=4
3683 IF (nl_dtn == 0) nl_dtn=15
3684 IF (scal_dtn == zero) scal_dtn=two_third
3685 IF (scal_dtp == zero) scal_dtp=onep01
3686 ELSEIF (idtc == 2) THEN
3687 IF (nl_dtp == 0) nl_dtp=6
3688 IF (nl_dtn == 0) nl_dtn=20
3689 IF (idyna == 0) THEN
3690 IF (scal_dtn == zero) scal_dtn=two_third
3691 IF (scal_dtp == zero) scal_dtp=onep1
3692 ELSE
3693 IF (scal_dtn == zero) scal_dtn=two_third
3694 IF (scal_dtp == zero) scal_dtp=onep1
3695 ENDIF
3696C-------ALEN=ALEN0 IF ALEN0=0 otherwise ALEN is computed automatically
3697C-------RIKS ARC LENGTH METHOD ------
3698 ELSEIF (idtc == 3) THEN
3699 IF (nl_dtp == 0) nl_dtp=12
3700 IF (nl_dtn == 0) nl_dtn=25
3701 IF (scal_dtn == zero) scal_dtn=two_third
3702 IF (scal_dtp == zero) scal_dtp=onep2
3703 IF (ial_m == 0) ial_m = 2
3704 IF (ndtfix > 0) THEN
3705 IF(iprint==1) THEN
3706 WRITE(istdo,*)
3707 . ' ** WARNING :RIKS METHOD IS NOT ','COMPATIBLE WITH FIXED TIME POINT '
3708 WRITE(istdo,*) ' ** FIXED TIME POINT : DEACTIVATED '
3709 WRITE(iout,*)' ** WARNING :RIKS METHOD IS NOT ','COMPATIBLE WITH FIXED TIME POINT '
3710 WRITE(iout,*) ' ** FIXED TIME POINT : DEACTIVATED '
3711 ndtfix = 0
3712 idtfix = 0
3713 ENDIF
3714 ENDIF
3715 ELSE
3716 IF(.NOT.(ismdisp > 0.AND.isolv < 4)) THEN
3717 IF(iprint==1) THEN
3718 WRITE(istdo,*) ' ** WARNING: NO TIMESTEP CONTROL METHOD DEFINED **'
3719 WRITE(istdo,*)' ** POTENTIAL INFINITE LOOP IF NO CONVERGENCE IS ACHIEVED **'
3720 WRITE(iout,*)' ** WARNING: NO TIMESTEP CONTROL METHOD DEFINED **'
3721 WRITE(iout,*) ' ** POTENTIAL INFINITE LOOP IF NO CONVERGENCE IS ACHIEVED **'
3722 ENDIF
3723 END IF !(.NOT.(ISMDISP > 0.AND.ISOLV < 4)) THEN
3724 IF (scal_dtn == zero) scal_dtn=half
3725 END IF !(IDTC == 1)
3726C
3727 IF (dt_max == zero) dt_max=ep10
3728 IF (dt_min == zero) dt_min=em10
3729C
3730 IF (dt_imp == zero) THEN
3731 IF(iprint==1) THEN
3732 WRITE(istdo,*)' ** WARNING: NO INITIAL TIMESTEP DEFINED **'
3733 WRITE(iout,*)' ** WARNING: NO INITIAL TIMESTEP DEFINED **'
3734 ENDIF
3735 ENDIF
3736C
3737 IF (rf_max == zero) rf_max=ep30
3738C
3739 IF (ismdisp == 1 ) THEN
3740 ikg =0
3741 ikpres = 0
3742 IF (ikproj == 0 ) ikproj =-1
3743C
3744 IF (idyna > 0 .AND. idtc > 0.AND.isolv < 4 .AND. scal_dtp /= one) THEN
3745 IF(iprint==1) THEN
3746 WRITE(istdo,*)' ** WARNING: CONST. TIME-STEP WILL BE USED WITH SMALL DISP. **'
3747 WRITE(iout,*)' ** WARNING: CONST. TIME-STEP WILL BE USED WITH SMALL DISP. **'
3748 ENDIF
3749 scal_dtp = one
3750 ENDIF
3751 END IF
3752C
3753 IF (n_lim == 0) THEN
3754 IF (isolv < 3.OR.idtc == 3) THEN
3755 n_lim=3
3756 ELSEIF (isolv == 5.OR.isolv == 6) THEN
3757 n_lim=3
3758 ELSE
3759 n_lim=6
3760 END IF
3761 END IF
3762C
3763 END IF !IF (ILINE == 1) THEN
3764
3765 IF (imp_chk > 0) THEN
3766 nty = 5
3767 IF (iqstat > 0) iqstat=1
3768 ENDIF
3769
3770 IF (nbuck > 0) nty = 8
3771 IF (isolv == 3.AND.imumpsd == 0) imumpsd=1
3772C
3773 IF (isolv == 5) imumpsd=1
3774C
3775C-----------attention initialization should not be inside below--
3776 IF(iprint==1) THEN
3777 IF (nspmd == 1.AND.isolv == 3) THEN
3778 msg_isol(isolv)='DIRECT (BCS)'
3779 ELSEIF (isolv == 3) THEN
3780 msg_isol(isolv)='DIRECT (MUMPS)'
3781 ENDIF
3782 IF (neig == 0) THEN
3783 IF(isolv == 3.OR.isolv == 4) THEN
3784 isol = isolv
3785 IF (imumpsv==1) isol = 2
3786 WRITE(iout,5010)msg_type(nty),msg_isol(isol),lprint
3787 ELSE
3788 isol=min(9,isolv)
3789 WRITE(iout,5000)msg_type(nty),msg_isol(isol),msg_pre(iprec),itol,l_lim,l_tol,lprint
3790 ENDIF
3791 ibid =0
3792 IF (intp_c < 0) ibid =1
3793 WRITE(iout,5020)ikg,ikpres,iautspc,isprb,ibid
3794 ELSE
3795 WRITE(iout,5050)msg_type(4)
3796 ENDIF
3797 IF (m_vs > 0) WRITE(iout,8400)m_vs,ipro_s0
3798 IF (ikproj /= 0) WRITE(iout,7600)ikproj
3799C
3800 IF (iline /= 1) THEN
3801 ibid = insolv
3802 IF (insolv==4) insolv=1
3803 IF (ibid == 5) ibid = 3
3804 IF (nitol < 12) THEN
3805 WRITE(iout,5100)msg_insol(ibid),dt_imp,nitol,n_tol
3806 ELSEIF (nitol < 123) THEN
3807 IF (nitol == 12) THEN
3808 WRITE(iout,5112)msg_insol(ibid),dt_imp,nitol,n_tole,n_tolf
3809 ELSEIF (nitol == 23) THEN
3810 WRITE(iout,5123)msg_insol(ibid),dt_imp,nitol,n_tolf,n_tolu
3811 ELSEIF (nitol == 13) THEN
3812 WRITE(iout,5113)msg_insol(ibid),dt_imp,nitol,n_tole,n_tolu
3813 ENDIF
3814 ELSEIF (nitol == 123) THEN
3815 WRITE(iout,5132)msg_insol(ibid),dt_imp,nitol,n_tole,n_tolf,
3816 . n_tolu
3817 ENDIF
3818C
3819 IF(isolv == 5.OR.isolv == 6) THEN
3820 WRITE(iout,5150)ipupd,n_lim,nprint,isigini,irref,idtc,dt_min,dt_max
3821 ELSE
3822 WRITE(iout,5180)n_lim, nprint,isigini,irref,idtc,dt_min,dt_max
3823 ENDIF
3824C
3825 IF(irig_m == 1) THEN
3826 WRITE(iout,8600)
3827 ELSEIF(irig_m > 1) THEN
3828 WRITE(iout,8700) e_ref(1:3)
3829 ENDIF
3830C
3831 WRITE(iout,8010) ismdisp
3832 WRITE(iout,8200) rf_min,rf_max
3833 IF (ncy_max > 0) WRITE(iout,7900) ncy_max
3834 IF (idtc == 1) THEN
3835 WRITE(iout,7700)
3836 WRITE(iout,5200)nl_dtp,scal_dtp,nl_dtn,scal_dtn
3837 ELSEIF (idtc == 2) THEN
3838 WRITE(iout,7700)
3839 WRITE(iout,5300)nl_dtp,nl_dtn,scal_dtn,scal_dtp,alen0
3840 ELSEIF (idtc == 3) THEN
3841 s = scal_riks
3842 WRITE(iout,7800)
3843 WRITE(iout,7650)nl_dtp,nl_dtn,scal_dtn,scal_dtp,alen0,ial_m,s
3844 scal_riks = s*s
3845 ENDIF
3846 END IF !(ILINE /= 1)
3847
3848
3849C
3850 IF (idyna == 2) THEN
3851 WRITE(iout,6300)newm_a,newm_b
3852 ELSEIF (idyna > 0) THEN
3853 WRITE(iout,5400)hht_a
3854 ELSEIF (iqstat > 0.AND.scal_dtq /= one) THEN
3855 WRITE(iout,6400)scal_dtq
3856 ENDIF
3857 IF (idy_damp > 0) WRITE(iout,6200)dampa_imp,dampb_imp
3858 IF (n_pat > 1) WRITE(iout,6100)n_pat
3859 IF (ittoff > 0) WRITE(iout,6500)
3860 IF (ilintf > 0) WRITE(iout,6600)
3861 IF (iscau > 0) WRITE(iout,6700)
3862 IF (imp_lr > 0) WRITE(iout,6800)
3863C
3864 ENDIF ! IF(IPRINT==1) THEN
3865C
3866 IF (iline /= 1) THEN
3867 IF (iline_s == 0) iline_s=3
3868 IF (iline_s == 100) THEN
3869 iline_s=0
3870 IF(iprint==1)WRITE(iout,7000)
3871 ENDIF
3872 ELSE
3873 iline_s=0
3874 ENDIF
3875
3876 IF (iline /= 1.AND.iline_s > 0) THEN
3877 IF (nls_lim == 0) nls_lim=20
3878 IF (ls_tol == zero) ls_tol=em03
3879 IF(iprint==1)WRITE(iout,6900)iline_s,nls_lim,ls_tol
3880 IF (iline_s == 3) THEN
3881 IF (nitol /= 2.AND.nitol /= 4) THEN
3882 ls_tol=five*ls_tol
3883 ELSE
3884 ls_tol=half*ls_tol
3885 ENDIF
3886 ELSEIF (iline_s == 2) THEN
3887 ls_tol=half*ls_tol
3888 ENDIF
3889 ENDIF
3890
3891 IF (iline /= 1.AND.irefi > 0) THEN
3892 IF(iprint==1)WRITE(iout,7100)irefi
3893 END IF
3894
3895 IF (iline /= 1.AND.ndiver == 0) THEN
3896 IF (irefi > 2.AND.iline_s /= 1) THEN
3897 ndiver=2
3898 ELSEIF(ikt > 0.AND.iline_s /= 1) THEN
3899 ndiver=0
3900 ELSE
3901 ndiver=1
3902 END IF
3903 ELSEIF(ndiver == -1) THEN
3904 ndiver=0
3905 END IF
3906
3907 IF (iline /= 1.AND.ndiver > 0) THEN
3908 IF(iprint==1)WRITE(iout,7200)ndiver
3909 ndiver = ndiver + 1
3910 END IF
3911
3912 IF (iline /= 1) THEN
3913 IF (tol_div == zero ) THEN
3914 tol_div = ep04
3915 IF (iline_s == 1) tol_div=ep03
3916 IF (ismdisp == 1) tol_div=ep10
3917 ELSE
3918 IF(iprint==1)WRITE(iout,8500)tol_div
3919 END IF
3920 END IF
3921
3922 IF (ikt == 1) THEN
3923 IF(iprint==1)WRITE(iout,7300)
3924 ELSEIF (ikt == 2) THEN
3925 IF(iprint==1)WRITE(iout,7400)
3926 ELSEIF (ikt == 3) THEN
3927 IF(iprint==1)WRITE(iout,8000)
3928 ELSEIF (ikt == 4) THEN
3929 IF(iprint==1)WRITE(iout,8100)
3930 END IF
3931
3932 IF (ndtfix > 0) THEN
3933 IF(iprint==1) THEN
3934 WRITE(iout,7500) ndtfix
3935 WRITE(iout,7510)(dtimpf(j),j=1,ndtfix)
3936 END IF
3937 END IF
3938
3939 IF (nbuck > 0) THEN
3940 IF (imumpsv> 0) THEN
3941 IF (bisolv /= 1.AND.bisolv /= 2) THEN
3942 WRITE(istdo,*) ' ** ERROR ** UNAVAILABLE SOLVER FOR BUCKLING ANALYSIS'
3943 WRITE(iout,*) ' ** ERROR ** UNAVAILABLE SOLVER FOR BUCKLING ANALYSIS'
3944 CALL arret(2)
3945 ENDIF
3946 IF (ispmd == 0) THEN
3947 WRITE(iout,6000) nbuck, shftbuck, bniter, bincv, bmaxncv, msg_bsol(2)
3948 ENDIF
3949 ELSE
3950 CALL prout_buck(iout,nbuck,ibuckl)
3951 END IF
3952 ENDIF
3953C
3954 RETURN
3955 5000 FORMAT(/
3956 . ' IMPLICIT OPTIONS USED :'//
3957 . ' IMPLICIT TYPE : . . . . . . . . . . . . . ',2x,a/
3958 . ' LINEAR SOLVER : . . . . . . . . . . . . . ',2x,a/
3959 . ' PRECONDITION METHOD : . . . . . . . . . . ',2x,a/
3960 . ' STOP CRITERION FOR LINEAR SOLVER . . . . .',2x,i5/
3961 . ' ITERATION NUM. LIMIT FOR LINEAR SOLVER . .',2x,i5/
3962 . ' TOLERANCE FOR LINEAR SOLVER . . . . . . . ',2x,g14.7/
3963 . ' PRINTOUT FREQUENCY FOR LINEAR SOLVER . . .',2x,i5/)
3964 5010 FORMAT(/
3965 . ' IMPLICIT OPTIONS USED :'//
3966 . ' IMPLICIT TYPE : . . . . . . . . . . . . . ',2x,a/
3967 . ' LINEAR SOLVER : . . . . . . . . . . . . . ',2x,a/
3968 . ' PRINTOUT FREQUENCY FOR LINEAR SOLVER . . .',2x,i5/)
3969 5020 FORMAT(/
3970 . ' GEOMETRICAL STIFFNESS FLAG . . .. . . . .',2x,i5/
3971 . ' LOAD (PRESSURE) STIFFNESS FLAG . . . . . ',2x,i5/
3972 . ' AUTOSPC FLAG (0:OFF,1:ON,2:ALL) . . .. . .',2x,i5/
3973 . ' SPRING-BACK OPTION : . . . . . . . . . . .',2x,i5/
3974 . ' SPECIAL PCG SOLVER FOR CONTACT . . . .. . ',2x,i5/)
3975 5050 FORMAT(/
3976 . ' IMPLICIT OPTIONS USED :'//
3977 . ' IMPLICIT TYPE : . . . . . . . . . . . . . ',2x,a//)
3978 5100 FORMAT(
3979 . ' NON-LINEAR SOLVER : . . . . . . . . . . . ',2x,a/
3980 . ' INITIAL TIME STEP . . . . . . . . . . . . ',2x,g14.7/
3981 . ' STOP CRITERION FOR NON-LINEAR SOLVER . . .',2x,i5/
3982 . ' TOLERANCE FOR NON-LINEAR SOLVER . . . . . ',2x,g14.7)
3983 5112 FORMAT(
3984 . ' NON-LINEAR SOLVER : . . . . . . . . . . . ',2x,a/
3985 . ' INITIAL TIME STEP . . . . . . . . . . . . ',2x,g14.7/
3986 . ' STOP CRITERION FOR NON-LINEAR SOLVER . . .',2x,i5/
3987 . ' ENERGY TOLERANCE FOR NON-LINEAR SOLVER . .',2x,g14.7/
3988 . ' FORCE TOLERANCE FOR NON-LINEAR SOLVER . .',2x,g14.7)
3989 5113 FORMAT(
3990 . ' NON-LINEAR SOLVER : . . . . . . . . . . . ',2x,a/
3991 . ' INITIAL TIME STEP . . . . . . . . . . . . ',2x,g14.7/
3992 . ' STOP CRITERION FOR NON-LINEAR SOLVER . . .',2x,i5/
3993 . ' ENERGY TOLERANCE FOR NON-LINEAR SOLVER . .',2x,g14.7/
3994 . ' DISP. TOLERANCE FOR NON-LINEAR SOLVER . .',2x,g14.7)
3995 5123 FORMAT(
3996 . ' NON-LINEAR SOLVER : . . . . . . . . . . . ',2x,a/
3997 . ' INITIAL TIME STEP . . . . . . . . . . . . ',2x,g14.7/
3998 . ' STOP CRITERION FOR NON-LINEAR SOLVER . . .',2x,i5/
3999 . ' FORCE TOLERANCE FOR NON-LINEAR SOLVER . .',2x,g14.7/
4000 . ' DISP. TOLERANCE FOR NON-LINEAR SOLVER . .',2x,g14.7)
4001 5132 FORMAT(
4002 . ' NON-LINEAR SOLVER : . . . . . . . . . . . ',2x,a/
4003 . ' INITIAL TIME STEP . . . . . . . . . . . . ',2x,g14.7/
4004 . ' STOP CRITERION FOR NON-LINEAR SOLVER . . .',2x,i5/
4005 . ' ENERGY TOLERANCE FOR NON-LINEAR SOLVER . .',2x,g14.7/
4006 . ' FORCE TOLERANCE FOR NON-LINEAR SOLVER . .',2x,g14.7/
4007 . ' DISP. TOLERANCE FOR NON-LINEAR SOLVER . .',2x,g14.7)
4008 5150 FORMAT(
4009 . ' REFORMING FLAG IN MIX SOLVER(0:AUTO,>0:ITER)',2x,i5/
4010 . ' ITERATION NUM.LIMIT FOR REFORMING MATRIX .',2x,i5/
4011 . ' PRINTOUT FREQUENCY FOR NON-LINEAR SOLVER .',2x,i5/
4012 . ' PRE-STRESSES CONTROL FLAG . . . . . . . . ',2x,i5/
4013 . ' REFERENCE RESIDUAL FLAG . . . . . . .. . .',2x,i5/
4014 . ' TIME STEP CONTROL METHOD . . . . . . . . .',2x,i5/
4015 . ' MINIMUM TIME STEP . . . . . . . . . . . . ',2x,g14.7/
4016 . ' MAXIMUM TIME STEP . . . . . . . . . . . . ',2x,g14.7//)
4017 5180 FORMAT(
4018 . ' ITERATION NUM.LIMIT FOR REFORMING MATRIX .',2x,i5/
4019 . ' PRINTOUT FREQUENCY FOR NON-LINEAR SOLVER .',2x,i5/
4020 . ' PRE-STRESSES CONTROL FLAG . . . . . . . . ',2x,i5/
4021 . ' reference residual flag . . . . . . .. . .',2X,I5/
4022 . ' time step control method . . . . . . . . .',2X,I5/
4023 . ' minimum time step . . . . . . . . . . . . ',2X,G14.7/
4024 . ' maximum time step . . . . . . . . . . . . ',2X,G14.7//)
4025 5200 FORMAT(
4026 . ' converge iteration num. for increasing dt. ',2X,I5/
4027 . ' increasing time step scale factor. . . . .',2X,G14.7/
4028 . ' converge iteration num. for decreasing dt .',2X,I5/
4029 . ' decreasing time step scale factor. . . . .',2X,G14.7/)
4030 5300 FORMAT(
4031 . ' desired converge iteration num. . . . . . .',2X,I5/
4032 . ' maximum converge iteration num. . . . . . .',2X,I5/
4033 . ' decreasing time step scale factor. . . . .',2X,G14.7/
4034 . ' maximum increasing time step scale factor ',2X,G14.7/
4035 . ' constant arc-length. . . . . . .. . . . . ',2X,G14.7//)
4036 5400 FORMAT(
4037 . ' time integration with hht-alpha constant ',2X,G14.7//)
4038 6000 FORMAT(
4039 . ' euler buckling analysis :'/
4040 . ' number of modes to be computed :. . . . . ',2X,I5/
4041 . ' shift in buckling modes pencil :. . . . . ',2X,G14.7/
4042 . ' maximum number of arnoldi iterations :. . ',2X,I5/
4043 . ' initial factor for subspace dimension : . ',2X,I5/
4044 . ' maximum factor for subspace dimension : . ',2X,I5/
4045 . ' linear solver : . . . . . . . . . . . . . ',2X,A/)
4046 6100 FORMAT(
4047 . ' precondition matrix sparse pattern(a^n) . ',2X,I5/)
4048 6200 FORMAT(
4049 . ' IMPLICIT rayleigh damping coefficients : ',2X,2G14.7/)
4050 6300 FORMAT(
4051 . ' time integration with newmark constants ',2X,2G14.7//)
4052 6400 FORMAT(
4053 . ' quasi-static inertia scale factor : ',2X,G14.7//)
4054 6500 FORMAT(
4055 . ' crossing contact node detection deactivated .',/)
4056 6600 FORMAT(
4057 . ' linear analyse taking into account contact . .',/)
4058 6700 FORMAT(
4059 . ' cauchy stress selected for linear analyse . .',/)
4060 6800 FORMAT(
4061 . ' taking into account large rigid rotation . .',/)
4062 6900 FORMAT(
4063 . ' line-search method :. . . . . . . . . . . .',2X,I5/
4064 . ' maximum line-search iteration num. . . . . ',2X,I5/
4065 . ' tolerance for line-search iteration. . . .',2X,G14.7/)
4066 7000 FORMAT(
4067 . ' line-search deactivated . . . . . . . . . . .',/)
4068 7100 FORMAT(
4069 . ' reference residual options for contact . . ',2X,I5/)
4070 7200 FORMAT(
4071 . ' divergence criterion numbers : . . . . . .',2X,I5/)
4072 7300 FORMAT(
4073 . ' simplified tangent stiffness activated . .',/)
4074 7400 FORMAT(
4075 . ' average continuum tangent stiffness activated',/)
4076 7500 FORMAT(
4077 . ' fixed time point number: . . . . . . . .',2X,I5)
4078 7510 FORMAT( /,3X,6G20.13,//)
4079 7600 FORMAT(
4080 . ' full projection for qeph(-1:off,1:on) . . .. . .',2X,I5/)
4081 7650 FORMAT(
4082 . ' desired converge iteration num. . . . . . .',2X,I5/
4083 . ' maximum converge iteration num. . . . . . .',2X,I5/
4084 . ' decreasing time step scale factor. . . . .',2X,G14.7/
4085 . ' maximum increasing time step scale factor ',2X,G14.7/
4086 . ' constant arc-length. . . . . . .. . . . . ',2X,G14.7/
4087 . ' constraint TYPE . . . .. . . . . . . . . . ',2X,I5/
4088 . ' loading contribution scale factor . . . . ',2X,G14.7//)
4089 7700 FORMAT('automatic time step control:'/)
4090 7800 FORMAT('automatic time step with riks method:'/)
4091 7900 FORMAT(
4092 . ' maximum increment(ncycle) num . . .. . .',2X,I5/)
4093 8000 FORMAT(
4094 . ' continuum tangent stiffness activated. .',/)
4095 8100 FORMAT(
4096 . ' consistent tangent stiffness activated. .',/)
4097 8200 FORMAT(
4098 . ' minimum reference force residual . . . .',2X,G14.7/
4099 . ' maximum reference force residual . . . . ',2X,G14.7//)
4100 8010 FORMAT(
4101 . ' small displacement option(0:off,1:on) . . .. . .',2X,I5/)
4102 8400 FORMAT(
4103 . ' number of projection vectors of pcg . . . ',2X,I5/
4104 . ' projection vector initialization method . ',2X,I5/)
4105 8500 FORMAT(
4106 . ' diverging tol. of relative force residual :',2X,G14.7/)
4107 8600 FORMAT(
4108 . ' free rigid motion /mrigm used . . . . . . .'/)
4109 8700 FORMAT(
4110 . ' free rigid motion /mrigm w/ ref_node_id:',2X,3I10/)
my_real
#define my_real
Definition cppsort.cpp:32
damping
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
prout_buck
subroutine prout_buck(ip, nbuck, ibuck)
Definition lectur.F:3262
alpha
#define alpha
Definition eval.h:35
jacobien
subroutine jacobien(a, n, ew, ev, tol, lamda)
Definition imp_glob_k.F:1788
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
imp_kbcs
Definition impbufdef_mod.F:471
imp_pcg_proj
Definition impbufdef_mod.F:646
imp_pcg_proj::m_vs
integer m_vs
Definition impbufdef_mod.F:648
imp_spbrm
Definition impbufdef_mod.F:696
imp_spbrm::e_ref
integer, dimension(4) e_ref
Definition impbufdef_mod.F:698
message_mod
Definition message_mod.F:1257
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:895
arret
subroutine arret(nn)
Definition arret.F:86
static
subroutine static(v, vr, a, ar, ms, in, igrnod, weight_md, wfext)
Definition static.F:33

◆ lectur()

subroutine lectur ( integer, dimension(*) icode,
integer, dimension(*) iskew,
integer, dimension(liskn,*) iskwn,
integer, dimension(nixtg,*) ixtg,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(*) itab,
integer, dimension(*) itabm1,
integer, dimension(*) npc,
integer, dimension(nparg,ngroup) iparg,
integer, dimension(nigrv,*) igrv,
integer, dimension(*) ibgr,
integer, dimension(npari,*) ipari,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer, dimension(*) nnlink,
integer, dimension(*) llink,
integer, dimension(*) linale,
integer, dimension(*) neflsw,
integer, dimension(*) nnflsw,
integer, dimension(*) icut,
integer, dimension(*) inoise,
x,
v,
vr,
ms,
in,
skew,
pld,
rby,
wa,
crflsw,
xcut,
dampr,
type(group_), dimension(ngrnod) igrnod,
integer, dimension(nisp,*) kxsp,
integer, dimension(*) weight,
integer, dimension(*) fr_rby2,
integer, dimension(nspmd+2,*) fr_rl,
partsav,
integer, dimension(*) ipart,
pm,
integer, dimension(*) monvol,
volmon,
integer, dimension(*) ipart_state,
geo,
type(ttable), dimension(*) table,
integer, dimension(liskn,*) iframe,
xframe,
type(elbuf_struct_), dimension(ngroup), target elbuf_str,
integer, dimension(npropgi,*) igeo,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer, dimension(npropmi,*) ipm,
type (h3d_database) h3d_data,
type (multi_fvm_struct) multi_fvm,
type(group_), dimension(ngrpart) igrpart,
integer, dimension(*) tag_skins6,
integer, dimension(sizfield,*) icfield,
integer, dimension(*) lcfield,
integer, dimension(*) tagslv_rby,
character, dimension(1024,mds_nmat) mds_label,
integer, dimension(mds_nmat*max_depvar) mds_output_table,
integer mds_nmat,
integer max_depvar,
integer, dimension(*) mds_ndepsvar,
type (stack_ply) stack,
integer, dimension(*) ibcl,
integer, dimension(*) iloadp,
integer, dimension(*) lloadp,
type (sensors_), intent(inout), target sensors,
type (dynain_database), intent(inout) dynain_data,
type (dt_), intent(inout) dt,
type (loads_), intent(in) loads,
type(output_), intent(inout) output,
type(names_and_titles_), intent(inout) names_and_titles,
type (matparam_struct_), dimension(nummat), intent(inout) mat_param,
type (glob_therm_), intent(inout) glob_therm,
type (pblast_), intent(inout) pblast )
Parameters
[in,out]outputoutput structure
[in,out]names_and_titlesNAMES_AND_TITLES host the input deck names and titles for outputs

Definition at line 86 of file lectur.F.

105C-----------------------------------------------
106C M o d u l e s
107C-----------------------------------------------
108 USE table_mod
109 USE message_mod
110 USE mat_elem_mod
111 USE intbufdef_mod
112 USE stack_mod
113 USE h3d_mod
114 USE multi_fvm_mod
115 USE groupdef_mod
116 USE intstamp_glob_mod
117 USE fvbag_mod
118 USE check_mod
119 USE sensor_mod
120 USE output_mod
121 USE state_mod
122 USE alemuscl_mod , only:alemuscl_param
123 USE ale_mod
124 USE dt_mod
125 USE loads_mod
126 USE fxb_mod
127 USE my_alloc_mod
128 USE names_and_titles_mod
129 USE elbufdef_mod
130 USE glob_therm_mod
131 USE pblast_mod
132 USE prelech3d_mod
133 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
134C-----------------------------------------------
135C I m p l i c i t T y p e s
136C-----------------------------------------------
137#include "implicit_f.inc"
138C-----------------------------------------------
139C C o m m o n B l o c k s
140C-----------------------------------------------
141#include "com01_c.inc"
142#include "com04_c.inc"
143#include "com06_c.inc"
144#include "com08_c.inc"
145#include "com09_c.inc"
146#include "param_c.inc"
147#include "warn_c.inc"
148#include "scr02_c.inc"
149#include "scr03_c.inc"
150#include "scr05_c.inc"
151#include "scr06_c.inc"
152#include "scr07_c.inc"
153#include "scr14_c.inc"
154#include "scr16_c.inc"
155#include "scr17_c.inc"
156#include "scr18_c.inc"
157#include "cong1_c.inc"
158#include "cong2_c.inc"
159#include "scrfs_c.inc"
160#include "stati_c.inc"
161#include "statr_c.inc"
162#include "units_c.inc"
163#include "scrcut_c.inc"
164#include "scrnoi_c.inc"
165#include "parit_c.inc"
166#include "chara_c.inc"
167#include "task_c.inc"
168#include "sphcom.inc"
169#include "impl1_c.inc"
170#include "tabsiz_c.inc"
171#include "remesh_c.inc"
172#include "sms_c.inc"
173#include "rad2r_c.inc"
174#include "inter22.inc"
175#include "userlib.inc"
176#include "spmd_c.inc"
177#include "intstamp_c.inc"
178#include "couple_c.inc"
179C-----------------------------------------------
180C D u m m y A r g u m e n t s
181C-----------------------------------------------
182 INTEGER IPARG(NPARG,NGROUP), IPARI(NPARI,*), IXS(NIXS,*),
183 . IXQ(NIXQ,*), IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
184 . IXR(NIXR,*), IXTG(NIXTG,*),ITAB(*), ITABM1(*),
185 . ISKWN(LISKN,*), NPBY(NNPBY,*),NNLINK(*) ,LLINK(*) ,LINALE(*),
186 . ICODE(*) ,ISKEW(*),NPC(*),NEFLSW(*),NNFLSW(*),ICUT(*),
187 . INOISE(*),IGRV(NIGRV,*),IBGR(*),
188 . LPBY(*),KXSP(NISP,*),WEIGHT(*),FR_RBY2(*),
189 . FR_RL(NSPMD+2,*),
190 . IPART(*), MONVOL(*), IPART_STATE(*),IFRAME(LISKN,*),
191 . IGEO(NPROPGI,*),IPM(NPROPMI,*),TAG_SKINS6(*),
192 . ICFIELD(SIZFIELD,*), LCFIELD(*), TAGSLV_RBY(*),
193 . MDS_OUTPUT_TABLE(MDS_NMAT*MAX_DEPVAR),MDS_NMAT,MAX_DEPVAR,
194 . MDS_NDEPSVAR(*),IBCL(*),ILOADP(*),LLOADP(*)
195 my_real
196 . skew(lskew,*),rby(*),ms(*),in(*),
197 . x(*), v(*), vr(*),wa(*),pld(*),crflsw(*),xcut(*),
198 . dampr(nrdamp,*), partsav(*),pm(npropm,*),
199 . volmon(*),geo(npropg,*),xframe(nxframe,*)
200 TYPE(TTABLE) TABLE(*)
201 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_STR
202 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
203 TYPE (H3D_DATABASE) :: H3D_DATA
204 TYPe (MULTI_FVM_STRUCT) :: MULTI_FVM
205 TYPE(GROUP_) ,DIMENSION(NGRNOD) :: IGRNOD
206 TYPE(GROUP_) ,DIMENSION(NGRPART) :: IGRPART
207 CHARACTER MDS_LABEL(1024,MDS_NMAT)
208 TYPE (STACK_PLY) :: STACK
209 TYPE (SENSORS_) ,INTENT(INOUT) ,TARGET :: SENSORS
210 TYPE (DYNAIN_DATABASE), INTENT(INOUT) :: DYNAIN_DATA
211 TYPE (DT_), INTENT(INOUT) :: DT
212 TYPE (LOADS_), INTENT(IN) :: LOADS
213 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT !< output structure
214 TYPE(NAMES_AND_TITLES_),INTENT(INOUT) :: NAMES_AND_TITLES !< NAMES_AND_TITLES host the input deck names and titles for outputs
215 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
216 type (glob_therm_) ,intent(inout) :: glob_therm
217 type (pblast_) ,intent(inout) :: pblast
218C-----------------------------------------------
219C L o c a l V a r i a b l e s
220C-----------------------------------------------
221 INTEGER NLEC(16), I, NSLIOF, NELSOF, NELQOF, NDAMPN,
222 . NELCOF, NELTOF, NELPOF, NELROF, NINTCH, NUBCSN, ITFOR0, IRFE0,
223 . IRFL0, K, NELOF, NN, NBC, IL, II, J, KLG, KUG, NBLK, NG,
224 . ITY, NEL, NFT, IAD, IGOF, K1, K2, N, I1, I2, I3, IR1, IR2, IR3,
225 . ISK, IC, ICR, M1, M2, IM, NOINT, NSEARCH, JPRI, NPTS,
226 . NRBYON, NRBYOF, NELTGOF,NINIV,NSLIOFN,NSLIOFS,KK,NTY,
227 . NSN,NRTS,NRTM,NMN,L,NCPRI1,NRLINK0,NALELK0,
228 . NSPHOF,IWIOUT,NLECSPH(10),NFXINP,NCRST1,NEIGOFF,NEOFF,
229 . NALEOF,NEULEROF,NTHERMOF,NFVMESH,MLW,LL,ISK1,ISK2,
230 . NFVMODI,IOK, ALEStrL(0:8), NALELINK0, GR_ID,
231 . NALELK_starter, uID, NALELK_removed, JALE,USERL_COUNT,
232 . IDEL2,IS,
233 . STEXT1,MULTIREST1,NLPRI1,IERROR,
234 . NINTERSKID,IVOLU,IFV,IFV_TYPE,ISTATG_P,
235 . K3,K4,K5,K6,K7,K8,K9,NINEFRICG,NS,NI,NPARTOF,IFT,ILT,K10,K11,JJ,DTFCT,Ok
236
237 INTEGER :: NBPARTALEON, NBPARTALEOFF, PARTID, ISON, ION, IOFF, NBALEON_PART, NBALEOFF_PART
238 INTEGER, DIMENSION(:), ALLOCATABLE :: ALEOFF_PARTIDS_TMP, ALEOFF_PARTIDS,
239 . ALEON_PARTIDS_TMP, ALEON_PARTIDS
240 INTEGER, DIMENSION(:), ALLOCATABLE :: ALELIN_ON_OFF
241 my_real
242 . tfi, dtf, dtm, alp, gam,
243 . cv1, cv2, cv3, volm, tstart, tfin,dt_input, dt_crit
244 CHARACTER*9 Label1,Label2,Label3,Label4,Label5,Label6,Label7,Label8
245 CHARACTER*16 ALEform(0:8),Cale1,Cale2,CHAR1,CHAR2,Label9
246 CHARACTER*3 :: LABEL_DEF,LABEL_ROT
247 CHARACTER(LEN=4), DIMENSION(20) :: TITLE
248 my_real eta1,eta2,min_aspect,min_defv,dydx
249 my_real, DIMENSION(:), POINTER :: offg
250 TYPE (SENSOR_STR_) ,DIMENSION(:) ,POINTER :: SENSOR_TAB
251 LOGICAL IS_ALREADY_PRINTED
252 REAL(KIND=8) :: dth
253 REAL(KIND=8), dimension(9) :: dth1
254 INTEGER, DIMENSION(:), ALLOCATABLE :: IPARTOF
255C-----------------------------------------------
256C E x t e r n a l F u n c t i o n s
257C-----------------------------------------------
258 INTEGER,EXTERNAL :: NGR2USR
259 my_real,EXTERNAL :: finter
260C-----------------------------------------------
261 ! setting NOINT in IPARI(13)
262 ierr = 0
263 dt_input= zero
264 DO i=1,ninter
265 ipari(13,i)=10
266 IF(ipari(15,i) == 0) ipari(15,i)=i
267 ENDDO
268 sensor_tab => sensors%SENSOR_TAB(1:sensors%NSENSOR)
269
270 CALL chkipari(ipari)
271
272 READ (iin,'(20A4)') title
273 READ (iin,'(4F16.0,I8,I10,2I8)')tfi,dth,dtf,dtm,ncpri1,ncrst1,multirest1,nlpri1
274 READ (iin,'(5F16.0)')(dth1(i),i=1,5)
275 READ (iin,'(4F16.0)')(dth1(i+5),i=1,4)
276 READ (iin,'(6F10.0)')alp,gam,cv1,cv2,cv3,volm
277 READ (iin,'(10I8)') nsliof,nelsof,nelqof,nelcof,neltof,nelpof,nelrof,neltgof,nsliofn,nsliofs
278 READ (iin,'(I8)') nsphof
279 READ (iin,'(4I8)') naleof,neulerof,nthermof,npartof
280 READ (iin,'(2I8)') nrlink0,nalelk0
281 READ (iin,'(2I8)') nalelink0
282C--------------
283C ALE ON / OFF
284C--------------
285 READ (iin, '(I8, I8)') nbpartaleon, nbpartaleoff
286 IF(mcheck == 0)THEN
287 nrlink=nrlink0
288 nalelk=nalelk0
289 nalelink=nalelink0
290 irprev = 0
291 ENDIF
292 nrbyon = 0
293 nrbyof = 0
294 nubcsn = 0
295 niniv = 0
296 READ (iin,'(2I8)') nubcsn,niniv
297 READ (iin,'(3I8)') nintch,nrbyon,nrbyof
298 READ (iin,'(I8)') ndampn
299 READ(iin,'(I8)') nfxinp
300C-----
301 READ(iin,'(2I8)') neigoff, neoff
302 READ(iin,'(2I8)') nfvmesh, nfvmodi
303C-----
304 IF(ncpri1 == 0) ncpri1=1
305 IF(mcheck == 0)ncpri = ncpri1
306C-----
307 IF(mcheck == 0)nlpri = nlpri1
308C
309 IF(ncrst1 == 0.AND.mcheck == 0) ncrst=10000000
310 IF(tfi /= 0.0) tstop=tfi
311C
312 IF(toutp0 /= zero) toutp = toutp0
313 IF(dtoutp0 > zero) dtoutp= dtoutp0
314 IF(dtoutp<=zero) toutp = ep30
315 IF (toutp < tt-dt2.AND.dtoutp > zero)toutp = toutp
316 . + int((tt-dt2-toutp)/dtoutp)*dtoutp
317 IF (toutp < tt-dt2)toutp = toutp+dtoutp
318C
319C .sta files
320 IF(tstat0 /= zero) tstat = tstat0
321 IF(dtstat0 > zero) dtstat= dtstat0
322 IF(dtstat<=zero) tstat = ep30
323 IF (tstat < tt-dt2.AND.dtstat > zero)tstat = tstat
324 . + int((tt-dt2-tstat)/dtstat)*dtstat
325 IF (tstat < tt-dt2)tstat = tstat+dtstat
326C .dynain files
327 IF(dynain_data%TDYNAIN0 /= zero) dynain_data%TDYNAIN = dynain_data%TDYNAIN0
328 IF(dynain_data%DTDYNAIN0 > zero) dynain_data%DTDYNAIN= dynain_data%DTDYNAIN0
329 IF(dynain_data%DTDYNAIN<=zero) dynain_data%TDYNAIN = ep30
330 IF (dynain_data%TDYNAIN < tt-dt2.AND.dynain_data%DTDYNAIN > zero)dynain_data%TDYNAIN = dynain_data%TDYNAIN
331 . + int((tt-dt2-dynain_data%TDYNAIN)/dynain_data%DTDYNAIN)*dynain_data%DTDYNAIN
332 IF (dynain_data%TDYNAIN< tt-dt2)dynain_data%TDYNAIN = dynain_data%TDYNAIN+dynain_data%DTDYNAIN
333C abf files
334 DO i=1,10
335 IF(dtabf0(i) > zero) dtabf(i)= dtabf0(i)
336 IF(dtabfwr0(i) > zero) dtabfwr(i)= dtabfwr0(i)
337 ENDDO
338 IF (abfile(1) /= 0) tabfis(1) = tt
339C
340 IF(dth /= zero.AND.mcheck == 0) output%TH%DTHIS=dth
341 DO i= 1, 9
342 IF(dth1(i) /= zero.AND.mcheck == 0) output%TH%DTHIS1(i)=dth1(i)
343 ENDDO
344
345C
346 IF(mcheck == 0)THEN
347 ale%GRID%VGY0=zero
348 ale%GRID%VGZ0=zero
349 IF(dtf /= zero) dtfac=dtf
350 IF(dtm /= zero) dtmin=dtm
351 IF(alp /= zero) ale%GRID%ALPHA=alp
352 IF(gam /= zero) ale%GRID%GAMMA=gam
353 IF(cv1 /= zero) ale%GRID%VGX =cv1
354 IF(cv2 /= zero) ale%GRID%VGY =cv2
355 IF(cv3 /= zero) ale%GRID%VGZ =cv3
356 IF(ale%GRID%NWALE_ENGINE == 2)THEN
357 IF(alp /= zero) THEN
358 ale%GRID%ALPHA = alp/(-ale%GRID%VGX+sqrt(ale%GRID%VGX**2+ one))
359 dt_input = alp
360 ELSE
361 dt_input = ale%GRID%ALPHA*(-ale%GRID%VGX+sqrt(ale%GRID%VGX**2+ one))
362 ENDIF
363 ENDIF
364 IF(ale%GRID%NWALE_ENGINE == 1.AND.alp == zero) ale%GRID%ALPHA=ep30
365 IF(volm /= zero)volmin=volm
366 IF(int22>0)THEN
367 dtfac22 = one
368 IF(dtfac>half)dtfac22 = half / dtfac
369 ENDIF
370 ENDIF
371C
372 IF(mcheck==0)THEN
373 IF(idtmins/=0)THEN
374 IF(dtmins == zero)dtmins = dtmin
375 IF(dtfacs == zero)dtfacs = dtfac
376 IF(tol_sms == zero) tol_sms = em03
377 IF(nsmspcg==0)nsmspcg=1000
378 idtgrs =idtgrs_old
379 IF(ispmd==0)THEN
380C
381 IF(idtmins==2.AND.irest_mselt==0)THEN
382 CALL ancmsg(msgid=120,anmode=aninfo_blind)
383 CALL arret(2)
384 END IF
385C
386C IF((IDTMINS==2.OR.IDTMINS_INT/=0).AND.NODADT/=0)THEN
387C CALL ANCMSG(MSGID=209,ANMODE=ANINFO_BLIND)
388C CALL ARRET(2)
389C END IF
390 END IF
391 ENDIF
392 IF(idtmins_int/=0)THEN
393 IF(dtmins_int == zero)dtmins_int = dtmin
394 IF(dtfacs_int == zero)dtfacs_int = dtfac
395 IF(tol_sms == zero) tol_sms = em03
396 IF(nsmspcg==0)nsmspcg=1000
397 ENDIF
398 ELSE
399 idtmins=idtmins_old
400 dtmins =dtmins_old
401 dtfacs =dtfacs_old
402 idtgrs =idtgrs_old
403 idtmins_int=idtmins_int_old
404 dtmins_int =dtmins_int_old
405 dtfacs_int =dtfacs_int_old
406 END IF
407C
408 dtfacx = one
409 DO i=1,51
410 IF(dtmin1(i) == zero)dtmin1(i) = dtmin
411 IF(dtfac1(i) == zero)dtfac1(i) = dtfac
412 dtfacx = min(dtfac1(i), dtfacx)
413 ENDDO
414
415 IF(idtmin(52) == 0)idtmin(52) = 1
416 IF(dtfac1(52) == zero)dtfac1(52) = zep9
417 IF(dtmin1(52) == zero)dtmin1(52) = em20
418
419 i=102
420 IF(ale%GLOBAL%IDT_ALE==-1)THEN
421 IF(dtmin1(i) == zero)dtmin1(i) = dtmin
422 IF(dtfac1(i) == zero)dtfac1(i) = dtfac
423 ELSE
424 IF(dtmin1(i) == zero)dtmin1(i) = zero
425 IF(dtfac1(i) == zero)dtfac1(i) = half
426 ENDIF
427C
428 IF(nodadt == 0)THEN
429 IF(idtmin(1) == 0)idtmin(1) = 1
430 IF(idtmin(2) == 0)idtmin(2) = 1
431 IF(idtmin(3) == 0)idtmin(3) = 2
432 IF(idtmin(7) == 0)idtmin(7) = 2
433 ENDIF
434C
435 IF(ispmd == 0) WRITE(iout,'(//1X,20A4//)') title
436 itfor0=itform + 1
437 irfe0 =(irform/5)
438 irfl0 =(irform-5*irfe0) + 1
439 irfe0 =irfe0 + 1
440
441C --------------------------------------------------------------------
442c CALL RCHECKMASS(IXR ,GEO ,PM ,MSR ,INR ,
443c . MS ,IN ,ITAB ,IGEO ,IPM ,
444c . UPARAM ,IPART ,IPARTR )
445C --------------------------------------------------------------------
446C User Libraries output & checks
447C --------------------------------------------------------------------
448 IF (nspmd > 1)THEN
449 userl_count = userl_avail
450 CALL spmd_glob_isum9(userl_count,1)
451 IF (ispmd==0)THEN
452 IF (userl_count /= 0 .AND. userl_count /= nspmd)THEN
453 CALL ancmsg(msgid=254,anmode=aninfo,
454 . c1=dlibfile(1:dlibfile_size))
455 CALL arret(2)
456 ENDIF
457 ENDIF
458 ENDIF
459C When Dynamical user libraries are used, add a print in 0001.out file
460 IF (userl_avail==1)THEN
461 IF(ispmd==0)THEN
462 WRITE(iout,4500)
463 WRITE(iout,4600) dlibfile(1:dlibfile_size),dlibtkvers
464 ENDIF
465 ENDIF
466C --------------------------------------------------------------------
467
468 IF (irad2r==1) THEN
469 IF(ispmd==0) WRITE(iout,1099)
470 IF (itfor0==1 ) THEN
471 CALL ancmsg(msgid=242,anmode=aninfo_blind)
472 CALL arret(2)
473 ENDIF
474 ELSE
475 IF ((r2r_siu==1).AND.(ispmd==0)) THEN
476 CALL ancmsg(msgid=239,anmode=aninfo_blind)
477 CALL arret(2)
478 ENDIF
479 ENDIF
480C
481 min_aspect = dt%BRICK_CST_COL_MIN
482 min_defv = dt%BRICK_CST_DEFV_MIN
483 IF(ispmd == 0.AND.mcheck == 0)WRITE(iout,1100)tstop,output%TH%DTHIS,dtfac,dtmin
484 IF(nodadt == 0)THEN
485 IF ((min_aspect+min_defv)>zero) THEN
486 IF(ispmd == 0.AND.mcheck == 0)THEN
487 WRITE(iout,4700) dtfac1(1),dtmin1(1),idtmin(1),
488 + min_aspect,min_defv,
489 + dtfac1(2),dtmin1(2),idtmin(2),
490 + dtfac1(3),dtmin1(3),idtmin(3),
491 + dtfac1(4),dtmin1(4),idtmin(4),
492 + dtfac1(5),dtmin1(5),idtmin(5),
493 + dtfac1(6),dtmin1(6),idtmin(6),
494 + dtfac1(9),dtmin1(9),idtmin(9),
495 + dtfac1(10),dtmin1(10),idtmin(10)
496 !WRITE(IOUT,4710) DTFAC1(102),DTMIN1(102)
497 IF(idt1sh /=0) WRITE(iout,4720)
498 IF(idt1sol/=0) WRITE(iout,4730)
499 IF(idt1tet10/=0) WRITE(iout,4740)
500 endif!(ISPMD == 0.AND.MCHECK == 0)
501 ELSE
502 IF(ispmd == 0.AND.mcheck == 0)THEN
503 WRITE(iout,1105) dtfac1(1),dtmin1(1),idtmin(1),
504 + dtfac1(2),dtmin1(2),idtmin(2),
505 + dtfac1(3),dtmin1(3),idtmin(3),
506 + dtfac1(4),dtmin1(4),idtmin(4),
507 + dtfac1(5),dtmin1(5),idtmin(5),
508 + dtfac1(6),dtmin1(6),idtmin(6),
509 + dtfac1(9),dtmin1(9),idtmin(9),
510 + dtfac1(10),dtmin1(10),idtmin(10)
511 !WRITE(IOUT,4710) DTFAC1(102),DTMIN1(102)
512 IF(idt1sh /=0) WRITE(iout,4720)
513 IF(idt1sol/=0) WRITE(iout,4730)
514 IF(idt1tet10/=0) WRITE(iout,4740)
515 endif!(ISPMD == 0.AND.MCHECK == 0)
516 END IF !(MIN_ASPECT+MIN_DEFV)>ZERO)
517 IF (dt%IDEL_BRICK>zero) THEN
518 IF(ispmd == 0.AND.mcheck == 0)THEN
519 WRITE(iout,5020)dt%BRICK_DEL_COL_MIN,dt%BRICK_DEL_DEFV_MIN,dt%BRICK_DEL_ASP_MAX,dt%BRICK_DEL_DEFV_MAX
520 ENDIF
521 ENDIF
522 IF(idtmin(11) == 3 .OR. idtmin(11) == 8) THEN
523 IF(ispmd == 0.AND.mcheck == 0)WRITE(iout,1107)dtfac1(11),dtmin1(11),idtmin(11)
524 ENDIF
525 IF(idtmins_int/=0)THEN
526 IF((ispmd == 0).AND.mcheck == 0)THEN
527 WRITE(iout,1209) dtfacs_int,dtmins_int
528 END IF
529 END IF
530 IF(idtmins/=0)THEN
531 IF((ispmd == 0).AND.mcheck == 0.AND.idtgrs<=0)THEN
532 WRITE(iout,1109) dtfacs,dtmins,tol_sms,nsmspcg,m_vs_sms,ncprisms,-idtgrs
533 ELSEIF((ispmd == 0).AND.mcheck == 0)THEN
534 WRITE(iout,1109) dtfacs,dtmins,tol_sms,nsmspcg,m_vs_sms,ncprisms,igrpart(idtgrs)%ID
535 END IF
536 END IF
537 ELSE
538 IF(ispmd == 0.AND.mcheck == 0)THEN
539 IF(idtmin(11)==0)THEN
540 WRITE(iout,1116) dtfac1(11),zero
541 ELSEIF(idtmin(11)==1.OR.idtmin(11)==3.OR.idtmin(11) == 8)THEN
542 IF ( percent_addmass > zero) THEN
543 WRITE(iout,1206) dtfac1(11),dtmin1(11),percent_addmass,idtmin(11)
544 ELSE
545 WRITE(iout,1106) dtfac1(11),dtmin1(11),idtmin(11)
546 ENDIF
547 END IF
548 END IF
549 IF ((min_aspect+min_defv)>zero) THEN
550 IF(ispmd == 0.AND.mcheck == 0)THEN
551 WRITE(iout,4700) dtfac1(1),dtmin1(1),idtmin(1),
552 + min_aspect,min_defv,
553 + dtfac1(2),dtmin1(2),idtmin(2),
554 + dtfac1(3),dtmin1(3),idtmin(3),
555 + dtfac1(4),dtmin1(4),idtmin(4),
556 + dtfac1(5),dtmin1(5),idtmin(5),
557 + dtfac1(6),dtmin1(6),idtmin(6),
558 + dtfac1(9),dtmin1(9),idtmin(9),
559 + dtfac1(10),dtmin1(10),idtmin(10)
560 !WRITE(IOUT,4710) DTFAC1(102),DTMIN1(102)
561 IF(idt1sh /=0) WRITE(iout,4720)
562 IF(idt1sol/=0) WRITE(iout,4730)
563 IF(idt1tet10/=0) WRITE(iout,4740)
564 ENDIF
565 ELSE
566 IF(ispmd == 0.AND.mcheck == 0)THEN
567 WRITE(iout,1105) dtfac1(1),dtmin1(1),idtmin(1),
568 + dtfac1(2),dtmin1(2),idtmin(2),
569 + dtfac1(3),dtmin1(3),idtmin(3),
570 + dtfac1(4),dtmin1(4),idtmin(4),
571 + dtfac1(5),dtmin1(5),idtmin(5),
572 + dtfac1(6),dtmin1(6),idtmin(6),
573 + dtfac1(9),dtmin1(9),idtmin(9),
574 + dtfac1(10),dtmin1(10),idtmin(10)
575 !WRITE(IOUT,4710) DTFAC1(102),DTMIN1(102)
576 IF(idt1sh /=0) WRITE(iout,4720)
577 IF(idt1sol/=0) WRITE(iout,4730)
578 IF(idt1tet10/=0) WRITE(iout,4740)
579 ENDIF
580 END IF !((MIN_ASPECT+MIN_DEFV)>ZERO) THEN
581 IF (dt%IDEL_BRICK>zero) THEN
582 IF(ispmd == 0.AND.mcheck == 0)THEN
583 WRITE(iout,5020)dt%BRICK_DEL_COL_MIN,dt%BRICK_DEL_DEFV_MIN,dt%BRICK_DEL_ASP_MAX,dt%BRICK_DEL_DEFV_MAX
584 ENDIF
585 END IF
586 IF(idtmins_int/=0)THEN
587 IF((ispmd == 0).AND.mcheck == 0)THEN
588 WRITE(iout,1209) dtfacs_int,dtmins_int
589 END IF
590 END IF
591C
592 IF(idtmins/=0)THEN
593C
594 IF (isms_selec < 3) THEN
595 IF((ispmd == 0).AND.mcheck == 0.AND.idtgrs<=0) THEN
596 WRITE(iout,1108) dtfacs,dtmins,tol_sms,nsmspcg,ncprisms,-idtgrs
597 ELSEIF((ispmd == 0).AND.mcheck == 0)THEN
598 WRITE(iout,1108) dtfacs,dtmins,tol_sms,nsmspcg,ncprisms,igrpart(idtgrs)%ID
599 END IF
600C
601 ELSE
602C- /DT /CST_AMS>- Automatic election
603 dt_crit = dtmins / max(em20,dtfac1(11))
604 IF((ispmd == 0).AND.mcheck == 0.AND.idtgrs<=0)THEN
605 WRITE(iout,2109) dtfacs,dtmins,tol_sms,nsmspcg,m_vs_sms,ncprisms,dt_crit,-idtgrs
606 ELSEIF((ispmd == 0).AND.mcheck == 0)THEN
607 WRITE(iout,2109) dtfacs,dtmins,tol_sms, nsmspcg,m_vs_sms,ncprisms,dt_crit,igrpart(idtgrs)%ID
608 END IF
609C
610 END IF
611C
612 ENDIF
613C
614 ENDIF
615C
616
617 IF(nodadt==0.AND.(istatcnd/=0.AND.impl_s==0))THEN
618 CALL ancmsg(msgid=121,anmode=aninfo_blind)
619 CALL arret(2)
620 END IF
621 IF(ispmd == 0.AND.mcheck == 0.AND.kdtint /= 0)THEN
622 WRITE(iout,'(A)')' NEW (HIDDEN) TIME STEP COMPUTATION',' ON INTERFACE TYPE 7,11 AND 19 IS ON'
623 ENDIF
624 IF(ispmd == 0.AND.mcheck == 0.AND.kdtsmstr == 0)THEN
625 WRITE(iout,'(A)')' BACK TO VERSION 4 COMPUTATION OF NODAL TIME STEP',' CASE OF SMALL STRAIN FOR SOLIDS.'
626 ENDIF
627 IF(codvers>=44.AND.numsph /= 0.AND.mcheck == 0)THEN
628 IF(idtmin(51) == 3)THEN
629 IF(ispmd == 0)THEN
630 WRITE(istdo,*)' ** WARNING SMALL STRAIN FORMULATION FOR SPH'
631 WRITE(iout,*)' ** WARNING SMALL STRAIN FORMULATION IS NOT AVAILABLE FOR SPH,',' OPTION /DT/SPHCEL/CST WILL BE OMITTED.'
632 END IF
633 idtmin(51)=0
634 ENDIF
635 IF(nodadt == 1)THEN
636 IF(ispmd == 0) WRITE(iout,*)'IMPROVED TIME STEP (NODAL) COMPUTATION ON SPH PARTICLES :'
637 dtfac1(51)=dtfac1(11)
638 ENDIF
639 IF(ispmd == 0) WRITE(iout,1151)dtfac1(51),dtmin1(51),idtmin(51)
640 ENDIF
641C
642 IF(ispmd == 0.AND.mcheck == 0) THEN
643 IF(num_opt_dt_fvmbag_0+num_opt_dt_fvmbag_1>0)THEN
644 !if at least on option /DT/FVMBAG/0 or /DT/FVMBAG/1 is defined then output parameter for the retained one (last read one)
645 ! (multiple definition is not expected)
646 IF(num_opt_dt_fvmbag_1>0)THEN
647 WRITE(iout,1156)
648 ELSE
649 WRITE(iout,1155)
650 ENDIF
651 WRITE(iout,1152)dtfac1(52),dtmin1(52),idtmin(52)
652 ENDIF
653 ENDIF
654 IF(ispmd == 0.AND.mcheck == 0) THEN
655 k1 = 1
656 is_already_printed = .false.
657 DO ivolu = 1, nvolu
658 ifv = monvol(k1 - 1 + 45)
659 ifv_type = monvol(k1 - 1 + 2)
660 IF (ifv_type == 6 .OR. ifv_type == 8 .OR. ifv_type == 11) THEN
661 IF(.NOT.is_already_printed)THEN
662 WRITE(iout,1157)
663 is_already_printed=.true.
664 ENDIF
665 ENDIF
666 IF(ifv_type == 6) WRITE(iout,1147)monvol(k1)
667 IF(ifv_type == 8) WRITE(iout,1148)monvol(k1)
668 IF(ifv_type == 11)WRITE(iout,1149)monvol(k1)
669 IF (ifv_type == 6 .OR. ifv_type == 8 .OR. ifv_type == 11) THEN
670 WRITE(iout,1153)fvdata_old(ifv)%CFL_COEF,fvdata_old(ifv)%DTMIN,fvdata_old(ifv)%ID_DT_OPTION
671 IF(fvdata_old(ifv)%ID_DT_OPTION ==2)THEN
672 WRITE(iout,1154)fvdata_old(ifv)%L_TYPE,fvdata_old(ifv)%LAMBDA,fvdata_old(ifv)%DTOLD
673 ENDIF
674 ENDIF
675 k1=k1+nimv
676 ENDDO
677 ENDIF
678C
679 IF(ispmd == 0.AND.mcheck == 0.AND.idt1sol /= 0) WRITE(iout,'(A)')' OPTIMIZED TIME STEP COMPUTATION FOR HEPH.'
680 IF(ispmd == 0.AND.mcheck == 0.AND.idttsh /= 0) WRITE(iout,'(A)')' OPTIMIZED (SHELL) TIME STEP FOR THICK SHELLS.'
681 IF(ispmd == 0.AND.mcheck == 0)WRITE(iout,1110)ncpri,ncrst,multirest,invers,itfor0
682 IF(ispmd == 0.AND.restart_file == 0) WRITE(iout,*) check_message(2)(1:len_trim(check_message(2)) )
683 IF (impl_s == 1.AND.ikg>=5) THEN
684 ikg=ikg-5
685 IF(ispmd == 0) THEN
686 WRITE(iout,*) ' ** WARNING ** : PARITH/ON IS NOT ','COMPATIBLE WITH IMPLICIT OPTION '
687 WRITE(iout,*) ' ** RESETTING ** : PARITH/OFF '
688 ENDIF
689 ENDIF
690C---------------------
691C FE THERMAL ANALYSIS
692C---------------------
693 IF(ispmd == 0 .AND. imassi > 0 ) THEN
694 WRITE(iout,'(A)')' RESET INITIAL MASS FOR THIS RUN '
695 ENDIF
696C---------------------
697C INITIAL MASS
698C---------------------
699 IF (ispmd == 0 .AND. glob_therm%ITHERM_FE > 0 ) THEN
700 WRITE(iout,'(A)')' FINITE ELEMENT THERMAL ANALYSIS '
701 IF (glob_therm%IDT_THERM == 1) THEN
702 WRITE(iout,'(A)')' THERMAL ANALYSIS ONLY'
703 WRITE(iout,'(A,1X,G14.7)')' THERMAL TIME STEP SCALE FACTOR . . . . . . . . .', glob_therm%DTFACTHERM
704 ENDIF
705 IF (glob_therm%THEACCFACT > one ) THEN
706 WRITE(iout,'(A,1X,G14.7/)')' FACTOR TO SPEED-UP THERMAL ANALYSIS. . . . . . .', glob_therm%THEACCFACT
707 ENDIF
708 ENDIF
709C
710C-----------------------
711C The correct indexes in ANIM data structures wrt integration points or layers
712C of all actual elements will be rebuilt ::
713C-----------------------
714 CALL anim_build_index_all(ispmd ,mcheck ,sensors ,igeo ,geo )
715C-------------------------------------------
716C STOP/SENSOR
717C-------------------------------------------
718 IF (mcheck == 0) THEN
719 ALLOCATE(sensors%STOP(sensors%NSTOP))
720 sensors%STOP(:) = 0
721 END IF
722 IF (mcheck == 0) THEN
723 IF (sensors%NSTOP > 0) THEN
724 DO k=1,sensors%NSTOP
725 ierr = 1
726 IF (sensors%STOP_TMP(k) > 0) THEN
727 DO i=1,sensors%NSENSOR
728 IF (sensor_tab(i)%SENS_ID == sensors%STOP_TMP(k)) THEN
729 sensors%STOP(k) = i
730 ierr = 0
731 EXIT
732 ENDIF
733 ENDDO
734 ENDIF
735 IF (ierr == 1) THEN
736 CALL ancmsg(msgid=233, anmode=aninfo,i1=sensors%STOP_TMP(k))
737 ENDIF
738 ENDDO
739 ENDIF
740 END IF !(ISPMD==0.AND.MCHECK==0)
741C-------------------------------------------
742C STATE/SENSOR
743C-------------------------------------------
744 IF (mcheck == 0) THEN
745 ALLOCATE(sensors%STAT(sensors%NSTAT))
746 sensors%STAT(:) = 0
747 END IF
748 IF (ispmd == 0 .AND. mcheck == 0) THEN
749 mstatt = 0
750 IF (sensors%NSTAT > 0) THEN
751 DO k=1,sensors%NSTAT
752 ierr = 1
753 IF(sensors%STAT(k) /= 0) THEN
754 DO i=1,sensors%NSENSOR
755 IF (sensors%SENSOR_TAB(i)%SENS_ID == sensors%STAT(k)) THEN
756 sensors%STAT(k) = i
757 ierr = 0
758 EXIT
759 ENDIF
760 ENDDO
761 ENDIF
762 IF (ierr == 1) THEN
763 CALL ancmsg(msgid=235, anmode=aninfo,i1=sensors%STAT(k))
764 ELSE
765 mstat(k) = 0
766 ENDIF
767 ENDDO
768 ENDIF
769 END IF !(ISPMD==0.AND.MCHECK==0)
770C-------------------------------------------
771C OUTP/SENSOR
772C-------------------------------------------
773 IF (mcheck == 0) THEN
774 ALLOCATE(sensors%OUTP(sensors%NOUTP))
775 sensors%OUTP(:) = 0
776 END IF
777 IF (ispmd == 0 .AND. mcheck == 0) THEN
778 IF (sensors%NOUTP > 0) THEN
779 DO k=1,sensors%NOUTP
780 ierr = 1
781 IF (sensors%OUTP_TMP(k) > 0) THEN
782 DO i=1,sensors%NSENSOR
783 IF (sensors%SENSOR_TAB(i)%SENS_ID == sensors%OUTP_TMP(k)) THEN
784 sensors%OUTP(k) = i
785 ierr = 0
786 EXIT
787 ENDIF
788 ENDDO
789 ENDIF
790 IF (ierr == 1) THEN
791 CALL ancmsg(msgid=236, anmode=aninfo,i1 = sensors%OUTP_TMP(k))
792 ENDIF
793 ENDDO
794 ENDIF
795 END IF !(ISPMD==0.AND.MCHECK==0)
796
797C-------------------------------------------
798C STATE/SENSOR
799C-------------------------------------------
800 IF(ispmd == 0.AND.mcheck == 0) THEN
801 WRITE(iout,1150)dtin,dtmx
802 IF(impl /= 0)
803 . WRITE(iout,1160)eps,eps2,nitmx
804 istatg_p = iabs(istatg)
805 IF(istat == 1)THEN
806 WRITE(iout,1171)istatg_p,beta,period
807 ELSEIF(istat == 2)THEN
808 IF (tst_start>zero.OR.tst_stop>zero) THEN
809 IF (tst_stop==zero) tst_stop = tstop
810 WRITE(iout,5001)istatg_p,tst_start,tst_stop
811 ELSE
812 WRITE(iout,1172)istatg_p
813 END IF
814 ELSEIF(istat == 3)THEN
815 IF (tst_start>zero.OR.tst_stop>zero) THEN
816 IF (tst_stop==zero) tst_stop = tstop
817 WRITE(iout,5011)istatg_p,tst_start,tst_stop
818 ELSE
819 WRITE(iout,5010)istatg_p
820 END IF
821 ENDIF
822C-----------------------
823 IF(iparit == 0)THEN
824 WRITE(iout,1180)
825 ELSEIF(iparit == 1)THEN
826 WRITE(iout,1181)
827 ELSE
828 WRITE(iout,1182)iparit-1
829 ENDIF
830C-----------------------
831 WRITE(iout,1300) nsliof,npartof,nelsof,nelqof,nelcof,neltof,nelpof,nelrof,neltgof,nsphof
832 WRITE(iout,1400) nrlink
833 WRITE(iout,1500) nubcsn
834 IF(iale /= 0.OR.ieuler /= 0)WRITE(iout,1450) nalelink+nalelk !format v12 + format v5
835c
836 ELSEIF(ispmd == 0 .AND. mcheck /= 0) THEN
837 ENDIF !(ISPMD==0.AND.MCHECK==0)
838C-----------------------------------
839C ALE/EULER : UPWIND
840C----------------------------------------
841 ! ALE%UPWIND%UPW_UPDATE == 1 : ENGINE /UPWIND CARD DETECTED
842 !ALE%UPWIND%UPW_UPDATE == 2 : /UPWIND CARD IS CHANGING AT LEAST ONE PARAMETER
843 !if /UPWIND is defined then set new parameters
844 IF(ispmd == 0 .AND. mcheck == 0)THEN
845 IF(iale /= 0 .OR. ieuler /= 0)THEN
846 IF(ale%UPWIND%UPW_UPDATE /= 0 )THEN
847 DO k=1,nummat-1
848 !ILAW=PM(19,K)
849 jale=int(pm(72,k)) ! JALE from PROP (IGEO(62,IPID)) is not checked since this option /UPWIND is obsolete
850 IF(jale /= 0)THEN
851 IF(pm(15,k) /= ale%UPWIND%UPWMG2 .OR. pm(16,k) /= ale%UPWIND%UPWOG2)THEN
852 ale%UPWIND%UPW_UPDATE = 2
853 pm(15,k) = ale%UPWIND%UPWMG2
854 pm(16,k) = ale%UPWIND%UPWOG2
855 ENDIF
856 ENDIF
857 ENDDO
858 IF(ale%UPWIND%UPWSM /= ale%UPWIND%UPWSM2)THEN
859 ale%UPWIND%UPW_UPDATE = 2
860 ale%UPWIND%UPWSM = ale%UPWIND%UPWSM2
861 ENDIF
862 !if /upwind is not defined then catch parameter from previous run
863 ELSEIF(ale%UPWIND%UPW_UPDATE == 0)THEN
864 ale%UPWIND%UPWMG2=one
865 ale%UPWIND%UPWOG2=one
866 ale%UPWIND%UPWSM2=one
867 DO k=1,nummat-1
868 !ILAW=PM(19,K)
869 jale=int(pm(72,k))
870 IF(jale /= 0)THEN
871 IF(pm(15,k) /= ale%UPWIND%UPWMG2 .OR. pm(16,k) /= ale%UPWIND%UPWOG2 .OR. ale%UPWIND%UPWSM /= ale%UPWIND%UPWSM2)THEN
872 IF(pm(15,k) /= zero)ale%UPWIND%UPWMG2 = pm(15,k)
873 IF(pm(16,k) /= zero)ale%UPWIND%UPWOG2 = pm(16,k)
874 IF(ale%UPWIND%UPWSM /= zero)ale%UPWIND%UPWSM2 = ale%UPWIND%UPWSM
875 EXIT
876 ENDIF
877 ENDIF
878 ENDDO
879 ENDIF
880 ENDIF
881 ENDIF
882C-----------------------------------
883C ALE/EULER : OUTPUT
884C----------------------------------------
885 IF(iale /= 0 .OR. ieuler /= 0)THEN
886 !-----------------------
887 ! QUASI-INCOMPRESSIBLE /INCMP
888 !-----------------------
889 IF(ale%GLOBAL%INCOMP == 1.AND.mcheck == 0) WRITE(iout,1196)
890 !-----------------------
891 ! GRID FORMULATION
892 !-----------------------
893 !---ALE GRID FORMULATION CHECK---!
894 IF(ale%GRID%NWALE_ENGINE /= ale%GRID%NWALE_RST .AND. ale%GRID%NWALE_ENGINE /= -1) THEN !Forbid ALE grid formulation switch
895 IF(ale%GRID%NWALE_ENGINE /= 3)THEN !expect if new one is /ALE/ZERO
896 aleform=(/'DONEA ','DISP ','SPRING ', 'ZERO ',
897 . 'STANDARD ','LAPLACIAN ','VOLUME ', 'FLOW-TRACKING ',
898 . 'LAGRANGE ' /)
899 alestrl=(/5,4,6,4,8,9,6,13,8/)
900 cale1=aleform(ale%GRID%NWALE_ENGINE)
901 cale2=aleform(ale%GRID%NWALE_RST)
902 CALL ancmsg(msgid=229,anmode=aninfo,
903 . c1=cale1(1:alestrl(ale%GRID%NWALE_ENGINE)),c2=cale2(1:alestrl(ale%GRID%NWALE_RST)))
904 CALL arret(2)
905 ELSE
906 ale%GRID%NWALE_ENGINE = 3
907 END IF
908 END IF
909
910 !--Labels for Staggered Scheme
911 IF(ale%UPWIND%UPWM == 2)THEN
912 label1='TG '
913 ELSEIF(ale%UPWIND%UPWM == 3)THEN
914 label1='SUPG '
915 ELSE
916 label1='UPWIND '
917 ENDIF
918 label2='UPWIND '
919 label3='UPWIND '
920 IF(alemuscl_param%IALEMUSCL == 0)THEN
921 label4='UPWIND '
922 ELSE
923 label4='MUSCL '
924 ENDIF
925 !--Labels for Colocated Scheme
926 IF(alemuscl_param%IALEMUSCL == 0)THEN
927 label5='1ST-ORDER'
928 label6='1ST-ORDER'
929 label7='1ST-ORDER'
930 label8='1ST-ORDER'
931 ELSEIF(alemuscl_param%IALEMUSCL == 1)THEN
932 label5='2ND-ORDER'
933 label6='2ND-ORDER'
934 label7='2ND-ORDER'
935 label8='2ND-ORDER'
936 ELSEIF(alemuscl_param%IALEMUSCL == 2)THEN
937 label5='1ST-ORDER'
938 label6='1ST-ORDER'
939 label7='1ST-ORDER'
940 label8='2ND-ORDER'
941 ENDIF
942 multi_fvm%LOWMACH_OPT = .false.
943 IF (ale%GLOBAL%HLLC_LOWMACH == 1 .AND. multi_fvm%IS_USED) THEN
944 multi_fvm%LOWMACH_OPT = .true.
945 ENDIF
946 aleform=(/'DONEA ','DISP ','SPRING ', 'ZERO ',
947 . 'STANDARD ','LAPLACIAN ','VOLUME ', 'FLOW-TRACKING ',
948 . 'LAGRANGE '/)
949 !effective value which will be retained during numerical solving
950 IF(ale%GRID%NWALE_ENGINE /= -1)THEN
951 ale%GRID%NWALE = ale%GRID%NWALE_ENGINE
952 ELSE
953 ale%GRID%NWALE = ale%GRID%NWALE_RST
954 ENDIF
955 label9(:)=' '
956 label9(1:16)=aleform(ale%GRID%NWALE)
957 eta1=ale%UPWIND%UPWMG2
958 eta2=ale%UPWIND%UPWOG2
959 IF(ale%UPWIND%UPWM>1)eta1=ale%UPWIND%CUPWM
960 !OUTPUT NUMERICAL SCHEME AND ITS PARAMETERS
961 IF(ispmd == 0 .AND. mcheck == 0)THEN
962 WRITE(iout,1001)
963 WRITE(iout,1002)label1,eta1,label2,eta2,label3,eta2,label4
964 IF(multi_fvm%IS_USED)THEN
965 WRITE(iout,1003)label5,label6,label7,label8
966 IF(multi_fvm%LOWMACH_OPT)WRITE(iout,1004)
967 IF(alemuscl_param%IALEMUSCL/=0)WRITE(iout,1005)alemuscl_param%BETA
968 ENDIF
969 !OUTPUT COURANT NUMBER
970 WRITE(iout,1006) dtfac1(102),dtmin1(102)
971 !OUTPUT GRID SMOOTHING FORMULATION AND ITS PARAMETERS
972 WRITE(iout,1007)label9(1:len_trim(label9))
973 SELECT CASE (ale%GRID%NWALE)
974 CASE(0) !DONEA
975 WRITE(iout,1008)
976 WRITE(iout,1200) ale%GRID%ALPHA,ale%GRID%GAMMA,ale%GRID%VGX,ale%GRID%VGY,ale%GRID%VGZ,volmin
977 CASE(1) !DISP
978 WRITE(iout,1008)
979 WRITE(iout,1220) ale%GRID%ALPHA,volmin
980 CASE(2) !SPRING
981 WRITE(iout,1008)
982 WRITE(iout,1250) dt_input,ale%GRID%ALPHA,ale%GRID%GAMMA,ale%GRID%VGX,ale%GRID%VGY,volmin
983 CASE(3) !ZERO
984 !no parameters
985 CASE(4) !STANDARD
986 WRITE(iout,1008)
987 WRITE(iout,1254) ale%GRID%ALPHA,ale%GRID%GAMMA,ale%GRID%VGX,ale%GRID%VGY
988 CASE(5)! laplacian
989 WRITE(iout,1008)
990 WRITE(iout,1254) ale%GRID%ALPHA,ale%GRID%GAMMA,ale%GRID%VGX,ale%GRID%VGY
991 CASE(6) !VOLUME
992 !no parameters
993 CASE(7) !FLOW-TRACKING
994 WRITE(iout,1008)
995 label_def=' NO'
996 label_rot=' NO'
997 IF(int(ale%GRID%VGX) == 1)label_def='YES'
998 IF(int(ale%GRID%VGY) == 1)label_rot='YES'
999 WRITE(iout,1257) label_def,label_rot,ale%GRID%ALPHA,ale%GRID%GAMMA
1000 CASE(8) !LAGRANGE
1001 !no parameters
1002 END SELECT
1003 ENDIF
1004 ENDIF !(IALE/=0.OR.IEULER/=0)
1005 !---CHECK END-------------------!
1006!-----------------------
1007! FEM MOMENTUM INTEGRATION
1008!-----------------------
1009 IF(ispmd == 0.AND.mcheck == 0)THEN
1010 IF(iale+ieuler /= 0 .AND. ale%GLOBAL%ISFINT /= 3)THEN
1011 SELECT CASE(ale%GLOBAL%ISFINT)
1012 !CASE(3)
1013 ! WRITE(IOUT,1197) !default
1014 CASE(2)
1015 WRITE(iout,1198)
1016 CASE(1)
1017 WRITE(iout,1199)
1018 END SELECT
1019 ENDIF
1020 ENDIF
1021
1022C-------------------------------
1023C ELIMINATION PARTIE ALE EULER THERMIQUE
1024C-------------------------------
1025 IF(iale /= 0.AND.naleof == 1)THEN
1026 IF(ispmd == 0.AND.mcheck == 0)THEN
1027 WRITE(iout,*)'ALE FORMULATION SWITCHED OFF '
1028 END IF
1029 iale = 0
1030 END IF
1031 IF(ieuler /= 0.AND.neulerof == 1)THEN
1032 IF(ispmd == 0.AND.mcheck == 0)THEN
1033 WRITE(iout,*)'EULER FORMULATION SWITCHED OFF '
1034 END IF
1035 ieuler = 0
1036 END IF
1037 IF (glob_therm%ITHERM /= 0.AND.nthermof == 1)THEN
1038 IF(ispmd == 0.AND.mcheck == 0)THEN
1039 WRITE(iout,*)'THERMIC FORMULATION SWITCHED OFF '
1040 END IF
1041 glob_therm%ITHERM = 0
1042 END IF
1043C-------------------------------
1044 IF(idel7 /= 0.AND.mcheck == 0.AND.n2d == 0)THEN
1045 ideli7 = idel7 - 1
1046 IF(ispmd == 0)THEN
1047 WRITE(iout,1550) ideli7
1048 CALL ancmsg(msgid=122,anmode=aninfo_blind)
1049 CALL arret(2)
1050 ENDIF
1051 ELSEIF(n2d /= 0.AND.mcheck == 0)THEN
1052 IF(ispmd == 0)WRITE(iout,1550) idel7-1
1053 END IF
1054C-------------------------------
1055C INTERFACE CLEANING
1056C-------------------------------
1057 IF(nsliof /= 0) THEN
1058C
1059 nn=(nsliof+9)/10
1060 DO il=1,nn
1061 READ (iin,'(10I10)') (nlec(i),i=1,10)
1062 DO i=1,10
1063 IF(nlec(i) == 0)cycle
1064 IF(ispmd == 0.AND.mcheck == 0)WRITE(iout,2000) nlec(i)
1065 DO k=1,ninter
1066 IF(ipari(15,k) == nlec(i))THEN
1067 IF(ipari(7,k)==2)THEN
1068 idel2= ipari(17,k)
1069 IF(idel2 /= 0)THEN
1070C SMASS & SINER have been saved only if IDEL2 /= 0
1071 nsn = ipari(5,k)
1072 DO n=1,nsn
1073 is =intbuf_tab(k)%NSV(n)
1074 IF(is > 0)THEN
1075 ms(is)=intbuf_tab(k)%SMAS(n)
1076 in(is)=intbuf_tab(k)%SINER(n)
1077 intbuf_tab(k)%NSV(n)=-is
1078 END IF
1079 END DO
1080 END IF
1081 END IF
1082C----- change T_stop for int25 otherwise issue w/ int25
1083 IF(ipari(7,k)==25)THEN
1084 intbuf_tab(k)%VARIABLES(11) = zero
1085 ELSE
1086 ipari(7,k)=0
1087 ENDIF
1088 END IF
1089 ENDDO
1090 ENDDO !next I
1091 ENDDO
1092 ENDIF
1093C-----------------------------------
1094C CLEANING INTERFACE NODES
1095C----------------------------------------
1096 IF(nsliofn /= 0) THEN
1097 READ (iin,'(2I8)') i,nn
1098 kk=0
1099 DO k=1,ninter
1100 IF(ipari(15,k) == i)kk=k
1101 ENDDO
1102 IF(kk == 0)THEN
1103 IF(ispmd == 0) THEN
1104 CALL ancmsg(msgid=123,anmode=aninfo_blind)
1105 ENDIF
1106 CALL arret(2)
1107 ENDIF
1108 nrts =ipari(3,kk)
1109 nrtm =ipari(3,kk)
1110 nsn =ipari(5,kk)
1111 nmn =ipari(6,kk)
1112 nty =ipari(7,kk)
1113 IF (ipari(71,kk)/=0) nty = 19 ! Interface type 19
1114 IF(nty == 3)THEN
1115 nsn =nsn + nmn
1116 ELSEIF(nty == 4 .OR. nty == 5)THEN
1117 ELSEIF(nty == 7 .OR. nty == 10 .OR. nty == 22)THEN
1118 ELSE
1119 IF(ispmd == 0) THEN
1120 CALL ancmsg(msgid=124,anmode=aninfo_blind)
1121 ENDIF
1122 CALL arret(2)
1123 ENDIF
1124 DO il=1,nn
1125 READ (iin,'(10I10)') (nlec(i),i=1,10)
1126 DO i=1,10
1127 IF(nlec(i) /= 0)THEN
1128 DO k=1,nsn
1129 IF(itab(intbuf_tab(kk)%NSV(k)) == nlec(i))THEN !NSV(K)
1130 intbuf_tab(kk)%STFNS(k)=zero !STFNS(K)
1131 ENDIF
1132 ENDDO
1133 ENDIF
1134 ENDDO
1135 ENDDO
1136 ENDIF
1137C----------------------------------------------
1138C CLEANING ELEMS
1139C----------------------------------------------
1140 nelof=nelsof+nelqof+nelcof+neltof+nelpof+nelrof+neltgof+nsphof
1141C-----------------------
1142C 1. 3D ELEMS
1143C-----------------------
1144 IF(nelsof > 0)THEN
1145 IF(ispmd == 0.AND.mcheck == 0)WRITE (iout,1810)
1146 nn=(nelsof+4)/5
1147 nbc=5
1148 DO il=1,nn
1149 READ (iin,'(10I10)') (nlec(ii),ii=1,10)
1150 DO j=1,nbc
1151 klg=nlec(2*j-1)
1152 kug=nlec(2*j )
1153 IF(klg<=0) GO TO 120
1154 nblk=(il-1)*nbc+j
1155 DO l=1,numels
1156 IF(ixs(nixs,l)>=klg.AND.ixs(nixs,l)<=kug) THEN
1157 DO k=klg,kug
1158 IF(ixs(nixs,l) == k) THEN
1159 ixs(1,l)=-iabs(ixs(1,l))
1160 GOTO 111
1161 ENDIF
1162 ENDDO
1163 ENDIF
1164111 CONTINUE
1165 ENDDO
1166 ENDDO
1167 ENDDO
1168 120 CONTINUE
1169 k=0
1170 DO j=1,numels
1171 IF(ixs(1,j) < 0)THEN
1172 k=k+1
1173 nlec(k) = ixs(nixs,j)
1174 IF(k == 10)THEN
1175 IF(mcheck == 0)WRITE (iout,'(5I10)') (nlec(ii),ii=1,k)
1176 k=0
1177 ENDIF
1178 ENDIF
1179 ENDDO
1180 IF(k > 0) THEN
1181 IF(mcheck == 0)WRITE (iout,'(5I10)') (nlec(ii),ii=1,k)
1182 ENDIF
1183 IF(nspmd > 1) THEN
1184 ! required treatments to retrieve deleted elems in correct order
1185 iwiout = 0
1186 IF (ispmd /= 0) CALL spmd_chkw(iwiout,iout)
1187 CALL spmd_glob_isum9(iwiout,1)
1188 CALL spmd_ibcast(iwiout,iwiout,1,1,0,2)
1189 IF (iwiout > 0) THEN
1190 CALL spmd_wiout(iout,iwiout)
1191 iwiout = 0
1192 ENDIF
1193 ENDIF
1194 endif!(NELSOF > 0)
1195C-----------------------
1196C 2. 2D-ELEMS
1197C-----------------------
1198 IF(nelqof > 0)THEN
1199 IF(ispmd == 0.AND.mcheck == 0)WRITE (iout,1820)
1200 IF (invers < 18) THEN
1201 nn=(nelqof+7)/8
1202 nbc=8
1203 ELSE
1204 nn=(nelqof+4)/5
1205 nbc=5
1206 ENDIF
1207 DO i=1,nn
1208 READ (iin,'(10I10)') (nlec(ii),ii=1,10)
1209 DO j=1,nbc
1210 klg=nlec(2*j-1)
1211 kug=nlec(2*j )
1212 IF(klg<=0) GO TO 220
1213 nblk=(i-1)*nbc+j
1214 DO l=1,numelq
1215 IF(ixq(nixq,l)>=klg.AND.ixq(nixq,l)<=kug) THEN
1216 DO k=klg,kug
1217 IF(ixq(nixq,l) == k) THEN
1218 ixq(1,l)=-iabs(ixq(1,l))
1219 GOTO 211
1220 ENDIF
1221 ENDDO
1222 ENDIF
1223 211 CONTINUE
1224 ENDDO
1225 ENDDO
1226 ENDDO
1227 220 CONTINUE
1228 k=0
1229 DO j=1,numelq
1230 IF(ixq(1,j) < 0)THEN
1231 k=k+1
1232 nlec(k) = ixq(nixq,j)
1233 IF(k == 10)THEN
1234 IF(mcheck == 0)WRITE (iout,'(5I10)') (nlec(ii),ii=1,k)
1235 k=0
1236 ENDIF
1237 ENDIF
1238 ENDDO
1239 IF(k > 0) THEN
1240 IF(mcheck == 0)WRITE (iout,'(5I10)') (nlec(ii),ii=1,k)
1241 ENDIF
1242 IF(nspmd > 1) THEN
1243 ! required treatments to retrieve deleted elems in correct order
1244 iwiout = 0
1245 IF (ispmd /= 0) CALL spmd_chkw(iwiout,iout)
1246 CALL spmd_glob_isum9(iwiout,1)
1247 CALL spmd_ibcast(iwiout,iwiout,1,1,0,2)
1248 IF (iwiout > 0) THEN
1249 CALL spmd_wiout(iout,iwiout)
1250 iwiout = 0
1251 ENDIF
1252 ENDIF
1253 END IF
1254C-----------------------
1255C 3. SHELL ELEMS
1256C-----------------------
1257 IF(nelcof > 0)THEN
1258 IF(ispmd == 0.AND.mcheck == 0)WRITE (iout,1830)
1259 nn=(nelcof+4)/5
1260 nbc=5
1261 DO i=1,nn
1262 READ (iin,'(10I10)') (nlec(ii),ii=1,10)
1263 DO j=1,nbc
1264 klg=nlec(2*j-1)
1265 kug=nlec(2*j )
1266 IF(klg<=0) GO TO 320
1267 nblk=(i-1)*nbc+j
1268 DO l=1,numelc
1269 IF(ixc(nixc,l)>=klg.AND.ixc(nixc,l)<=kug) THEN
1270 DO k=klg,kug
1271 IF(ixc(nixc,l) == k) THEN
1272 ixc(1,l)=-iabs(ixc(1,l))
1273 GOTO 311
1274 ENDIF
1275 ENDDO
1276 ENDIF
1277 311 CONTINUE
1278 ENDDO
1279 ENDDO
1280 ENDDO
1281 320 CONTINUE
1282 k=0
1283 DO j=1,numelc
1284 IF(ixc(1,j) < 0)THEN
1285 k=k+1
1286 nlec(k) = ixc(nixc,j)
1287 IF(k == 10)THEN
1288 IF(mcheck == 0)WRITE (iout,'(5I10)') (nlec(ii),ii=1,k)
1289 k=0
1290 ENDIF
1291 ENDIF
1292 ENDDO
1293 IF(k > 0) THEN
1294 IF(mcheck == 0)WRITE (iout,'(5I10)') (nlec(ii),ii=1,k)
1295 ENDIF
1296 IF(nspmd > 1) THEN
1297 ! required treatments to retrieve deleted elems in correct order
1298 iwiout = 0
1299 IF (ispmd /= 0) CALL spmd_chkw(iwiout,iout)
1300 CALL spmd_glob_isum9(iwiout,1)
1301 CALL spmd_ibcast(iwiout,iwiout,1,1,0,2)
1302 IF (iwiout > 0) THEN
1303 CALL spmd_wiout(iout,iwiout)
1304 iwiout = 0
1305 ENDIF
1306 ENDIF
1307 END IF
1308C-----------------------
1309C 4. ROD ELEMS
1310C-----------------------
1311 IF(neltof > 0)THEN
1312 IF(ispmd == 0.AND.mcheck == 0)WRITE (iout,1840)
1313 nn=(neltof+4)/5
1314 nbc=5
1315 DO i=1,nn
1316 READ (iin,'(10I10)') (nlec(ii),ii=1,10)
1317 DO j=1,nbc
1318 klg=nlec(2*j-1)
1319 kug=nlec(2*j )
1320 IF(klg<=0) GO TO 420
1321 nblk=(i-1)*nbc+j
1322 DO l=1,numelt
1323 IF(ixt(nixt,l)>=klg.AND.ixt(nixt,l)<=kug) THEN
1324 DO k=klg,kug
1325 IF(ixt(nixt,l) == k) THEN
1326 ixt(1,l)=-iabs(ixt(1,l))
1327 GOTO 411
1328 ENDIF
1329 ENDDO
1330 ENDIF
1331 411 CONTINUE
1332 ENDDO
1333 ENDDO
1334 ENDDO
1335 420 CONTINUE
1336 k=0
1337 DO j=1,numelt
1338 IF(ixt(1,j) < 0)THEN
1339 k=k+1
1340 nlec(k) = ixt(nixt,j)
1341 IF(k == 10)THEN
1342 IF(mcheck == 0)WRITE (iout,'(5I10)') (nlec(ii),ii=1,k)
1343 k=0
1344 ENDIF
1345 ENDIF
1346 ENDDO
1347 IF(k > 0) THEN
1348 IF(mcheck == 0) WRITE (iout,'(5I10)') (nlec(ii),ii=1,k)
1349 ENDIF
1350 IF(nspmd > 1) THEN
1351 ! required treatments to retrieve deleted elems in correct order
1352 iwiout = 0
1353 IF (ispmd /= 0) CALL spmd_chkw(iwiout,iout)
1354 CALL spmd_glob_isum9(iwiout,1)
1355 CALL spmd_ibcast(iwiout,iwiout,1,1,0,2)
1356 IF (iwiout > 0) THEN
1357 CALL spmd_wiout(iout,iwiout)
1358 iwiout = 0
1359 ENDIF
1360 ENDIF
1361 END IF
1362C-----------------------
1363C 5. BEAM ELEMS
1364C-----------------------
1365 IF(nelpof > 0)THEN
1366 IF(ispmd == 0.AND.mcheck == 0)WRITE (iout,1850)
1367 nn=(nelpof+4)/5
1368 nbc=5
1369 DO i=1,nn
1370 READ (iin,'(10I10)') (nlec(ii),ii=1,10)
1371 DO j=1,nbc
1372 klg=nlec(2*j-1)
1373 kug=nlec(2*j )
1374 IF(klg<=0) GO TO 520
1375 nblk=(i-1)*nbc+j
1376 DO l=1,numelp
1377 IF(ixp(nixp,l)>=klg.AND.ixp(nixp,l)<=kug) THEN
1378 DO k=klg,kug
1379 IF(ixp(nixp,l) == k) THEN
1380 ixp(1,l)=-iabs(ixp(1,l))
1381 GOTO 511
1382 ENDIF
1383 ENDDO
1384 ENDIF
1385 511 CONTINUE
1386 ENDDO
1387 ENDDO
1388 ENDDO
1389 520 CONTINUE
1390 k=0
1391 DO j=1,numelp
1392 IF(ixp(1,j) < 0)THEN
1393 k=k+1
1394 nlec(k) = ixp(nixp,j)
1395 IF(k == 10)THEN
1396 IF(mcheck == 0)WRITE (iout,'(5I10)') (nlec(ii),ii=1,k)
1397 k=0
1398 ENDIF
1399 ENDIF
1400 ENDDO
1401 IF(k > 0) THEN
1402 IF(mcheck == 0)WRITE (iout,'(5I10)') (nlec(ii),ii=1,k)
1403 ENDIF
1404 IF(nspmd > 1) THEN
1405 ! required treatments to retrieve deleted elems in correct order
1406 iwiout = 0
1407 IF (ispmd /= 0) CALL spmd_chkw(iwiout,iout)
1408 CALL spmd_glob_isum9(iwiout,1)
1409 CALL spmd_ibcast(iwiout,iwiout,1,1,0,2)
1410 IF (iwiout > 0) THEN
1411 CALL spmd_wiout(iout,iwiout)
1412 iwiout = 0
1413 ENDIF
1414 ENDIF
1415 END IF
1416C-----------------------
1417C 6. SPRING ELEMS
1418C-----------------------
1419 IF(nelrof > 0)THEN
1420 IF(ispmd == 0.AND.mcheck == 0)WRITE (iout,1860)
1421 nn=(nelrof+4)/5
1422 nbc=5
1423 DO i=1,nn
1424 READ (iin,'(10I10)') (nlec(ii),ii=1,10)
1425 DO j=1,nbc
1426 klg=nlec(2*j-1)
1427 kug=nlec(2*j )
1428 IF(klg<=0) GO TO 620
1429 nblk=(i-1)*nbc+j
1430 DO l=1,numelr
1431 IF(ixr(nixr,l)>=klg.AND.ixr(nixr,l)<=kug) THEN
1432 DO k=klg,kug
1433 IF(ixr(nixr,l) == k) THEN
1434 ixr(1,l)=-iabs(ixr(1,l))
1435 GOTO 611
1436 ENDIF
1437 ENDDO
1438 ENDIF
1439 611 CONTINUE
1440 ENDDO
1441 ENDDO
1442 ENDDO
1443 620 CONTINUE
1444 k=0
1445 DO j=1,numelr
1446 IF(ixr(1,j) < 0)THEN
1447 k=k+1
1448 nlec(k) = ixr(nixr,j)
1449 IF(k == 10)THEN
1450 IF(mcheck == 0)WRITE (iout,'(5I10)') (nlec(ii),ii=1,k)
1451 k=0
1452 ENDIF
1453 ENDIF
1454 ENDDO
1455 IF(k > 0) THEN
1456 IF(mcheck == 0) WRITE (iout,'(5I10)') (nlec(ii),ii=1,k)
1457 ENDIF
1458 IF(nspmd > 1) THEN
1459 ! required treatments to retrieve deleted elems in correct order
1460 iwiout = 0
1461 IF (ispmd /= 0) CALL spmd_chkw(iwiout,iout)
1462 CALL spmd_glob_isum9(iwiout,1)
1463 CALL spmd_ibcast(iwiout,iwiout,1,1,0,2)
1464 IF (iwiout > 0) THEN
1465 CALL spmd_wiout(iout,iwiout)
1466 iwiout = 0
1467 ENDIF
1468 ENDIF
1469 ENDIF
1470C-----------------------
1471C 7. 3N-SHELL-ELEMS
1472C-----------------------
1473 IF(neltgof > 0)THEN
1474 IF(ispmd == 0.AND.mcheck == 0)WRITE (iout,1870)
1475 nn=(neltgof+4)/5
1476 nbc=5
1477 DO i=1,nn
1478 READ (iin,'(10I10)') (nlec(ii),ii=1,10)
1479 DO j=1,nbc
1480 klg=nlec(2*j-1)
1481 kug=nlec(2*j )
1482 IF(klg<=0) GO TO 640
1483 nblk=(i-1)*nbc+j
1484 DO l=1,numeltg
1485 IF(ixtg(nixtg,l)>=klg.AND.ixtg(nixtg,l)<=kug) THEN
1486 DO k=klg,kug
1487 IF(ixtg(nixtg,l) == k) THEN
1488 ixtg(1,l)=-iabs(ixtg(1,l))
1489 GOTO 631
1490 ENDIF
1491 ENDDO
1492 ENDIF
1493 631 CONTINUE
1494 ENDDO
1495 ENDDO
1496 ENDDO
1497 640 CONTINUE
1498 k=0
1499 DO j=1,numeltg
1500 IF(ixtg(1,j) < 0)THEN
1501 k=k+1
1502 nlec(k) = ixtg(nixtg,j)
1503 IF(k == 10)THEN
1504 IF(mcheck == 0)WRITE (iout,'(5I10)') (nlec(ii),ii=1,k)
1505 k=0
1506 ENDIF
1507 ENDIF
1508 ENDDO
1509 IF(k > 0) THEN
1510 IF(mcheck == 0) WRITE (iout,'(5I10)') (nlec(ii),ii=1,k)
1511 ENDIF
1512 IF(nspmd > 1) THEN
1513 ! required treatments to retrieve deleted elems in correct order
1514 iwiout = 0
1515 IF (ispmd /= 0) CALL spmd_chkw(iwiout,iout)
1516 CALL spmd_glob_isum9(iwiout,1)
1517 CALL spmd_ibcast(iwiout,iwiout,1,1,0,2)
1518 IF (iwiout > 0) THEN
1519 CALL spmd_wiout(iout,iwiout)
1520 iwiout = 0
1521 ENDIF
1522 ENDIF
1523C
1524 END IF
1525C-----------------------
1526C 8. SPH PARTICLES
1527C-----------------------
1528 IF(nsphof > 0)THEN
1529 IF(ispmd == 0.AND.mcheck == 0)WRITE (iout,1880)
1530 nn=(nsphof+4)/5
1531 nbc=5
1532 k=0
1533 DO i=1,nn
1534 READ (iin,'(10i10)') (NLEC(II),II=1,10)
1535 DO J=1,NBC
1536 KLG=NLEC(2*J-1)
1537 KUG=NLEC(2*J )
1538 IF(KLG<=0) GO TO 732
1539 NBLK=(I-1)*NBC+J
1540 DO L=1,NUMSPH
1541.AND. IF(KXSP(NISP,L)>=KLGKXSP(NISP,L)<=KUG) THEN
1542C number of the related group :
1543 NG =MOD(ABS(KXSP(2,L)),NGROUP+1)
1544 IF(NG /= 0)THEN
1545 NFT=IPARG(3,NG)
1546 IAD=IPARG(4,NG)
1547 II=L-NFT
1548! ELBUF_STR(NG)%GBUF%OFF(II) = ZERO
1549 KXSP(2,L) = 0
1550 K=K+1
1551 NLECSPH(K) = KXSP(NISP,L)
1552 IF(K == 10)THEN
1553 IF(MCHECK == 0) WRITE (IOUT,'(5i10)') (NLECSPH(II),II=1,K)
1554 K=0
1555 END IF
1556 END IF
1557 ENDIF
1558 ENDDO
1559 ENDDO
1560 ENDDO
1561 732 CONTINUE
1562 IF(K > 0) THEN
1563 IF(MCHECK == 0)WRITE (IOUT,'(5i10)') (NLECSPH(II),II=1,K)
1564 END IF
1565 IF(NSPMD > 1) THEN
1566 ! required treatments to retrieve deleted elems in correct order
1567 IWIOUT = 0
1568 IF (ISPMD /= 0) CALL SPMD_CHKW(IWIOUT,IOUT)
1569 CALL SPMD_GLOB_ISUM9(IWIOUT,1)
1570 CALL SPMD_IBCAST(IWIOUT,IWIOUT,1,1,0,2)
1571 IF (IWIOUT > 0) THEN
1572 CALL SPMD_WIOUT(IOUT,IWIOUT)
1573 IWIOUT = 0
1574 ENDIF
1575 ENDIF
1576C
1577 END IF
1578!-----------------------
1579! 9. /DEL/PART
1580!-----------------------
1581 IF(NPARTOF > 0)THEN
1582.AND. IF(ISPMD == 0MCHECK == 0)WRITE (IOUT,1890)
1583 NN=(NPARTOF+4)/5
1584 NBC=5
1585 ALLOCATE(IPARTOF(NPART))
1586 IPARTOF = 0
1587 DO I=1,NN
1588 READ (IIN,'(10i10)') (NLEC(II),II=1,10)
1589 DO J=1,NBC
1590 KLG=NLEC(2*J-1)
1591 KUG=NLEC(2*J )
1592 IF(KLG<=0) GO TO 832
1593 NBLK=(I-1)*NBC+J
1594 DO L = 1, NPART
1595 DO K=KLG,KUG
1596 IF(IPART(4 + (L - 1) * LIPART1) == K) THEN
1597 IPARTOF(L)=1
1598 CYCLE
1599 ENDIF
1600 ENDDO
1601 ENDDO
1602 ENDDO
1603 ENDDO
1604 832 CONTINUE
1605 K=0
1606 DO L=1,NPART
1607 IF(IPARTOF(L)== 1)THEN
1608 K=K+1
1609 NLEC(K) = IPART(4 + (L - 1) * LIPART1)
1610 IF(K == 10)THEN
1611 IF(MCHECK == 0)WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1612 K=0
1613 ENDIF
1614 ENDIF
1615 ENDDO
1616 IF(K > 0) THEN
1617 IF(MCHECK == 0) WRITE (IOUT,'(5i10)') (NLEC(II),II=1,K)
1618 ENDIF
1619 IF(NSPMD > 1) THEN
1620 ! required treatments to retrieve deleted elems in correct order
1621 IWIOUT = 0
1622 IF (ISPMD /= 0) CALL SPMD_CHKW(IWIOUT,IOUT)
1623 CALL SPMD_GLOB_ISUM9(IWIOUT,1)
1624 CALL SPMD_IBCAST(IWIOUT,IWIOUT,1,1,0,2)
1625 IF (IWIOUT > 0) THEN
1626 CALL SPMD_WIOUT(IOUT,IWIOUT)
1627 IWIOUT = 0
1628 ENDIF
1629 ENDIF
1630!
1631 END IF
1632
1633
1634C-----------------------
1635C RESET OFF ARRAY
1636C-----------------------
1637 IF (NELOF > 0)THEN
1638 DO NG=1,NGROUP
1639 OFFG => ELBUF_STR(NG)%GBUF%OFF
1640 MLW=IPARG(1,NG)
1641 ITY=IPARG(5,NG)
1642 NEL=IPARG(2,NG)
1643 NFT=IPARG(3,NG)
1644 IAD=IPARG(4,NG)
1645 IGOF=0
1646C-----------------------
1647C 1. SOLID ELEMS
1648C-----------------------
1649.AND. IF(ITY == 1NELSOF /= 0)THEN
1650 IGOF=1
1651 DO I=1,NEL
1652 II=I+NFT
1653 IF(IXS(1,II) < 0)THEN
1654 IXS(1,II)=-IXS(1,II)
1655 IF (MLW /= 0) THEN
1656 OFFG(I)=ZERO
1657 ELSE ! loi0, no off
1658 CALL ANCMSG(MSGID=238,ANMODE=ANINFO_BLIND,I1=IXS(NIXS,II),C1='brick',C2='brick')
1659 ENDIF
1660 ELSE
1661 IGOF=0
1662 ENDIF
1663 ENDDO
1664C-----------------------
1665C 2. 2D ELEMS
1666C-----------------------
1667.AND. ELSEIF(ITY == 2NELQOF /= 0)THEN
1668 IGOF=1
1669 DO I=1,NEL
1670 II=I+NFT
1671 IF(IXQ(1,II) < 0)THEN
1672 IXQ(1,II)=-IXQ(1,II)
1673 OFFG(I) = ZERO
1674 ELSE
1675 IGOF=0
1676 ENDIF
1677 ENDDO
1678C-----------------------
1679C 3. SHELL ELEMS
1680C-----------------------
1681.AND. ELSEIF(ITY == 3NELCOF /= 0)THEN
1682 IGOF=1
1683 DO I=1,NEL
1684 II=I+NFT
1685 IF(IXC(1,II) < 0)THEN
1686 IXC(1,II)=-IXC(1,II)
1687 IF (MLW /= 0) THEN
1688 OFFG(I) = ZERO
1689 ELSE ! loi0, no off
1690 CALL ANCMSG(MSGID=238,ANMODE=ANINFO_BLIND,I1=IXC(NIXC,II), C1='shell',C2='shell')
1691 ENDIF
1692 ELSE
1693 IGOF=0
1694 ENDIF
1695 ENDDO
1696C-----------------------
1697C 4. ROD ELEMS
1698C-----------------------
1699.AND. ELSEIF(ITY == 4NELTOF /= 0)THEN
1700C IGOF=1
1701C removal of the group incompatible with gap truss option
1702 IGOF=0
1703 DO I=1,NEL
1704 II=I+NFT
1705 IF(IXT(1,II) < 0)THEN
1706 IXT(1,II)=-IXT(1,II)
1707 OFFG(I) = ZERO
1708C ELSE
1709C IGOF=0
1710 ENDIF
1711 ENDDO
1712C-----------------------
1713C 5. BEAM ELEMS
1714C-----------------------
1715.AND. ELSEIF(ITY == 5NELPOF /= 0)THEN
1716 IGOF=1
1717 DO I=1,NEL
1718 II=I+NFT
1719 IF(IXP(1,II) < 0)THEN
1720 IXP(1,II)=-IXP(1,II)
1721 OFFG(I) = ZERO
1722 ELSE
1723 IGOF=0
1724 ENDIF
1725 ENDDO
1726C-----------------------
1727C 6. ELEMENTS RESSORTS
1728C-----------------------
1729.AND. ELSEIF(ITY == 6NELROF /= 0)THEN
1730 IGOF=0
1731 DO I=1,NEL
1732 II=I+NFT
1733 IF(IXR(1,II) < 0)THEN
1734 IXR(1,II)=-IXR(1,II)
1735 OFFG(I) = ZERO
1736 ENDIF
1737 ENDDO
1738C-----------------------
1739C 7. 3N-SHELL-ELEMS
1740C-----------------------
1741.AND. ELSEIF(ITY == 7NELTGOF /= 0)THEN
1742 IGOF=1
1743 DO I=1,NEL
1744 II=I+NFT
1745 IF(IXTG(1,II) < 0)THEN
1746 IXTG(1,II)=-IXTG(1,II)
1747 IF(MLW /= 0) THEN
1748 OFFG(I) = ZERO
1749 ELSE ! loi0, no off
1750 CALL ANCMSG(MSGID=238,ANMODE=ANINFO_BLIND,I1=IXTG(NIXTG,II), C1='sh_3n',C2='sh_3n')
1751 ENDIF
1752 ELSE
1753 IGOF=0
1754 ENDIF
1755 ENDDO
1756C-----------------------
1757C 8. SPH PARTICLES
1758C-----------------------
1759.AND. ELSEIF(ITY == 51NSPHOF /= 0)THEN
1760 IGOF=1
1761 DO I=1,NEL
1762 II=I+NFT
1763 IF(KXSP(2,II) == 0)THEN
1764 OFFG(I) = ZERO
1765 ELSE
1766 IGOF=0
1767 ENDIF
1768 ENDDO
1769 ENDIF
1770C----------------------------------------
1771C CHECK FOR GROUP CLEANING
1772C----------------------------------------
1773 IPARG(8,NG)=MAX0(IPARG(8,NG),IGOF)
1774 ENDDO ! next NG
1775 END IF
1776! /DEL/PART
1777 IF(NPARTOF > 0)THEN
1778! per group
1779 K1=1+LIPART1*(NPART+NTHPART)+2*9*(NPART+NTHPART)
1780 K2=K1+NUMELS
1781 K3=K2+NUMELQ
1782 K4=K3+NUMELC
1783 K5=K4+NUMELT
1784 K6=K5+NUMELP
1785 K7=K6+NUMELR
1786 K8=K7
1787 K9=K8+NUMELTG
1788 K10= K9 + NUMELX
1789 K11= K10+ NUMSPH
1790 DO NG = 1, NGROUP
1791 OFFG => ELBUF_STR(NG)%GBUF%OFF
1792 MLW=IPARG(1,NG)
1793 ITY = IPARG(5, NG)
1794 NEL = IPARG(2, NG)
1795 NFT = IPARG(3, NG)
1796 IF (NEL == 0) CYCLE
1797 IGOF=0
1798 SELECT CASE (ITY)
1799 CASE(1)
1800! 1. SOLID ELEMS
1801 IGOF=1
1802 DO I=1,NEL
1803 II=I+NFT-1
1804 PARTID = IPART(K1 + II)
1805 IF (IPARTOF(PARTID)==1) THEN
1806 IF (MLW/=0) OFFG(I) = ZERO
1807 ELSE
1808 IGOF=0
1809 ENDIF
1810 ENDDO
1811 CASE(2)
1812! 2. 2D ELEMS
1813 IGOF=1
1814 DO I=1,NEL
1815 II=I+NFT-1
1816 PARTID = IPART(K2 + II)
1817 IF (IPARTOF(PARTID)==1) THEN
1818 OFFG(I) = ZERO
1819 ELSE
1820 IGOF=0
1821 ENDIF
1822 ENDDO
1823 CASE(3)
1824! 3. SHELL ELEMS
1825 IGOF=1
1826 DO I=1,NEL
1827 II=I+NFT-1
1828 PARTID = IPART(K3 + II)
1829 IF (IPARTOF(PARTID)==1) THEN
1830 IF (MLW/=0) OFFG(I) = ZERO
1831 ELSE
1832 IGOF=0
1833 ENDIF
1834 ENDDO
1835 CASE(4)
1836! 4. ROD ELEMS
1837 IGOF=0
1838 DO I=1,NEL
1839 II=I+NFT-1
1840 PARTID = IPART(K4 + II)
1841 IF (IPARTOF(PARTID)==1) OFFG(I) = ZERO
1842 ENDDO
1843 CASE(5)
1844! 5. BEAM ELEMS
1845 IGOF=1
1846 DO I=1,NEL
1847 II=I+NFT-1
1848 PARTID = IPART(K5 + II)
1849 IF (IPARTOF(PARTID)==1) THEN
1850 OFFG(I) = ZERO
1851 ELSE
1852 IGOF=0
1853 ENDIF
1854 ENDDO
1855 CASE(6)
1856! 6. ELEMENTS RESSORTS
1857 IGOF=0
1858 DO I=1,NEL
1859 II=I+NFT-1
1860 PARTID = IPART(K6 + II)
1861 IF (IPARTOF(PARTID)==1) OFFG(I) = ZERO
1862 ENDDO
1863 CASE(7)
1864! 7. 3N-SHELL-ELEMS
1865 IGOF=1
1866 DO I=1,NEL
1867 II=I+NFT-1
1868 PARTID = IPART(K7 + II)
1869 IF (IPARTOF(PARTID)==1) THEN
1870 IF (MLW/=0) OFFG(I) = ZERO
1871 ELSE
1872 IGOF=0
1873 ENDIF
1874 ENDDO
1875 CASE(51)
1876! 8. SPH PARTICLES
1877 IGOF=1
1878 DO I=1,NEL
1879 II=I+NFT-1
1880 PARTID = IPART(K10 + II)
1881 IF (IPARTOF(PARTID)==1) THEN
1882 OFFG(I) = ZERO
1883 KXSP(2,NFT+I) = 0
1884 ELSE
1885 IGOF=0
1886 ENDIF
1887 ENDDO
1888 END SELECT
1889 IPARG(8,NG)=MAX0(IPARG(8,NG),IGOF)
1890 ENDDO
1891 IF (ALLOCATED(IPARTOF)) DEALLOCATE(IPARTOF)
1892 END IF
1893C-------------------------------------------
1894C ADDING RIGID LINK BETWEEN NODES
1895C-------------------------------------------
1896.AND. IF(NRLINK > 0 MCHECK == 0) THEN
1897 K1 =1
1898 K2 =1
1899 DO K=1,NRLINK
1900 READ (IIN,'(i8,1x,3i1,1x,3i1,i10)')N,I1,I2,I3,IR1,IR2,IR3,ISK
1901 READ (IIN,'(10i10)') (LLINK(K2+I-1),I=1,N)
1902 IC=I3+2*I2+4*I1
1903 ICR=IR3+2*IR2+4*IR1
1904 IF(IRODDL == 0)ICR=0
1905.AND. IF(ISPMD == 0MCHECK == 0)WRITE(IOUT,2100) K,I1,I2,I3,IR1,IR2,IR3,ISK,N
1906.AND. IF(ISPMD == 0MCHECK == 0)WRITE(IOUT,'(10i10)') (LLINK(K2+I-1),I=1,N)
1907 IF ( ISK /= 0) THEN
1908 ISK1 = 0
1909 ISK2 = 0
1910 DO LL=0,NUMSKW
1911 IF(ISK == ISKWN(4,LL+1)) THEN
1912 ISK1 = LL
1913 ISK2 = 1
1914 ENDIF
1915 ENDDO
1916 IF ( ISK2 == 0) THEN
1917 CALL ANCMSG(MSGID=125,ANMODE=ANINFO)
1918 CALL ARRET(2)
1919 ENDIF
1920 ISK = ISK1
1921 ENDIF
1922 ! shared verification & defining specific data structure
1923 CALL FR_RLINK1(LLINK(K2),ITABM1,FR_RL(1,K),N)
1924 CALL RLINK0(
1925 1 V ,VR ,MS ,IN ,NNLINK(K1),
1926 2 NNLINK(K1+1),NNLINK(K1+2),LLINK(K2),N ,IC ,
1927 3 ICR ,NNLINK(K1+3),ISK ,SKEW(1,ISK+1),ISKWN ,
1928 4 FR_RL(1,K) ,WEIGHT )
1929 K1=K1+4
1930 K2=K2+N
1931 IF(IC+ICR == 0)THEN
1932 IF(ISPMD == 0)CALL ANCMSG(MSGID=126,ANMODE=ANINFO)
1933 CALL ARRET(2)
1934 ENDIF
1935 ENDDO
1936 ENDIF
1937C-------------------------------------------
1938C ALE - LINK ON GRID VELOCITY
1939C format v5 ('/VEL/*')
1940C-------------------------------------------
1941C
1942C |ALE LINK 1 |2 |NALELK
1943C +----+----+----+----+----+----+----+----+----+...-+----+----+----+--...+----+----+--...
1944C LINALE |uID | M1 | M2 | N | IC | IM |id1 |id2 |id3 |... |idn | ... |
1945C +----+----+----+----+----+----+----+----+----+...-+----+----+----+--...+----+----+--...
1946C (1:SLINALE) 1 2 3 4 5 6 6+1 6+N
1947C +LLINAL |
1948C (N=1 if grnod_id is used)
1949C
1950C First subarrays are used to define ale links from starter (1:SLINALE). Engine links are in (SLINALE+1:SLINALE+LLINAL)
1951C Only Starter part is written in restart files.
1952C
1953C M1 : MAIN node 1
1954C M2 : MAIN node 2
1955C N : number of nodes
1956C IC : dir XYZ
1957C IM : formulation option -1,0,1
1958C id*: node_id list or grnod_id
1959C
1960C N<0 means that ALE LINK is tagged in FRALNK() as defined from a grnod_id.
1961
1962C
1963C +--RADIOSS2
1964C +--LECINP
1965C | +--FREFORM (direct access writing IUSC1, counting number of /VEL/ALE cards)
1966C | +--FRALNK(src/freef/fralnk.F) (LINALE size calculation:SLINALE, reading/checking GRNOD option)
1967C +--LECTUR (storing data in LINALE)
1968C | +--FR_RLALE(priv/spmd/fr_rlink1.F) (check and tag available nodes on current domain)
1969C +--RESOL
1970C +--ALEWDX
1971C +--ALELIN(priv/ale/alelin.F) (ale link subroutine, updated to be used with grnod_id)
1972C
1973C
1974C
1975
1976C SLINALE : starter size
1977C LLINAL : engine size
1978C NALELK : engine /VEL/ALE card (obsolete)
1979C NALELINK: engine /ALELINK/VEL
1980C after reading : SLINALE <- SLINALE+LLINAL
1981C NALELK <- NALELK+NALELINK
1982
1983 NALELK_starter = 0
1984 IF(MCHECK==0)NALELK_starter = SLINALE/7 !SLINALE : starter linale size
1985 NALELK_removed=0
1986 K=6
1987
1988 !setting MAIN node user id to internal id
1989 DO J=1,NALELK_starter
1990.AND. IF(IRUN == 1 MCHECK == 0)
1991 . CALL FR_RLALE(LINALE(K-4),LINALE(K-3),LINALE(K+1),ITABM1,-1)
1992 K=K+1+6
1993 ENDDO
1994
1995.AND. IF(NALELK /= 0MCHECK == 0)THEN
1996 K=SLINALE+6 !LINALE(1:SLINALE):starter cards ;LINALE(SLINALE+1:SLINALE+LLINE):engine cards
1997 !K=5 !en attendant de copier LIALE starter dans (1:SLINALE)
1998 DO J=1,NALELK
1999 READ (IIN,'(3i10,5x,3i1,i10)')M1,M2,N,I1,I2,I3,IM
2000 !---------------------------------!
2001 ! ALE LINK DEFINED FROM NODES !
2002 !---------------------------------!
2003 IF(N>0)THEN
2004 READ (IIN,'(10i10)')(LINALE(K+I),I=1,N)
2005 IC=I3+2*I2+4*I1
2006 IF(IC == 0)THEN
2007 IC=7
2008 I1=1
2009 I2=1
2010 I3=1
2011 ENDIF
2012.AND. IF(ISPMD == 0MCHECK == 0)WRITE(IOUT,2200)M1,M2,I1,I2,I3,IM
2013 LINALE(K-4)=M1
2014 LINALE(K-3)=M2
2015 LINALE(K-2)=N
2016 LINALE(K-1)=IC
2017 LINALE(K)=IM
2018.AND. IF(ISPMD == 0MCHECK == 0)THEN
2019 WRITE(IOUT,'(10i10)')(LINALE(K+I),I=1,N)
2020 WRITE(IOUT,2201)
2021 ENDIF
2022c Verification shared and tag in - nodes not present
2023 CALL FR_RLALE(LINALE(K-4),LINALE(K-3),LINALE(K+1),ITABM1,N)
2024 K=K+N+6
2025 !---------------------------------!
2026 ! ALE LINK DEFINED FROM GRNOD !
2027 !---------------------------------!
2028 ELSE !N<=0
2029 !M1 < 0
2030 !GR_ID < 0
2031 READ (IIN,'(i10)', ERR=998,IOSTAT=IERROR)GR_ID
2032
2033 0998 IF(IERROR/=0)THEN
2034 WRITE(ISTDO,*) ' ** error in ale link: invalid grnod_id'
2035 GR_ID = 0
2036 ENDIF
2037 LINALE(K+1)=NGR2USR(GR_ID,IGRNOD,NGRNOD)
2038
2039 IF(LINALE(K+1)==0)CALL ARRET(2) !node group not found
2040
2041.AND. IF(IM==0IGRNOD(LINALE(K+1))%SORTED /= 1)THEN
2042 !option 0 needs to be defined with a /GRNOD/NODENS
2043 WRITE(ISTDO,*)' ** error in ale link:'
2044 WRITE(ISTDO,*) ' unsortable node group required with option 0 (/grnod/nodens)'
2045 WRITE(IOUT ,*)' ** error in ale link:'
2046 WRITE(IOUT,*) ' unsortable node group required with option 0 (/grnod/nodens)'
2047 CALL ARRET(2)
2048 ENDIF
2049
2050 IC=I3+2*I2+4*I1
2051 IF(IC == 0)THEN
2052 IC=7
2053 I1=1
2054 I2=1
2055 I3=1
2056 ENDIF
2057.AND. IF(ISPMD == 0MCHECK == 0)THEN
2058 WRITE(IOUT,2200)M1,M2,I1,I2,I3,IM !N=1 with GRNOD option
2059 WRITE(IOUT,2202)GR_ID
2060 ENDIF
2061 LINALE(K-4)=M1
2062 LINALE(K-3)=M2
2063 LINALE(K-2)=N
2064 LINALE(K-1)=IC
2065 LINALE(K)=IM
2066 !shared verification & untag non present nodes
2067 CALL FR_RLALE(LINALE(K-4),LINALE(K-3),LINALE(K+1),ITABM1,N)
2068 K=K+1+6
2069 ENDIF
2070 ENDDO !next J
2071 SLINALE = SLINALE + LLINAL
2072.AND. ENDIF !IF(NALELK /= 0MCHECK == 0)THEN
2073
2074C-------------------------------------------
2075C ALE - LINK ON GRID VELOCITY
2076C format >= v12 ('/ALE/LINK/*')
2077C-------------------------------------------
2078.AND. IF(NALELINK /= 0MCHECK == 0)THEN
2079 IF(NALELK==0)K=SLINALE+6
2080 DO J=1,NALELINK
2081 READ (IIN,'(3i10,5x,3i1,i10)')M1,M2,N,I1,I2,I3,IM
2082.AND. IF(M1>0M2>0)THEN
2083 !---------------------------------!
2084 ! ALE LINK DEFINED FROM NODES !
2085 !---------------------------------!
2086 IF(N>0)THEN
2087 READ (IIN,'(10i10)')(LINALE(K+I),I=1,N)
2088 IC=I3+2*I2+4*I1
2089 IF(IC == 0)THEN
2090 IC=7
2091 I1=1
2092 I2=1
2093 I3=1
2094 ENDIF
2095.AND. IF(ISPMD == 0MCHECK == 0)WRITE(IOUT,2200)M1,M2,I1,I2,I3,IM
2096 LINALE(K-4)=M1
2097 LINALE(K-3)=M2
2098 LINALE(K-2)=N
2099 LINALE(K-1)=IC
2100 LINALE(K)=IM
2101.AND. IF(ISPMD == 0MCHECK == 0)THEN
2102 WRITE(IOUT,'(10i10)')(LINALE(K+I),I=1,N)
2103 WRITE(IOUT,2201)
2104 ENDIF
2105 ! Verification shared and tag in - nodes not present
2106 CALL FR_RLALE(LINALE(K-4),LINALE(K-3),LINALE(K+1),ITABM1,N)
2107 K=K+N+6
2108 !---------------------------------!
2109 ! ALE LINK DEFINED FROM GRNOD !
2110 !---------------------------------!
2111 ELSE !(N<=0)
2112 READ (IIN,'(i10)', err=999,iostat=ierror)gr_id
2113 0999 IF(ierror/=0)THEN
2114 WRITE(istdo,*) ' ** ERROR IN ALE LINK: CANNOT READ GRNOD_ID VALUE'
2115 gr_id = 0
2116 CALL arret(2) !node group not read
2117 ENDIF
2118
2119 linale(k+1)=ngr2usr(gr_id,igrnod,ngrnod)
2120 IF(linale(k+1)==0)THEN
2121 WRITE(istdo,*) ' ** ERROR IN ALE LINK: INVALID GRNOD_ID'
2122 CALL arret(2) !node group not found
2123 ENDIF
2124
2125 IF(im==0.AND.igrnod(linale(k+1))%SORTED /= 1)THEN
2126 !option 0 needs to be defined with a /GRNOD/NODENS
2127 WRITE(istdo,*)' ** ERROR IN ALE LINK:'
2128 WRITE(istdo,*)' UNSORTABLE NODE GROUP REQUIRED WITH OPTION 0 (/GRNOD/NODENS)'
2129 WRITE(iout ,*)' ** ERROR IN ALE LINK:'
2130 WRITE(iout,*) ' UNSORTABLE NODE GROUP REQUIRED WITH OPTION 0 (/GRNOD/NODENS)'
2131 CALL arret(2)
2132 ENDIF
2133
2134 ic=i3+2*i2+4*i1
2135 IF(ic == 0)THEN
2136 ic=7
2137 i1=1
2138 i2=1
2139 i3=1
2140 ENDIF
2141 IF(ispmd == 0.AND.mcheck == 0)THEN
2142 WRITE(iout,2200)m1,m2,i1,i2,i3,im !N=1 with GRNOD option
2143 WRITE(iout,2202)gr_id
2144 ENDIF
2145 linale(k-4)=m1
2146 linale(k-3)=m2
2147 linale(k-2)=n
2148 linale(k-1)=ic
2149 linale(k)=im
2150 !shared verification & untag non present nodes
2151 CALL fr_rlale(linale(k-4),linale(k-3),linale(k+1),itabm1,n)
2152 k=k+1+6
2153 ENDIF !(N>0)
2154
2155 !---------------------------------!
2156 ! ALE LINK SET ON !
2157 !---------------------------------!
2158 ELSEIF(m1==-1)THEN ! ON
2159 ALLOCATE(alelin_on_off(iabs(n)))
2160 READ (iin,'(10I10)')(alelin_on_off(i),i=1,n)
2161 !L=1 !pos
2162 kk=0 ! number of ale link deactivated
2163 DO i1=1,n
2164 l=1 !pos
2165 m1=alelin_on_off(i1)
2166 DO i=1,nalelk_starter
2167 !---------------------------------!
2168 ! CHECK AND DEACTIVATE !
2169 !---------------------------------!
2170 IF(l>=slinale)THEN
2171 !warning : uID does not exist
2172 WRITE(istdo,*)' ** WARNING ALE LINK DOES NOT EXIST :',m1
2173 WRITE(iout,*) ' ** WARNING ALE LINK DOES NOT EXIST :',m1
2174 EXIT
2175 ELSE
2176 uid = linale(l+0)
2177 n = linale(l+3)
2178 IF(uid==-m1)THEN
2179 nalelk_removed = nalelk_removed+1 !counting deactivated links
2180 linale(l+0)=-linale(l+0) !setting negative uID to skip ALE LINK treatment (alelin.F)
2181 !printout :
2182 IF(ispmd == 0.AND.mcheck == 0)WRITE(iout,2211)m1 !N=1 with GRNOD option
2183 EXIT !next ALELIN_ON_OFF
2184 ELSEIF(uid==m1)THEN
2185 nalelk_removed = nalelk_removed+1 !counting deactivated links
2186 !warning uID already set OFF :
2187 WRITE(istdo,*)' ** WARNING ALE LINK ALREADY ACTIVATED : ',m1
2188 EXIT !next ALELIN_ON_OFF
2189 ENDIF
2190
2191 ENDIF
2192 l = l+6+iabs(n) !next uID position in LINALE()
2193 ENDDO
2194 ENDDO
2195 DEALLOCATE(alelin_on_off)
2196 !IF(NALELK_removed>0)NALELK_removed=1 !/ALE/LINK/ON or OFF card is no longer taken into account
2197
2198 !---------------------------------!
2199 ! ALE LINK SET OFF !
2200 !---------------------------------!
2201 ELSEIF(m1==-2)THEN ! OFF
2202 ALLOCATE(alelin_on_off(iabs(n)))
2203 READ (iin,'(10I10)')(alelin_on_off(i),i=1,n)
2204 !L=1 !pos
2205 kk=0 ! number of ale link deactivated
2206 DO i1=1,n
2207 l=1 !pos
2208 m1=alelin_on_off(i1)
2209 DO i=1,nalelk_starter
2210 !---------------------------------!
2211 ! CHECK AND DEACTIVATE !
2212 !---------------------------------!
2213 IF(l>=slinale)THEN
2214 !warning : uID does not exist
2215 WRITE(istdo,*) ' ** WARNING ALE LINK DOES NOT EXIST :',m1
2216 WRITE(iout,*) ' ** WARNING ALE LINK DOES NOT EXIST :',m1
2217 EXIT
2218 ELSE
2219 uid = linale(l+0)
2220 n = linale(l+3)
2221 IF(uid==m1)THEN
2222 nalelk_removed = nalelk_removed+1 !counting deactivated links
2223 linale(l+0)=-linale(l+0) !setting negative uID to skip ALE LINK treatment (alelin.F)
2224 !printout :
2225 IF(ispmd == 0.AND.mcheck == 0)WRITE(iout,2210)m1 !N=1 with GRNOD option
2226 EXIT !next ALELIN_ON_OFF
2227 ELSEIF(uid==-m1)THEN
2228 nalelk_removed = nalelk_removed+1 !counting deactivated links
2229 !warning uID already set OFF :
2230 WRITE(istdo,*)' ** WARNING ALE LINK ALREADY DEACTIVATED :',m1
2231 EXIT !next ALELIN_ON_OFF
2232 ENDIF
2233 ENDIF
2234 l = l+6+iabs(n) !next uID position in LINALE()
2235 ENDDO
2236 ENDDO
2237 DEALLOCATE(alelin_on_off)
2238 !IF(NALELK_removed>0)NALELK_removed=1 !/ALE/LINK/ON or OFF card is no longer taken into account
2239 ENDIF
2240
2241 ENDDO
2242 slinale = slinale + llinal
2243 nalelk = nalelk+nalelink-nalelk_removed
2244 ENDIF !(NALELINK /= 0.AND.MCHECK == 0)
2245
2246 IF(mcheck==0)nalelk=nalelk+nalelk_starter
2247
2248C-------------------------------------------
2249C ALE ON/ OFF
2250C-------------------------------------------
2251 IF(nbpartaleon > 0) ALLOCATE(aleon_partids_tmp(nbpartaleon))
2252 IF(nbpartaleoff > 0) ALLOCATE(aleoff_partids_tmp(nbpartaleoff))
2253 ion = 0
2254 ioff = 0
2255 DO i = 1, nbpartaleon + nbpartaleoff
2256 READ(iin, '(I10, I10)') partid, ison
2257 IF (ison == 1) THEN
2258 ion = ion + 1
2259 aleon_partids_tmp(ion) = partid
2260 ELSE IF(ison == 0) THEN
2261 ioff = ioff + 1
2262 aleoff_partids_tmp(ioff) = partid
2263 ENDIF
2264 ENDDO
2265C Checking for duplicates and removal
2266 DO i = 1, nbpartaleon
2267 partid = aleon_partids_tmp(i)
2268 IF (partid /= -1) THEN
2269 DO j = 1, nbpartaleon
2270 IF (j == i) cycle
2271 IF (aleon_partids_tmp(j) == partid) THEN
2272 nbpartaleon = nbpartaleon - 1
2273 aleon_partids_tmp(j) = -1
2274 ENDIF
2275 ENDDO
2276 ENDIF
2277 ENDDO
2278 DO i = 1, nbpartaleoff
2279 partid = aleoff_partids_tmp(i)
2280 IF (partid /= -1) THEN
2281 DO j = 1, nbpartaleoff
2282 IF (j == i) cycle
2283 IF (aleoff_partids_tmp(j) == partid) THEN
2284 nbpartaleoff = nbpartaleoff - 1
2285 aleoff_partids_tmp(j) = -1
2286 ENDIF
2287 ENDDO
2288C Check if part is also defined in ON
2289C By default, all parts are ON, if a part is set to OFF
2290C and ON at the same time, we choose to OFF it
2291 DO j = 1, nbpartaleon
2292 IF (aleon_partids_tmp(j) == partid) THEN
2293 !!! WARNING TO OUTPUT HERE
2294 aleon_partids_tmp(j) = -1
2295 nbpartaleon = nbpartaleon - 1
2296 CALL ancmsg(msgid = 272, anmode = aninfo, i1 = partid)
2297 ENDIF
2298 ENDDO
2299 ENDIF
2300 ENDDO
2301C Checking that part ids exist in IPART(4, *)
2302 nbaleoff_part = nbpartaleoff
2303 nbaleon_part = nbpartaleon
2304 DO i = 1, nbpartaleon
2305 partid = aleon_partids_tmp(i)
2306 ison = 0
2307 IF (partid /= -1) THEN
2308 DO j = 1, npart
2309 IF (ipart(4 + (j - 1) * lipart1) == partid) THEN
2310 ison = 1
2311 aleon_partids_tmp(i) = j
2312 EXIT
2313 ENDIF
2314 ENDDO
2315 ENDIF
2316 IF (ison == 0) THEN
2317 aleon_partids_tmp(i) = -1
2318 nbaleon_part = nbaleon_part - 1
2319 CALL ancmsg(msgid = 271, anmode = aninfo, i1 = partid)
2320 CALL arret(2)
2321 ENDIF
2322 ENDDO
2323 DO i = 1, nbpartaleoff
2324 partid = aleoff_partids_tmp(i)
2325 ison = 0
2326 IF (partid /= -1) THEN
2327 DO j = 1, npart
2328 IF (ipart(4 + (j - 1) * lipart1) == partid) THEN
2329 ison = 1
2330 aleoff_partids_tmp(i) = j
2331 EXIT
2332 ENDIF
2333 ENDDO
2334 ENDIF
2335 IF (ison == 0) THEN
2336 aleoff_partids_tmp(i) = -1
2337 nbaleoff_part = nbaleoff_part - 1
2338 CALL ancmsg(msgid = 271, anmode = aninfo, i1 = partid)
2339 CALL arret(2)
2340 ENDIF
2341 ENDDO
2342C Filling module values
2343 IF (nbaleoff_part > 0) ALLOCATE(aleoff_partids(nbaleoff_part))
2344 IF (nbaleon_part > 0) ALLOCATE(aleon_partids(nbaleon_part))
2345 DO i = 1, nbpartaleon
2346 partid = aleon_partids_tmp(i)
2347 ison = 0
2348 IF (partid /= -1) THEN
2349 ison = ison + 1
2350 aleon_partids(ison) = partid
2351 ENDIF
2352 ENDDO
2353 ison = 0
2354 DO i = 1, nbpartaleoff
2355 partid = aleoff_partids_tmp(i)
2356 IF (partid /= -1) THEN
2357 ison = ison + 1
2358 aleoff_partids(ison) = partid
2359 ENDIF
2360 ENDDO
2361C OUTPUT
2362 DO i = 1, nbaleoff_part
2363 WRITE(iout, 4800) aleoff_partids(i)
2364 ENDDO
2365C-------------------------------------------
2366C Fill IPARG
2367C-------------------------------------------
2368 k1 = 1 + lipart1 * (npart + nthpart) + 2 * 9 * (npart + nthpart)
2369 k2 = k1 + numels
2370 DO ng = 1, ngroup
2371 ity = iparg(5, ng)
2372 nel = iparg(2, ng)
2373 nft = iparg(3, ng)
2374C Initially, IPARG(76, *) = 0 --> ON
2375C When restarting a computation, IPARG(76, NG) = Whatever was put here during previous run
2376C Find part associated to the current group
2377C by checking the first element of the group
2378C NB : all elements in a same group belong necessarily to the same part
2379
2380 IF (ity == 1) THEN
2381C Solid groups
2382 partid = ipart(k1 + nft)
2383 ELSEIF (ity == 2) THEN
2384C Shells and coques
2385 partid = ipart(k2 + nft)
2386 ENDIF
2387C Check if this part is found in ALEOFF_PARTIDS
2388 DO i = 1, nbaleoff_part
2389 IF (aleoff_partids(i) == partid) THEN
2390 iparg(76, ng) = 1 ! --> OFF
2391 EXIT
2392 ENDIF
2393 ENDDO
2394C Check if this part is found in ALEON_PARTIDS
2395 DO i = 1, nbaleon_part
2396 IF (aleon_partids(i) == partid) THEN
2397 iparg(76, ng) = 0 ! --> ON
2398 EXIT
2399 ENDIF
2400 ENDDO
2401 ENDDO
2402 IF (ALLOCATED(aleon_partids_tmp)) DEALLOCATE(aleon_partids_tmp)
2403 IF (ALLOCATED(aleoff_partids_tmp)) DEALLOCATE(aleoff_partids_tmp)
2404 IF (ALLOCATED(aleon_partids)) DEALLOCATE(aleon_partids)
2405 IF (ALLOCATED(aleoff_partids)) DEALLOCATE(aleoff_partids)
2406C-------------------------------------------
2407C MODIFICATION DES CONDITIONS AUX LIMITES
2408C-------------------------------------------
2409 IF(nubcsn /= 0)THEN
2410 CALL lcbcsf(icode,iskew,nubcsn,itab,itabm1,npby ,iskwn,weight)
2411 IF(nspmd > 1) THEN
2412C necessary processing to recover limit cond nodes
2413 iwiout = 0
2414 IF (ispmd /= 0) CALL spmd_chkw(iwiout,iout)
2415 CALL spmd_glob_isum9(iwiout,1)
2416 CALL spmd_ibcast(iwiout,iwiout,1,1,0,2)
2417 IF (iwiout > 0) THEN
2418 CALL spmd_wiout(iout,iwiout)
2419 iwiout = 0
2420 END IF
2421 END IF
2422 END IF
2423C-------------------------------------------
2424C INTERFACE MODIFICATION
2425C-------------------------------------------
2426 IF(nintch /= 0)THEN
2427 DO i=1,nintch
2428 READ(iin,'(2I8,2F16.0)')noint,nsearch,tstart,tfin
2429 IF(tfin == 0.0)tfin=1.e30
2430 IF(tfin <= tstart) THEN
2431 CALL ancmsg(msgid=307,anmode=anstop)
2432 CALL arret(2)
2433 ENDIF
2434
2435 jpri = -1
2436 DO j=1,ninter
2437 IF(noint == ipari(15,j)) THEN
2438 IF(nsearch /= 0) ipari(13,j)=nsearch
2439 intbuf_tab(j)%VARIABLES(3) = tstart
2440 intbuf_tab(j)%VARIABLES(11) = tfin
2441 jpri=j
2442 ENDIF
2443 ENDDO
2444 IF(jpri/=-1) THEN
2445 IF(ispmd == 0.AND.mcheck == 0) WRITE(iout,2300)noint,ipari(13,jpri),tstart,tfin
2446 ELSE
2447 IF(ispmd == 0.AND.mcheck == 0) WRITE(iout,2301)noint
2448 ENDIF
2449 ENDDO
2450 ENDIF
2451C
2452 IF(mcheck /= 0)THEN
2453 DO i = 1,mx_outp
2454 nv_outp = nv_outp + outp_v(i)
2455 nss_outp = nss_outp + outp_ss(i)
2456 nst_outp = nst_outp + outp_st(i)
2457 ncs_outp = ncs_outp + outp_cs(i)
2458 nct_outp = nct_outp + outp_ct(i)
2459 nts_outp = nts_outp + outp_ts(i)
2460 nps_outp = nps_outp + outp_ps(i)
2461 npt_outp = npt_outp + outp_pt(i)
2462 nrs_outp = nrs_outp + outp_rs(i)
2463 nrt_outp = nrt_outp + outp_rt(i)
2464 ENDDO
2465 IF(outp_v(12) == 1)nv_outp=nv_outp+1
2466 ENDIF
2467C-------------------------------------------
2468C MODIFICATION OF RIGID BODY
2469C-------------------------------------------
2470 IF(nrbyof /= 0)
2471 1 CALL rbyonf(iparg,ipari ,ms ,in ,
2472 2 ixs ,ixq ,ixc ,ixt ,ixp ,
2473 3 ixr ,skew ,itab ,itabm1 ,iskwn ,
2474 4 npby ,0 ,nrbyof,wa ,lpby ,
2475 5 rby ,x ,v ,vr ,ixtg ,
2476 6 igrv ,ibgr ,weight,fr_rby2,partsav,
2477 7 ipart,elbuf_str,icfield,lcfield,tagslv_rby)
2478C
2479 IF(nrbyon /= 0)
2480 1 CALL rbyonf(iparg,ipari ,ms ,in ,
2481 2 ixs ,ixq ,ixc ,ixt ,ixp ,
2482 3 ixr ,skew ,itab ,itabm1 ,iskwn ,
2483 4 npby ,1 ,nrbyon,wa ,lpby ,
2484 5 rby ,x ,v ,vr ,ixtg ,
2485 6 igrv ,ibgr ,weight,fr_rby2,partsav,
2486 7 ipart,elbuf_str,icfield,lcfield,tagslv_rby)
2487C---------------------------------------------------------
2488C READING DATA FOR FLUX & ROTATION
2489C---------------------------------------------------------
2490 IF (nsflsw /= 0.AND.mcheck == 0) THEN
2491 CALL lecflsw (nsflsw,ntflsw,neflsw,nnflsw,crflsw,x,ixs,iparg,wa)
2492 ENDIF
2493C-------------------------------------------------
2494C MODIFICATION OF TIME FUNCTIONS
2495C-------------------------------------------------
2496 IF (nfct /= 0) THEN
2497 CALL lecfun (npc, pld, nfct, npts, table)
2498 END IF
2499C-------------------------------------------------
2500C RESET VELOCITIES
2501C-------------------------------------------------
2502 IF (niniv /= 0) THEN
2503 CALL lecinv (niniv,x,v,vr,itab,iframe,xframe,igrnod,fxbipm,fxbvit,fxbrpm)
2504 END IF
2505C---------------------------------------------------------
2506C CUTS
2507C---------------------------------------------------------
2508 IF(ncuts > 0.AND.mcheck == 0)CALL leccut(icut,xcut,itabm1)
2509C---------------------------------------------------------
2510C ANIMATION (DT ,DMAS)
2511C---------------------------------------------------------
2512! DO I=1,SANIN
2513! ANIN(I)=ZERO
2514! ENDDO
2515C---------------------------------------------------------
2516C FILTERED SAMPLED OUTPUT
2517C---------------------------------------------------------
2518 IF(nnoise > 0)CALL lecnoise(inoise,itabm1,names_and_titles)
2519 nnoiser=nnoise
2520C---------------------------------------------------------
2521C MADYMO COUPLING GENERAL DATA (CONVERSION FACTORS).
2522C---------------------------------------------------------
2523#ifdef DNC
2524 IF( imadcpl > 0.AND.invers>=40.AND.mcheck == 0)CALL leccpl()
2525#endif
2526C---------------------------------------------------------
2527C OPTIONS SPMD SPECIFIQUES
2528 IF(ipread > 0.AND.ispmd == 0.AND.mcheck == 0) WRITE(iout,4000)
2529 IF(iddw > 0.AND.ispmd == 0.AND.mcheck == 0) WRITE(iout,4100)
2530C---------------------------------------------------------
2531C RAYLEIGH DAMPING
2532C---------------------------------------------------------
2533 CALL lecdamp(ndampn, dampr, igrnod)
2534C---------------------------------------------------------
2535 istatcnd_sav= istatcnd
2536 IF(impl_s/=0) THEN
2537 IF(isprb==0.AND.nadmesh/=0)THEN
2538 IF (ispmd == 0) THEN
2539 CALL ancmsg(msgid=131,anmode=aninfo)
2540 ENDIF
2541 CALL arret(2)
2542 ENDIF
2543 istatcnd = 0
2544 END IF
2545C---------------------------------------------------------
2546 IF (impl_s == 1.OR.neig > 0) CALL lecimpl
2547 IF (nfxinp > 0) CALL lecfxinp(nfxinp)
2548 IF(ale%SUB%NODSUBDT /= 0)THEN
2549 IF(ispmd == 0) THEN
2550 CALL ancmsg(msgid=129,anmode=aninfo_blind)
2551 END IF
2552 CALL arret(2)
2553 END IF
2554 IF (neigoff > 0) CALL leceig(neigoff, neoff)
2555 IF (nfvmesh > 0) CALL lecfvbag(nfvmesh, monvol, volmon, x)
2556 IF (nfvmodi > 0) CALL lecfvbag1(nfvmodi, monvol, volmon)
2557C-------------------------------------------
2558C .sta files
2559C-------------------------------------------
2560 IF(mcheck /= 0)THEN
2561 nc_stat = 0
2562 DO i = 1,mx_stat
2563 nc_stat = nc_stat + stat_c(i)
2564 ENDDO
2565 ENDIF
2566 IF(nstatprt /= 0 .OR. nstatall /= 0)THEN
2567 k1=1+lipart1*(npart+nthpart)+2*9*(npart+nthpart)
2568 k2=k1+numels
2569 k3=k2+numelq
2570 k4=k3+numelc
2571 k5=k4+numelt
2572 k6=k5+numelp
2573 k7=k6+numelr
2574 k8=k7
2575 k9=k8+numeltg
2576 CALL lecstat(ipart,ipart_state,elbuf_str,ipm,iparg,ipart(k1),
2577 . ipart(k3),ipart(k8),mat_param)
2578 END IF
2579C-------------------------------------------
2580C .dynain files
2581C-------------------------------------------
2582 IF(dynain_data%NDYNAINPRT /= 0 .OR. dynain_data%NDYNAINALL /= 0)THEN
2583 k1=1+lipart1*(npart+nthpart)+2*9*(npart+nthpart)
2584 k2=k1+numels
2585 k3=k2+numelq
2586 k4=k3+numelc
2587 k5=k4+numelt
2588 k6=k5+numelp
2589 k7=k6+numelr
2590 k8=k7
2591 k9=k8+numeltg
2592 CALL read_dynain(ipart,dynain_data,ipart(k3),ipart(k8),ixc,ixtg)
2593 END IF
2594C-------------------------------------------
2595C .h3d files
2596C-------------------------------------------
2597 CALL prelech3d(numgeo ,npropgi ,npropmi ,nummat ,numply ,
2598 . igeo ,ipm ,h3d_data ,multi_fvm,mds_output_table,
2599 . mds_nmat ,max_depvar,mds_ndepsvar,mat_param,numsphg)
2600 CALL lech3d(output,geo,igeo,ipm,ipart,h3d_data,multi_fvm,ipari,iparg,tag_skins6,
2601 . mds_label,mds_output_table,mds_nmat,max_depvar,mds_ndepsvar,
2602 . elbuf_str,stack,ibcl,iloadp,lloadp,loads,mat_param,pblast,
2603 . igrpart,npc,pld,snpc,stf)
2604c
2605 IF(h3d_data%N_OUTP_H3D /= 0 .AND. ispmd == 0)THEN
2606 WRITE(iout,5000)h3d_data%TH3D,h3d_data%DTH3D
2607 WRITE(iout,*)' |'
2608 DO i=1,h3d_data%N_OUTP_H3D
2609 IF( h3d_data%OUTPUT_LIST(i)%ETYPE == 1 .OR.
2610 . h3d_data%OUTPUT_LIST(i)%ETYPE == 2 .AND. numelcg+numeltgg > 0 .OR.
2611 . h3d_data%OUTPUT_LIST(i)%ETYPE == 3 .AND. numelsg > 0 .OR.
2612 . h3d_data%OUTPUT_LIST(i)%ETYPE == 4 .AND. numeltrg+numelpg+numelrg > 0 .OR.
2613 . h3d_data%OUTPUT_LIST(i)%ETYPE == 5 .AND. numsphg > 0 .OR.
2614 . h3d_data%OUTPUT_LIST(i)%ETYPE == 6 .AND. numelqg > 0 .OR.
2615 . h3d_data%OUTPUT_LIST(i)%ETYPE == 7 .AND. numsking > 0) THEN
2616 char1=' '
2617 IF(h3d_data%OUTPUT_LIST(i)%ETYPE == 1)THEN
2618 char1='NODAL'
2619 ELSEIF(h3d_data%OUTPUT_LIST(i)%ETYPE == 2)THEN
2620 char1='SHELL'
2621 ELSEIF(h3d_data%OUTPUT_LIST(i)%ETYPE == 3)THEN
2622 char1='SOLID'
2623 ELSEIF(h3d_data%OUTPUT_LIST(i)%ETYPE == 4)THEN
2624 char1='ONED'
2625 ELSEIF(h3d_data%OUTPUT_LIST(i)%ETYPE == 5)THEN
2626 char1='SPH'
2627 ELSEIF(h3d_data%OUTPUT_LIST(i)%ETYPE == 6)THEN
2628 char1='QUAD'
2629 ELSEIF(h3d_data%OUTPUT_LIST(i)%ETYPE == 7)THEN
2630 char1='SKIN'
2631 ENDIF
2632c
2633 char2=' '
2634 IF(h3d_data%OUTPUT_LIST(i)%OUTP_TYPE == 1)THEN
2635 char2='SCALAR'
2636 ELSEIF(h3d_data%OUTPUT_LIST(i)%OUTP_TYPE == 2)THEN
2637 char2='VECTOR'
2638 ELSEIF(h3d_data%OUTPUT_LIST(i)%OUTP_TYPE == 3)THEN
2639 char2='TENSOR'
2640 ELSEIF(h3d_data%OUTPUT_LIST(i)%OUTP_TYPE == 4)THEN
2641 char2='TORSOR'
2642 ENDIF
2643c
2644 stext1 = h3d_data%OUTPUT_LIST(i)%S_STRING1
2645 WRITE(iout,*) ' |----'//char1//' '//char2//' : '
2646c WRITE(IOUT,*) ' |----'//H3D_DATA%OUTPUT_LIST(I)%KEYWORD
2647 WRITE(iout,*) ' | '//h3d_data%OUTPUT_LIST(i)%STRING1(1:stext1)
2648
2649 IF (h3d_data%OUTPUT_LIST(i)%IUVAR > 0)
2650 . WRITE(iout,*) ' | UVAR=', h3d_data%OUTPUT_LIST(i)%IUVAR
2651
2652 IF (h3d_data%OUTPUT_LIST(i)%PLY > 0)
2653 . WRITE(iout,*) ' | PLY=',h3d_data%OUTPUT_LIST(i)%PLY
2654
2655 IF (h3d_data%OUTPUT_LIST(i)%LAYER > 0)
2656 . WRITE(iout,*) ' | LAYER=',h3d_data%OUTPUT_LIST(i)%LAYER
2657
2658 IF (h3d_data%OUTPUT_LIST(i)%IPT > 0)
2659 . WRITE(iout,*) ' | IPT=',h3d_data%OUTPUT_LIST(i)%IPT
2660
2661 IF (h3d_data%OUTPUT_LIST(i)%IR > 0)
2662 . WRITE(iout,*) ' | IR=',h3d_data%OUTPUT_LIST(i)%IR
2663
2664 IF (h3d_data%OUTPUT_LIST(i)%IR > 0)
2665 . WRITE(iout,*) ' | IS=',h3d_data%OUTPUT_LIST(i)%IS
2666
2667 IF (h3d_data%OUTPUT_LIST(i)%IT > 0)
2668 . WRITE(iout,*) ' | IT=',h3d_data%OUTPUT_LIST(i)%IT
2669
2670 WRITE(iout,*)' |'
2671 ENDIF
2672 ENDDO
2673 WRITE(iout,*)' '
2674 WRITE(iout,*)' '
2675 ENDIF
2676C-------------------------------------------
2677C H3D/SENSOR
2678C-------------------------------------------
2679 IF (ispmd == 0.AND.mcheck == 0) THEN
2680 DO k=1,h3d_data%N_SENS_H3D
2681 iok = 0
2682 IF(h3d_data%LSENS_H3D(k) /= 0)THEN
2683 DO i=1,sensors%NSENSOR
2684 IF(h3d_data%LSENS_H3D(k) == sensor_tab(i)%SENS_ID)THEN
2685 h3d_data%LSENS_H3D(k)=i
2686 iok = 1
2687 EXIT
2688 ENDIF
2689 ENDDO
2690 ENDIF
2691 IF(iok == 0) THEN
2692 CALL ancmsg(msgid=283,anmode=aninfo,i1=h3d_data%LSENS_H3D(k))
2693 CALL arret(2)
2694 ENDIF
2695 ENDDO
2696 ENDIF !(ISPMD==0.AND.MCHECK==0)
2697C-------------------------------
2698C Output by interface :
2699C 1 - Skid lines
2700C-------------------------------
2701 IF(h3d_data%N_SCAL_SKID > 0.AND.nintskidold==0) THEN
2702 ninterskid = h3d_data%N_SCAL_SKID
2703 IF(nintstamp/=0) THEN
2704 ALLOCATE (pskids(ninterskid,numnodg))
2705 pskids(1:ninterskid,1:numnodg) = zero
2706 ELSE
2707 ALLOCATE (pskids(ninterskid,numnod))
2708 pskids(1:ninterskid,1:numnod) = zero
2709 ENDIF
2710 ELSEIF(h3d_data%N_SCAL_SKID == 0.AND.nintskidold==0)THEN
2711 ALLOCATE (pskids(0,0))
2712 ENDIF
2713C-------------------------------------------
2714C 2 - Frictionnal energy: allocs tabs
2715C--------------------------------------------
2716 IF(h3d_data%N_SCAL_CSE_FRIC >0.AND.output%DATA%S_EFRIC == 0)THEN
2717 ALLOCATE(output%DATA%EFRICG(numnod))
2718 output%DATA%EFRICG(1:numnod) = zero
2719 IF(nintstamp/=0) THEN
2720 ALLOCATE(output%DATA%EFRICG_STAMP(numnodg))
2721 output%DATA%EFRICG_STAMP(1:numnodg) = zero
2722 ELSE
2723 ALLOCATE(output%DATA%EFRICG_STAMP(0))
2724 ENDIF
2725 ELSEIF(output%DATA%S_EFRIC==0)THEN
2726 ALLOCATE(output%DATA%EFRICG(0))
2727 ALLOCATE(output%DATA%EFRICG_STAMP(0))
2728 ENDIF
2729
2730 IF(h3d_data%N_SCAL_CSE_FRICINT > 0.AND.output%DATA%S_EFRICINT==0) THEN
2731C
2732 ninefricg = h3d_data%N_SCAL_CSE_FRICINT
2733 output%DATA%NINEFRIC_STAMP = 0
2734 output%DATA%NINEFRIC = 0
2735 IF(nintstamp/=0) THEN
2736 DO n=1,ninter
2737 ni = h3d_data%N_CSE_FRIC_INTER (n)
2738 IF(ni/= 0.AND.ipari(7,n)==21) output%DATA%NINEFRIC_STAMP = output%DATA%NINEFRIC_STAMP + 1
2739 ENDDO
2740 ENDIF
2741 IF(output%DATA%NINEFRIC_STAMP==ninefricg) THEN
2742 CALL my_alloc(output%DATA%EFRIC_STAMP,ninefricg,numnodg)
2743 output%DATA%EFRIC_STAMP(1:ninefricg,1:numnodg) = zero
2744 CALL my_alloc(output%DATA%EFRIC,0,0)
2745 ELSEIF(output%DATA%NINEFRIC_STAMP==0) THEN
2746 output%DATA%NINEFRIC = ninefricg
2747 CALL my_alloc(output%DATA%EFRIC,output%DATA%NINEFRIC,numnod)
2748 output%DATA%EFRIC(1:ninefricg,1:numnod) = zero
2749 CALL my_alloc(output%DATA%EFRIC_STAMP,0,0)
2750 ELSE
2751 output%DATA%NINEFRIC = ninefricg-output%DATA%NINEFRIC_STAMP
2752 CALL my_alloc(output%DATA%EFRIC_STAMP,output%DATA%NINEFRIC_STAMP,numnodg)
2753 output%DATA%EFRIC_STAMP(1:output%DATA%NINEFRIC_STAMP,1:numnodg) = zero
2754 CALL my_alloc(output%DATA%EFRIC,output%DATA%NINEFRIC,numnod)
2755 output%DATA%EFRIC(1:output%DATA%NINEFRIC,1:numnod) = zero
2756 ns = 0
2757 nn= 0
2758 DO n=1,ninter
2759 ni = h3d_data%N_CSE_FRIC_INTER (n)
2760 IF(ni/= 0.AND.ipari(7,n)==21) THEN
2761 ns = ns+1
2762 h3d_data%N_CSE_FRIC_INTER (n) = output%DATA%NINEFRIC + ns
2763 ELSEIF (ni/=0) THEN
2764 nn = nn+1
2765 h3d_data%N_CSE_FRIC_INTER (n) = nn
2766 ENDIF
2767 ENDDO
2768 ENDIF
2769 ELSEIF(output%DATA%S_EFRICINT==0)THEN
2770 CALL my_alloc(output%DATA%EFRIC,0,0)
2771 CALL my_alloc(output%DATA%EFRIC_STAMP,0,0)
2772 ENDIF
2773C-----------------------------------
2774C-------------------------------------------
2775C Animations
2776C-------------------------------------------
2777
2778C------------------------------------------------
2779C Check function load of output frequencie and initial time step
2780C------------------------------------------------
2781 IF(output%nb_anim_frame >0.AND.output%DTANIM_FCT_ID==0) THEN
2782 IF(output%TANIM_STOP0 >zero.AND.output%TANIM_STOP0 /= ep20.AND.output%TANIM0 > 0) THEN
2783 output%DTANIM0 = (output%TANIM_STOP0 - output%TANIM0) / output%nb_anim_frame
2784 ELSEIF(output%TANIM_STOP0 >zero.AND.output%TANIM_STOP0 /= ep20) THEN
2785 output%DTANIM0 = (output%TANIM_STOP0-tt) / output%nb_anim_frame
2786 ELSEIF(output%TANIM0 >zero) THEN
2787 output%DTANIM0 = (tstop-output%TANIM0) / output%nb_anim_frame
2788 ELSE
2789 output%DTANIM0 = (tstop-tt) / output%nb_anim_frame
2790 ENDIF
2791 IF (output%DTANIM0 <= zero) THEN
2792 CALL ancmsg(msgid=293,anmode=aninfo,c1='ANIM',c2='ANIM')
2793 CALL arret(0)
2794 ENDIF
2795 ENDIF
2796
2797 ok = 0
2798 dtfct = 0
2799 IF (output%DTANIM_FCT_ID > 0) THEN
2800
2801 DO jj=1,nfunct
2802 IF(output%DTANIM_FCT_ID == npc(nfunct+2+jj-1)) THEN
2803 dtfct=jj
2804 ok = 1
2805 EXIT
2806 ENDIF
2807 ENDDO
2808 IF (ok == 0) THEN
2809 CALL ancmsg(msgid=315,
2810 . msgtype=msgerror,
2811 . anmode=aninfo_blind_1,
2812 . c1='ANIM',
2813 . i2=output%DTANIM_FCT_ID)
2814 ENDIF
2815 IF (ok >0) output%DTANIM_FCT_ID = dtfct
2816
2817 IF(output%DTANIM_FCT_ID > 0) THEN
2818 output%DTANIM0 = finter(output%DTANIM_FCT_ID,zero,npc,pld,dydx)
2819 !need to add the python also
2820 ENDIF
2821
2822 IF (output%DTANIM0 <= zero) THEN
2823 CALL ancmsg(msgid=293,anmode=aninfo,c1='ANIM',c2='ANIM')
2824 CALL arret(0)
2825 ENDIF
2826 ENDIF
2827
2828 IF(output%TANIM0 /= zero) output%TANIM = output%TANIM0
2829 IF(output%TANIM_STOP0/=zero .AND. output%TANIM_STOP0/=ep20) output%TANIM_STOP = output%TANIM_STOP0
2830 IF(output%DTANIM0 > zero) output%DTANIM= output%DTANIM0
2831 IF(output%DTANIM<=zero) output%TANIM = ep30
2832 IF (output%TANIM < tt-dt2.AND.output%DTANIM > zero)output%TANIM = output%TANIM
2833 . + int((tt-dt2-output%TANIM)/output%DTANIM)*output%DTANIM
2834 IF (output%TANIM < tt-dt2)output%TANIM = output%TANIM+output%DTANIM
2835C-----------------------
2836 IF(anim_v(14)+h3d_data%N_VECT_DROT > 0 .AND.
2837 . ((isecut == 0 .AND. iisrot == 0 .AND. impose_dr == 0 .AND. idrot == 0) .OR. iroddl == 0)) THEN
2838 IF(ispmd == 0) THEN
2839 WRITE(iout,*) ' ** WARNING ** : /ANIM/DROT OPTION USED',
2840 . ' WHILE ROTATIONAL DOF ARE NOT COMPUTED',
2841 . ' (IDROT = 0 IN /IOFLAG OPTION)'
2842 WRITE(istdo,*) ' ** WARNING ** : /ANIM/DROT OPTION USED',
2843 . ' WHILE ROTATIONAL DOF ARE NOT COMPUTED',
2844 . ' (IDROT = 0 IN /IOFLAG OPTION)'
2845 ENDIF
2846 IF(anim_v(14) == 1) THEN
2847 anim_v(14) = 0
2848 nv_ani = nv_ani - 1
2849 ENDIF
2850 ENDIF
2851C-----------------------
2852 IF(ispmd == 0.AND.mcheck == 0) THEN
2853C-----------------------
2854C Tracing Animations cards
2855C-----------------------
2856 WRITE(iout,1120)output%TANIM,output%DTANIM,output%TANIM_STOP,sensors%ANIM_ID,sensors%ANIM_DT,
2857 + anim_e(1),anim_e(2),anim_e(3),anim_e(25),
2858 + anim_e(4),anim_e(5),anim_e(6),
2859 + anim_e(7),anim_e(8),anim_e(9),
2860 + anim_e(10)+anim_e(4960)+anim_e(4961)+anim_e(4962)
2861 WRITE(iout,1129) anim_n(3),anim_n(4),anim_n(6)
2862 WRITE(iout,1130)
2863 + anim_v(1),anim_v(2),anim_v(3),anim_v(4),anim_v(5),
2864 + anim_v(6),anim_v(7),anim_v(9),anim_v(12),
2865 + anim_t(1),anim_t(2),anim_t(3),anim_t(4)
2866 WRITE(iout,1140)
2867 + anim_t(5),anim_t(6),anim_t(7),anim_t(8),
2868 + anim_m,anim_k
2869 ENDIF
2870C-------------------------------------------
2871c-----------------------------------------
2872c deallocate temporary SENSOR arrays
2873c-----------------------------------------
2874 IF (ALLOCATED(sensors%ANIM_TMP)) DEALLOCATE (sensors%ANIM_TMP)
2875 IF (ALLOCATED(sensors%STAT_TMP)) DEALLOCATE (sensors%STAT_TMP)
2876 IF (ALLOCATED(sensors%OUTP_TMP)) DEALLOCATE (sensors%OUTP_TMP)
2877 IF (ALLOCATED(sensors%STOP_TMP)) DEALLOCATE (sensors%STOP_TMP)
2878C---------------------------------------------------------
2879 IF(ierr == 0) RETURN
2880 CALL arret(0)
2881 1001 FORMAT(/
2882 & 1x,'ALE EULER SOLVERS'/
2883 & 1x,'-----------------'/)
2884 1002 FORMAT(
2885 & 1x,' +--STAGGERRED SCHEME'/
2886 & 1x,' | +--MOMENTUM : ',a16,' eta=',g14.7/
2887 & 1x,' | +--MASS : ',a16,' eta=',g14.7/
2888 & 1x,' | +--ENERGY : ',a16,' eta=',g14.7/
2889 & 1x,' | +--VOLUME FRACTION : ',a16)
2890 1003 FORMAT(
2891 & 1x,' |'/
2892 & 1x,' +--COLOCATED SCHEME (LAW151)'/
2893 & 1x,' | +--MOMENTUM : ',a16/
2894 & 1x,' | +--MASS : ',a16/
2895 & 1x,' | +--ENERGY : ',a16/
2896 & 1x,' | +--VOLUME FRACTION : ',a16 )
2897 1004 FORMAT(
2898 & 1x,' | +--LOW MACH OPTION : ENABLED' )
2899 1005 FORMAT(
2900 & 1x,' | +--MUSCL OPTION : ENABLED beta=',g14.7)
2901 1006 FORMAT(
2902 & 1x,' |'/
2903 & 1x,' +--TIME STEP'/
2904 & 1x,' | +--COURANT NUMBER : ',g14.7/
2905 & 1x,' | +--MINIMUM TIME STEP : ',g14.7)
2906 1007 FORMAT(
2907 & 1x,' |'/
2908 & 1x,' +--GRID SMOOTHING'/
2909 & 1x,' +--FORMULATION : ',a17)
2910 1008 FORMAT(
2911 & 1x,' +--PARAMETERS :')
2912
2913 1099 FORMAT(
2914 . ' MULTIDOMAINS COUPLING . . . . . . . . . . . . . .',g14.7//)
2915 1100 FORMAT(
2916 . ' FINAL TIME . . . . . . . . . . . . . . . . . . . ',g14.7//
2917 . ' TIME INTERVAL FOR TIME HISTORY PLOTS . . . . . . ',g14.7//
2918 . ' TIME STEP SCALE FACTOR . . . . . . . . . . . . . ',g14.7//
2919 . ' MINIMUM TIME STEP . . . . . . . . . . . . . . . ',g14.7//)
2920 1105 FORMAT(
2921 . ' BRICK TIME STEP SCALE FACTOR . . . . . . . . . . ',g14.7/
2922 . ' BRICK MINIMUM TIME STEP. . . . . . . . . . . . . ',g14.7/
2923 . ' MIN. TIME STEP FLAG (1:STOP RUN, 2:DELETE BRICK) ',i5//
2924 . ' QUAD TIME STEP SCALE FACTOR. . . . . . . . . . . ',g14.7/
2925 . ' QUAD MINIMUM TIME STEP . . . . . . . . . . . . . ',g14.7/
2926 . ' MIN. TIME STEP FLAG (1:STOP RUN, 2:DELETE QUAD). ',i5//
2927 . ' SHELL TIME STEP SCALE FACTOR . . . . . . . . . . ',g14.7/
2928 . ' SHELL MINIMUM TIME STEP. . . . . . . . . . . . . ',g14.7/
2929 . ' MIN. TIME FLAG (1:STOP, 2:DELETE, 3:SMALL STRAIN)',i5//
2930 . ' TRUSS TIME STEP SCALE FACTOR . . . . . . . . . . ',g14.7/
2931 . ' TRUSS MINIMUM TIME STEP. . . . . . . . . . . . . ',g14.7/
2932 . ' MIN. TIME FLAG (1:STOP, 2:DELETE). . . . . . . . ',i5//
2933 . ' BEAM TIME STEP SCALE FACTOR. . . . . . . . . . . ',g14.7/
2934 . ' BEAM MINIMUM TIME STEP . . . . . . . . . . . . . ',g14.7/
2935 . ' MIN. TIME FLAG (1:STOP, 2:DELETE). . . . . . . . ',i5//
2936 . ' SPRING TIME STEP SCALE FACTOR. . . . . . . . . . ',g14.7/
2937 . ' SPRING MINIMUM TIME STEP . . . . . . . . . . . . ',g14.7/
2938 . ' MIN. TIME FLAG (1:STOP, 2:DELETE). . . . . . . . ',i5//
2939 . ' AIRBAG TIME STEP SCALE FACTOR. . . . . . . . . . ',g14.7/
2940 . ' AIRBAG MINIMUM TIME STEP . . . . . . . . . . . . ',g14.7/
2941 . ' MIN. TIME FLAG (1:STOP). . . . . . . . . . . . . ',i5//
2942 . ' CONTACT TIME STEP SCALE FACTOR . . . . . . . . . ',g14.7/
2943 . ' CONTACT MINIMUM TIME STEP. . . . . . . . . . . . ',g14.7/
2944 . ' MIN. TIME FLAG(1:STOP, 2:REMOVE NODE FROM INTERF)',i5/ )
2945 1155 FORMAT('/DT/FVMBAG/0 OPTION')
2946 1156 FORMAT('/DT/FVMBAG/1 OPTION')
2947 1157 FORMAT('FVMBAG TIME STEP SYNTHESIS')
2948 1147 FORMAT(
2949 . ' FVMBAG ID. . . . . . . . . . . . . . . . . . . . ',i10)
2950 1148 FORMAT(
2951 . ' FVMBAG1 ID. . . . . . . . . . . . . . . . . . . . ',i10)
2952 1149 FORMAT(
2953 . ' FVMBAG2 ID. . . . . . . . . . . . . . . . . . . . ',i10)
2954 1151 FORMAT(
2955 . ' SMOOTH PARTICLES TIME STEP SCALE FACTOR. . . . . ',g14.7/
2956 . ' SMOOTH PARTICLES MINIMUM TIME STEP . . . . . . . ',g14.7/
2957 . ' MIN. TIME FLAG (1:STOP, 2:DELETE, 5:KILL). . . . ',i5 )
2958 1152 FORMAT(
2959 . ' FVMBAG TIME STEP SCALE FACTOR. . . . . . . . . . ',g14.7/
2960 . ' FVMBAG MINIMUM TIME STEP . . . . . . . . . . . . ',g14.7/
2961 . ' FVMBAG TIME STEP FLAG. . . . . . . . . . . . . . ',i5,/)
2962 1153 FORMAT(
2963 . ' . . TIME STEP SCALE FACTOR. . . . . . . . . . . . . . ',g14.7/
2964 . ' . . MINIMUM TIME STEP . . . . . . . . . . . . . . . . ',g14.7/
2965 . ' . . TIME STEP FLAG. . . . . . . . . . . . . . . . . . ',i5)
2966 1154 FORMAT(
2967 . ' . . CHARACTERISTIC LENGTH OPTION. . . . . . . . . . . ',i5/
2968 . ' . . TIME STEP SMOOTHING FACTOR. . . . . . . . . . . . ',g14.7/
2969 . ' . . PREVIOUS TIME STEP. . . . . . . . . . . . . . . . ',g14.7)
2970 1107 FORMAT(
2971 . ' CONTACT NODAL TIME STEP SCALE FACTOR . . . . . . ',g14.7/
2972 . ' CONTACT NODAL MINIMUM TIME STEP. . . . . . . . . ',g14.7/
2973 . ' CONTACT NODAL MIN. TIME FLAG . . . . . . . . . . ',i5/
2974 . ' 3:INCREASE MASS, ORIGINAL FORMULATION . . . . ',/
2975 . ' 8:INCREASE MASS, IMPROVED FORMULATION . . . . ',//)
2976 1209 FORMAT(
2977 . ' AMS CONTACT TIME STEP IS ON . . . . . . . . . . . . .',/
2978 . ' . . . . . .(ALL CONTACTS WILL BE CONCERNED).) . . . .',/
2979 . ' AMS CONTACT TIME STEP SCALE FACTOR. . . . . . . . . .',g14.7/
2980 . ' AMS CONTACT MINIMUM TIME STEP . . . . . . . . . . . .',g14.7//)
2981 1106 FORMAT(
2982 . ' NODAL TIME STEP SCALE FACTOR, . . . . . . . . . ',g14.7/
2983 . ' NODAL MINIMUM TIME STEP. . . . . . . . . . . . . ',g14.7/
2984 . ' MIN. TIME FLAG . . . . . . . . . . . . . . . . . ',i5/
2985 . ' 1:STOP. . . . . . . . . . . . . . . . . . . . ',/
2986 . ' 3:INCREASE MASS, ORIGINAL FORMULATION . . . . ',/
2987 . ' 8:INCREASE MASS, IMPROVED FORMULATION . . . . ',//)
2988 1116 FORMAT(
2989 . ' NODAL TIME STEP SCALE FACTOR, . . . . . . . . . ',g14.7/
2990 . ' NODAL MINIMUM TIME STEP. . . . . . . . . . . . . ',g14.7/)
2991 1206 FORMAT(
2992 . ' NODAL TIME STEP SCALE FACTOR, . . . . . . . . . ',g14.7/
2993 . ' NODAL MINIMUM TIME STEP. . . . . . . . . . . . . ',g14.7/
2994 . ' ADDED MASS RATIO (DM/M0) . . . . . . . . . . . . ',g14.7/
2995 . ' MIN. TIME FLAG . . . . . . . . . . . . . . . . . ',i5/
2996 . ' 1:STOP. . . . . . . . . . . . . . . . . . . . ',/
2997 . ' 3:INCREASE MASS, ORIGINAL FORMULATION . . . . ',/
2998 . ' 8:INCREASE MASS, IMPROVED FORMULATION . . . . ',//)
2999 1108 FORMAT(
3000 . ' ADVANCED MASS SCALING IS ON . . . . . . . . . . .',/
3001 . ' AMS NODAL TIME STEP SCALE FACTOR. . . . . . . . .',g14.7/
3002 . ' AMS NODAL MINIMUM TIME STEP . . . . . . . . . . .',g14.7/
3003 . ' AMS TOLERANCE ON CONVERGENCE. . . . . . . . . . .',g14.7/
3004 . ' AMS MAXIMUM NUMBER OF ITERATIONS FOR CONVERGENCE.',i10/
3005 . ' OUTPUT FREQUENCY OF INFORMATION / CONVERGENCE . .',i10/
3006 . ' PART GROUP ID (=0 ALL PARTS) . . . . . . . . . . ',i10//)
3007 1109 FORMAT(
3008 . ' ADVANCED MASS SCALING IS ON . . . . . . . . . . .',/
3009 . ' AMS TIME STEP SCALE FACTOR. . . . . . . . . . . .',g14.7/
3010 . ' AMS MINIMUM TIME STEP . . . . . . . . . . . . . .',g14.7/
3011 . ' AMS TOLERANCE ON CONVERGENCE. . . . . . . . . . .',g14.7/
3012 . ' AMS MAXIMUM NUMBER OF ITERATIONS FOR CONVERGENCE.',i10/
3013 . ' number of preconditioning vectors for pcg . . . .',I10/
3014 . ' output frequency of information / convergence . .',I10/
3015 . ' part group id(=0 all parts) . . . . . . . . . . ',I10//)
3016 2109 FORMAT(
3017 . ' advanced mass scaling is on . . . . . . . . . . .',/
3018 . ' ams time step scale factor. . . . . . . . . . . .',G14.7/
3019 . ' ams minimum time step . . . . . . . . . . . . . .',G14.7/
3020 . ' ams tolerance on convergence. . . . . . . . . . .',G14.7/
3021 . ' ams maximum number of iterations for convergence.',I10/
3022 . ' number of preconditioning vectors for pcg . . . .',I10/
3023 . ' output frequency of information / convergence . .',I10/
3024 . ' auto element selection - time step criteria . . .',G14.7/
3025 . ' part group id(=0 all parts) . . . . . . . . . . ',I10//)
3026 1110 FORMAT(
3027 . ' printout cycle frequency . . . . . . . . . . . . ',I5 //
3028 . ' restart cycle frequency. . . . . . . . . . . . . ',I10 //
3029 . ' maximum restart WRITE before overwrite . . . . . ',I5 //
3030 . ' invers: input deck version . . . . . . . . . . . ',I5/
3031 . ' ittyp : flag for TYPE of t-file. . . . . . . . . ' ,I5/)
3032 1120 FORMAT(/
3033 . ' time for first animation-file plot . . . . . . . ',G14.7/
3034 . ' time interval for animation-file plots . . . . . ',G14.7/
3035 . ' time to stop animation-file plots. . . . . . . . ',G14.7/
3036 . ' sensor for animation-file plots. . . . . . . . . ',I10/
3037 . ' time interval for sensor animation-file plots. . ',G14.7//
3038 . ' variable saved on animation files(1: yes) :',/
3039 . ' plastic strain. . . . . . ',I5/
3040 . ' density(solid only). ',I5/
3041 . ' specific energy . . . . . ',I5/
3042 . ' hourglass energy. . . . . ',I5/
3043 . ' temperature(solid only). ',I5/
3044 . ' thickness(shell only). ',I5/
3045 . ' pressure(solid only). ',I5/
3046 . ' von mises . . . . . . . . ',I5/
3047 . ' turbulent energy(fluid). ',I5/
3048 . ' turbulent viscosity(fluid)',I5/
3049 . ' vorticity(fluid) . . . . ',I5)
3050 1129 FORMAT(
3051 . ' nodal values saved on animation files(1: yes) :',/
3052 . ' pressure. . . . . . . . . ',I5/
3053 . ' density . . . . . . . . . ',I5/
3054 . ' temperature . . . . . . . ',I5)
3055 1130 FORMAT(
3056 . ' vector saved on animation files(1: yes) :',/
3057 . ' velocity vector . . . . . ',I5/
3058 . ' displacement vector . . . ',I5/
3059 . ' acceleration vector . . . ',I5/
3060 . ' contact forces. . . . . . ',I5/
3061 . ' internal forces . . . . . ',I5/
3062 . ' EXTERNAL forces . . . . . ',I5/
3063 . ' section rby rwall forces. ',I5/
3064 . ' rotational velocity vector',I5/
3065 . ' contact pressure(vectors)',I5/
3066 . ' shell tensor saved on animation files(1: yes) :',/
3067 . ' membrane stress . . . . . ',I5/
3068 . ' bending stress(moment/t^2)',I5/
3069 . ' upper layer stress. . . . ',I5/
3070 . ' lower layer stress. . . . ',I5)
3071 1140 FORMAT(
3072 . ' membrane strain . . . . . ',I5/
3073 . ' curvature . . . . . . . . ',I5/
3074 . ' upper layer strain. . . . ',I5/
3075 . ' lower layer strain. . . . ',I5/
3076 . ' nodal mass saved on animation files(1: yes) :',I5/
3077 . ' keep deleted element(1: yes) :',I5//)
3078 1150 FORMAT(
3079 . ' initial time step. . . . . . . . . . . . . . . . ',G14.7/
3080 . ' maximum time step. . . . . . . . . . . . . . . . ',G14.7)
3081 1160 FORMAT(/
3082 . ' IMPLICIT : conjugated gradient ' /
3083 . ' global convergence precision . . . . . . . . . . ',G14.7/
3084 . ' incremental convergence precision. . . . . . . . ',G14.7/
3085 . ' maximum number of iterations . . . . . . . . . . ',I5)
3086 1171 FORMAT(/
3087 . ' dynamic relaxation ' /
3088 . ' node group id(=0 all nodes) . . . . . . . . . . ',I10/
3089 . ' beta . . . . . . . . . . . . . . . . . . . . . . ',G14.7/
3090 . ' period . . . . . . . . . . . . . . . . . . . . . ',G14.7)
3091 1172 FORMAT(/
3092 . ' kinematic relaxation ' /
3093 . ' node group id(=0 all nodes) . . . . . . . . . . ',I10)
3094 1180 FORMAT(/
3095 . ' parallel arithmetic off')
3096 1181 FORMAT(/
3097 . ' parallel arithmetic on')
3098 1182 FORMAT(/
3099 . ' parallel arithmetic flag . . . . . . . . . . . . ',I5)
3100 1196 FORMAT(/
3101 . ' quasi-compressible formulation on(/incmp)')
3102 1198 FORMAT(
3103 . ' momentum : mixed integration')
3104 1199 FORMAT(
3105 . ' momentum : volume integration')
3106 1200 FORMAT(
3107 . 28X,' alpha : donea coefficient. . . . . . . . . . . ',g14.7/
3108 . 28x,' GAMMA : GRID VELOCITY LIMITATION FACTOR. . . . ',g14.7/
3109 . 28x,' FscaleX : X-GRID VELOCITY SCALE FACTOR . . . . . ',g14.7/
3110 . 28x,' FscaleY : Y-GRID VELOCITY SCALE FACTOR . . . . . ',g14.7/
3111 . 28x,' FscaleZ : Z-GRID VELOCITY SCALE FACTOR . . . . . ',g14.7/
3112 . 28x,' VOLMIN : MINIMUM VOLUME FOR ELEMENT DELETION. . ',g14.7//)
3113 1220 FORMAT(
3114 . 28x,' UMAX : MAXIMUM ABSOLUTE GRID VELOCITY . . . . . ',g14.7/
3115 . 28x,' VMIN : MINIMUM VOLUME FOR ELEMENT DELETION. . . ',g14.7//)
3116 1250 FORMAT(
3117 . 28x,' DT0 : TYPICAL TIME STEP. . . . . . . . . . . . ',g14.7/
3118 . 28x,' DT0* : EFFECTIVE TIME STEP. . . . . . . . . . . ',g14.7/
3119 . 28x,' GAMMA : NON LINEARITY FACTOR . . . . . . . . . . ',g14.7/
3120 . 28x,' ETA : DAMPING COEFFICIENT . . . . . . . . . . ',g14.7/
3121 . 28x,' NU : SHEAR FACTOR . . . . . . . . . . . . . . ',g14.7/
3122 . 28x,' VOLMIN: MINIMUM VOLUME FOR ELEMENT DELETION. . . ',g14.7//)
3123 1254 FORMAT(
3124 . 28x,' ALPHA : STABILITY FACTOR . . . . . . . . . . . . ',g14.7/
3125 . 28x,' GAMMA : NON LINEARITY FACTOR . . . . . . . . . . ',g14.7/
3126 . 28x,' BETA : DAMPING COEFFICIENT. . . . . . . . . . . ',g14.7/
3127 . 28x,' LC : CHARACTERISTIC LENGTH. . . . . . . . . . ',g14.7//)
3128 1257 FORMAT(
3129 . 28x,' ENABLED DEFORMATION . . . . . . . . . . . . . . ',a3/
3130 . 28x,' ENABLED ROTATION . . . . . . . . . . . . . . . ',a3/
3131 . 28x,' SCALE FACTOR FOR DEFORMATION . . . . . . . . . . ',g14.7/
3132 . 28x,' SCALE FACTOR FOR ROTATION . . . . . . . . . . . ',g14.7//)
3133 1300 FORMAT(
3134 . ' NUMBER OF INTERFACES TO BE ELIMINATED. . . . . . ',i8//
3135 . ' NUMBER OF PARTS TO BE ELIMINATED . . . . . . . . ',i8//
3136 . ' NUMBER OF SOLID ELEMENT BLOCKS TO BE ELIMINATED ',i8//
3137 . ' NUMBER OF QUAD ELEMENT BLOCKS TO BE ELIMINATED ',i8//
3138 . ' NUMBER OF SHELL ELEMENT BLOCKS TO BE ELIMINATED ',i8//
3139 . ' NUMBER OF TRUSS ELEMENT BLOCKS TO BE ELIMINATED ',i8//
3140 . ' NUMBER OF BEAM ELEMENT BLOCKS TO BE ELIMINATED ',i8//
3141 . ' NUMBER OF SPRING ELEMENT BLOCKS TO BE ELIMINATED ',i8//
3142 . ' NUMBER OF SH_3N ELEMENT BLOCKS TO BE ELIMINATED ',i8//
3143 . ' NUMBER OF SPH PARTICLES BLOCKS TO BE ELIMINATED ',i8/)
3144 1400 FORMAT(
3145 . ' NUMBER OF RIGID LINKS. . . . . . . . . . . . . . ',i8/)
3146 1450 FORMAT(
3147 . ' NUMBER OF ALE LINKS. . . . . . . . . . . . . . . ',i8/)
3148 1500 FORMAT(
3149 . ' NUMBER OF NEW BOUNDARY CONDITIONS. . . . . . . . ',i8/)
3150 1550 FORMAT(
3151 . ' REMOVE INTER.7 SEGMENT AFTER SHELL FAILURE(1 YES)',i5/)
3152 1810 FORMAT(///' LIST OF ELIMINATED SOLID ELEMENTS ')
3153 1820 FORMAT(///' LIST OF ELIMINATED QUAD ELEMENTS ')
3154 1830 FORMAT(///' LIST OF ELIMINATED SHELL ELEMENTS ')
3155 1840 FORMAT(///' LIST OF ELIMINATED TRUSS ELEMENTS ')
3156 1850 FORMAT(///' LIST OF ELIMINATED BEAM ELEMENTS ')
3157 1860 FORMAT(///' LIST OF ELIMINATED SPRING ELEMENTS ')
3158 1870 FORMAT(///' LIST OF ELIMINATED SH_3N ELEMENTS ')
3159 1880 FORMAT(///' LIST OF ELIMINATED SPH PARTICLES ')
3160 1890 FORMAT(///' LIST OF ELIMINATED PARTS ')
3161 2000 FORMAT(/' INTERFACE NUMBER',i10,' IS ELIMINATED')
3162 2100 FORMAT(/' RIGID LINK:',i5,
3163 . ' TRANSLATION X,Y,Z',3(1x,i1),
3164 . ' ROTATION X,Y,Z',3(1x,i1),
3165 . ' SKEW ',i10,/
3166 . ' ---------- ',i10,' NODES :')
3167 2200 FORMAT(/' ALE LINK: ',/,
3168 . ' --------',/,
3169 . ' MAIN NODES : ',2i8,/,
3170 . ' (X,Y,Z) : (',i1,',',i1,',',i1,')',/,
3171 . ' TYPE : ',i2)
3172 2201 FORMAT( ' NODES :')
3173 2202 FORMAT( ' NODE GROUP : ',i2)
3174 2210 FORMAT(' DEACTIVATING ALE LINK ID:',i5)
3175 2211 FORMAT(' ACTIVATING ALE LINK ID:',i5)
3176 2300 FORMAT(/' INTERFACE CHANGES'/
3177 . ' INTERFACE NB . . . . . . . . . . . . . . . . . . ',i10/
3178 . ' SEARCH OF CLOSEST NODES EACH NSEARCH TIME STEPS. ',i5/
3179 . ' START TIME . . . . . . . . . . . . . . . . . . . ',g14.7/
3180 . ' STOP TIME . . . . . . . . . . . . . . . . . . . ',g14.7)
3181
3182 2301 FORMAT(/' ERROR IN INTERFACE CHANGES'/
3183 . ' INTERFACE NB IS NOT EXISTING . . . . . . . . . . ',i10)
3184
3185 4000 FORMAT(/
3186 . ' SPMD PARALLEL RESTART READING (PREAD) ACTIVATED')
3187 4100 FORMAT(/
3188 . ' SPMD ELEMENT WEIGHT ESTIMATION (DDW) ACTIVATED')
3189C
3190 4500 FORMAT(/
3191 & 1x,'EXTERNAL LIBRARY FOR USERS CODE INTERFACE ')
3192 4600 FORMAT(
3193 & 1x,'LIBRARY NAME . . . . . . . . . . . . . . . . . . . . ',a/
3194 & 1x,'RADIOSS USERS CODE INTERFACE VERSION . . . . . . . .',i10//)
3195 4700 FORMAT(
3196 . ' BRICK TIME STEP SCALE FACTOR . . . . . . . . . . ',g14.7/
3197 . ' BRICK MINIMUM TIME STEP. . . . . . . . . . . . . ',g14.7/
3198 . ' MIN. TIME STEP FLAG (1:STOP RUN, 2:DELETE 3:CST )',i5//
3199 . ' BRICK_CST MINIMUM ASPECT RATIO (Tet collapse). . ',g14.7/
3200 . ' brick_cst minimum volume change . . . . . . . . ',G14.7//
3201 . ' quad time step scale factor. . . . . . . . . . . ',G14.7/
3202 . ' quad minimum time step . . . . . . . . . . . . . ',G14.7/
3203 . ' min. time step flag(1:stop run, 2:delete quad). ',I5//
3204 . ' shell time step scale factor . . . . . . . . . . ',G14.7/
3205 . ' shell minimum time step. . . . . . . . . . . . . ',G14.7/
3206 . ' min. time flag(1:stop, 2:delete, 3:small strain)',I5//
3207 . ' truss time step scale factor . . . . . . . . . . ',G14.7/
3208 . ' truss minimum time step. . . . . . . . . . . . . ',G14.7/
3209 . ' min. time flag(1:stop, 2:delete). . . . . . . . ',I5//
3210 . ' beam time step scale factor. . . . . . . . . . . ',G14.7/
3211 . ' beam minimum time step . . . . . . . . . . . . . ',G14.7/
3212 . ' min. time flag(1:stop, 2:delete). . . . . . . . ',I5//
3213 . ' spring time step scale factor. . . . . . . . . . ',G14.7/
3214 . ' spring minimum time step . . . . . . . . . . . . ',G14.7/
3215 . ' min. time flag(1:stop, 2:delete). . . . . . . . ',I5//
3216 . ' airbag time step scale factor. . . . . . . . . . ',G14.7/
3217 . ' airbag minimum time step . . . . . . . . . . . . ',G14.7/
3218 . ' min. time flag(1:stop). . . . . . . . . . . . . ',I5//
3219 . ' INTERFACE type 7 time step scale factor. . . . . ',G14.7/
3220 . ' INTERFACE type 7 minimum time step . . . . . . . ',G14.7/
3221 . ' min. time flag(1:stop, 2:remove node from interf)',I5/ )
3222 4720 FORMAT(
3223 . ' accurate time step for shells is used. . . . . . ',/)
3224 4730 FORMAT(
3225 . ' accurate time step for 4-node & 8-node solid is used',/)
3226 4740 FORMAT(
3227 . ' accurate time step for 10-node tetrahedra is used ',/)
3228 4800 FORMAT(
3229 . ' part deactivated for ale / euler computation',2X,I10)
3230 5000 FORMAT(/' h3d files : '/
3231 . ' time for first h3d-file plot . . . . . . . . . . ',G14.7/
3232 . ' time interval for h3d-file plots . . . . . . . . ',G14.7/
3233 . ' variable saved on h3d files : ')
3234 5001 FORMAT(/
3235 . ' kinematic relaxation ' /
3236 . ' node group id(=0 all nodes) . . . . . . . . . . ',I10/
3237 . ' start time. . . . . . . . . . . . . . . . . . . ',G14.7/
3238 . ' stop time. . . . . . . . . . . . . . . . . . . ',G14.7)
3239 5010 FORMAT(/
3240 . ' adaptive dynamic relaxation ' ,/
3241 . ' node group id(=0 all nodes) . . . . . . . . . . ',I10/)
3242 5011 FORMAT(/
3243 . ' adaptive dynamic relaxation ' /
3244 . ' node group id(=0 all nodes) . . . . . . . . . . ',I10/
3245 . ' start time. . . . . . . . . . . . . . . . . . . ',G14.7/
3246 . ' stop time. . . . . . . . . . . . . . . . . . . ',G14.7)
3247 5020 FORMAT(
3248 . ' brick_del minimum collapse ratio. . . . . . . . . ',G14.7/
3249 . ' brick_del minimum volume change . . . . . . . . . ',G14.7/
3250 . ' brick_del maximum aspect ratio . . . . . . . . . ',G14.7/
3251 . ' brick_del maximum volume change . . . . . . . . . ',G14.7//)
3252
anim_build_index_all
subroutine anim_build_index_all(ispmd, mcheck, sensors, igeo, geo)
Definition anim_build_index_all.F:36
chkipari
subroutine chkipari(ipari)
Definition chkstfn3.F:211
lecimpl
subroutine lecimpl
Definition lectur.F:3321
lecfun
subroutine lecfun(npc, pld, nfct, nptst, table)
Definition lecfun.F:35
fr_rlale
subroutine fr_rlale(m1, m2, nod, itabm1, itag)
Definition fr_rlink1.F:131
lcbcsf
subroutine lcbcsf(icode, iskew, numbcsn, itab, itabm1, npby, iskwn, weight)
Definition lcbcsf.F:36
leccut
subroutine leccut(icut, xcut, itabm1)
Definition leccut.F:31
lecdamp
subroutine lecdamp(nd, dampr, igrnod)
Definition lecdamp.F:36
leceig
subroutine leceig(neigoff, neoff)
Definition leceig.F:31
lecflsw
subroutine lecflsw(nsflsw, ntflsw, neflsw, nnflsw, crflsw, x, ixs, iparg, itmp)
Definition lecflsw.F:37
lecfvbag1
subroutine lecfvbag1(nfvmodi, monvol, volmon)
Definition lecfvbag1.F:29
lecfvbag
subroutine lecfvbag(nfvmesh, monvol, volmon, x)
Definition lecfvbag.F:34
lecfxinp
subroutine lecfxinp(nfxinp)
Definition lecfxinp.F:33
lech3d
subroutine lech3d(output, geo, igeo, ipm, ipart, h3d_data, multi_fvm, ipari, iparg, tag_skins6, mds_label, mds_output_table, mds_nmat, max_depvar, mds_ndepsvar, elbuf_str, stack, ibcl, iloadp, lloadp, loads, mat_param, pblast, igrpart, npc, tf, snpc, stf)
Definition lech3d.F:97
lecinv
subroutine lecinv(niniv, x, v, vr, itab, iframe, xframe, igrnod, fxbipm, fxbvit, fxbrpm)
Definition lecinv.F:39
lecnoise
subroutine lecnoise(inoise, itabm1, names_and_titles)
Definition lecnoise.F:45
lecstat
subroutine lecstat(ipart, ipart_state, elbuf_tab, ipm, iparg, iparts, ipartc, ipartg, mat_param)
Definition lecstat.F:37
id
initmumps id
Definition multiplerhs_example.m:4
ale_mod
Definition ale_mod.F:150
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:253
alemuscl_mod
Definition alemuscl_mod.F:55
alemuscl_mod::alemuscl_param
type(alemuscl_param_) alemuscl_param
Definition alemuscl_mod.F:76
check_mod
Definition check_mod.F:34
check_mod::restart_file
integer restart_file
Definition check_mod.F:52
check_mod::check_message
character(len=2048), dimension(check_message_size) check_message
Definition check_mod.F:54
dt_mod
Definition dt_mod.F:80
fvbag_mod
Definition fvbag_mod.F:44
fvbag_mod::fvdata_old
type(fvbag_data), dimension(:), allocatable fvdata_old
Definition fvbag_mod.F:193
fvbag_mod::num_opt_dt_fvmbag_1
integer num_opt_dt_fvmbag_1
Definition fvbag_mod.F:199
fvbag_mod::num_opt_dt_fvmbag_0
integer num_opt_dt_fvmbag_0
Definition fvbag_mod.F:198
fxb_mod
Definition fxb_mod.F:32
fxb_mod::fxbipm
integer, dimension(:,:), allocatable fxbipm
Definition fxb_mod.F:39
groupdef_mod
Definition groupdef_mod.F:668
h3d_mod
Definition h3d_mod.F:311
intstamp_glob_mod
Definition intstamp_glob_mod.F:30
names_and_titles_mod
Definition names_and_titles_mod.F:1002
stack_mod
Definition stack_mod.F:75
state_mod
Definition state_mod.F:54
table_mod
Definition table_mod.F:113
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:323
rbyonf
subroutine rbyonf(iparg, ipari, ms, in, ixs, ixq, ixc, ixt, ixp, ixr, skew, itab, itabm1, iskwn, npby, onof, nrbynf, itag, lpby, rby, x, v, vr, ixtg, igrv, ibgr, weight, fr_rby2, partsav, ipart, elbuf_tab, icfield, lcfield, tagslv_rby)
Definition rbyonf.F:42
read_dynain
subroutine read_dynain(ipart, dynain_data, ipartc, iparttg, ixc, ixtg)
Definition read_dynain.F:39
section
subroutine section(nnod, n1, n2, n3, nstrf, x, v, vr, fsav, fopta, secfcum, ms, in, ifram, xsec)
Definition section.F:34
spmd_chkw
subroutine spmd_chkw(iwiout, iout)
Definition spmd_chkw.F:38
spmd_ibcast
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
Definition spmd_ibcast.F:57
spmd_glob_isum9
subroutine spmd_glob_isum9(v, len)
Definition spmd_th.F:520
spmd_wiout
subroutine spmd_wiout(iout, iwiout)
Definition spmd_wiout.F:40
upwind
subroutine upwind(rho, vis, vdx, vdy, vdz, r, s, t, deltax, gam, nel)
Definition upwind.F:35
velocity
subroutine velocity(a, ar, v, vr, fzero, itab, nale)
Definition velocity.F:29

◆ prout_buck()

subroutine prout_buck ( integer ip,
integer nbuck,
integer ibuck )

Definition at line 3261 of file lectur.F.

3262C-----------------------------------------------
3263C M o d u l e s
3264C-----------------------------------------------
3265 USE imp_kbcs
3266C-----------------------------------------------
3267C I m p l i c i t T y p e s
3268C-----------------------------------------------
3269#include "implicit_f.inc"
3270C-----------------------------------------------
3271C D u m m y A r g u m e n t s
3272C-----------------------------------------------
3273 INTEGER IP,NBUCK,IBUCK
3274C-----------------------------------------------
3275C L o c a l V a r i a b l e s
3276C-----------------------------------------------
3277 CHARACTER*25 MSG_BSOL(2)
3278 DATA
3279 . msg_bsol
3280 . / 'BCS',
3281 . '-' /
3282C-----------------------------------------------
3283 IF (ibuck > 0) THEN
3284 WRITE(ip,1000)
3285 ELSE
3286 WRITE(ip,2000)
3287 END IF
3288 WRITE(ip,3000)nbuck,shift_b,emin_b,emax_b,msgl_b,maxset_b, msg_bsol(1)
3289
3290 RETURN
3291 1000 FORMAT(
3292 . ' EULER BUCKLING ANALYSIS (RESTART):'/)
3293 2000 FORMAT(
3294 . ' EULER BUCKLING ANALYSIS :'/)
3295 3000 FORMAT(
3296 . ' NUMBER OF MODES TO BE COMPUTED: . . . . . ',2x,i5/
3297 . ' SHIFT IN BUCKLING MODES PENCIL: . . . . . ',2x,g14.7/
3298 . ' MINIMUM EIGENVALUE: . . . . . . . . . . . ',2x,g14.7/
3299 . ' MAXIMUM EIGENVALUE: . . . . . . . . . . . ',2x,g14.7/
3300 . ' OUTPUT MESSAGE LEVEL: . . . . . . . . . . ',2x,i5/
3301 . ' NUMBER OF VECTORS IN BLOCK OR SET: . . . ',2x,i5/
3302 . ' LINEAR SOLVER: . . . . . . . . . . . . . ',2x,a/)
imp_kbcs::maxset_b
integer maxset_b
Definition impbufdef_mod.F:475
imp_kbcs::msgl_b
integer msgl_b
Definition impbufdef_mod.F:475