OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lectur.F File Reference
#include "implicit_f.inc"
#include "r4r8_p.inc"
#include "hash_id.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com09_c.inc"
#include "com10_c.inc"
#include "com_engcards_c.inc"
#include "com_xfem1.inc"
#include "eigcom.inc"
#include "flowcom.inc"
#include "fxbcom.inc"
#include "intstamp_c.inc"
#include "lagmult.inc"
#include "sphcom.inc"
#include "param_c.inc"
#include "remesh_c.inc"
#include "tabsiz_c.inc"
#include "tablen_c.inc"
#include "scr03_c.inc"
#include "scr05_c.inc"
#include "scr06_c.inc"
#include "scr10_c.inc"
#include "scr12_c.inc"
#include "scr14_c.inc"
#include "scr15_c.inc"
#include "scr16_c.inc"
#include "scr17_c.inc"
#include "scr19_c.inc"
#include "scr23_c.inc"
#include "scry_c.inc"
#include "sms_c.inc"
#include "spmd_c.inc"
#include "ddspmd_c.inc"
#include "sysunit.inc"
#include "titr_c.inc"
#include "units_c.inc"
#include "warn_c.inc"
#include "r2r_c.inc"
#include "intread_c.inc"
#include "elbuf_c.inc"
#include "userlib.inc"
#include "drape_c.inc"
#include "boltpr_c.inc"
#include "inigrav_c.inc"
#include "inter18.inc"
#include "inter22.inc"
#include "ige3d_c.inc"
#include "random_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine lectur (multi_fvm, lsubmodel, is_dyna, detonators, ebcs_tab, seatbelt_converted_elements, nb_seatbelt_shells, nb_dyna_include, user_windows, output, mat_elem, names_and_titles, defaults, glob_therm, pblast, sensor_user_struct, check_used)
subroutine set_ibufssg_io (isphio, igrsurf, ibufssg_io)
subroutine init_permutation ()
subroutine tet4_10 (igeo, itet4_10)

Function/Subroutine Documentation

◆ init_permutation()

subroutine init_permutation

Definition at line 11549 of file lectur.F.

11550C-----------------------------------------------
11551C M o d u l e s
11552C-----------------------------------------------
11553 USE reorder_mod
11554
11555C-----------------------------------------------
11556C I m p l i c i t T y p e s
11557C-----------------------------------------------
11558#include "implicit_f.inc"
11559C-----------------------------------------------
11560C C o m m o n B l o c k s
11561C-----------------------------------------------
11562#include "com04_c.inc"
11563C-----------------------------------------------
11564C L o c a l V a r i a b l e s
11565C-----------------------------------------------
11566 INTEGER I
11567
11568 DO i=1,numels
11569 permutation%SOLID(i)=i
11570 ENDDO
11571 DO i=1,numelc
11572 permutation%SHELL(i)=i
11573 ENDDO
11574 DO i=1,numeltg
11575 permutation%TRIANGLE(i)=i
11576 ENDDO
11577
11578 RETURN
reorder_mod
Definition reorder_mod.F:45
reorder_mod::permutation
type(reorder_struct_) permutation
Definition reorder_mod.F:54

◆ lectur()

subroutine lectur ( type(multi_fvm_struct) multi_fvm,
type(submodel_data), dimension(nsubmod) lsubmodel,
integer, intent(in) is_dyna,
type(detonators_struct_), target detonators,
type(t_ebcs_tab), intent(inout) ebcs_tab,
integer, dimension(3,nb_seatbelt_shells), intent(inout) seatbelt_converted_elements,
integer, intent(in) nb_seatbelt_shells,
integer, intent(in) nb_dyna_include,
type(user_windows_), intent(inout) user_windows,
type(output_), intent(inout) output,
type (mat_elem_), intent(inout) mat_elem,
type(names_and_titles_), intent(inout) names_and_titles,
type(defaults_), intent(inout) defaults,
type(glob_therm_), intent(inout) glob_therm,
type(pblast_), intent(inout) pblast,
type(sensor_user_struct_) sensor_user_struct,
integer, intent(in) check_used )
Parameters
[in,out]names_and_titlesNAMES_AND_TITLES host the input deck names and titles for outputs
[in]check_usedFlag to check if node is used

Definition at line 540 of file lectur.F.

544C-----------------------------------------------
545C M o d u l e s
546C-----------------------------------------------
547 USE my_alloc_mod
548 USE dsgraph_mod
549 USE fvbag_mod
550 USE restmod
551 USE intbufmod
552 USE nod2el_mod
553 USE intstamp_glob_mod
554 USE submodel_mod
555 USE sms_mod
556 USE table_glob_mod
557 USE r2r_mod
558 USE elbufdef_mod
559 USE elbuftag_mod
560 USE message_mod
561 USE front_mod
562 USE sph_mod
563 USE cluster_mod
564 USE intbufdef_mod
565 USE intbufscratch_mod
566 USE ddweights_mod
567 USE xfem2def_mod
568 USE stack_mod
569 USE alefvm_mod
570 USE int8_mod
571 USE fvmbag_meshcontrol_mod
572 USE multi_fvm_mod
573 USE stack_var_mod
574 USE bpreload_mod
575 USE reorder_mod
576 USE inigrav
577 USE intbuf_fric_mod
578 USE inimap1d_mod
579 USE inimap2d_mod
580 USE func2d_mod
581 USE groupdef_mod
582 USE group_mod
583 USE optiondef_mod
584 USE option_mod
585 USE optiondef_mod
586 USE mid_pid_mod
587 USE failwave_mod
588 USE nlocal_reg_mod
589 USE skew_mod
590 USE meshsurfig3d_mod
591 USE mat_elem_mod
592 USE split_cfd_mod
593 USE pinchtype_mod
594 USE check_mod
595 USE inoutfile_mod
596 USE monvol_struct_mod
597 USE setdef_mod
598 USE set_mod
599 USE detonators_mod
600 USE ale_connectivity_mod
601 USE drape_mod
602 USE inivol_def_mod
603 USE sensor_mod
604 USE random_mod
605 USE ale_ebcs_mod
606 USE inverted_group_mod
607 USE mapping_option_mod
608 USE ebcs_mod
609 USE joint_mod
610 USE hm_option_read_mod
611 USE seatbelt_mod
612 USE loads_mod
613 USE state_mod
614 USE user_windows_mod
615 USE user_sensor_mod
616 USE ale_mod
617 USE output_mod
618 USE interfaces_mod
619 USE read_funct_python_mod
620 USE python_funct_mod
621 USE inter_cand_mod
622 USE names_and_titles_mod
623 USE damping_rby_spmdset_mod
624 USE hm_read_preload_axial_mod
625 USE bcs_mod, ONLY : bcs, bcs_struct_
626 USE defaults_mod
627 USE shell_offset_ini_mod,ONLY: shell_offset_ini
628 USE inter_offset_itag_mod, ONLY:inter_offset_itag
629 USE chk_shell_offset_mod, ONLY:chk_shell_offset
630 USE shell_offsetp_mod, ONLY:shell_offsetp
631 USE updfail_mod
632 USE random_walk_def_mod
633 use constraint_mod , only : constraint_,alloc_constraint_struct,dealloc_constraint_struct
634 use split_rwall_mod , only : split_rwall
635 use stifint_icontrol_mod, only : stifint_icontrol
636 use fractal_elem_renum_mod
637 use hm_preread_inivel_mod, only : hm_preread_inivel
638 use brokmann_random_def_mod
639 use brokmann_elem_renum_mod
640 use glob_therm_mod
641 use hm_read_inivol_mod
642 use pblast_mod
643 use iniebcs_propellant_
644 use init_monvol_mod ,only : init_monvol
645 use python_duplicate_nodes_mod
646 use split_bcs_wall_mod , only : split_bcs_wall
647 use split_bcs_nrf_mod , only : split_bcs_nrf
648 use hm_read_bcs_wall_mod , only : hm_read_bcs_wall
649 use hm_read_bcs_nrf_mod , only : hm_read_bcs_nrf
650 use element_mod , only : nixs,nixq,nixc,nixp,nixt,nixr,nixtg
651 use hm_preread_skw_mod, ONLY : hm_preread_skw
652 use hierarchy_rbody_mod
653C-----------------------------------------------
654C I m p l i c i t T y p e s
655C-----------------------------------------------
656#include "implicit_f.inc"
657C-----------------------------------------------
658C D u m m y A r g u m e n t s
659C-----------------------------------------------
660 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
661 TYPE(SUBMODEL_DATA) :: LSUBMODEL(NSUBMOD)
662 INTEGER,INTENT(IN) :: IS_DYNA
663 TYPE(DETONATORS_STRUCT_),TARGET :: DETONATORS
664 TYPE(T_EBCS_TAB), INTENT(INOUT) :: EBCS_TAB
665 INTEGER,INTENT(IN) :: NB_SEATBELT_SHELLS
666 INTEGER,INTENT(INOUT) :: SEATBELT_CONVERTED_ELEMENTS(3,NB_SEATBELT_SHELLS)
667 INTEGER,INTENT(IN) :: NB_DYNA_INCLUDE
668 TYPE(USER_WINDOWS_), INTENT(INOUT) :: USER_WINDOWS
669 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
670 TYPE(NAMES_AND_TITLES_),INTENT(INOUT) :: NAMES_AND_TITLES !< NAMES_AND_TITLES host the input deck names and titles for outputs
671 TYPE(DEFAULTS_),INTENT(INOUT) :: DEFAULTS
672 type(glob_therm_) ,intent(inout) :: glob_therm
673 TYPE(PBLAST_),INTENT(INOUT) :: PBLAST
674 TYPE(SENSOR_USER_STRUCT_) :: SENSOR_USER_STRUCT
675 INTEGER,INTENT(IN) :: CHECK_USED !< Flag to check if node is used
676C-----------------------------------------------
677C G l o b a l P a r a m e t e r s
678C-----------------------------------------------
679#include "r4r8_p.inc"
680C-----------------------------------------------
681C C o m m o n B l o c k s
682C-----------------------------------------------
683#include "hash_id.inc"
684#include "com01_c.inc"
685#include "com04_c.inc"
686#include "com06_c.inc"
687#include "com09_c.inc"
688#include "com10_c.inc"
689#include "com_engcards_c.inc"
690#include "com_xfem1.inc"
691#include "eigcom.inc"
692#include "flowcom.inc"
693#include "fxbcom.inc"
694#include "intstamp_c.inc"
695#include "lagmult.inc"
696#include "sphcom.inc"
697#include "param_c.inc"
698#include "remesh_c.inc"
699#include "tabsiz_c.inc"
700#include "tablen_c.inc"
701#include "scr03_c.inc"
702#include "scr05_c.inc"
703#include "scr06_c.inc"
704#include "scr10_c.inc"
705#include "scr12_c.inc"
706#include "scr14_c.inc"
707#include "scr15_c.inc"
708#include "scr16_c.inc"
709#include "scr17_c.inc"
710#include "scr19_c.inc"
711#include "scr23_c.inc"
712#include "scry_c.inc"
713#include "sms_c.inc"
714#include "spmd_c.inc"
715#include "ddspmd_c.inc"
716#include "sysunit.inc"
717#include "titr_c.inc"
718#include "units_c.inc"
719#include "warn_c.inc"
720#include "r2r_c.inc"
721#include "intread_c.inc"
722#include "elbuf_c.inc"
723#include "userlib.inc"
724#include "drape_c.inc"
725#include "boltpr_c.inc"
726#include "inigrav_c.inc"
727#include "inter18.inc"
728#include "inter22.inc"
729#include "ige3d_c.inc"
730#include "random_c.inc"
731C-----------------------------------------------
732C F u n c t i o n
733C-----------------------------------------------
734 INTEGER NLOCAL
735 EXTERNAL nlocal
736 INTEGER SET_USRTOS
737 EXTERNAL set_usrtos
738C-----------------------------------------------
739C L o c a l V a r i a b l e s
740C-----------------------------------------------
741 TYPE intermasurfep
742 INTEGER, DIMENSION(:), POINTER :: P
743 END TYPE intermasurfep
744
745 INTEGER II,I,J,KK,N, NPTS, NMNT, NRTMT_25,MLW,
746 . NUMEL, IFIP, IS_EULER,NB_EULER_GROUPS,
747 . NAIRWA,NTHWA, LWASPIO, LEN_G,LEN_M,LEN,
748 . IADBUF, IADGEO, NUVAR, NUVARI,
749 . NS_I7,NEL,ND,AUX,NS_I21,
750 . NPT,NS_I11,
751 . SVOLMON0,FLAG_GOTO,
752 . INNOD,INSEG,NSIGI, NSIGS, NSIGSH, NSIGSPH,
753 . LB_MAX, P, NG,
754 . IINU ,NEL3D,NEL2D,NEL1D,IMAX,JMAX,
755 . OFF, NELEM, IDDLEVEL, NELEMINT,
756 . IFIXIN,IFIEND,ICO,
757 . IDS,IUN,L_MUL_LAG,NCMAX,NKMAX,
758 . MAXRTMS,MAXNSNE,
759 . MAXRTM,LWAT, L_MUL_LAG1,ISHIF,LIBAGALE,
760 . LENTHG, LBUFMAT, LBUFGEO, LBUFSF,
761 . LNOM_OPT, LENVOLU, ILEN, LCNE, LCNI2G,LENPOR,
762 . PM1SHF, NFX, AIPM, ANOD, AMOD, NBNO, NBMO,
763 . ALM, NELS, NELC, NELTG, NLGRAV, AGRVI, AGRVR,
764 . NNT, RCLEN,PM1SPH, STAT, NELDMAX, VERSDD,
765 . DSNISM, NSLEVEL,NSDEC,NSVMAX,NSPRI,DSARCH,NELT,NELP,NSEGS,
766 . NNFT, NDOFMIN, NMANIM, DSANIM,NRCVVOIS0,NSIGRS,
767 . LRBAGALE,FLAGG,ICOUNT,SWAFT, SWA4, SMATER, SEL2FA,
768 . SNFACPTX,SIXEDGE,SOFFX1,SNUMX1,SXNORM,SINVERT,SFUNC1,SIAD,
769 . SMAS,LEN_RM,LAG_NCF0,LAG_NKF0,
770 . LAG_NHF0,LAG_NCL0,LAG_NKL0,MAXNNOD, IBID,
771 . SRTRANS,LCNE_CRKXFEM,NSEGSMAX,XFEMON,
772 . IN10,IN20,SNOM_OPT_OLD,LENI,FLAG_ALLOCATE,
773 . PROC_BID,FLG_R2R_ERR,NSPCOND0,LENTHGR,FLAG_XFEM,
774 . IADTABIGE,NDOUBLONIGE,DECALIGEO,HM_NSENSOR,
775 . IPARSENS,NBT8,
776 . TAB_SOL(6),ISTR_24,IDEL_SOLID,
777 . LCNCND,I24MAXNSNE,NSIGBEAM,NSIGTRUSS,S_LOADPINTER,
778 . FLAGF,ITHFLAG,MAXRTM_T2,NS_I2,SITAGE,NCTRLMAX,INLIN,SVR_1
779 INTEGER (KIND=8) EMAX
780 INTEGER (KIND=8) K0,K1,K2,K3,K4,K5,K6,K7,K8
781! integer 8 version of the variables NUMELC etc.
782 INTEGER(KIND=8) NUMELCK8
783 INTEGER(KIND=8) NUMELTGK8
784 INTEGER(KIND=8) NUMELSK8
785 INTEGER(KIND=8) NUMELRK8
786 INTEGER(KIND=8) NUMELPK8
787 INTEGER(KIND=8) NUMELTK8
788 INTEGER(KIND=8) NUMELQK8
789 INTEGER(KIND=8) NUMELXK8
790 INTEGER(KIND=8) NUMELIG3DK8
791 INTEGER(KIND=8) NUMSPHK8
792 INTEGER(KIND=8) SVEUL8
793
794 integer
795 . isubmod(nsubmod),
796 . iuparam(100),ddstat(50,parasiz),igrnrb2(nrbe2),
797 . lcne_pxfem
798 INTEGER NSNT,NMNT_2
799
800 INTEGER, DIMENSION(:), ALLOCATABLE :: POIN_UMP_OLD
801 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAB_UMP_OLD
802 my_real, DIMENSION(:), ALLOCATABLE :: cputime_mp_old
803
804 INTEGER, DIMENSION(:,:), ALLOCATABLE :: POIN_PART_SHELL,POIN_PART_TRI
805 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: POIN_PART_SOL
806 TYPE(MID_PID_TYPE), DIMENSION(:), ALLOCATABLE :: MID_PID_SHELL,MID_PID_TRI
807 TYPE(MID_PID_TYPE), DIMENSION(:,:), ALLOCATABLE :: MID_PID_SOL
808 LOGICAL MARQUEUR3
809
810 INTEGER, DIMENSION(:),ALLOCATABLE ::
811 * IWCONT, IWCIN2 , IKINE1LAG ,DSDOF, TAGXREF,
812 * ADDCNE, ADDCNE_PXFEM, FXBTAG ,ADDCNE_CRKXFEM,
813 * TAGREFSTA,CSRECT
814
815 INTEGER, DIMENSION(:),ALLOCATABLE ::
816 * ISOLNOD,ISOLOFF,ISHEOFF,ITRUOFF,IPOUOFF,
817 * IRESOFF,ITRIOFF,IGRNRBY,IQUAOFF
818C
819 INTEGER(KIND=8) :: KVOISPH8,NUMSPH8,SIXSP8,LIMIT8
820 INTEGER :: INTEGER_LIMIT32
821
822 INTEGER, DIMENSION(:),ALLOCATABLE :: CEP,CEL,CNE,
823 . CNI2, CELI2, CEPI2,
824 . CEPSP, CELSPH, ITAGSH,
825 . CNE_PXFEM,CEL_PXFEM
826 INTEGER, DIMENSION(:), ALLOCATABLE :: FXBIPM, FXBNOD, FXBELM,
827 . FXBGRVI, EIGIPM, EIGIBUF,
828 . IMERGE,INTIDS,
829 . IMERGE2,IADMERGE2,
830 . NSLNRBM, SLNRBM,
831 . IGEO_STACK
832 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: ELDOM
833 INTEGER, DIMENSION(:), ALLOCATABLE :: CEPTMP, NELDOM
834 INTEGER, DIMENSION(:), ALLOCATABLE :: LLL
835 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ELSUB
836 INTEGER(KIND=8) ,TARGET :: DSMEMORY(7,NSPMD)
837 INTEGER, DIMENSION(:,:), ALLOCATABLE :: FXANI,IWORKSH, FXB_MATRIX_ADD
838 INTEGER, DIMENSION(:), ALLOCATABLE :: FASTAG,SEGTAG
839 INTEGER(KIND=8),TARGET :: MEMFLOW(2,NSPMD)
840 INTEGER, DIMENSION(:), ALLOCATABLE :: IFLOW
841C
842 INTEGER, DIMENSION(:), ALLOCATABLE :: KINWORK
843
844 INTEGER, DIMENSION(:), ALLOCATABLE :: CNE_CRKXFEM,CEL_CRKXFEM,ITAGN,ITAGE,CEP_CRKXFEM,IEDGE_TMP0,CRKNODIAD
845 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IEDGE_TMP
846C
847 INTEGER, DIMENSION(:), ALLOCATABLE :: NALE_R2R
848 INTEGER, DIMENSION(:,:), ALLOCATABLE :: FRONTB_R2R
849c elem sorting
850 INTEGER, DIMENSION(:), ALLOCATABLE :: IXS_S ,IXS_S_IND,
851 2 IXQ_S,IXQ_S_IND,IXC_S,IXC_S_IND,
852 3 IXT_S ,IXT_S_IND,IXP_S,IXP_S_IND,IXR_S,IXR_S_IND,
853 4 IXTG_S,IXTG_S_IND
854
855c tab IBUFSSG_IO specific inlet/outlet
856 INTEGER, DIMENSION(:), ALLOCATABLE :: IBUFSSG_IO, RESERVEP
857
858 INTEGER, DIMENSION(:), ALLOCATABLE :: IXR_KJ,R_SKEW
859C
860C initial direction for beams
861 INTEGER, DIMENSION(:), ALLOCATABLE :: IBEAM_VECTOR
862 my_real, DIMENSION(:,:), ALLOCATABLE :: rbeam_vector
863C
864C Sol2sph
865 INTEGER, DIMENSION(:), ALLOCATABLE :: SOL2SPH_TYP
866c tab /BCS/CYCLIC
867 INTEGER, DIMENSION(:), ALLOCATABLE :: IBCSCYC,LBCSCYC,ITAGCYC
868C
869 INTEGER, DIMENSION(:,:), ALLOCATABLE :: QP_IPERTURB,RBY_MSN
870 my_real
871 . , DIMENSION(:,:), ALLOCATABLE :: qp_rperturb,rby_iniaxis
872C
873 my_real
874 . eanit2(10),cost_r2r,totmas
875 TARGET :: eanit2
876C OpenMP specific
877 INTEGER ITASK, NP
878#if defined(_OPENMP)
879 INTEGER OMP_GET_THREAD_NUM, OMP_GET_NUM_THREADS
880 EXTERNAL omp_get_thread_num, omp_get_num_threads
881#endif
882
883 my_real
884 . , DIMENSION(:), ALLOCATABLE ::
885 . fxbrpm, fxbmod, fxbglm, fxbcpm, fxbcps, fxblm,
886 . fxbfls, fxbdls, fxbdep, fxbvit, fxbacc, fxbsig,
887 . fxbgrvr, eigrpm ,rmstifn, rmstifr,stiffn,
888 . ms_ply0, zi_ply0,msz20,msz2,lelx,fxb_matrix
889 my_real
890 . , DIMENSION(:,:), ALLOCATABLE :: mbufel, mdepl,rnoise
891 my_real
892 . , DIMENSION(:), ALLOCATABLE :: rflow,cmerge,dnull
893 my_real
894 . probint, flrec6(6), dscutfrq
895 my_real, DIMENSION(:), ALLOCATABLE ::
896 . xfiltr,stfac,fric_p,frigap,i2rupt,areasl,thk_part,
897 . geo_stack
898
899 my_real, DIMENSION(:,:,:), ALLOCATABLE :: xrefc,xreftg,xrefs
900 my_real, DIMENSION(:), ALLOCATABLE :: xyzref
901
902 my_real, DIMENSION(:), ALLOCATABLE :: dt_r2r
903 TYPE(INTERSURFP) , DIMENSION(:,:), ALLOCATABLE :: INTERCEP
904 my_real dtnoda
905 my_real, DIMENSION(:), ALLOCATABLE :: sh4ang,sh3ang
906 my_real, DIMENSION(:), ALLOCATABLE :: ms_b,in_b,dtelem
907C
908 TYPE (STACK_PLY) :: STACK
909C
910 INTEGER, DIMENSION(:), ALLOCATABLE :: IDRAPEID,PERTURB
911 TYPE (FVM_INIVEL_STRUCT), DIMENSION(:), ALLOCATABLE :: FVM_INIVEL
912 TYPE (FAILWAVE_STR_) :: FAILWAVE
913 TYPE (NLOCAL_STR_) :: NLOC_DMG
914 TYPE (PINCH) :: PINCH_DATA
915 TYPE (drape_) ,DIMENSION(:), ALLOCATABLE :: drape,drape_wrk
916 TYPE (DRAPEG_) :: DRAPEG
917 TYPE(DRAPE_WORK_) ,DIMENSION(:), ALLOCATABLE :: IWORK_T
918C ! DEF_SHELL / ioffset=1 treatment for contact
919 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAGOSET !Offset
920 my_real, DIMENSION(:), ALLOCATABLE, TARGET :: xyz
921 my_real, DIMENSION(:), POINTER :: x_c ! points to X or XYZ
922C
923 INTEGER, DIMENSION(:), ALLOCATABLE :: EBCS_TAG_CELL_SPMD
924C
925 TYPE (DYNAIN_DATABASE) :: DYNAIN_DATA
926 TYPE (INTERFACES_) :: INTERFACES
927 TYPE (MAT_ELEM_) ,INTENT(INOUT) :: MAT_ELEM
928 INTEGER LWAMP_L !< Size of work array in Engine (WA)
929 INTEGER LWANMP_L !< Size of work array in Engine (WA)
930C-----------------------------------------------
931 CHARACTER(LEN=4096) :: SCR_FILE_NAME
932 CHARACTER(LEN=ncharline) :: RLINE
933 CHARACTER (LEN=4) :: CWIN
934 LOGICAL :: IS_AVAILABLE
935 INTEGER NLINES,NUSERWI,USERWI_ID
936 INTEGER SCR_FILE_NAME_LEN
937 CHARACTER(LEN=ncharkey) :: KEY
938 INTEGER NUSPHCEL
939 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IXSPS
940 LOGICAL MAT20_DISCRETE_FILL
941 INTEGER, DIMENSION(:,:), ALLOCATABLE :: FLAG_ELEM_INTER25
942 INTEGER, DIMENSION(:), ALLOCATABLE :: LIST_NIN25
943 INTEGER, DIMENSION(:), ALLOCATABLE :: ISKEW_TMP
944 my_real, DIMENSION(:), ALLOCATABLE :: skew_tmp
945C-----------------------------------------------
946C Model Checker Memory
947 DATA iun/1/
948C======================================================================|
949C Allocations MA (Entiers)
950C======================================================================|
951 TYPE :: int_ptr_array
952 INTEGER, DIMENSION(:), POINTER :: ptr
953 END TYPE int_ptr_array
954 TYPE(int_ptr_array) :: IBUFTMP(0:1),NIGE_TMP(0:1)
955 TYPE :: real_ptr_array
956 my_real, DIMENSION(:), POINTER :: ptr2
957 END TYPE real_ptr_array
958 TYPE(real_ptr_array) :: RIGE_TMP(0:1),XIGE_TMP(0:1),
959 . VIGE_TMP(0:1)
960 INTEGER, DIMENSION(:), ALLOCATABLE ::
961 . FR_IAD,FUNCRYPT,
962 . IWORK,ITRI,KSYSUSR,PTSHEL,PTSH3N,PTSOL,PTQUAD,
963 . PTSPH,ISPTAG,DD_TMP,ITAG,ITAGND_SHXFEM,
964 . ITHPART,ITHSUB,ITHBUFTMP,DD_TMP2,
965 . IADHF,JCIHF,JLL,IWA,WEIGHT_RM,
966 . PTSPRI,PTBEAM,PTTRUSS
967 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IPARGTMP
968 TARGET :: iwork
969
970 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAB_UMP_LOC
971 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: TAB_UMP_LOC2
972 INTEGER, DIMENSION(:), POINTER ::
973 . IPARTTH,IPARTS,IPARTQ,IPARTC,IPARTT,IPARTP,IPARTR,
974 . IPARTG,IPARTX,IPARTSP,NPC1,IXS10,IXS20,IXS16,IPRES,
975 . IBMPC2,IBMPC3,IBMPC4,IWORK2,
976 . ITRI1,ITRI2,ITRI3,INDEX,
977 . INDEX1,INDEX2,IWD,IWEIG,INUM,EADD,ITR1,ITR2,XEP,
978 . IPARTTHI,IPARTIG3D,IEDGESH4,IEDGESH3,IELCRK4,IELCRK3
979 INTEGER BID13(1),SNPC1
980 INTEGER L0,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12,SIXTG0,
981 . SIXS0,SIXS10,SIXS20,SIXS16,SIWORK,SIWORK2,SIEXTAG,
982 . NUMCLD,NUMPRES,NUMLINK,NUMGRAV,NUMRBYMOU,
983 . SNRBODY,SLRBODY,LITHPART,LITHSUB,IDX,IDX1,IDX2,IDXCNT,
984 . LITHBUFI,LITHBUFMX,NTHGRPMX,SINDEX,SITRI,LDD_IAD,
985 . LSIGI,LSIGSH,LSIGSP,LSIGSPH,SINSCR,
986 . SIPART0,SIPARTTH,SIPARTS,SIPARTQ,SIPARTC,SIPARTT,SIPARTP,
987 . SIPARTR,SIPARTG,SIPARTX,SIPARTSP,ITER,
988 . LIXINT,SBUFALE,NVARTOT,
989 . NVARTOT0,NVARTOTMAX,NVARABF,
990 . PIXS10,PIXS16,PIXS20,NUMCFIELD,NUMLOADP,IXEL,
991 . SIPARTIG3D,IDXIGE1,IDXIGE2,
992 . IDXIGECNT,TAGSURFIGE,LSIGRS,LSIGBEAM,LSIGTRUSS,NSETFRICTOT,
993 . IORTHFRICMAX,COEFSLEN,NPFRICORTH,NGRPF,LENG,
994 . NIMPDISP,NIMPVEL,NIMPACC,NIMPV_LAGM,NFV0,NSETMAX,NFXVEL0
995 TYPE(CLUSTER_),DIMENSION(:),ALLOCATABLE :: CLUSTERS
996 TYPE(INTBUF_STRUCT_),DIMENSION(:),ALLOCATABLE :: INTBUF_TAB
997 TYPE(SCRATCH_STRUCT_),DIMENSION(:),ALLOCATABLE :: INSCR
998C--- Bolt preloading
999 INTEGER SIPRELOAD, SPRELOAD !NUMPRELOAD,
1000
1001c--- Element Buffer --------------------------------------------------
1002 TYPE(ELBUF_STRUCT_),DIMENSION(:) ,ALLOCATABLE :: ELBUF_TAB
1003 TYPE(ELBUF_STRUCT_),DIMENSION(:,:),ALLOCATABLE :: XFEM_TAB
1004 TYPE(MLAW_TAG_) ,DIMENSION(:) ,ALLOCATABLE, TARGET :: MTAG_INI,MTAG_R2R
1005 TYPE(MLAW_TAG_) ,DIMENSION(:) ,POINTER :: MLAW_TAG
1006 TYPE(EOS_TAG_) ,DIMENSION(:) ,ALLOCATABLE :: EOS_TAG
1007 TYPE(PROP_TAG_) ,DIMENSION(0:MAXPROP) :: PROP_TAG
1008 TYPE(FAIL_TAG_) ,DIMENSION(0:MAXFAIL) :: FAIL_TAG
1009c---- Xfem ------------------------------------------------------------
1010 TYPE (XFEM_SHELL_) ,DIMENSION(:), ALLOCATABLE :: CRKSHELL ! NLEVMAX
1011 TYPE (XFEM_LVSET_) ,DIMENSION(:), ALLOCATABLE :: CRKLVSET ! NLEVMAX
1012 TYPE (XFEM_SKY_) ,DIMENSION(:), ALLOCATABLE :: CRKSKY ! NLEVMAX
1013 TYPE (XFEM_AVX_) ,DIMENSION(:), ALLOCATABLE :: CRKAVX ! NLEVMAX
1014 TYPE (XFEM_EDGE_) ,DIMENSION(:), ALLOCATABLE :: CRKEDGE ! NXLAYMAX
1015 TYPE(XFEM_PHANTOM_),DIMENSION(:), ALLOCATABLE :: XFEM_PHANTOM ! NXLAYMAX
1016C NCRKPART & IND_CRK are global values shared by all processors (only for ANIM)
1017C ---- Interface t8
1018 TYPE(INT8_STRUCT_) , DIMENSION(:,:), ALLOCATABLE :: INTERT8
1019 INTEGER NCRKPART
1020 INTEGER, DIMENSION(:), ALLOCATABLE :: INDX_CRK
1021 INTEGER, DIMENSION(:), ALLOCATABLE :: PERMIGE
1022 TYPE(TABCONPATCH_IG3D_), DIMENSION(:), ALLOCATABLE :: TABCONPATCH
1023c--- Material data --------------------------------------------------
1024 TYPE(MATPARAM_STRUCT_) , DIMENSION(:), ALLOCATABLE , TARGET :: MPARAM_INI,MPARAM_R2R
1025c--- Element group parameter table --------------------------------------------------
1026 TYPE(GROUP_PARAM_) , DIMENSION(:), ALLOCATABLE :: GROUP_PARAM_TAB ! NGROUP
1027C AMS
1028 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: T2MAIN_SMS
1029C
1030 INTEGER :: SRNOISE1,SRNOISE2
1031C T2 SPT 27/28
1032 INTEGER NSN_MULTI_CONNEC
1033 INTEGER, ALLOCATABLE, DIMENSION(:) :: T2_NB_CONNEC
1034C MERGE RBODY
1035 INTEGER, DIMENSION(:), ALLOCATABLE :: MGRBY
1036C PINCHING
1037 INTEGER SPINCH
1038C For /H3D/STRESS/TENS/OUTER
1039 INTEGER, ALLOCATABLE, DIMENSION(:) :: TAG_SKINS6
1040 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEATBELT_SHELL_TO_SPRING
1041C--- Bolt preload/axial
1042 INTEGER :: NPRELOAD_A
1043 INTEGER, ALLOCATABLE, DIMENSION(:) :: ITAGPRLD_SPRING
1044 INTEGER, ALLOCATABLE, DIMENSION(:) :: ITAGPRLD_BEAM
1045 INTEGER, ALLOCATABLE, DIMENSION(:) :: ITAGPRLD_TRUSS
1046 TYPE(PREL1D_), DIMENSION(:), ALLOCATABLE :: PRELOAD_A
1047 INTEGER, ALLOCATABLE, DIMENSION(:) :: IPRELOAD_FUN ! workarray fun_id,sen_id
1048C======================================================================|
1049C Allocations AM (Reels)
1050C======================================================================|
1051 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: DBRWORK
1052 my_real, DIMENSION(:), ALLOCATABLE ::
1053 . rwork,stifint,mwa,mss,mssx,mssf,msq,msr,
1054 . inp,inr,ins,vns,vnsx,stc,stt,stp,str,sttg,stur,
1055 . bns,bnsx,volnod,bvolnod,etnod,nshnod,xelemwa,
1056 . xnum,xtmp,rtrans,msig3d,stifintr,strc,strr,strp,strtg,
1057 . vnige,bnige
1058 TARGET ::
1059 . rwork
1060 my_real, DIMENSION(:), POINTER ::
1061 . thkec,eanit,pres,wma
1062 INTEGER SRWORK
1063 INTEGER LXINTD
1064 my_real totaddmas
1065 CHARACTER(LEN=NCHARLINE) ::ERR_MSG
1066 INTEGER, DIMENSION(:), ALLOCATABLE :: IBORDEDGE,INOM_OPT
1067 DOUBLE PRECISION RSIBUFSSG,RNIGE,RRIGE,RXIGE,RVIGE
1068 INTEGER INTMAX, LLINAL,ITET4_10
1069C--------- Itet=2 of S10
1070 INTEGER, DIMENSION(:), ALLOCATABLE :: ICNDS10,ITAGND,ADDCNCND,
1071 . CNCND, CELCND, CEPCND
1072
1073 !Pointer to send a valid explicit address as argument in cas of not allocated
1074 INTEGER(KIND=8) ,POINTER :: pMEMFLOW
1075
1076 DATA intmax /2147483647/
1077 my_real,
1078 . DIMENSION(:), ALLOCATABLE :: fillsol
1079C
1080C Dynamical User Library
1081 CHARACTER FILNAM*512,CLAW*4
1082 INTEGER LEN_FILNAM
1083 INTEGER IADBOXMAX
1084 INTEGER, DIMENSION(:), ALLOCATABLE :: IADBOXMAX_NODE,IADBOXMAX_SURF,
1085 . IADBOXMAX_LINE,IADBOXMAX_ELEM
1086C
1087 my_real, DIMENSION(:,:), ALLOCATABLE ::
1088 . sigi,sigsh,sigsp,sigsph,sigrs,sigbeam,sigtruss
1089 INTEGER, DIMENSION(:), ALLOCATABLE ::
1090 . STRSGLOB,STRAGLOB,ORTHOGLOB
1091 INTEGER ISIGSH,IYLDINI,KSIGSH3,FAIL_INI(5),IUSOLYLD,IUSERL
1092C
1093 INTEGER FVMAIN(NVOLU + NMONVOL),NBSUBMAT
1094C GROUPS OF GROUPS
1095 INTEGER :: MEM_MARGIN
1096 parameter(mem_margin = 250000)
1097C--- INterface Friction model
1098 TYPE(INTBUF_FRIC_STRUCT_), DIMENSION(:), ALLOCATABLE :: INTBUF_FRIC_TAB
1099 INTEGER, DIMENSION(:), ALLOCATABLE ::TABCOUPLEPARTS_FRIC_TMP,TABPARTS_FRIC_TMP,
1100 . TAGPRT_FRIC,NSETINIT,IFRICORTH_TMP,
1101 . PFRICORTH ,IREPFORTH ,LENGRPF
1102 my_real, DIMENSION(:), ALLOCATABLE ::tabcoef_fric_tmp , vforth ,phiforth
1103 TYPE(INIMAP1D_STRUCT), DIMENSION(:), ALLOCATABLE :: INIMAP1D
1104 TYPE(INIMAP2D_STRUCT), DIMENSION(:), ALLOCATABLE :: INIMAP2D
1105 TYPE(FUNC2D_STRUCT), DIMENSION(:), ALLOCATABLE :: FUNC2D
1106 TYPE(PYTHON_) :: PYTHON
1107! DDSPLIT local arrays :
1108 LOGICAL :: FLAG_24_25
1109 INTEGER :: NINDX_NM,NINDX_SCRT,I24MAXNSNE2
1110 INTEGER, DIMENSION(NSPMD) :: NUMNOD_L
1111 INTEGER, DIMENSION(:), ALLOCATABLE :: TAG_NM,INDX_NM
1112 INTEGER, DIMENSION(:), ALLOCATABLE :: TAG_SCRATCH,INDX_SCRT
1113C FLEXIBLE BODY
1114 INTEGER FXB_LAST_ADDRESS(10)
1115 CHARACTER, DIMENSION(:), ALLOCATABLE :: FXBFILE_TAB*2148
1116C
1117! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1118! INDX_XXX : size = NUMNOD
1119! index of non-zero TAG_XXX value
1120! used for optimize the initialization
1121! of TAG_XXX array (XXX = NM or SCRT for SCRATCH)
1122! allocated array in lectur and threadprivate array
1123! NINDX_XXX : number of non-zero TAG_XXX value
1124! TAG_XXX : size = NUMNOD
1125! array used to tag an element for
1126! a given interface ; allocated in lectur
1127! allocated array in lectur and threadprivate array
1128! FLAG_24_25 : logical, flag for interface 24 or 25
1129! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1130 INTEGER, DIMENSION(:), ALLOCATABLE :: TAG_SKN
1131 TYPE(SKEW_) :: SKEWS
1132 TYPE (SENSOR_STR_) ,DIMENSION(:) ,ALLOCATABLE :: SENSOR_TMP
1133! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1134! TAG_SKN : integer ; dimension=NUMSKW+1
1135! tag array --> tag the i SKEW if a SPRING uses it
1136! tag array=0 --> the SKEW is not used by a SPRING
1137! tag array=1 --> the SKEW is used by one SPRING
1138! tag array>1 --> the SKEW is used by several SPRING
1139! tag array <0 --> the SKEW is used by several options (has to be duplicated to all domains that have the nodes)
1140! SKEWS : SKEW_ ; SKEW Type
1141 ! SKEWS%MULTIPLE_SKEW : dimension=NUMSKW+1
1142! %MULTIPLE_SKEW(I)%PLIST(:) is a list of processor
1143! where the SKEW is stick
1144! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1145 TYPE(SURF_), DIMENSION(:,:), ALLOCATABLE :: IGRSURF_PROC
1146! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1147! IGRSURF_PROC : SURF_ ; dimension=NSURF*NSPMD
1148! local surface property array (=IGRSURF for each proc)
1149! %ELTYP --> type of element (shell, triangle...)
1150! %ELEM --> element id
1151! %NSEG --> total element number
1152! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1153 INTEGER :: GRNOD_UID
1154 INTEGER, DIMENSION(NSPMD) :: SIZE_ALE_ELM
1155 TYPE(split_cfd_type), DIMENSION(:),ALLOCATABLE :: ALE_ELM
1156! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1157! SIZE_ALE_ELM : integer ; dimension=NSPMD ; size of ALE_ELM%SOL_ID array
1158! ALE_ELM : split_cfd_type ; dimension=NSPMD ; solid element ID used
1159! during the domain splitting (ALE part)
1160! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1161 INTEGER :: LEN_TMP_NAME
1162 CHARACTER(len=4096) :: TMP_NAME
1163! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1164! LEN_TMP_NAME : integer ; size of TMP_NAME
1165! TMP_NAME : character ; local name of file, when -outfile or
1166! -infile cdl are used, need to define the folder paths
1167! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1168 TYPE(MONVOL_STRUCT_), DIMENSION(:), ALLOCATABLE :: T_MONVOL
1169 TYPE(MONVOL_METADATA_) :: T_MONVOL_METADATA
1170 TYPE(t_ale_connectivity) :: ALE_CONNECTIVITY
1171
1172 INTEGER :: NBR_TH_MONVOL,NBR_TH_MONVOL01(9)! number of /TH/MONV
1173c For /RANDOM --------------------------------------------------
1174 INTEGER,DIMENSION(:),ALLOCATABLE :: IRAND
1175 my_real,DIMENSION(:),ALLOCATABLE :: alea,xseed
1176
1177! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1178! BOOL_ALE_TG : logical, true only if 2d model + MULTI_FVM used
1179! INDX_xxx : integer ; dimension=NUMELxxx ; index for the surface
1180! of the remote connected element
1181! FACE_ELM_xxx : integer ; dimension=(6/4/3*NUMELxxx,2) ; surface
1182! of the remote connected element
1183! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1184 LOGICAL :: BOOL_ALE_TG
1185 INTEGER, DIMENSION(:), ALLOCATABLE :: INDX_S,INDX_Q,INDX_TG
1186 INTEGER, DIMENSION(:,:), ALLOCATABLE :: FACE_ELM_S,FACE_ELM_Q,FACE_ELM_TG
1187! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1188! INV_GROUP : structure ; connectivity ELEMENT -> PART
1189! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1190 TYPE(INVERTGROUP_STRUCT_) :: INV_GROUP
1191 TYPE(MAPPING_STRUCT_) :: MAP_TABLES
1192 ! -------------
1193 ! Load structure
1194 TYPE (LOADS_) :: LOADS ! global structure for /LOAD
1195 TYPE (LOADS_), DIMENSION(NSPMD) :: LOADS_PER_PROC ! local structurfsdcod(e for each processor --> used for the restart operation
1196 ! -------------
1197 ! BCS wall structure
1198 TYPE (bcs_struct_), DIMENSION(NSPMD) :: BCS_PER_PROC
1199 ! -------------
1200 INTEGER NINIVELT
1201 INTEGER NINTEMP
1202 INTEGER ALE_EULER
1203
1204C MERGE NODES
1205 INTEGER NMERGE_NODE_CAND,NMERGE_NODE_DEST,NMERGE_TOT
1206 INTEGER, DIMENSION(:), ALLOCATABLE :: MERGE_NODE_TAB
1207 my_real,DIMENSION(:),ALLOCATABLE :: merge_node_tol
1208C
1209 my_real,DIMENSION(:),ALLOCATABLE :: dgapint, intgaploadp ,dgaploadint
1210C SEATBELTS
1211 INTEGER NB_MAT_SEATBELT,NB_MAT
1212C
1213 INTEGER :: NUMSH3,NUMSH4, NSLICE,NPT_DRAPE,JJ,ISL, IP,IE, IDSHEL
1214 INTEGER , DIMENSION(:), ALLOCATABLE :: INDXSH
1215 INTEGER :: NUMBER_LOAD_CYL
1216 INTEGER :: S_NOD2ELS,S_NOD2ELTG,S_NOD2EL1D
1217C DAMPING
1218 INTEGER :: NDAMP_VREL_RBY
1219 INTEGER :: NDAMP_FREQ_RANGE
1220 INTEGER , DIMENSION(:), ALLOCATABLE :: DAMP_RANGE_PART
1221C SPH
1222 INTEGER :: PRE_SEARCH,SZ_INTP_DIST
1223 my_real :: max_intp_dist_part
1224
1225 TYPE(INTER_CAND_) :: INTER_CAND
1226 TYPE (FAIL_FRACTAL_) :: FAIL_FRACTAL
1227 TYPE (FAIL_BROKMANN_) :: FAIL_BROKMANN
1228 INTEGER DEF_INTER(100)
1229 ! constraint structure
1230 type(constraint_) :: constraint_struct
1231C RWALL PENALTY
1232 INTEGER :: SLN_PEN
1233 my_real, DIMENSION(:), ALLOCATABLE :: rwstif_pen
1234c=======================================================================
1235 ireac = 0
1236 python%NB_FUNCTS = 0
1237 python%NB_SENSORS = 0
1238! domain decomposition statistic
1239 ddstat(1:50,1:parasiz)=0
1240 i22len_l = 0
1241 fvmain(1:nvolu + nmonvol) = 0
1242 m51_iflg6 = 0
1243 nvartotmax = 0
1244 err_msg='BEGINNING'
1245 err_category='INTERNAL'
1246 CALL trace_in1(err_msg,len_trim(err_msg))
1247 flag_goto = 0
1248 CALL titre2
1249 nvarabf = 1
1250 intbag=0
1251 l_mul_lag=0
1252 lag_ncf = 0
1253 lag_nkf = 0
1254 lag_nhf = 0
1255 lag_ncl = 0
1256 lag_nkl = 0
1257 lag_nhl = 0
1258 numels8a = 0
1259 nairwa = 0
1260 nmanim=0
1261 dsanim=0
1262 impl_s0 = 0
1263 flg_split = 0
1264 nvartotmax = 0
1265 nxlaymax = 0 ! max layer nb in parts xfem
1266C /DAMP/VREL + RBY
1267 ndamp_vrel_rby = 0
1268C /DAMP/FREQUENCY_RANGE
1269 ndamp_freq_range = 0
1270C ply xfem
1271 iplyxfem = 0
1272 nplyxfe = 0
1273 eplyxfe = 0
1274 intplyxfem = 0
1275C
1276 inter_ithknod=0 !defined in interface module (common_source directory)
1277 irigid_mat = 0
1278C
1279! IKINE1LAG = 0
1280 ialelag = 0
1281C added nodal mass
1282 totaddmas = zero
1283 ipart_stack = 0
1284 ipart_pcompp = 0
1285C
1286 sfrontb_r2r = 1
1287C Flag to set for Domain Decomposition and Additional nodes
1288 user_grp_domain=0
1289 nsnt=0
1290 nmnt_2=0
1291 def_inter(1:100) = defaults%interface%DEF_INTER(1:100)
1292c OpenMP specific
1293 itask=0
1294C flag need generalize BUFINTI in DDPSLIT with Interface type 11.
1295C BEFORE ININTR / I11STO KD(11)=KD(10)+4*NRTS
1296C After ININTR : KD(11)=KD(10)+2*NRTS
1297C Idem with (KD(12) = KD(11) + 4*NRTM )
1298 i11flag=0
1299 inter18_autoparam = 0
1300 inter18_is_variable_gap_defined = .false.
1301 nbpreld = 10
1302 ALLOCATE(ebcs_tag_cell_spmd(numelq+numeltg+numels))
1303C
1304 ALLOCATE(eos_tag(0:maxeos))
1305C Interface give CPU to Main surface - INITIALIZE ARRAY
1306C new initiation for XFEM CRACK
1307C
1308 ALLOCATE(intercep(3,ninter))
1309
1310 DO i=1,ninter
1311 NULLIFY(intercep(1,i)%P)
1312 NULLIFY(intercep(2,i)%P)
1313 NULLIFY(intercep(3,i)%P)
1314 ENDDO
1315C------------------------------------------------------------------
1316C Initializations of NNOISE variables (for Rad2noise Engine files
1317C------------------------------------------------------------------
1318 nnoise_sav = 0
1319 sinoise = 0
1320 sfnoise = 0
1321 ALLOCATE(inoise(0))
1322 ALLOCATE(fnoise(0))
1323C------------------------------------------------------------------
1324C Initialization size for INISHCEL
1325C------------------------------------------------------------------
1326 nusphcel = 0
1327C----------------------------------------------
1328C ALLOCATION TO REDUCE STACKSIZE
1329C----------------------------------------------
1330C INTEGER
1331 ALLOCATE(iwcont(5*numnod),stat=stat)
1332 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1333 . msgtype=msgerror,
1334 . c1='IWCONT')
1335
1336 ALLOCATE(iwcin2(2*numnod),stat=stat)
1337 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1338 . msgtype=msgerror,
1339 . c1='IWCIN2')
1340
1341C
1342 ALLOCATE(ikine1lag(3*numnod),stat=stat)
1343 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1344 . msgtype=msgerror,
1345 . c1='IKINE1LAG')
1346 ikine1lag(1:3*numnod)=0
1347
1348 ALLOCATE(dsdof(numnod),stat=stat)
1349 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1350 . msgtype=msgerror,
1351 . c1='DSDOF')
1352 dsdof(1:numnod)=0
1353
1354 ALLOCATE( addcne(0:numnod+1),stat=stat)
1355 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1356 . msgtype=msgerror,
1357 . c1='ADDCNE')
1358C ADDCNE_PXFEM needed when IPLYXFEM used
1359 ALLOCATE(addcne_pxfem(0:numnod +1),stat=stat)
1360 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1361 . msgtype=msgerror,
1362 . c1='ADDCNE_PXFEM')
1363C
1364 IF(nfxbody>0) THEN
1365 nbipm = 45
1366 ALLOCATE(fxbtag(numnod),fxbipm(nbipm*nfxbody),stat=stat)
1367 fxbipm(1:nbipm*nfxbody) = zero
1368 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1369 . msgtype=msgerror,
1370 . c1='FXBTAG')
1371 ! Table of FXBODY file name for QAPRINT
1372 ALLOCATE(fxbfile_tab(nfxbody))
1373 ELSE
1374 nbipm = 1
1375 ALLOCATE(fxbtag(1),fxbipm(1),stat=stat)
1376 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1377 . msgtype=msgerror,
1378 . c1='FXBTAG')
1379 ALLOCATE(fxbfile_tab(0))
1380 ENDIF
1381C
1382 ALLOCATE(isolnod(numels),stat=stat)
1383 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1384 . msgtype=msgerror,
1385 . c1='ISOLNOD')
1386 ALLOCATE(isoloff(numels),stat=stat)
1387 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1388 . msgtype=msgerror,
1389 . c1='ISOLOFF')
1390 ALLOCATE(isheoff(numelc),stat=stat)
1391 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1392 . msgtype=msgerror,
1393 . c1='ISHEOFF')
1394 ALLOCATE(itruoff(numelt),stat=stat)
1395 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1396 . msgtype=msgerror,
1397 . c1='ITRUOFF')
1398 ALLOCATE(ipouoff(numelp),stat=stat)
1399 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1400 . msgtype=msgerror,
1401 . c1='IPOUOFF')
1402 ALLOCATE(iresoff(numelr),stat=stat)
1403 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1404 . msgtype=msgerror,
1405 . c1='IRESOFF')
1406 ALLOCATE(itrioff(numeltg),stat=stat)
1407 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1408 . msgtype=msgerror,
1409 . c1='ITRIOFF')
1410 ALLOCATE(igrnrby(nrbody),stat=stat)
1411 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1412 . msgtype=msgerror,
1413 . c1='IGRNRBY')
1414 igrnrby(1:nrbody) = 0
1415 ALLOCATE(iquaoff(numelq),stat=stat)
1416 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1417 . msgtype=msgerror,
1418 . c1='IQUAOFF')
1419C Float
1420C----------------------------------------------
1421C ALLOC INTEGER TABLES IGEO and IPM
1422C----------------------------------------------
1423 len_g = npropgi*numgeo
1424 len_m = npropmi*nummat
1425 ALLOCATE(igeo(len_g),stat=stat)
1426 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1427 . msgtype=msgerror,
1428 . c1='IGEO')
1429 ALLOCATE(ipm(len_m),stat=stat)
1430 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1431 . msgtype=msgerror,
1432 . c1='IPM')
1433 igeo = 0
1434 ipm = 0
1435C----------------------------------------------
1436C ALLOC DDWEIGHTS ARRAY FROM MODULE
1437C----------------------------------------------
1438 CALL init_mat_weight(nummat)
1439C----------------------------------------------
1440 ALLOCATE(ipart_state(npart),stat=stat)
1441 IF(stat /= 0) THEN
1442 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,
1443 . c1='IPART_STATE')
1444 ELSE
1445 ipart_state=0
1446 END IF
1447 CALL trace_out1()
1448C----------------------------------------------
1449C ALLOC AND INIT OF TAG TABLE FOR NODES USED ON P0
1450C----------------------------------------------
1451 err_category='INTERNAL'
1452c obsolete code, replaced by new chained-list IFRONT
1453C coding of different types of boundary nodes:
1454C 0 node not on proc
1455C 1 acceleration boundary
1456C 10 kinematic boundary
1457C 100 interface boundary
1458C possible combinations
1459
1460
1461c SIFRONT minimum size NUMNOD. Value set to 2*NUMNOD
1462 sifront = 2*numnod
1463
1464c Linked-list IFRONT
1465C IFRONT%IENTRY : entry in IFRONT for node N
1466C IFRONT%P(1,N) : SPMD domain for node N
1467C IFRONT%P(2,N) : next index in IFRONT for node N
1468 ALLOCATE(ifront%P(2,sifront),stat=stat)
1469 ALLOCATE(ifront%IENTRY(numnod),stat=stat)
1470
1471c IENTRY2 use to save IENTRY
1472 ALLOCATE(ientry2(numnod),stat=stat)
1473 IF(stat/=0) THEN
1474 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,
1475 . c1='IFRONT')
1476 ENDIF
1477c FLAGKIN array to identify boundary nodes with kinematic constraints
1478c (FLAGKIN(N)=1 <=> old FRONT TAG=10)
1479 ALLOCATE(flagkin(numnod),stat=stat)
1480 IF(stat/=0) THEN
1481 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,
1482 . c1='FLAGKIN')
1483 ENDIF
1484C----------------------------------------------
1485 CALL ini_ifront()
1486 ientry2(1:numnod) = -1
1487 flagkin(1:numnod) = 0
1488
1489c IF(FLAG_GOTO == 1) GOTO 207 !!go to traitement rad2rad
1490C--------------------------------------------
1491C CALCULATE ISECUT
1492C--------------------------------------------
1493 isecut=0
1494 CALL lecsec0(lsubmodel)
1495C--------------------------------------------
1496C IMPOSED VELOCITIES : Check rotational DOFs : IMPOSE_DR
1497C--------------------------------------------
1498 impose_dr=0
1499 CALL hm_preread_impvel0(impose_dr,unitab,lsubmodel) !read /IMPDISP
1500C--------------------------------------------
1501C STOCKAGE DYNAMIQUE (GENERAL) REEL
1502C--------------------------------------------
1503 ifrwv=0
1504208 sx = 3*numnod
1505 sd = 5*numnod
1506 sv = 3*numnod
1507 svr = 3*numnod*max(iroddl,iroddl0)
1508 svr_1 = numnod*max(iroddl,iroddl0)
1509 sthke = numelc+numeltg
1510 sms = numnod
1511 spinch= npinch
1512 sin = numnod*max(iroddl,iroddl0)
1513 IF(isecut>0 .OR. iisrot>0 .OR. impose_dr>0 .OR. idrot == 1) THEN
1514 sdr = 3*numnod*max(iroddl,iroddl0)
1515 ELSE
1516 sdr = 0
1517 ENDIF
1518 IF(flag_goto == 1) GOTO 258
1519C--------------------------------------------
1520 IF(ndamp > 0) THEN
1521 sdampr = nrdamp*ndamp
1522 sdamp = 3*(1+max(iroddl,iroddl0))*numnod
1523 CALL hm_option_count('/DAMP/FREQUENCY_RANGE',ndamp_freq_range)
1524 IF (ndamp == ndamp_freq_range) sdamp = 0
1525 ALLOCATE(dampr(sdampr+sdamp) ,stat=stat)
1526 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1527 . msgtype=msgerror,
1528 . c1='DAMPR')
1529 damp => dampr(sdampr+1:sdampr+sdamp)
1530 dampr = 0
1531 ELSE
1532 sdampr = 0
1533 sdamp = 0
1534 ALLOCATE(dampr(sdampr) ,stat=stat)
1535 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1536 . msgtype=msgerror,
1537 . c1='DAMPR')
1538 ALLOCATE(damp(sdamp) ,stat=stat)
1539 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1540 . msgtype=msgerror,
1541 . c1='DAMP')
1542 ENDIF
1543 ALLOCATE(damp_range_part(npart),stat=stat)
1544 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1545 . msgtype=msgerror,
1546 . c1='DAMP_RANGE_PART')
1547 damp_range_part = 0
1548 ALLOCATE(x(sx) ,stat=stat)
1549 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1550 . msgtype=msgerror,
1551 . c1='X')
1552 ALLOCATE(d(sd) ,stat=stat)
1553 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1554 . msgtype=msgerror,
1555 . c1='D')
1556 ALLOCATE(v(sv) ,stat=stat)
1557 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1558 . msgtype=msgerror,
1559 . c1='V')
1560 ALLOCATE(vr(svr) ,stat=stat)
1561 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1562 . msgtype=msgerror,
1563 . c1='VR')
1564 ALLOCATE(dr(sdr) ,stat=stat)
1565 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1566 . msgtype=msgerror)
1567 ALLOCATE(thke(sthke) ,stat=stat)
1568 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1569 . msgtype=msgerror,
1570 . c1='THKE')
1571 ALLOCATE(ms(sms) ,stat=stat)
1572 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1573 . msgtype=msgerror,
1574 . c1='MS')
1575 ALLOCATE(in(sin) ,stat=stat)
1576 ALLOCATE(xyzref(sx) ,stat=stat)
1577 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1578 . msgtype=msgerror,
1579 . c1='XYZREF')
1580 ALLOCATE(sh4ang(numelc) ,stat=stat)
1581 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1582 . msgtype=msgerror,
1583 . c1='SH4ANG')
1584 ALLOCATE(sh3ang(numeltg) ,stat=stat)
1585 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1586 . msgtype=msgerror,
1587 . c1='SH3ANG')
1588 IF(numnod > 0) THEN
1589 x = 0
1590 d = 0
1591 v = 0
1592 ms = 0
1593 ENDIF
1594 IF(svr > 0) vr = 0
1595 IF(sdr > 0) dr = 0
1596 IF(sin > 0) in = 0
1597C--------------------------------------------
1598258 IF(numelc<sthke) THEN
1599 thkec => thke(numelc+1:sthke)
1600 ELSE
1601 thkec => thke
1602 END IF
1603 IF ((sthke > 0).AND.(flag_goto==0)) thke = 0
1604 IF(numelc > 0) sh4ang = 0
1605 IF(numeltg > 0) sh3ang = 0
1606c
1607 CALL nbfunct(nfunct,ntable,npts,lsubmodel)
1608C--------------------------------------------
1609C STOCKAGE DYNAMIQUE (GENERALE) ENTIER
1610C--------------------------------------------
1611C--- Longueurs
1612 sicode = numnod
1613 siskew = numnod
1614 siskwn = liskn*((numskw+1)+min(iun,nspcond)*numsph+(numfram+1)+nsubmod)
1615 siframe = liskn*(numfram+1)
1616c SNETH = 2*NSNOD+NSELS+NSELQ+NSELC+NSELT+NSELP+NSELR+NSELTG = 0
1617 sibcslag= 5*nbcslag
1618 sipart0 = lipart1*npart+lipart1*nthpart
1619 sipartth= 2*9*npart+2*9*nthpart
1620 siparts = numels
1621 sipartq = numelq
1622 sipartc = numelc
1623 sipartt = numelt
1624 sipartp = numelp
1625 sipartr = numelr
1626 sipartg = numeltg
1627 sipartx = numelx
1628 sipartsp= numsph
1629 sipartig3d = numelig3d
1630 sipart = sipart0+sipartth+siparts+sipartq+sipartc+sipartt+sipartp
1631 . + sipartr+sipartg+sipartx+sipartig3d+sipartsp
1632 numel = numels+numelq+numelc+numelt+numelp+numelr
1633 . + numeltg+numelx+numsph+numelig3d
1634c
1635 snpc = 3*nfunct+1
1636 sixtg0 = nixtg*numeltg
1637 sixtg = sixtg0
1638 sixs0 = nixs*numels
1639 sixs10 = numels10*6
1640 sixs20 = numels20*12
1641 sixs16 = numels16*8
1642 sixs = sixs0+sixs10+sixs20+sixs16
1643 sixq = nixq*numelq
1644 sixc = nixc*numelc
1645 sixt = nixt*numelt
1646 sixp = nixp*numelp
1647 sixr = nixr*numelr
1648 sitab = numnod
1649 sitabm1 = 2*numnod
1650 sgjbufi = lkjni*ngjoint
1651!---------
1652 slaccelm= 3*naccelm
1653 snom_opt1= nrbody+naccelm+nvolu+nmonvol+ninter+nintsub+
1654 + nrwall+njoint+nsect+nlink+
1655 + numskw+1+numfram+1+nfxbody+nflow+nrbe2+
1656 + nrbe3+nsubmod+nfxvel+numbcs+nummpc+
1657 + ngjoint+nunit0+nfunct+nadmesh+
1658 + nsphio+nspcond+nrbykin+nebcs+
1659 + ninicrack+nodmas+nbgauge+ncluster+ninterfric+
1660 + nrbmerge+numbcsn+nslipring+nretractor
1661 snom_opt = snom_opt1*lnopt1+1
1662 sinom_opt= 33
1663 snom_sect= ncharline*nsect
1664 IF(flag_goto==1) GOTO 209
1665C
1666C--- Allocations
1667 ALLOCATE(icode(sicode) ,stat=stat)
1668 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1669 . msgtype=msgerror,
1670 . c1='ICODE')
1671 ALLOCATE(iskew(siskew) ,stat=stat)
1672 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1673 . msgtype=msgerror,
1674 . c1='ISKEW')
1675 ALLOCATE(iskwn(siskwn) ,stat=stat)
1676 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1677 . msgtype=msgerror,
1678 . c1='ISKWN')
1679 ALLOCATE(ibcslag(sibcslag) ,stat=stat)
1680 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1681 . msgtype=msgerror,
1682 . c1='IBCSLAG')
1683 ALLOCATE(ipart(sipart) ,stat=stat)
1684 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1685 . msgtype=msgerror,
1686 . c1='IPART')
1687 ALLOCATE(npc(snpc) ,stat=stat)
1688 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1689 . msgtype=msgerror,
1690 . c1='NPC')
1691 ALLOCATE(ixtg(sixtg) ,stat=stat)
1692 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1693 . msgtype=msgerror,
1694 . c1='IXTG')
1695 ALLOCATE(ixs(sixs) ,stat=stat)
1696 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1697 . msgtype=msgerror,
1698 . c1='IXS')
1699 ALLOCATE(ixq(sixq) ,stat=stat)
1700 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1701 . msgtype=msgerror,
1702 . c1='IXQ')
1703 ALLOCATE(ixc(sixc) ,stat=stat)
1704 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1705 . msgtype=msgerror,
1706 . c1='IXC')
1707 ALLOCATE(ixt(sixt) ,stat=stat)
1708 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1709 . msgtype=msgerror,
1710 . c1='IXT')
1711 ALLOCATE(ixp(sixp) ,stat=stat)
1712 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1713 . msgtype=msgerror,
1714 . c1='IXP')
1715 ALLOCATE(ixr(sixr) ,stat=stat)
1716 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1717 . msgtype=msgerror,
1718 . c1='IXR')
1719 ALLOCATE(itab(sitab) ,stat=stat)
1720 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1721 . msgtype=msgerror,
1722 . c1='ITAB')
1723 ALLOCATE(itabm1(sitabm1) ,stat=stat)
1724 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1725 . msgtype=msgerror,
1726 . c1='ITABM1')
1727 ALLOCATE(gjbufi(sgjbufi) ,stat=stat)
1728 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1729 . msgtype=msgerror,
1730 . c1='GJBUFI')
1731 ALLOCATE(laccelm(slaccelm) ,stat=stat)
1732 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1733 . msgtype=msgerror,
1734 . c1='LACCELM')
1735
1736 ALLOCATE(nom_opt(snom_opt) ,stat=stat)
1737 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1738 . msgtype=msgerror,
1739 . c1='NOM_OPT')
1740 ALLOCATE(inom_opt(0:sinom_opt) ,stat=stat)
1741 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1742 . msgtype=msgerror,
1743 . c1='INOM_OPT')
1744 ALLOCATE(nom_sect(snom_sect) ,stat=stat)
1745 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1746 . msgtype=msgerror,
1747 . c1='NOM_SECT')
1748 ALLOCATE(ixr_kj(5*(numelr+1)) ,stat=stat)
1749 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1750 . msgtype=msgerror,
1751 . c1='IXR_KJ')
1752 ALLOCATE(iworksh(3,numelc+numeltg) ,stat=stat)
1753 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1754 . msgtype=msgerror,
1755 . c1='IXC')
1756 IF(numelig3d > 0) THEN
1757 ALLOCATE(wige(numnod) ,stat=stat)
1758 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1759 . msgtype=msgerror,
1760 . c1='WIGE')
1761 deg_max=0
1762 ELSE
1763 ALLOCATE(wige(0) ,stat=stat)
1764 ENDIF
1765 ALLOCATE(r_skew(numelr) ,stat=stat)
1766 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1767 . msgtype=msgerror,
1768 . c1='R_SKEW')
1769C
1770 ALLOCATE(ibeam_vector(numelp) ,stat=stat)
1771 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1772 . msgtype=msgerror,
1773 . c1='IBEAM_VECTOR')
1774 ALLOCATE(rbeam_vector(3,numelp) ,stat=stat)
1775 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1776 . msgtype=msgerror,
1777 . c1='RBEAM_VECTOR')
1778C
1779 IF(abs(isigi)==3.OR.abs(isigi)== 4.OR.abs(isigi)==5)THEN
1780 ALLOCATE (ptshel(numelc) ,stat=stat)
1781 ptshel = 0
1782 ALLOCATE (ptsh3n(numeltg) ,stat=stat)
1783 ptsh3n = 0
1784 ELSE
1785 ALLOCATE (ptshel(0) ,stat=stat)
1786 ALLOCATE (ptsh3n(0) ,stat=stat)
1787 END IF
1788C --- Initialisations
1789 IF(sicode > 0) icode = 0
1790 IF(siskew > 0) iskew = 0
1791 IF(siskwn > 0) iskwn = 0
1792 IF(sibcslag > 0) ibcslag = 0
1793 IF(sipart > 0) ipart = 0
1794 IF(snpc > 0) npc = 0
1795 IF(sitab > 0) itab = 0
1796 IF(sitabm1 > 0) itabm1 = 0
1797 IF(sgjbufi > 0) gjbufi = 0
1798 IF(slaccelm > 0) laccelm = 0
1799 IF(snom_opt > 0) nom_opt = 0
1800 IF(sinom_opt > 0) inom_opt = 0
1801 IF(numelr > 0) ixr_kj = 0
1802 IF(numelc+numeltg > 0) iworksh = 0
1803 IF(numelr > 0) r_skew = 0
1804 IF(numelp > 0) ibeam_vector(1:numelp) = zero
1805 IF(numelp > 0) rbeam_vector(1:3,1:numelp) = zero
1806C
1807C--- Pointers: sub-arrays
1808 IF(siskwn-siframe<siskwn) THEN
1809 iframe => iskwn(siskwn-siframe+1:siskwn)
1810 ELSE
1811 iframe => iskwn
1812 END IF
1813
1814 ! ---------------------
1815 inter_cand%S_IXINT_2 = 0
1816 ALLOCATE( inter_cand%ADDRESS(ninter+1) )
1817 inter_cand%ADDRESS(1:ninter+1) = 0
1818 ! ---------------------
1819
1820!--- NEW DATA STRUCTE ALLOCATION FOR GROUPS OF ENTITIES
1821 ALLOCATE(subsets(nsubs))
1822 subsets(1:nsubs)%ID=0
1823 ALLOCATE(igrnod(ngrnod+nsets))
1824 ALLOCATE(igrbric(ngrbric+nsets))
1825 ALLOCATE(igrquad(ngrquad+nsets))
1826 ALLOCATE(igrsh4n(ngrshel+nsets))
1827 ALLOCATE(igrsh3n(ngrsh3n+2*nsets))
1828 ALLOCATE(igrtruss(ngrtrus+nsets))
1829 ALLOCATE(igrbeam(ngrbeam+nsets))
1830 ALLOCATE(igrspring(ngrspri+nsets))
1831 ALLOCATE(igrpart(ngrpart+nsets))
1832 ALLOCATE(igrsurf(nsurf+nsets))
1833 ALLOCATE(igrsurf_proc(nsurf+nsets,nspmd))
1834 ALLOCATE(igrslin(nslin+nsets))
1835 igrnod(1:ngrnod+nsets)%ID = 0
1836 igrnod(1:ngrnod+nsets)%NENTITY = 0
1837 igrnod(1:ngrnod+nsets)%GRTYPE = 0
1838 igrnod(1:ngrnod+nsets)%SORTED = 0
1839 igrnod(1:ngrnod+nsets)%GRPGRP = 0
1840 igrnod(1:ngrnod+nsets)%LEVEL = 0
1841 igrnod(1:ngrnod+nsets)%R2R_ALL = 0
1842 igrnod(1:ngrnod+nsets)%R2R_SHARE = 0
1843
1844
1845
1846 igrbric(1:ngrbric+nsets)%NENTITY = 0
1847 igrquad(1:ngrquad+nsets)%NENTITY = 0
1848 igrsh4n(1:ngrshel+nsets)%NENTITY = 0
1849 igrsh3n(1:ngrsh3n+2*nsets)%NENTITY = 0
1850 igrtruss(1:ngrtrus+nsets)%NENTITY = 0
1851 igrbeam(1:ngrbeam+nsets)%NENTITY = 0
1852 igrspring(1:ngrspri+nsets)%NENTITY = 0
1853 igrpart(1:ngrpart+nsets)%NENTITY = 0
1854!-- variable initialization to not printout the empty SET groups
1855 igrnod(1:ngrnod+nsets)%SET_GROUP = 0
1856 igrbric(1:ngrbric+nsets)%SET_GROUP = 0
1857 igrquad(1:ngrquad+nsets)%SET_GROUP = 0
1858 igrsh4n(1:ngrshel+nsets)%SET_GROUP = 0
1859 igrsh3n(1:ngrsh3n+2*nsets)%SET_GROUP = 0
1860 igrtruss(1:ngrtrus+nsets)%SET_GROUP = 0
1861 igrbeam(1:ngrbeam+nsets)%SET_GROUP = 0
1862 igrspring(1:ngrspri+nsets)%SET_GROUP = 0
1863 igrpart(1:ngrpart+nsets)%SET_GROUP = 0
1864 igrsurf(1:nsurf+nsets)%SET_GROUP = 0
1865 igrslin(1:nslin+nsets)%SET_GROUP = 0
1866
1867 igrsurf(1:nsurf+nsets)%NSEG = 0
1868 igrsurf(1:nsurf+nsets)%NSEG_IGE = 0
1869 igrsurf(1:nsurf+nsets)%SET_GROUP = 0
1870 igrsurf(1:nsurf+nsets)%NB_MADYMO = 0
1871 igrsurf(1:nsurf+nsets)%NSEG_R2R_ALL = 0
1872 igrsurf(1:nsurf+nsets)%NSEG_R2R_SHARE = 0
1873 igrsurf(1:nsurf+nsets)%EXT_ALL = 0
1874!--
1875! IF(NBOX > 0) CALL MY_ALLOC(IGRBOX,NBOX)
1876C ipart
1877216 l0 = sipart0
1878 l1 = l0 + sipartth
1879 l2 = l1 + siparts
1880 l3 = l2 + sipartq
1881 l4 = l3 + sipartc
1882 l5 = l4 + sipartt
1883 l6 = l5 + sipartp
1884 l7 = l6 + sipartr
1885 l8 = l7 + 0
1886 l9 = l8 + sipartg
1887 l10= l9 + sipartx
1888 l11= l10+ sipartsp
1889 l12= l11+ sipartig3d
1890 IF(l1>l0) THEN
1891 ipartth => ipart(l0+1:l1)
1892 ELSE
1893 ipartth => ipart
1894 END IF
1895 IF(l2>l1) THEN
1896 iparts => ipart(l1+1:l2)
1897 ELSE
1898 iparts => ipart
1899 END IF
1900 IF(l3>l2) THEN
1901 ipartq => ipart(l2+1:l3)
1902 ELSE
1903 ipartq => ipart
1904 END IF
1905 IF(l4>l3) THEN
1906 ipartc => ipart(l3+1:l4)
1907 ELSE
1908 ipartc => ipart
1909 END IF
1910 IF(l5>l4) THEN
1911 ipartt => ipart(l4+1:l5)
1912 ELSE
1913 ipartt => ipart
1914 END IF
1915 IF(l6>l5) THEN
1916 ipartp => ipart(l5+1:l6)
1917 ELSE
1918 ipartp => ipart
1919 END IF
1920 IF(l7>l6) THEN
1921 ipartr => ipart(l6+1:l7)
1922 ELSE
1923 ipartr => ipart
1924 END IF
1925 IF(l9>l8) THEN
1926 ipartg => ipart(l8+1:l9)
1927 ELSE
1928 ipartg => ipart
1929 END IF
1930 IF(l10>l9) THEN
1931 ipartx => ipart(l9+1:l10)
1932 ELSE
1933 ipartx => ipart
1934 END IF
1935 IF(l11>l10) THEN
1936 ipartsp=> ipart(l10+1:l11)
1937 ELSE
1938 ipartsp => ipart
1939 END IF
1940 IF(l12>l11) THEN
1941 ipartig3d=> ipart(l11+1:l12)
1942 ELSE
1943 ipartig3d => ipart
1944 END IF
1945 IF(flag_goto==1) GOTO 217
1946c
1947 IF(nfunct+2<=snpc-nfunct) THEN
1948 npc1 => npc(nfunct+2:snpc-nfunct)
1949 snpc1 = snpc-2*nfunct+1
1950 ELSE
1951 npc1 => npc
1952 snpc1 = snpc
1953 END IF
1954
1955212 IF(sixs0+sixs10>sixs0) THEN
1956 ixs10 => ixs(sixs0+1:sixs0+sixs10)
1957 ELSE
1958c IXS10 => IXS
1959c NULLIFY(IXS10)
1960 ALLOCATE(ixs10(1))
1961 END IF
1962 IF(sixs0+sixs10+sixs20>sixs0+sixs10) THEN
1963 ixs20 => ixs(sixs0+sixs10+1:sixs0+sixs10+sixs20)
1964 ELSE
1965c IXS20 => IXS
1966 ALLOCATE(ixs20(1))
1967 END IF
1968 IF(sixs>sixs0+sixs10+sixs20) THEN
1969 ixs16 => ixs(sixs0+sixs10+sixs20+1:sixs)
1970 ELSE
1971c IXS16 => IXS
1972c NULLIFY(IXS16)
1973 ALLOCATE(ixs16(1))
1974 END IF
1975 pixs10 = min(sixs,sixs0+1 )
1976 pixs20 = min(sixs,sixs0+sixs10+1 )
1977 pixs16 = min(sixs,sixs0+sixs10+sixs20+1)
1978
1979 IF(flag_goto==1) GOTO 213
1980C
1981C .. TO BE MAINTAINED (cf doc/inom_opt.txt) ..
1982210 inom_opt(1) = nrbody
1983 inom_opt(2) = inom_opt(1) + naccelm
1984 inom_opt(3) = inom_opt(2) + nvolu + nmonvol
1985 inom_opt(4) = inom_opt(3) + ninter
1986 inom_opt(5) = inom_opt(4) + nintsub
1987 inom_opt(6) = inom_opt(5) + nrwall
1988 inom_opt(7) = inom_opt(6) + 0 !obsolete option removed
1989 inom_opt(8) = inom_opt(7) + njoint
1990 inom_opt(9) = inom_opt(8) + nsect
1991 inom_opt(10)= inom_opt(9) + nlink
1992 inom_opt(11)= inom_opt(10)+ numskw+1+numfram+1+nsubmod
1993 inom_opt(12)= inom_opt(11)+ nfxbody
1994 inom_opt(13)= inom_opt(12)+ nflow
1995 inom_opt(14)= inom_opt(13)+ nrbe2
1996 inom_opt(15)= inom_opt(14)+ nrbe3
1997C
1998 inom_opt(16)= inom_opt(15)+ nfxvel
1999 inom_opt(17)= inom_opt(16)+ numbcs + numbcsn
2000 inom_opt(18)= inom_opt(17)+ nummpc
2001 inom_opt(19)= inom_opt(18)+ ngjoint
2002 inom_opt(20)= inom_opt(19)+ nunit0
2003 inom_opt(21)= inom_opt(20)+ nfunct
2004 inom_opt(22)= inom_opt(21)+ nadmesh
2005 inom_opt(23)= inom_opt(22)+ nsphio
2006 inom_opt(24)= inom_opt(23)+ nspcond
2007 inom_opt(25)= inom_opt(24)+ nebcs
2008 inom_opt(26)= inom_opt(25)+ ninicrack
2009 inom_opt(27)= inom_opt(26)+ nodmas
2010 inom_opt(28)= inom_opt(27)+ nbgauge
2011 inom_opt(29)= inom_opt(28)+ ncluster
2012 inom_opt(30)= inom_opt(29)+ ninterfric
2013 inom_opt(31)= inom_opt(30)+ nrbmerge
2014 inom_opt(32)= inom_opt(31)+ nslipring
2015 inom_opt(33)= inom_opt(32)+ nretractor
2016C
2017 IF(flag_goto==1) GOTO 211
2018
2019 CALL anodin( numnod)
2020 IF(npart==0) THEN
2021 CALL apartin(npart+1)
2022 ELSE
2023 CALL apartin(npart)
2024 END IF
2025C--------------------------------------------
2026C READING FUNCTIONS & TABLES
2027C--------------------------------------------
2028 err_msg='FUNCTIONS & TABLES'
2029 err_category='FUNCTIONS & TABLES'
2030 CALL trace_in1(err_msg,len_trim(err_msg))
2031c
2032 python%nb_functs = 0
2033 IF(nfunct > 0 .OR. ntable > 0) THEN
2034C
2035C NTABLE = NFUNCT + ...
2036 WRITE(istdo,'(A)')' .. FUNCTIONS & TABLES'
2037 ALLOCATE(table(ntable) ,stat=stat)
2038 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2039 . msgtype=msgerror,
2040 . c1='TABLE')
2041 CALL table_zero(table)
2042 IF(nfunct > 0) THEN
2043 err_msg='FUNCTIONS'
2044 CALL trace_in1(err_msg,len_trim(err_msg))
2045 ALLOCATE(tf(npts) ,stat=stat)
2046 ALLOCATE(funcrypt(nfunct) ,stat=stat)
2047 funcrypt = 0
2048 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2049 . msgtype=msgerror,
2050 . c1='TF')
2051 IF(npts > 0) tf = 0
2052 CALL hm_read_funct(npc ,tf ,nfunct ,table, npts,
2053 . nom_opt(lnopt1*inom_opt(20)+1) ,funcrypt, unitab, lsubmodel)
2054 CALL trace_out1()
2055 END IF
2056C TABLES
2057 err_msg='TABLES 1'
2058 CALL trace_in1(err_msg,len_trim(err_msg))
2059 CALL hm_read_table1 (ntable, table ,nfunct ,npc ,tf ,
2060 . nom_opt(lnopt1*inom_opt(20)+1), unitab, lsubmodel)
2061
2062 CALL hm_read_funct_python(python,npc,snpc,nfunct,lsubmodel,nsubmod,tf,npts,table, ntable)
2063 CALL chkfunct (nfunct, npc,nom_opt(lnopt1*inom_opt(20)+1))
2064 IF(nfunct > 0) THEN
2065 CALL hm_read_move_funct(npc ,tf ,nfunct ,table, ntable,funcrypt, unitab, lsubmodel)
2066 DEALLOCATE(funcrypt)
2067 END IF
2068 CALL hm_read_table2 (ntable, table ,nfunct , unitab, lsubmodel )
2069 CALL trace_out1()
2070 ELSE
2071C TABLES
2072 err_msg='TABLES 0'
2073 CALL trace_in1(err_msg,len_trim(err_msg))
2074 npts = 0
2075 ALLOCATE(tf(npts) ,stat=stat)
2076 ALLOCATE(table(0) ,stat=stat)
2077 CALL trace_out1()
2078 ENDIF
2079
2080
2081 stf = npts
2082
2083 CALL trace_out1()
2084C--------------------------------------------
2085C READING 2D FUNCTIONS
2086C--------------------------------------------
2087 ALLOCATE(func2d(nfunc2d))
2088 IF(nfunc2d > 0) THEN
2089 CALL hm_read_func2d(func2d, lsubmodel, unitab)
2090 ENDIF
2091C--------------------------------------------
2092C Dynamic storage (General) Reel - Suite
2093C-------------------------------------------
2094 err_msg='DYNAMIC STORAGE'
2095 err_msg='INTERNAL'
2096 CALL trace_in1(err_msg,len_trim(err_msg))
2097 spm = nummat*npropm
2098 sskew = lskew*(numskw+1)
2099 IF(nspcond > 0) sskew = sskew + lskew*numsph
2100 IF(nsubmod > 0) sskew = sskew + lskew*nsubmod
2101 sxframe = nxframe*(numfram+1)
2102 sskew = sskew + sxframe
2103 sgeo = numgeo*npropg
2104 seani = numels+numelq+numelc+numeltg
2105 ishif = numels+numelq+numelc
2106
2107 ALLOCATE(pm(spm) ,stat=stat)
2108 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='PM')
2109 ALLOCATE(geo(sgeo),stat=stat)
2110 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='GEO')
2111c in the skew, we put all the skews of the model
2112 ALLOCATE(skew(sskew) ,stat=stat)
2113 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='SKEW')
2114 IF(sskew-sxframe<sskew) THEN
2115 xframe => skew(sskew-sxframe+1:sskew)
2116 ELSE
2117 xframe => skew
2118 END IF
2119c ALLOCATE(XFRAME(SXFRAME) ,STAT=stat)
2120 ALLOCATE(eani(seani) ,stat=stat)
2121 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='EANI')
2122 IF(seani > 0) eani = 0
2123 IF(numeltg > 0) THEN
2124 eanit => eani(ishif+1:seani)
2125 ELSE
2126 eanit => eanit2
2127 ENDIF
2128 pm = 0
2129 skew = 0
2130 geo = 0
2131 ishif =numels+numelq+numelc
2132 CALL trace_out1()
2133C--------------------------------------------
2134 err_msg='KINEMATIC INITIALIZATION'
2135 CALL trace_in1(err_msg,len_trim(err_msg))
2136 CALL kinini(d )
2137 CALL trace_out1()
2138C--------------------------------------------
2139C READING MATERIALS
2140C--------------------------------------------
2141 err_msg='MATERIALS'
2142 err_category='MATERIALS'
2143 CALL trace_in1(err_msg,len_trim(err_msg))
2144 CALL sav_buf_point(npc,5)
2145 CALL sav_buf_point(tf,6)
2146 WRITE(istdo,'(A)')titre(11)
2147 srwork = max(nummat*10000,1000000)
2148 sbufmat = 0
2149 ALLOCATE(rwork(srwork) ,stat=stat)
2150 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='RWORK')
2151 IF(srwork > 0) rwork = zero
2152c------------------------------------
2153 ALLOCATE(mtag_ini(nummat))
2154 ALLOCATE(mparam_ini(nummat))
2155 CALL init_mlaw_tag(mtag_ini,nummat)
2156 mat_elem%MAT_PARAM(1:nummat) => mparam_ini(1:nummat)
2157 mlaw_tag(1:nummat) => mtag_ini(1:nummat)
2158 nloc_dmg%IMOD = 0
2159c---------------------------------------------------------------
2160 CALL read_material_models(
2161 . mat_elem ,mlaw_tag ,fail_tag ,eos_tag ,
2162 . rwork ,srwork ,ipm ,pm ,unitab ,
2163 . multi_fvm ,failwave ,nloc_dmg ,lsubmodel ,table ,
2164 . ltitr ,userl_avail,mat_number,
2165 . npc ,tf ,snpc ,npts ,sbufmat )
2166c---------------------------------------------------------------
2167 ALLOCATE(bufmat(sbufmat) ,stat=stat)
2168 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2169 . msgtype=msgerror,
2170 . c1='BUFMAT')
2171 bufmat = rwork(1:sbufmat)
2172 IF(ALLOCATED(rwork)) DEALLOCATE(rwork)
2173 CALL trace_out1()
2174c
2175 err_msg='STORAGE'
2176 err_msg='INTERNAL'
2177 CALL trace_in1(err_msg,len_trim(err_msg))
2178c
2179 CALL titre3
2180C--------------------------------------------
2181C INITIALIZATION OF USER POINTERS
2182C--------------------------------------------
2183 CALL sav_buf_point(pm ,1)
2184 CALL sav_buf_point(bufmat ,2)
2185 CALL sav_buf_point(geo ,3)
2186C CALL SAV_BUF_POINT(AM(M26),4)
2187cma53a1 !!!!!!! a faire
2188 CALL sav_buf_point(iskwn ,7)
2189 CALL sav_buf_point(skew ,8)
2190 CALL sav_buf_point(ipm ,11)
2191 CALL sav_buf_point(igeo,12)
2192 CALL trace_out1()
2193C--------------------------------------------
2194C READ NODES / CNODES / BUILD GHOST NODES
2195C--------------------------------------------
2196C NODES
2197 err_msg='NODES'
2198 err_category='NODES'
2199 CALL trace_in1(err_msg,len_trim(err_msg))
2200 ALLOCATE(cmerge(numcnod),stat=stat)
2201 IF(stat /= 0) THEN
2202 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,
2203 . c1='CMERGE')
2204 ENDIF
2205 cmerge = zero
2206C
2207 WRITE(istdo,'(A)')titre(12)
2208 CALL hm_read_node(x ,itab ,itabm1 ,cmerge ,unitab ,
2209 . wige ,lsubmodel,is_dyna)
2210
2211 CALL trace_out1()
2212C--------------------------------------------
2213C PRE-READING SKEW DEFINITIONS
2214C--------------------------------------------
2215 IF(numskw > 0) THEN
2216 ALLOCATE(iskew_tmp(siskwn) ,stat=stat)
2217 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2218 . msgtype=msgerror,
2219 . c1='SKEW')
2220 ALLOCATE(skew_tmp(sskew) ,stat=stat)
2221 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2222 . msgtype=msgerror,
2223 . c1='SKEW')
2224 skew_tmp = 0
2225 CALL hm_preread_skw(skew_tmp ,iskew_tmp ,x ,itab ,itabm1 ,
2226 . lsubmodel ,unitab ,numnod ,numskw ,check_used,
2227 . liskn ,lskew ,n2d ,siskwn ,sskew )
2228 ELSE
2229 ALLOCATE(iskew_tmp(0))
2230 ALLOCATE(skew_tmp(0))
2231 ENDIF
2232C--------------------------------------------
2233C READING SUBMODELS & SUBMODEL TRANSFORMATION
2234C--------------------------------------------
2235 err_msg='SUBMODELS'
2236 err_category='SUBMODELS'
2237 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2238 . msgtype=msgerror)
2239 CALL trace_in1(err_msg,len_trim(err_msg))
2240 srtrans = nrtrans * ntransf
2241 ALLOCATE(rtrans(srtrans) ,stat=stat)
2242 IF(srtrans > 0) rtrans = zero
2243
2244 IF(nsubmod > 0)THEN
2245 WRITE(istdo,'(A)')' .. SUBMODELS'
2246 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2247 . msgtype=msgerror,
2248 . c1='RTRANS')
2249 CALL lectranssub(x ,igrnod ,itab ,itabm1 ,unitab,
2250 . rtrans ,lsubmodel,is_dyna,iskew_tmp,liskn ,
2251 . nspcond ,numsph ,siskwn )
2252 CALL lecsubmod(isubmod ,x ,unitab ,itabm1 ,rtrans,
2253 . itab ,lsubmodel ,is_dyna ,iskew_tmp ,liskn ,
2254 . skew_tmp ,lskew ,siskwn ,sskew )
2255 ENDIF
2256
2257 CALL trace_out1()
2258C--------------------------------------------
2259C READING OBLIQUE COORDINATE SYSTEMS
2260C + READING REFERENCE FRAMES
2261C--------------------------------------------
2262C SKEWS
2263 IF(ALLOCATED(iskew_tmp)) DEALLOCATE(iskew_tmp)
2264 IF(ALLOCATED(skew_tmp)) DEALLOCATE(skew_tmp)
2265 err_msg='SKEWS'
2266 err_category='SKEWS'
2267 CALL trace_in1(err_msg,len_trim(err_msg))
2268 IF(numskw/=0)WRITE(istdo,'(A)')titre(14)
2269 CALL hm_read_skw(skew ,iskwn ,x ,
2270 . itab ,itabm1 ,bid13 ,
2271 . lsubmodel,rtrans,
2272 . nom_opt(lnopt1*inom_opt(10)+1),unitab)
2273C
2274 CALL hm_read_frm(iskwn ,x ,itab ,itabm1 ,xframe ,
2275 . lsubmodel,rtrans,
2276 . nom_opt(lnopt1*inom_opt(10)+1),unitab)
2277 CALL trace_out1()
2278C--------------------------------------------
2279C PRE-READING PLY DEFINITIONS
2280C--------------------------------------------
2281 IF(ndrape > 0) THEN
2282 ALLOCATE(idrapeid(ndrape) ,stat=stat)
2283 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2284 . msgtype=msgerror,
2285 . c1='DRAPE')
2286 idrapeid = 0
2287 CALL hm_read_prelecdrape(idrapeid,lsubmodel)
2288 ELSE
2289 ALLOCATE(idrapeid(0))
2290 ENDIF
2291C--------------------------------------------
2292C READING PROPERTIES
2293C--------------------------------------------
2294 IF(nsphsol/=0)THEN
2295 CALL hm_preread_part(ipart,igeo,lsubmodel)
2296 END IF
2297C--------------------------------------------
2298 nrbag=0
2299 sbufgeo = 0
2300C PROPERTIES
2301 err_msg='PROPERTIES'
2302 err_category='PROPERTIES'
2303 CALL trace_in1(err_msg,len_trim(err_msg))
2304c
2305 IF(numgeo > 0)THEN
2306 WRITE(istdo,'(A)')titre(31)
2307 srwork = numgeo*(bgeosize+maxfunc+maxmat+maxpid+maxtab)
2308 sbufgeo = 0
2309 ALLOCATE(dbrwork(srwork) ,stat=stat)
2310 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2311 . msgtype=msgerror,
2312 . c1='DBRWORK')
2313 dbrwork = zero
2314 ALLOCATE(knot(sknot) ,stat=stat)
2315 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2316 . msgtype=msgerror,
2317 . c1='KNOT')
2318 CALL sav_buf_point(dbrwork,4)
2319C
2320 iadgeo=1
2321 CALL hm_read_properties(geo , x , ixc , pm ,itabm1 ,
2322 . dbrwork , sbufgeo , iskwn , igeo ,ipm ,
2323 . npc , tf , unitab , rtrans ,lsubmodel ,
2324 . prop_tag , ipart , knot , idrapeid ,stack_info,
2325 . numgeostack, nprop_stack , multi_fvm, iadgeo ,defaults ,
2326 . mat_elem%MAT_PARAM)
2327C
2328 ALLOCATE(bufgeo(sbufgeo) ,stat=stat)
2329 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2330 . msgtype=msgerror,
2331 . c1='BUFGEO')
2332 bufgeo(1:sbufgeo) = dbrwork(1:sbufgeo)
2333 DEALLOCATE(dbrwork)
2334 CALL sav_buf_point(bufgeo,4)
2335 ELSE
2336 ALLOCATE(bufgeo(sbufgeo) ,stat=stat)
2337 ENDIF
2338C
2339 IF(numply /= 0) THEN
2340 ALLOCATE(ply_info(3,numply),stat=stat)
2341 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2342 . msgtype=msgerror,
2343 . c1='PLY')
2344 ply_info = 0
2345 ELSE
2346 ALLOCATE(ply_info(0,0))
2347 ENDIF
2348c
2349 IF(numstack > 0) THEN
2350C pre-reading
2351 len_g = npropgi*(numstack + numply)
2352 ALLOCATE(igeo_stack(len_g),stat=stat)
2353 igeo_stack = 0
2354 len_g = npropg*(numstack + numply )
2355 ALLOCATE(geo_stack(len_g),stat=stat)
2356 geo_stack = zero
2357 CALL lecstack_ply(geo_stack ,x ,ixc ,pm ,itabm1 ,
2358 . iskwn ,igeo_stack ,ipm ,npc ,tf ,
2359 . unitab , rtrans ,lsubmodel,ipart ,idrapeid,
2360 . ply_info ,stack_info,numgeostack, nprop_stack ,
2361 . defaults )
2362 ELSE
2363 ALLOCATE(igeo_stack(0),stat=stat)
2364 ALLOCATE(geo_stack(0),stat=stat)
2365 ENDIF
2366C-----allocate DR if necessary------
2367 IF(sdr==0 .AND. idrot == 1) THEN
2368 sdr = 3*numnod*max(iroddl,iroddl0)
2369 IF(ALLOCATED(dr)) DEALLOCATE(dr)
2370 ALLOCATE(dr(sdr) ,stat=stat)
2371 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2372 . msgtype=msgerror)
2373 dr = zero
2374 ENDIF
2375C
2376
2377C print*, 'NPINCH', NPINCH, 'NUMNOD', NUMNOD
2378 spinch= npinch
2379C print*, SPINCH
2380 ALLOCATE(pinch_data%XPINCH(3,spinch) ,stat=stat)
2381 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2382 . msgtype=msgerror,
2383 . c1='XPINCH')
2384 ALLOCATE(pinch_data%DPINCH(3,spinch) ,stat=stat)
2385 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2386 . msgtype=msgerror,
2387 . c1='DPINCH')
2388 ALLOCATE(pinch_data%VPINCH(3,spinch) ,stat=stat)
2389 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2390 . msgtype=msgerror,
2391 . c1='VPINCH')
2392 ALLOCATE(pinch_data%MSPINCH(spinch) ,stat=stat)
2393 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2394 . msgtype=msgerror,
2395 . c1='MSPINCH')
2396C
2397 IF(npinch > 0) THEN
2398 pinch_data%XPINCH(1:3,1:spinch) = zero
2399 pinch_data%DPINCH(1:3,1:spinch) = zero
2400 pinch_data%VPINCH(1:3,1:spinch) = zero
2401 pinch_data%MSPINCH(1:spinch) = zero
2402 ENDIF
2403C
2404 CALL trace_out1()
2405C-----------------------------------------------------
2406C READING PARTS
2407C REPLACEMENT OF EXTERNAL MATERIAL NUMBERS
2408C REPLACEMENT OF EXTERNAL PROPERTY NUMBERS
2409C BY INTERNAL NUMBERS
2410C-----------------------------------------------------
2411 err_msg='PARTS'
2412 err_category='PARTS'
2413 CALL trace_in1(err_msg,len_trim(err_msg))
2414 siwork = max(2*numels,2*numelq,3*(npart+nthpart),3*numskw,numels,
2415 * numelc,numeltg,nummat+numgeo,numelt+numelp+numelr+
2416 * numelx+numelig3d)
2417 ALLOCATE(iwork(siwork) ,stat=stat)
2418 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2419 . msgtype=msgerror,
2420 . c1='IWORK')
2421 iwork = 0
2422 ALLOCATE(thk_part(npart) ,stat=stat)
2423C
2424 CALL hm_read_part(ipart ,pm ,geo ,ipm ,igeo ,iwork ,thk_part,
2425 . unitab,lsubmodel,multi_fvm ,mlaw_tag,mat_elem%MAT_PARAM,glob_therm)
2426
2427 CALL trace_out1()
2428
2429C--------------------------------------------
2430C STOCKAGE DYNAMIQUE (A.L.E.) ENTIER
2431C--------------------------------------------
2432 ale%GLOBAL%SNALE = max(iale,ieuler,ialelag)*numnod
2433 ale%GLOBAL%SIELVS = 6*numels+max(iale,glob_therm%ITHERM,ieuler,ialelag)* (4 * numelq + 3 * numeltg)
2434 sifill = nmult*numnod
2435 sims = nmult*numnod
2436C---
2437 ALLOCATE(ifill(sifill),stat=stat)
2438 IF(stat /= 0) CALL ancmsg(msgid = 268,
2439 . anmode = aninfo,
2440 . msgtype = msgerror,
2441 . c1 = 'IFILL')
2442
2443 ALLOCATE(ims(sims),stat=stat)
2444 IF(stat /= 0) CALL ancmsg(msgid = 268,
2445 . anmode = aninfo,
2446 . msgtype = msgerror,
2447 . c1 = 'IMS')
2448
2449
2450 IF(sifill > 0) ifill = 0
2451 IF(sims > 0) ims = 0
2452
2453 ALLOCATE(dflow(3*numnod*ialelag) ,stat=stat)
2454 ALLOCATE(vflow(3*numnod*ialelag) ,stat=stat)
2455 ALLOCATE(wflow(3*numnod*ialelag) ,stat=stat)
2456
2457 IF(ialelag > 0) THEN
2458 dflow = zero
2459 vflow = zero
2460 wflow = zero
2461 ENDIF
2462
2463 IF(alefvm_param%IEnabled > 0)THEN
2464 ALLOCATE(alefvm_buffer%FCELL(6,numels) ,stat=stat)
2465 alefvm_buffer%FCELL(:,:) = zero
2466 ENDIF
2467
2468C----------------------------------
2469C--------------------------------------------
2470C MULTIDOMAINS
2471C--------------------------------------------
2472 err_msg='MULTIDOMAINS'
2473 err_category='MULTIDOMAINS'
2474 CALL trace_in1(err_msg,len_trim(err_msg))
2475 nr2r = 5
2476 r2r_siu = 0
2477 siexlnk = nr2r*nr2rlnk
2478 IF((nr2rlnk+nsubdom)>0) THEN
2479 ALLOCATE(iexlnk(siexlnk) ,stat=stat)
2480 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2481 . msgtype=msgerror,
2482 . c1='IEXLNK')
2483 iexlnk = 0
2484 WRITE(istdo,'(A)') ' .. EXTERNAL COUPLING'
2485 CALL lecextlnk(iexlnk,ipart,lsubmodel)
2486 nl_ddr2r = nr2rlnk
2487 ELSE
2488 ALLOCATE(iexlnk(0))
2489 ENDIF
2490 IF(nsubdom > 0) THEN
2491 ALLOCATE(tag_part(npart),ipart_r2r(4,npart))
2492 tag_part(:)=0
2493 CALL r2r_void(ipart)
2494 nl_ddr2r = 4
2495 r2r_siu = 1
2496c complete mlaw_tag for new void materials
2497 !Material Buffer copy for R2R (rad2rad) with R2R_MATPARAM_COPY
2498 IF(nummat > nummat0) THEN
2499 ALLOCATE(mtag_r2r(nummat))
2500 ALLOCATE(mparam_r2r(nummat))
2501 CALL init_mlaw_tag(mtag_r2r ,nummat)
2502 mtag_r2r(1:nummat0) = mtag_ini(1:nummat0)
2503 CALL r2r_matparam_copy(mparam_r2r, mparam_ini ,nummat0 ,nummat)
2504 mlaw_tag(1:nummat) => mtag_r2r(1:nummat)
2505 mat_elem%MAT_PARAM(1:nummat) => mparam_r2r(1:nummat)
2506 mat_elem%NUMMAT = nummat
2507 DEALLOCATE(mtag_ini)
2508 IF(ALLOCATED(mparam_ini))THEN
2509 DO i=1,nummat0 ; CALL mparam_ini(i)%DESTRUCT() ; ENDDO
2510 DEALLOCATE(mparam_ini)
2511 ENDIF
2512 ENDIF
2513 ELSE
2514 ALLOCATE(tag_part(0),ipart_r2r(4,0))
2515 ENDIF
2516 CALL trace_out1()
2517C--------------------------------------------
2518C--------------------------------------------
2519C POIN UMP
2520C--------------------------------------------
2521! TABMP_L defined in tabsiz_c
2522 tabmp_l = 10
2523C
2524 CALL trace_in1(err_msg,len_trim(err_msg))
2525 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2526 . msgtype=msgerror,
2527 . c1='PARTS')
2528
2529 ALLOCATE( poin_part_shell(2,npart) )
2530 ALLOCATE( poin_part_tri(2,npart) )
2531 ALLOCATE( poin_part_sol(2,npart,7) )
2532 ALLOCATE( mid_pid_shell(nummat),mid_pid_tri(nummat) )
2533 ALLOCATE( mid_pid_sol(nummat,7) )
2534 poin_part_shell(1:2,1:npart) = 0
2535 poin_part_tri(1:2,1:npart) = 0
2536 poin_part_sol(1:2,1:npart,1:7) = 0
2537
2538 ALLOCATE(poin_ump(nummat), stat=stat)
2539 poin_ump(1:nummat) = 0
2540 ALLOCATE(tab_ump_loc(5,npart), stat=stat)
2541 tab_ump_loc(1:5,1:npart) = 0
2542C
2543 CALL set_poin_ump(ipart,ipm,tab_ump_loc,poin_ump,taille2)
2544 CALL trace_out1()
2545C--------------------------------------------
2546C READING SOLIDS
2547C--------------------------------------------
2548 err_msg='ELEMENTS'
2549 err_category='ELEMENTS'
2550 CALL trace_in1(err_msg,len_trim(err_msg))
2551 IF(numels/=0)THEN
2552 WRITE(istdo,'(A)')titre(15)
2553
2554 CALL hm_read_solid(ixs ,pm ,itab ,itabm1 ,
2555 . ipart ,iparts ,eani ,ixs10 ,ixs20 ,ixs16 ,
2556 . igeo ,lsubmodel,is_dyna,x )
2557
2558 ENDIF
2559 CALL trace_out1()
2560C--------------------------------------------
2561C READING 2D ELEMENTS
2562C--------------------------------------------
2563 IF(numelq/=0)THEN
2564 WRITE(istdo,'(A)')titre(16)
2565 CALL hm_read_quad(ixq ,itab ,itabm1 ,ipart ,ipartq ,
2566 . ipm ,igeo ,unitab ,lsubmodel)
2567 ENDIF
2568C--------------------------------------------
2569C READING SHELLS
2570C--------------------------------------------
2571 ALLOCATE(itag(numnod),stat=stat)
2572 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2573 . msgtype=msgerror,
2574 . c1='itag')
2575 ITAG=0
2576C
2577 IF(NUMELC/=0)THEN
2578 WRITE(ISTDO,'(a)')TITRE(17)
2579 CALL HM_READ_SHELL(IXC ,ITAB ,ITABM1 ,IPART ,IPARTC ,
2580 . THKE ,IPM ,IGEO ,UNITAB ,ITAG ,SH4ANG, LSUBMODEL)
2581 ENDIF
2582C
2583C WARNING, SHELL ELEMENTS ARE PERMUTED
2584C TO GENERATE OPTIMIZED GROUPS
2585C AFTER READING PIDs
2586C
2587C--------------------------------------------
2588C READING TRUSSES
2589C--------------------------------------------
2590 IF(NUMELT/=0)THEN
2591 WRITE(ISTDO,'(a)')TITRE(18)
2592 CALL HM_READ_TRUSS(IXT ,ITAB ,ITABM1 ,IPART ,IPARTT ,
2593 . IPM ,IGEO ,LSUBMODEL)
2594 ENDIF
2595C--------------------------------------------
2596C READING BEAMS
2597C--------------------------------------------
2598 IF(NUMELP/=0)THEN
2599 WRITE(ISTDO,'(a)')TITRE(19)
2600 CALL HM_READ_BEAM(IXP ,ITAB ,ITABM1 ,IPART ,IPARTP ,
2601 . IPM ,IGEO ,LSUBMODEL,IBEAM_VECTOR,RBEAM_VECTOR)
2602 ENDIF
2603C--------------------------------------------
2604C READING SPRINGS
2605C--------------------------------------------
2606 REINT = ZERO
2607 IF(NUMELR/=0)THEN
2608 WRITE(ISTDO,'(a)')TITRE(20)
2609 CALL HM_READ_SPRING(IXR ,ITAB ,ITABM1 ,IPART ,IPARTR ,
2610 . IGEO ,IXR_KJ ,LSUBMODEL,ISKWN,R_SKEW,IPM)
2611 ENDIF
2612C--------------------------------------------
2613C READING TRIANGULAR SHELLS
2614C--------------------------------------------
2615 IF(NUMELTG/=0)THEN
2616.AND. IF(N2D==0 NUMELTRIA==0)THEN
2617 WRITE(ISTDO,'(a)')TITRE(21)
2618 CALL HM_READ_SH3N( IXTG ,ITAB ,ITABM1 ,IPART ,IPARTG ,
2619 . THKEC ,PM ,GEO ,EANIT ,IGEO ,
2620 . IPM ,UNITAB ,SH3ANG , LSUBMODEL)
2621 ELSEIF(NUMELTRIA==NUMELTG)THEN
2622 WRITE(ISTDO,'(a)')TITRE(23)
2623 CALL HM_READ_TRIA(IXTG ,ITAB ,ITABM1 ,IPART ,IPARTG ,
2624 . PM ,GEO ,EANIT ,IGEO ,IPM ,
2625 . UNITAB , LSUBMODEL)
2626 ELSE
2627 !check is IXTG array is used with proper modeling : 2D-TRIA or 3D-SH3N
2628.AND..AND. IF(NUMELTG>0 N2D>0 NUMELTRIA==0)THEN
2629 CALL ANCMSG(MSGID=66,
2630 . MSGTYPE=MSGERROR,
2631 . ANMODE=ANINFO,
2632 . C1='sh3n',
2633 . C2='2d-analysis'
2634 . )
2635.AND..AND. ELSEIF(NUMELTG>0 N2D==0 NUMELTRIA==NUMELTG)THEN
2636 CALL ANCMSG(MSGID=66,
2637 . MSGTYPE=MSGERROR,
2638 . ANMODE=ANINFO,
2639 . C1='tria',
2640 . C2='3d-analysis'
2641 . )
2642 ENDIF
2643 NUMELTG = 0
2644 ENDIF
2645 ENDIF
2646C--------------------------------------------
2647C Check XFEM FLAG
2648 IF(NUMELTG + NUMELC == 0) ICRACK3D = 0
2649C--------------------------------------------
2650C READING ISO-GEOMETRIC ELEMENTS
2651C--------------------------------------------
2652 NCTRLMAX = 0
2653 IF(NUMELIG3D/=0)THEN
2654
2655 SKXIG3D = NIXIG3D*NUMELIG3D
2656 WRITE(ISTDO,'(a)')TITRE(22)
2657
2658 CALL PRELECIG3D(SIXIG3D)
2659
2660 ALLOCATE(KXIG3D(SKXIG3D) ,STAT=stat)
2661 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2662 . MSGTYPE=MSGERROR,
2663 . C1='kxig3d')
2664 ALLOCATE(IXIG3D(SIXIG3D+ADDSIXIG3D) ,STAT=stat)
2665 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2666 . MSGTYPE=MSGERROR,
2667 . C1='ixig3d')
2668 ALLOCATE(TABCONPATCH(NBPART_IG3D),STAT=stat)
2669 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2670 . MSGTYPE=MSGERROR,
2671 . C1='tabcon_patch_ig3d')
2672 KXIG3D = 0
2673 IXIG3D = 0
2674 CALL LECIG3D(
2675 . ITAB ,IPART ,IPARTIG3D ,IPM ,IGEO ,
2676 . KXIG3D ,IXIG3D ,ITABM1 ,NCTRLMAX,TABCONPATCH)
2677
2678 SKNOTLOCPC = DEG_MAX*3*(NUMNOD+L_TAB_NEWFCT)*NUMGEO ! THERE SHOULD BE A NUMBER OF IGE POINTS AND INDICES
2679cSknotlocpc is slightly oversized as it takes into account temporary work points
2680.OR. IF(SKNOTLOCPC > INTMAX SKNOTLOCPC < ZERO) THEN ! L_TAB_NEWFCT to allow for workspace size
2681 SKNOTLOCPC = INTMAX
2682 ELSE
2683 SKNOTLOCPC = INT(SKNOTLOCPC)
2684 ENDIF
2685 ALLOCATE(KNOTLOCPC(SKNOTLOCPC) ,STAT=stat)
2686 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2687 . MSGTYPE=MSGERROR,
2688 . C1='knotlocpc')
2689 KNOTLOCPC(:)=0
2690
2691 SKNOTLOCEL = 2*3*NUMELIG3D
2692.OR. IF(SKNOTLOCEL > INTMAX SKNOTLOCEL < ZERO) THEN
2693 SKNOTLOCEL = INTMAX
2694 ELSE
2695 SKNOTLOCEL = INT(SKNOTLOCEL)
2696 ENDIF
2697 ALLOCATE(KNOTLOCEL(SKNOTLOCEL) ,STAT=stat)
2698 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2699 . MSGTYPE=MSGERROR,
2700 . C1='knotlocel')
2701 KNOTLOCEL(:)=0
2702
2703 CALL PRERAFIG3D(KNOT,KNOTLOCPC,KNOTLOCEL,
2704 . KXIG3D,IXIG3D,IGEO,
2705 . IPARTIG3D,
2706 . X,V,D,MS,WIGE,TABCONPATCH,1)
2707c
2708 SIXIG3D=SIXIG3D+ADDSIXIG3D
2709 ALLOCATE(MSIG3D(NUMELIG3D*NCTRLMAX) ,STAT=stat)
2710 MSIG3D(1:NUMELIG3D*NCTRLMAX) = ZERO
2711 ELSE
2712 ALLOCATE(KXIG3D(0) ,STAT=stat)
2713 ALLOCATE(MSIG3D(0) ,STAT=stat)
2714 ALLOCATE(IXIG3D(0) ,STAT=stat)
2715 ALLOCATE(KNOTLOCEL(0) ,STAT=stat)
2716 ALLOCATE(KNOTLOCPC(0) ,STAT=stat)
2717 ENDIF
2718C--------------------------------------------
2719C PRE-READING GRNOD/NODENS
2720C--------------------------------------------
2721.AND. IF(NUMELX > 0 NGRNOD > 0 )THEN
2722 WRITE(ISTDO,'(a)')' .. nodens group '
2723 CALL HM_PRELECGRNS(ITABM1 ,IGRNOD, LSUBMODEL)
2724 ENDIF
2725C---------------------------------------------
2726C PRE-READING MULTI-PURPOSE ELEMENTS.
2727C---------------------------------------------
2728 ERR_MSG='multi-purpose elements'
2729 ERR_CATEGORY='multi-purpose elements'
2730 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
2731 IF(NUMELX > 0) THEN
2732 SKXX = NIXX*NUMELX
2733 CALL HM_PREREAD_XELEM(SIXX, IGRNOD,LSUBMODEL)
2734 ALLOCATE(KXX(SKXX) ,STAT=stat)
2735 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2736 . MSGTYPE=MSGERROR,
2737 . C1='kxx')
2738 ALLOCATE(IXX(SIXX+150) ,STAT=stat)
2739 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2740 . MSGTYPE=MSGERROR,
2741 . C1='ixx')
2742 KXX = 0
2743 IXX = 0
2744 ALLOCATE(LELX(NUMELX) ,STAT=stat)
2745 LELX(1:NUMELX) = ZERO
2746 CALL HM_READ_XELEM(IGRNOD ,ITAB ,ITABM1 ,IPART ,IPARTX,
2747 . IPM ,IGEO ,KXX ,IXX ,LSUBMODEL)
2748 ELSE
2749 SKXX = 0
2750 SIXX = 0
2751 ALLOCATE(KXX(SKXX) ,STAT=stat)
2752 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2753 . MSGTYPE=MSGERROR,
2754 . C1='kxx')
2755 ALLOCATE(IXX(SIXX) ,STAT=stat)
2756 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2757 . MSGTYPE=MSGERROR,
2758 . C1='ixx')
2759 ALLOCATE(LELX(NUMELX) ,STAT=stat)
2760 ENDIF
2761 CALL TRACE_OUT1()
2762C--------------------------------------------
2763C ADAPTIVE MESHING
2764C--------------------------------------------
2765 ERR_MSG='adaptive meshing'
2766 ERR_CATEGORY='adaptive meshing'
2767 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
2768 LEVELMAX=0
2769 LSH4TRIM=0
2770 LSH3TRIM=0
2771 IF(NADMESH/=0)THEN
2772
2773 ALLOCATE(SH4TREE(KSH4TREE,NUMELC),STAT=stat)
2774 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2775 . MSGTYPE=MSGERROR,
2776 . C1='sh4tree')
2777 SH4TREE=0
2778 ALLOCATE(SH3TREE(KSH3TREE,NUMELTG),STAT=stat)
2779 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2780 . MSGTYPE=MSGERROR,
2781 . C1='sh3tree')
2782 SH3TREE=0
2783 ALLOCATE(IPADMESH(KIPADMESH,NPART),STAT=stat)
2784 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2785 . MSGTYPE=MSGERROR,
2786 . C1='ipadmesh')
2787 IPADMESH=0
2788
2789 ALLOCATE(PADMESH(KPADMESH,NPART),STAT=stat)
2790 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2791 . MSGTYPE=MSGERROR,
2792 . C1='padmesh')
2793 PADMESH=ZERO
2794
2795 CALL SET_ADMESH(IPART ,IPADMESH,PADMESH,UNITAB,LSUBMODEL )
2796
2797 IF(IADMSTAT/=0)THEN
2798 LSH4TRIM=NUMELC
2799 ALLOCATE(SH4TRIM(LSH4TRIM),STAT=stat)
2800 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2801 . MSGTYPE=MSGERROR,
2802 . C1='sh4trim')
2803 SH4TRIM=0
2804 LSH3TRIM=NUMELTG
2805 ALLOCATE(SH3TRIM(LSH3TRIM),STAT=stat)
2806 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2807 . MSGTYPE=MSGERROR,
2808 . C1='sh3trim')
2809 SH3TRIM=0
2810 CALL STATE_ADMESH(
2811 . IPART ,IPARTC ,IPARTG ,IXC ,IXTG ,
2812 . SH4TREE, SH3TREE, SH4TRIM, SH3TRIM,
2813 . LSUBMODEL)
2814 END IF
2815 CALL BUILD_ADMESH(
2816 . IPART ,IPARTC ,IPARTG ,IXC ,IXTG ,
2817 . X ,ITAB ,ITABM1 ,SH4TREE, SH3TREE,
2818 . IPADMESH,PADMESH)
2819 ELSE
2820 ALLOCATE(SH4TREE(0,0))
2821 ALLOCATE(SH3TREE(0,0))
2822 ALLOCATE(IPADMESH(0,0))
2823 ALLOCATE(PADMESH(0,0))
2824 ALLOCATE(SH4TRIM(0))
2825 ALLOCATE(SH3TRIM(0))
2826 END IF
2827
2828 IF(ISTATCND/=0)THEN
2829 ALLOCATE(MSCND(NUMNOD),INCND(NUMNOD),STAT=stat)
2830 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2831 . MSGTYPE=MSGERROR,
2832 . C1='mscnd')
2833 MSCND=ZERO
2834 INCND=ZERO
2835 ELSE
2836 ALLOCATE(MSCND(0),INCND(0))
2837 END IF
2838 CALL TRACE_OUT1()
2839
2840C--------------------------------------------
2841C REINITIALISATION MAT/PROP
2842C--------------------------------------------
2843
2844 IF(TAILLE2>0) THEN
2845 ALLOCATE(TAB_UMP_LOC2(7+6,TAILLE2,2),STAT=stat)
2846 TAB_UMP_LOC2 = 0
2847 CALL REINI_MATPROP(TAILLE,TAILLE2,TAB_UMP_LOC,TAB_UMP_LOC2,
2848 . IXS,IXQ,IXC,IXT,IXP,IXR,
2849 . IXTG,EANI,POIN_UMP)
2850
2851 ALLOCATE( TAB_UMP(7,TAILLE), STAT=stat)
2852 TAB_UMP = 0
2853 IF(TAILLE>0) THEN
2854 CALL REINI_MATPROP2(TAILLE,TAILLE2,
2855 . TAB_UMP_LOC,TAB_UMP_LOC2,TAB_UMP,TAB_SOL,
2856 . POIN_UMP)
2857 ENDIF
2858 DEALLOCATE(TAB_UMP_LOC2)
2859 ENDIF
2860 DEALLOCATE(TAB_UMP_LOC)
2861C--------------------------------------------
2862C TABLEAUX X-FEM (SHELL 4-N + SHELL 3-N)
2863C xfem for crack propagation (mono + multi layer shells)
2864C--------------------------------------------
2865 IF(ICRACK3D > 0) THEN
2866 NXEL = 3 ! nb of phantom elements within one layer (change to NXEL=3)
2867 XFEMON = 1
2868 IF(IPARI0 /= 1) IPARI0=1 ! force flag parith/on pour XFEM (pareil engine)
2869 ELSE
2870 NXEL = 0
2871 XFEMON = 0
2872 ENDIF
2873C-----
2874 ERR_MSG='xfem for shells - allocations'
2875 ERR_CATEGORY='internal'
2876 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
2877C-----
2878 LEN = XFEMON*NUMNOD
2879 ALLOCATE(ADDCNE_CRKXFEM(0:LEN+1),STAT=stat)
2880 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2881 . MSGTYPE=MSGERROR,C1='addcne_crkxfem')
2882 ADDCNE_CRKXFEM(0:LEN+1) = 0
2883c
2884 ALLOCATE(ITAGN(LEN),STAT=stat)
2885 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2886 . MSGTYPE=MSGERROR,C1='itagn')
2887 ALLOCATE(INOD_CRKXFEM(LEN),STAT=stat)
2888 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2889 . MSGTYPE=MSGERROR,C1='inod_crkxfem')
2890 ALLOCATE(IBORDNODE(LEN),STAT=stat)
2891 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANSTOP,
2892 . MSGTYPE=MSGERROR,C1='ibordnode')
2893 LEN = XFEMON*(NUMELC+NUMELTG)
2894 SITAGE=LEN
2895 ALLOCATE(ITAGE(LEN),STAT=stat)
2896 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2897 . MSGTYPE=MSGERROR,C1='itage')
2898 ALLOCATE(IEL_CRKXFEM(LEN),STAT=stat)
2899 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2900 . MSGTYPE=MSGERROR,C1='iel_crkxfem')
2901c
2902 ITAGN = 0
2903 ITAGE = 0
2904 INOD_CRKXFEM = 0
2905 IEL_CRKXFEM = 0
2906 IBORDNODE = 0
2907c
2908 CALL TRACE_OUT1()
2909C--------------------------------------------
2910C READING GLOBAL PARAMETERS + SPH PARTICLES.
2911C---------------------------------------------
2912 ERR_MSG='sph'
2913 ERR_CATEGORY='sph'
2914 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
2915 IF(NSPHSOL/=0)THEN
2916 ALLOCATE(SPH2SOL(NUMSPH) ,STAT=stat)
2917 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2918 . MSGTYPE=MSGERROR,
2919 . C1='sph2sol')
2920 SPH2SOL=0
2921 ALLOCATE(SOL2SPH(2*NUMELS8) ,STAT=stat)
2922 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2923 . MSGTYPE=MSGERROR,
2924 . C1='sol2sph')
2925 SOL2SPH=0
2926 ALLOCATE(IRST(3*NSPHSOL) ,STAT=stat)
2927 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2928 . MSGTYPE=MSGERROR,
2929 . C1='irst')
2930 IRST=0
2931 ALLOCATE(SOL2SPH_TYP(NUMELS8) ,STAT=stat)
2932 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2933 . MSGTYPE=MSGERROR,
2934 . C1='sol2sph_typ')
2935 SOL2SPH_TYP=0
2936 ELSE
2937 ALLOCATE(SPH2SOL(0) ,STAT=stat)
2938 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2939 . MSGTYPE=MSGERROR,
2940 . C1='sph2sol')
2941 ALLOCATE(SOL2SPH(0) ,STAT=stat)
2942 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2943 . MSGTYPE=MSGERROR,
2944 . C1='sol2sph')
2945 ALLOCATE(IRST(0) ,STAT=stat)
2946 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2947 . MSGTYPE=MSGERROR,
2948 . C1='irst')
2949 ALLOCATE(SOL2SPH_TYP(0) ,STAT=stat)
2950 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2951 . MSGTYPE=MSGERROR,
2952 . C1='sol2sph_typ')
2953 END IF
2954 IF(NUMSPH > 0) THEN
2955 SSPBUF = NSPBUF*NUMSPH
2956 SKXSP = NISP*NUMSPH
2957 SIXSP = KVOISPH*NUMSPH
2958c test with INTEGER 64 bits to avoid integer 32 bits overflow with huge cases (10 Millions SPH cells)
2959 KVOISPH8 = KVOISPH
2960 NUMSPH8 = NUMSPH
2961
2962c limit INTEGER 32 bits ((2^31)-1), we add a security marge of 5%
2963 SIXSP8 = (NUMSPH8/(NSPMD))*KVOISPH8
2964 LIMIT8 = (HUGE(INTEGER_LIMIT32)-1)*0.95!((2**31)-1)*0.95
2965 IF(SIXSP8>LIMIT8)THEN
2966 CALL ANCMSG(MSGID=981,
2967 . MSGTYPE=MSGERROR,
2968 . ANMODE=ANSTOP)
2969 ENDIF
2970
2971 SNOD2SP = NUMNOD
2972 ALLOCATE(KXSP(SKXSP) ,STAT=stat)
2973 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2974 . MSGTYPE=MSGERROR,
2975 . C1='kxsp')
2976 ALLOCATE(IXSP(KVOISPH,NUMSPH) ,STAT=stat)
2977 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2978 . MSGTYPE=MSGERROR,
2979 . C1='ixsp')
2980 ALLOCATE(NOD2SP(SNOD2SP) ,STAT=stat)
2981 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2982 . MSGTYPE=MSGERROR,
2983 . C1='nod2sp')
2984 ALLOCATE(SPBUF(SSPBUF) ,STAT=stat)
2985 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
2986 . MSGTYPE=MSGERROR,
2987 . C1='spbuf')
2988
2989.AND. IF(NSPHIO>0NBPARTINLET>0)THEN
2990 ALLOCATE(RESERVEP(NBPARTINLET) ,STAT=stat)
2991 IF(STAT /= 0) CALL ANCMSG(MSGID=268,
2992 . ANMODE=ANSTOP,
2993 . MSGTYPE=MSGERROR,
2994 . C1='reservep')
2995 RESERVEP(1:NBPARTINLET) = 0
2996 ELSE
2997 ALLOCATE(RESERVEP(1))
2998 RESERVEP(1) = 0
2999 ENDIF
3000 KXSP = 0
3001 IXSP = 0
3002 NOD2SP = 0
3003 SPBUF = ZERO
3004 WRITE(ISTDO,'(a)')' .. sph particles definition'
3005 CALL HM_READ_SPHCEL(ITAB ,ITABM1 ,IPART ,
3006 2 IPARTSP ,IPM ,IGEO ,KXSP ,IXSP ,
3007 3 NOD2SP, RESERVEP,IXS ,IPARTS ,EANI ,
3008 4 SPH2SOL,SOL2SPH ,IRST ,X ,SOL2SPH_TYP,
3009 5 LSUBMODEL,SPBUF ,UNITAB ,IPRI )
3010
3011 ELSE
3012 SSPBUF = 0
3013 SKXSP = 0
3014 SIXSP = 0
3015 SNOD2SP = 0
3016 ALLOCATE(KXSP(SKXSP) ,STAT=stat)
3017 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3018 . MSGTYPE=MSGERROR,
3019 . C1='kxsp')
3020 ALLOCATE(IXSP(0,0) ,STAT=stat)
3021 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3022 . MSGTYPE=MSGERROR,
3023 . C1='ixsp')
3024 ALLOCATE(NOD2SP(SNOD2SP) ,STAT=stat)
3025 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3026 . MSGTYPE=MSGERROR,
3027 . C1='nod2sp')
3028 ALLOCATE(SPBUF(SSPBUF) ,STAT=stat)
3029 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3030 . MSGTYPE=MSGERROR,
3031 . C1='spbuf')
3032 ENDIF
3033 CALL TRACE_OUT1()
3034C--------------------------------------------
3035C INVERSE CONNECTIVITY (Starter only)
3036C--------------------------------------------
3037C Create IXTG1 array and set to 0
3038 ERR_MSG='connectivity'
3039 ERR_CATEGORY='connectivity'
3040 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
3041 ! -------------------
3042 ! initialisation of invert_group structure, used in
3043 ! HM_READ_SET and in HM_READ_SENSORS for user sensor
3044 CALL INVERTED_GROUP_INIT(0,INV_GROUP,NUMSPH)
3045 ! example :
3046 CALL COMPUTE_CONNECT_PARTELM(IPARTS ,IPARTQ ,IPARTC ,IPARTT ,IPARTP,
3047 . IPARTG ,IPARTR ,IPARTSP ,INV_GROUP,NUMSPH,
3048 . NISP ,KXSP )
3049 ! -------------------
3050 IF(NUMELTG6 ==0 )THEN
3051 SIXTG1 = 0
3052 ELSE
3053 SIXTG1 = 4*NUMELTG
3054 ENDIF
3055 ALLOCATE(IXTG1(SIXTG1), STAT=stat)
3056 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3057 . MSGTYPE=MSGERROR,
3058 . C1='ixtg1')
3059 IXTG1 = 0
3060
3061214 ALLOCATE(KNOD2ELS(NUMNOD+1),STAT=stat)
3062 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3063 . MSGTYPE=MSGERROR,
3064 . C1='knod2els')
3065 KNOD2ELS=0
3066 ALLOCATE(KNOD2ELC(NUMNOD+1),STAT=stat)
3067 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3068 . MSGTYPE=MSGERROR)
3069 KNOD2ELC=0
3070 ALLOCATE(KNOD2ELTG(NUMNOD+1),STAT=stat)
3071 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3072 . MSGTYPE=MSGERROR,
3073 . C1='knod2eltg')
3074 KNOD2ELTG=0
3075 ALLOCATE(KNOD2EL1D(NUMNOD+1),STAT=stat)
3076 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3077 . MSGTYPE=MSGERROR,
3078 . C1='knod2el1d')
3079 KNOD2EL1D=0
3080
3081 ALLOCATE(KNOD2ELQ(NUMNOD+1),STAT=stat)
3082 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3083 . MSGTYPE=MSGERROR)
3084 KNOD2ELQ=0
3085
3086
3087 S_NOD2ELS = 8*NUMELS+6*NUMELS10+12*NUMELS20+8*NUMELS16
3088 ALLOCATE(NOD2ELS(S_NOD2ELS),STAT=stat)
3089 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3090 . MSGTYPE=MSGERROR,
3091 . C1='nod2els')
3092 NOD2ELS=0
3093 ALLOCATE(NOD2ELC(4*NUMELC),STAT=stat)
3094 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3095 . MSGTYPE=MSGERROR,
3096 . C1='nod2elc')
3097 NOD2ELC=0
3098 S_NOD2ELTG = 3*NUMELTG+3*NUMELTG6
3099 ALLOCATE(NOD2ELTG(S_NOD2ELTG),STAT=stat)
3100 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3101 . MSGTYPE=MSGERROR,
3102 . C1='nod2eltg')
3103 NOD2ELTG=0
3104 S_NOD2EL1D=2*NUMELT+2*NUMELP+3*NUMELR+2*SIXX
3105 ALLOCATE(NOD2EL1D(S_NOD2EL1D),STAT=stat)
3106 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3107 . MSGTYPE=MSGERROR,
3108 . C1='nod2el1d')
3109 NOD2EL1D=0
3110 ALLOCATE(KNOD2ELIG3D(NUMNOD+1),STAT=stat)
3111 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3112 . MSGTYPE=MSGERROR,
3113 . C1='knod2elig3d')
3114 KNOD2ELIG3D=0
3115 ALLOCATE(NOD2ELIG3D(NCTRLMAX*NUMELIG3D),
3116 . STAT=stat)
3117 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3118 . MSGTYPE=MSGERROR,
3119 . C1='nod2elig3d')
3120 NOD2ELIG3D=0
3121 ALLOCATE(NOD2ELQ(4*NUMELQ),STAT=stat)
3122 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3123 . MSGTYPE=MSGERROR,
3124 . C1='nod2elq')
3125 NOD2ELQ=0
3126
3127 IF(FLAG_GOTO==1) GOTO 215
3128
3129C--------------------------------------------
3130 CALL BUILD_CNEL(
3131 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
3132 3 IXR ,IXTG ,IXS10 ,IXS20 ,
3133 4 IXS16 ,IXTG1 ,IGEO ,KNOD2ELS ,KNOD2ELC ,
3134 5 KNOD2ELTG ,NOD2ELS ,NOD2ELC ,NOD2ELTG ,NOD2EL1D ,
3135 6 KNOD2EL1D ,KXX ,IXX ,X ,LELX ,
3136 7 IXIG3D ,KXIG3D ,KNOD2ELIG3D,NOD2ELIG3D,KNOD2ELQ,
3137 8 NOD2ELQ )
3138 IF(ALLOCATED(IWORK)) DEALLOCATE(IWORK)
3139 CALL TRACE_OUT1()
3140C--------------------------------------------
3141C READING SUBSETS
3142C--------------------------------------------
3143 TAGSURFIGE = 0
3144 SIBUFSSG = 0 ! to be removed
3145!
3146 ERR_MSG='subsets'
3147 ERR_CATEGORY='subsets'
3148 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
3149 IF(NSUBS > 0) THEN
3150 WRITE(ISTDO,'(a)')' .. subsets'
3151!
3152 CALL HM_READ_SUBSET(SUBSETS,IPART,NSUBS,NPART,LSUBMODEL)
3153 CALL SUBSET_INI(SUBSETS)
3154!
3155 ENDIF
3156 CALL TRACE_OUT1()
3157C--------------------------------------------
3158C READING BOXES (BOX and BOX of BOX)
3159C--------------------------------------------
3160 CALL STARTIME(19,1)
3161C--------------------------------------------
3162 ERR_MSG='boxes'
3163 ERR_CATEGORY='boxes'
3164 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
3165C
3166 ALLOCATE(IBOX (NBBOX))
3167 IF(NBBOX > 0) THEN
3168 WRITE(ISTDO,'(a)')' .. box '
3169c
3170 CALL HM_READ_BOX(IBOX ,UNITAB ,ITABM1 ,ISKWN ,SKEW ,
3171 . X ,RTRANS ,LSUBMODEL)
3172C
3173 ENDIF
3174C--------------------
3175 CALL TRACE_OUT1()
3176C--------------------------
3177C ELEMENT GROUT READING
3178C--------------------------
3179 ERR_MSG='groups'
3180 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
3181!
3182 IDXIGECNT= 1
3183!
3184 WRITE(ISTDO,'(a)')' .. element groups'
3185 ERR_CATEGORY='element groups'
3186 FLAGG = 0
3187 IADBOXMAX = 1
3188C count group elements
3189 ALLOCATE(IXS_S(NUMELS),IXS_S_IND(NUMELS),IXQ_S(NUMELQ),
3190 2 IXQ_S_IND(NUMELQ),IXC_S(NUMELC),IXC_S_IND(NUMELC),
3191 3 IXT_S(NUMELT),IXT_S_IND(NUMELT),IXP_S(NUMELP),
3192 4 IXP_S_IND(NUMELP),IXR_S(NUMELR),IXR_S_IND(NUMELR),
3193 5 IXTG_S(NUMELTG),IXTG_S_IND(NUMELTG))
3194
3195 CALL LECGROUP(
3196 1 ITAB ,ITABM1 ,ISUBMOD ,
3197 2 X ,IXS ,IXQ ,IXC ,IXT ,IXP ,
3198 3 IXR ,IXTG , IPART ,
3199 4 IPARTS ,IPARTQ ,IPARTC ,IPARTT ,IPARTP ,IPARTR ,
3200 5 IPARTG ,FLAGG ,SH4TREE ,SH3TREE ,
3201 6 SKEW ,ISKWN ,UNITAB ,IBOX ,
3202 7 IXS10 ,IXS16 ,IXS20 ,RTRANS,LSUBMODEL,
3203 8 IXS_S ,IXS_S_IND,IXQ_S,IXQ_S_IND,IXC_S,IXC_S_IND,
3204 9 IXT_S ,IXT_S_IND,IXP_S,IXP_S_IND,IXR_S,IXR_S_IND,
3205 A IXTG_S,IXTG_S_IND,IADBOXMAX,SUBSETS,IGRBRIC,IGRQUAD,
3206 B IGRSH4N,IGRSH3N,IGRTRUSS,IGRBEAM,IGRSPRING)
3207C---
3208 LENI=MAX(NUMELS,NUMELQ,NUMELC,NUMELT,NUMELP,NUMELR,NUMELTG)
3209!
3210 CALL SORTGROUP(
3211 1 IXS_S ,IXS_S_IND,IXQ_S,IXQ_S_IND,IXC_S,IXC_S_IND,
3212 2 IXT_S ,IXT_S_IND,IXP_S,IXP_S_IND,IXR_S,IXR_S_IND,
3213 3 IXTG_S,IXTG_S_IND,IXS,IXQ,IXC,IXT,IXP,IXR,IXTG,LENI)
3214!
3215 FLAGG = 1
3216 CALL LECGROUP(
3217 1 ITAB ,ITABM1 ,ISUBMOD ,
3218 2 X ,IXS ,IXQ ,IXC ,IXT ,IXP ,
3219 3 IXR ,IXTG , IPART ,
3220 4 IPARTS ,IPARTQ ,IPARTC ,IPARTT ,IPARTP ,IPARTR ,
3221 5 IPARTG ,FLAGG ,SH4TREE ,SH3TREE ,
3222 6 SKEW ,ISKWN ,UNITAB ,IBOX ,
3223 7 IXS10 ,IXS16,IXS20,RTRANS,LSUBMODEL,
3224 8 IXS_S ,IXS_S_IND,IXQ_S,IXQ_S_IND,IXC_S,IXC_S_IND,
3225 9 IXT_S ,IXT_S_IND,IXP_S,IXP_S_IND,IXR_S,IXR_S_IND,
3226 A IXTG_S,IXTG_S_IND,IADBOXMAX,SUBSETS,IGRBRIC,IGRQUAD,
3227 B IGRSH4N,IGRSH3N,IGRTRUSS,IGRBEAM,IGRSPRING)
3228!
3229 DEALLOCATE(IXS_S ,IXS_S_IND,IXQ_S,IXQ_S_IND,IXC_S,IXC_S_IND,
3230 2 IXT_S ,IXT_S_IND,IXP_S,IXP_S_IND,IXR_S,IXR_S_IND,
3231 3 IXTG_S,IXTG_S_IND)
3232C--------------------------------------------
3233C READING PART GROUPS (1st LEVEL)
3234C--------------------------------------------
3235 WRITE(ISTDO,'(a)')' .. part groups'
3236 ERR_CATEGORY='part groups'
3237
3238 FLAGG = 0 !TAG ENTITY & ALLOCATE
3239 CALL HM_READ_GRPART(IGRPART , IPART, ISUBMOD, FLAGG ,NGRPART,LSUBMODEL, SUBSETS )
3240
3241 FLAGG = 1 !BUILD GROUPS
3242 CALL HM_READ_GRPART(IGRPART , IPART, ISUBMOD, FLAGG ,NGRPART,LSUBMODEL, SUBSETS )
3243C--------------------------------------------
3244C READING GROUPS OF GROUPS
3245C--------------------------------------------
3246 ERR_CATEGORY='group of groups'
3247 ICOUNT = 1
3248 ITER = 0
3249 DO WHILE (ICOUNT > 0)
3250 ITER = ITER + 1
3251 FLAGG = 0
3252C---
3253 CALL LECGGROUP(
3254 . FLAGG ,
3255 . ICOUNT ,ITER ,IGRBRIC,IGRQUAD ,IGRSH4N,
3256 . IGRSH3N ,IGRTRUSS,IGRBEAM,IGRSPRING,IGRPART,
3257 . LSUBMODEL)
3258C---
3259 FLAGG = 1
3260C---
3261 CALL LECGGROUP(
3262 . FLAGG ,
3263 . ICOUNT ,ITER ,IGRBRIC,IGRQUAD ,IGRSH4N,
3264 . IGRSH3N ,IGRTRUSS,IGRBEAM,IGRSPRING,IGRPART,
3265 . LSUBMODEL)
3266 ENDDO
3267C--------------------------------------------
3268C READING SURFACES
3269C--------------------------------------------
3270
3271 ! allocation for pre-read of Rbody needed for /SET
3272 IF(NRBODY > 0) THEN
3273 ALLOCATE(RBY_MSN(2,NRBODY))
3274 CALL PREREAD_RBODY_SET(LSUBMODEL,ITABM1,RBY_MSN)
3275 ELSE
3276 ALLOCATE(RBY_MSN(0,0))
3277 ENDIF
3278
3279 ! PART UID to Internal ID conversion
3280
3281 CALL CREATE_MAP_TABLES ( MAP_TABLES ,1 ,
3282 * LSUBMODEL ,SUBSETS,
3283 * IPART,
3284 * IXS ,IXQ ,IXC ,IXTG ,
3285 * IXT ,IXP ,IXR ,KXSP,IBID,
3286 * RBY_MSN)
3287
3288
3289 SBUFSF = 0
3290 IF(NSURF+NSETS > 0)THEN
3291 ALLOCATE(RWORK(LISURF1*(NSURF+NSETS)) ,STAT=stat)
3292 RWORK = ZERO
3293 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3294 . MSGTYPE=MSGERROR,
3295 . C1='rwork')
3296 ENDIF
3297
3298 IF(NSURF > 0)THEN
3299 WRITE(ISTDO,'(a)')' .. surfaces '
3300 ERR_CATEGORY='surfaces definition'
3301c
3302C- Isogeometric Elements
3303 IADTABIGE = 0
3304 DECALIGEO = 0
3305 IDXIGE1 = 0
3306 IDXIGE2 = 1
3307 RNIGE=(1+NSURF*NUMELIG3D*16*6)
3308.OR. IF(RNIGE > INTMAX RNIGE < ZERO) THEN
3309 SNIGE = INTMAX
3310 ELSE
3311 SNIGE = INT(RNIGE)
3312 ENDIF
3313 ALLOCATE(NIGE_TMP(IDXIGE1)%ptr(SNIGE) ,STAT=stat)
3314 IF(STAT /= 0) THEN
3315 CALL ANCMSG(MSGID=727,
3316 . MSGTYPE=MSGERROR,
3317 . ANMODE=ANSTOP,
3318 . C1='nige')
3319 ENDIF
3320 RRIGE=(1+NSURF*NUMELIG3D*3*16*6)
3321.OR. IF(RRIGE > INTMAX RRIGE < ZERO) THEN
3322 SRIGE = INTMAX
3323 ELSE
3324 SRIGE = INT(RRIGE)
3325 ENDIF
3326 ALLOCATE(RIGE_TMP(IDXIGE1)%ptr2(SRIGE) ,STAT=stat)
3327 IF(STAT /= 0) THEN
3328 CALL ANCMSG(MSGID=727,
3329 . MSGTYPE=MSGERROR,
3330 . ANMODE=ANSTOP,
3331 . C1='rige')
3332 ENDIF
3333 RXIGE=(1+NSURF*NUMELIG3D*3*16*6)
3334.OR. IF(RXIGE > INTMAX RXIGE < ZERO) THEN
3335 SXIGE = INTMAX
3336 ELSE
3337 SXIGE = INT(RXIGE)
3338 ENDIF
3339 ALLOCATE(XIGE_TMP(IDXIGE1)%ptr2(SXIGE) ,STAT=stat)
3340 IF(STAT /= 0) THEN
3341 CALL ANCMSG(MSGID=727,
3342 . MSGTYPE=MSGERROR,
3343 . ANMODE=ANSTOP,
3344 . C1='xigeo')
3345 ENDIF
3346 RVIGE=(1+NSURF*NUMELIG3D*3*16*6)
3347.OR. IF(RVIGE > INTMAX RVIGE < ZERO) THEN
3348 SVIGE = INTMAX
3349 ELSE
3350 SVIGE = INT(RVIGE)
3351 ENDIF
3352 ALLOCATE(VIGE_TMP(IDXIGE1)%ptr2(SVIGE) ,STAT=stat)
3353 IF(STAT /= 0) THEN
3354 CALL ANCMSG(MSGID=727,
3355 . MSGTYPE=MSGERROR,
3356 . ANMODE=ANSTOP,
3357 . C1='vigeo')
3358 ENDIF
3359C
3360 SNIGE = 0
3361 SRIGE = 0
3362 SXIGE = 0
3363 SVIGE = 0
3364 IDXIGECNT = IDXIGECNT + 1
3365 IDXIGE1 = MOD(IDXIGECNT,2)
3366 IDXIGE2 = MOD(IDXIGECNT+1,2)
3367 FLAGG = 0
3368 INSEG = 0
3369 NUMFAKENODIGEO = 0
3370 IADBOXMAX = 1
3371C
3372 CALL HM_READ_SURF(
3373 1 ITAB ,ITABM1 ,
3374 2 IGRSURF ,IXS ,IXQ ,IXC ,IXT ,
3375 3 IXP ,IXR ,IXTG
3376 4 ,IPART ,IPARTS ,IPARTQ ,IPARTC ,
3377 5 IPARTT ,IPARTP ,IPARTR ,IPARTG ,X ,
3378 6 SBUFSF ,ISKWN ,SKEW ,
3379 7 RWORK ,KNOD2ELS ,NOD2ELS ,SH4TREE ,SH3TREE ,
3380 8 ISUBMOD ,FLAGG ,UNITAB ,IBOX ,
3381 9 IXS10 ,IXS16 ,IXS20 ,RTRANS,
3382 A LSUBMODEL ,KNOD2ELC ,NOD2ELC ,KNOD2ELTG ,NOD2ELTG,
3383 B KXIG3D ,IXIG3D ,IPARTIG3D ,
3384 C KNOT ,IGEO ,WIGE ,KNOD2ELIG3D,NOD2ELIG3D,
3385 D V ,NIGE_TMP(IDXIGE1)%ptr,
3386 E RIGE_TMP(IDXIGE1)%ptr2,XIGE_TMP(IDXIGE1)%ptr2,
3387 F VIGE_TMP(IDXIGE1)%ptr2,IADTABIGE,DECALIGEO,IADBOXMAX,KNOD2ELQ,
3388 G NOD2ELQ ,SUBSETS ,IGRBRIC ,IGRSH4N ,IGRSH3N ,
3389 F KNOTLOCPC ,KNOTLOCEL ,NSETS ,MAP_TABLES)
3390C
3391C- Isogeometric Elements
3392 ALLOCATE(NIGE_TMP(IDXIGE2)%ptr(SNIGE+NUMFAKENODIGEO) ,STAT=stat)
3393 IF(STAT /= 0) THEN
3394 CALL ANCMSG(MSGID=727,
3395 . MSGTYPE=MSGERROR,
3396 . ANMODE=ANSTOP,
3397 . C1='nige')
3398 ENDIF
3399 SNIGE = SNIGE + NUMFAKENODIGEO
3400 DEALLOCATE(NIGE_TMP(IDXIGE1)%ptr)
3401
3402 ALLOCATE(RIGE_TMP(IDXIGE2)%ptr2(SRIGE+3*NUMFAKENODIGEO) ,STAT=stat)
3403 IF(STAT /= 0) THEN
3404 CALL ANCMSG(MSGID=727,
3405 . MSGTYPE=MSGERROR,
3406 . ANMODE=ANSTOP,
3407 . C1='rige')
3408 ENDIF
3409 SRIGE = SRIGE + 3*NUMFAKENODIGEO
3410 DEALLOCATE(RIGE_TMP(IDXIGE1)%ptr2)
3411
3412 ALLOCATE(XIGE_TMP(IDXIGE2)%ptr2(SXIGE+3*NUMFAKENODIGEO) ,STAT=stat)
3413 IF(STAT /= 0) THEN
3414 CALL ANCMSG(MSGID=727,
3415 . MSGTYPE=MSGERROR,
3416 . ANMODE=ANSTOP,
3417 . C1='xige')
3418 ENDIF
3419 SXIGE = SXIGE + 3*NUMFAKENODIGEO
3420 DEALLOCATE(XIGE_TMP(IDXIGE1)%ptr2)
3421
3422 ALLOCATE(VIGE_TMP(IDXIGE2)%ptr2(SVIGE+3*NUMFAKENODIGEO) ,STAT=stat)
3423 IF(STAT /= 0) THEN
3424 CALL ANCMSG(MSGID=727,
3425 . MSGTYPE=MSGERROR,
3426 . ANMODE=ANSTOP,
3427 . C1='vige')
3428 ENDIF
3429 SVIGE = SVIGE + 3*NUMFAKENODIGEO
3430 DEALLOCATE(VIGE_TMP(IDXIGE1)%ptr2)
3431C
3432C fill, 1st level surfaces
3433 FLAGG = 1
3434 INSEG = 0
3435 CALL HM_READ_SURF(
3436 1 ITAB ,ITABM1 ,
3437 2 IGRSURF ,IXS ,IXQ ,IXC ,IXT ,
3438 3 IXP ,IXR ,IXTG
3439 4 ,IPART ,IPARTS ,IPARTQ ,IPARTC ,
3440 5 IPARTT ,IPARTP ,IPARTR ,IPARTG ,X ,
3441 6 SBUFSF ,ISKWN ,SKEW ,
3442 7 RWORK ,KNOD2ELS ,NOD2ELS ,SH4TREE ,SH3TREE ,
3443 8 ISUBMOD ,FLAGG ,UNITAB ,IBOX ,
3444 9 IXS10 ,IXS16 ,IXS20 ,RTRANS,
3445 A LSUBMODEL ,KNOD2ELC ,NOD2ELC ,KNOD2ELTG ,NOD2ELTG ,
3446 B KXIG3D ,IXIG3D ,IPARTIG3D ,
3447 C KNOT ,IGEO ,WIGE ,KNOD2ELIG3D,NOD2ELIG3D,
3448 D V ,NIGE_TMP(IDXIGE2)%ptr,
3449 E RIGE_TMP(IDXIGE2)%ptr2,XIGE_TMP(IDXIGE2)%ptr2,
3450 F VIGE_TMP(IDXIGE2)%ptr2,IADTABIGE,DECALIGEO,IADBOXMAX,KNOD2ELQ,
3451 G NOD2ELQ ,SUBSETS ,IGRBRIC ,IGRSH4N ,IGRSH3N ,
3452 H KNOTLOCPC ,KNOTLOCEL ,NSETS ,MAP_TABLES)
3453C
3454c IF(NUMELIG3D>0) THEN
3455 IF(NUMFAKENODIGEO>0) THEN
3456 ALLOCATE(PERMIGE(NUMFAKENODIGEO) ,STAT=stat)
3457c ALLOCATE(PERMIGE(IADTABIGE) ,STAT=stat)
3458c
3459 CALL PRESEARCHIGEO3D(IGRSURF,XIGE_TMP(IDXIGE2)%ptr2,PERMIGE)
3460c CALL MYQSORT3D(IADTABIGE,XIGE_TMP(IDXIGE2)%ptr2,PERMIGE)
3461c
3462 ALLOCATE(NIGE_TMP(IDXIGE1)%ptr(SNIGE) ,STAT=stat)
3463 IF(STAT /= 0) THEN
3464 CALL ANCMSG(MSGID=727,
3465 . MSGTYPE=MSGERROR,
3466 . ANMODE=ANSTOP,
3467 . C1='nige')
3468 ENDIF
3469
3470 ALLOCATE(RIGE_TMP(IDXIGE1)%ptr2(SRIGE) ,STAT=stat)
3471 IF(STAT /= 0) THEN
3472 CALL ANCMSG(MSGID=727,
3473 . MSGTYPE=MSGERROR,
3474 . ANMODE=ANSTOP,
3475 . C1='rige')
3476 ENDIF
3477
3478 ALLOCATE(XIGE_TMP(IDXIGE1)%ptr2(SXIGE) ,STAT=stat)
3479 IF(STAT /= 0) THEN
3480 CALL ANCMSG(MSGID=727,
3481 . MSGTYPE=MSGERROR,
3482 . ANMODE=ANSTOP,
3483 . C1='xige')
3484 ENDIF
3485
3486 ALLOCATE(VIGE_TMP(IDXIGE1)%ptr2(SVIGE) ,STAT=stat)
3487 IF(STAT /= 0) THEN
3488 CALL ANCMSG(MSGID=727,
3489 . MSGTYPE=MSGERROR,
3490 . ANMODE=ANSTOP,
3491 . C1='vige')
3492 ENDIF
3493c
3494c CALL SEARCHIGEO3D2(IGRSURF ,IADTABIGE ,PERMIGE ,
3495c . NIGE_TMP(IDXIGE2)%ptr ,NIGE_TMP(IDXIGE1)%ptr,
3496c . RIGE_TMP(IDXIGE2)%ptr2 ,RIGE_TMP(IDXIGE1)%ptr2,
3497c . XIGE_TMP(IDXIGE2)%ptr2 ,XIGE_TMP(IDXIGE1)%ptr2,
3498c . VIGE_TMP(IDXIGE2)%ptr2 ,VIGE_TMP(IDXIGE1)%ptr2,
3499c . NDOUBLONIGE)
3500
3501 CALL SEARCHIGEO3D(IGRSURF ,IADTABIGE ,PERMIGE ,
3502 . NIGE_TMP(IDXIGE2)%ptr ,NIGE_TMP(IDXIGE1)%ptr,
3503 . RIGE_TMP(IDXIGE2)%ptr2 ,RIGE_TMP(IDXIGE1)%ptr2,
3504 . XIGE_TMP(IDXIGE2)%ptr2 ,XIGE_TMP(IDXIGE1)%ptr2,
3505 . VIGE_TMP(IDXIGE2)%ptr2 ,VIGE_TMP(IDXIGE1)%ptr2,
3506 . NDOUBLONIGE)
3507
3508c
3509 DEALLOCATE(RIGE_TMP(IDXIGE2)%ptr2,XIGE_TMP(IDXIGE2)%ptr2,VIGE_TMP(IDXIGE2)%ptr2)
3510c
3511 SNIGE = NUMFAKENODIGEO
3512 SRIGE = 3*NUMFAKENODIGEO
3513 SXIGE = 3*NUMFAKENODIGEO
3514 SVIGE = 3*NUMFAKENODIGEO
3515
3516c SNIGE = SNIGE - NDOUBLONIGE
3517c SRIGE = SRIGE - 3*NDOUBLONIGE
3518c SXIGE = SXIGE - 3*NDOUBLONIGE
3519c SVIGE = SVIGE - 3*NDOUBLONIGE
3520c
3521 ALLOCATE(NIGE_TMP(IDXIGE2)%ptr(SNIGE) ,STAT=stat)
3522 IF(STAT /= 0) THEN
3523 CALL ANCMSG(MSGID=727,
3524 . MSGTYPE=MSGERROR,
3525 . ANMODE=ANSTOP,
3526 . C1='nige')
3527 ENDIF
3528 DO I=1,SNIGE
3529 NIGE_TMP(IDXIGE2)%ptr(I) = NIGE_TMP(IDXIGE1)%ptr(I)
3530 ENDDO
3531c
3532 ALLOCATE(RIGE_TMP(IDXIGE2)%ptr2(SRIGE) ,STAT=stat)
3533 IF(STAT /= 0) THEN
3534 CALL ANCMSG(MSGID=727,
3535 . MSGTYPE=MSGERROR,
3536 . ANMODE=ANSTOP,
3537 . C1='rige')
3538 ENDIF
3539 DO I=1,SRIGE
3540 RIGE_TMP(IDXIGE2)%ptr2(I) = RIGE_TMP(IDXIGE1)%ptr2(I)
3541 ENDDO
3542c
3543 ALLOCATE(XIGE_TMP(IDXIGE2)%ptr2(SXIGE) ,STAT=stat)
3544 IF(STAT /= 0) THEN
3545 CALL ANCMSG(MSGID=727,
3546 . MSGTYPE=MSGERROR,
3547 . ANMODE=ANSTOP,
3548 . C1='xige')
3549 ENDIF
3550 DO I=1,SXIGE
3551 XIGE_TMP(IDXIGE2)%ptr2(I) = XIGE_TMP(IDXIGE1)%ptr2(I)
3552 ENDDO
3553c
3554 ALLOCATE(VIGE_TMP(1)%ptr2(SVIGE) ,STAT=stat)
3555 IF(STAT /= 0) THEN
3556 CALL ANCMSG(MSGID=727,
3557 . MSGTYPE=MSGERROR,
3558 . ANMODE=ANSTOP,
3559 . C1='vige')
3560 ENDIF
3561 DO I=1,SVIGE
3562 VIGE_TMP(IDXIGE2)%ptr2(I) = VIGE_TMP(IDXIGE1)%ptr2(I)
3563 ENDDO
3564c
3565 TAGSURFIGE=1
3566 DEALLOCATE(RIGE_TMP(IDXIGE1)%ptr2,XIGE_TMP(IDXIGE1)%ptr2,
3567 . VIGE_TMP(IDXIGE1)%ptr2)
3568 DEALLOCATE(PERMIGE)
3569c
3570 ENDIF
3571c
3572C-------
3573C READING SURFACES OF SURFACES
3574C-------
3575 ICOUNT = 1
3576 ITER = 0
3577 DO WHILE (ICOUNT == 1)
3578 FLAGG = 0
3579 ITER = ITER + 1
3580 INSEG = 0
3581C--- count next level
3582 CALL HM_READ_SURFSURF(IGRSURF, INSEG, FLAGG, ICOUNT, ITER, NSETS, LSUBMODEL)
3583C---
3584C-------------------------------------------------
3585 FLAGG = 1
3586C--- fill next level
3587 CALL HM_READ_SURFSURF(IGRSURF, INSEG, FLAGG, ICOUNT, ITER, NSETS, LSUBMODEL)
3588C---
3589 ENDDO
3590 ENDIF
3591
3592 NSEGS=NPART
3593!
3594 NSEGSMAX=0
3595 DO I = 1,NSURF
3596 NSEGS=NSEGS+IGRSURF(I)%NSEG
3597 ENDDO
3598 DO I = 1,NGRNOD
3599 NSEGSMAX= MAX(NSEGSMAX,IGRNOD(I)%NENTITY)
3600 ENDDO
3601 DO I = 1,NGRBRIC
3602 NSEGSMAX= MAX(NSEGSMAX,IGRBRIC(I)%NENTITY)
3603 ENDDO
3604 DO I = 1,NGRQUAD
3605 NSEGSMAX= MAX(NSEGSMAX,IGRQUAD(I)%NENTITY)
3606 ENDDO
3607 DO I = 1,NGRSHEL
3608 NSEGSMAX= MAX(NSEGSMAX,IGRSH4N(I)%NENTITY)
3609 ENDDO
3610 DO I = 1,NGRSH3N
3611 NSEGSMAX= MAX(NSEGSMAX,IGRSH3N(I)%NENTITY)
3612 ENDDO
3613 DO I = 1,NGRTRUS
3614 NSEGSMAX= MAX(NSEGSMAX,IGRTRUSS(I)%NENTITY)
3615 ENDDO
3616 DO I = 1,NGRBEAM
3617 NSEGSMAX= MAX(NSEGSMAX,IGRBEAM(I)%NENTITY)
3618 ENDDO
3619 DO I = 1,NGRSPRI
3620 NSEGSMAX= MAX(NSEGSMAX,IGRSPRING(I)%NENTITY)
3621 ENDDO
3622 DO I = 1,NGRPART
3623 NSEGSMAX= MAX(NSEGSMAX,IGRPART(I)%NENTITY)
3624 ENDDO
3625 NSEGS=NSEGS+NSEGSMAX
3626C--------------------------------------------
3627C READING LINES
3628C--------------------------------------------
3629 IF(NSLIN > 0) THEN
3630 WRITE(ISTDO,'(a)')' .. lines '
3631 ERR_CATEGORY='lines'
3632 FLAGG = 0
3633 IADBOXMAX = 1
3634!
3635 CALL HM_READ_LINES(
3636 1 ITAB ,ITABM1 ,
3637 2 ISUBMOD ,IGRSLIN ,IGRSURF ,X ,IXS ,
3638 3 IXQ ,IXC ,IXT ,IXP ,IXR ,
3639 4 IXTG ,IPART ,IPARTS ,IPARTQ ,IPARTC ,
3640 5 IPARTT ,IPARTP ,IPARTR ,IPARTG ,
3641 6 NSEGS , FLAGG ,SKEW ,ISKWN ,
3642 7 UNITAB ,IBOX ,RTRANS ,LSUBMODEL,
3643 8 IPARTX ,KXX ,IXX ,IADBOXMAX,SUBSETS,
3644 9 IGRTRUSS,IGRBEAM,IGRSPRING,NSETS ,MAP_TABLES)
3645C---
3646 FLAGG = 1
3647C---
3648 CALL HM_READ_LINES(
3649 1 ITAB ,ITABM1 ,
3650 2 ISUBMOD ,IGRSLIN ,IGRSURF ,X ,IXS ,
3651 3 IXQ ,IXC ,IXT ,IXP ,IXR ,
3652 4 IXTG ,IPART ,IPARTS ,IPARTQ ,IPARTC ,
3653 5 IPARTT ,IPARTP ,IPARTR ,IPARTG ,
3654 6 NSEGS , FLAGG ,SKEW ,ISKWN ,
3655 7 UNITAB ,IBOX ,RTRANS ,LSUBMODEL,
3656 8 IPARTX ,KXX ,IXX ,IADBOXMAX,SUBSETS,
3657 9 IGRTRUSS,IGRBEAM,IGRSPRING,NSETS ,MAP_TABLES)
3658C-------
3659C READING LINES OF LINES
3660C-------
3661 ICOUNT = 1
3662 ITER = 0
3663 DO WHILE (ICOUNT == 1)
3664 ITER = ITER + 1
3665 INSEG = 0
3666 FLAGG = 0
3667C--- count next level
3668 CALL HM_LINES_OF_LINES(IGRSLIN ,INSEG ,FLAGG ,ICOUNT ,ITER ,NSETS, LSUBMODEL)
3669C--- fill next level
3670 FLAGG = 1
3671 CALL HM_LINES_OF_LINES(IGRSLIN ,INSEG ,FLAGG ,ICOUNT ,ITER ,NSETS, LSUBMODEL)
3672C---
3673 ENDDO
3674 ENDIF
3675C--------------------------------------------
3676C READING INITIAL CRACKS
3677C--------------------------------------------
3678 IF(NINICRACK > 0) THEN
3679 WRITE(ISTDO,'(a)')' .. initial crack '
3680 ERR_CATEGORY='initial cracks'
3681 SILEVSET = NINICRACK
3682 ALLOCATE(INICRACK(SILEVSET) ,STAT=stat)
3683 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3684 . MSGTYPE=MSGERROR,
3685 . C1='inicrack')
3686 ! Reading /INICRACK cards
3687 CALL HM_READ_INICRACK(ITABM1 ,INICRACK ,UNITAB ,LSUBMODEL)
3688C---
3689 ELSE
3690 SILEVSET = 0
3691 ALLOCATE(INICRACK(SILEVSET))
3692 ENDIF
3693C
3694C--------------------------------------------
3695C READING NODE GROUPS
3696C--------------------------------------------
3697 IF(NGRNOD > 0)THEN
3698 WRITE(ISTDO,'(a)')' .. node group'
3699 ERR_CATEGORY='node groups'
3700 INNOD = 0
3701 MAXNNOD = 1
3702 IADBOXMAX = 1
3703
3704 FLAGG = 0 !TAGNODES & ALLOCATE
3705 CALL HM_LECGRN(
3706 1 ITAB ,ITABM1 ,IGRNOD ,
3707 2 ISUBMOD ,X ,GEO ,IXS ,
3708 3 IXQ ,IXC ,IXT ,IXP ,IXR ,
3709 4 IXTG ,IPART ,
3710 5 IPARTS ,IPARTQ ,IPARTC ,IPARTT ,IPARTP ,
3711 6 IPARTR ,IPARTG ,IPARTSP ,KXSP ,
3712 7 FLAGG ,MAXNNOD ,SKEW ,ISKWN ,
3713 8 UNITAB ,IBOX ,IXS10 ,IXS20 ,
3714 9 IXS16 ,RTRANS ,LSUBMODEL,IXX,
3715 A KXX ,IPARTX ,IADBOXMAX,IGRSLIN,SUBSETS ,
3716 B IGRBRIC ,IGRQUAD ,IGRSH4N ,IGRSH3N ,IGRTRUSS,
3717 C IGRBEAM ,IGRSPRING,IGRSURF,NSETS )
3718!
3719 FLAGG = 1 !BUILD GROUPS
3720 CALL HM_LECGRN(
3721 1 ITAB ,ITABM1 ,IGRNOD ,
3722 2 ISUBMOD ,X ,GEO ,IXS ,
3723 3 IXQ ,IXC ,IXT ,IXP ,IXR ,
3724 4 IXTG ,IPART ,
3725 5 IPARTS ,IPARTQ ,IPARTC ,IPARTT ,IPARTP ,
3726 6 IPARTR ,IPARTG ,IPARTSP ,KXSP ,
3727 7 FLAGG ,MAXNNOD ,SKEW ,ISKWN ,
3728 8 UNITAB ,IBOX ,IXS10 ,IXS20 ,
3729 9 IXS16 ,RTRANS ,LSUBMODEL,IXX,
3730 A KXX ,IPARTX ,IADBOXMAX,IGRSLIN,SUBSETS ,
3731 B IGRBRIC ,IGRQUAD ,IGRSH4N ,IGRSH3N ,IGRTRUSS,
3732 C IGRBEAM ,IGRSPRING,IGRSURF,NSETS )
3733
3734C-------
3735C READING GROUPS OF GROUPS
3736 ICOUNT = 1
3737 ITER = 0
3738 DO WHILE (ICOUNT == 1)
3739 ITER = ITER + 1
3740 FLAGG = 0
3741 CALL HM_GROGRONOD(IGRNOD ,ICOUNT ,FLAGG ,ITER,'node',LSUBMODEL)
3742C--- fill next level
3743 FLAGG =1
3744 CALL HM_GROGRONOD(IGRNOD ,ICOUNT ,FLAGG ,ITER,'node',LSUBMODEL)
3745C---
3746 ENDDO
3747 ENDIF
3748
3749C--------------------------------------------
3750 CALL STOPTIME(19,1)
3751C--------------------------------------------
3752C /SET
3753C--------------------------------------------
3754 CALL STARTIME(17,1)
3755
3756 ALLOCATE(SET (NSETS))
3757 IF(NSETS > 0)THEN
3758 WRITE(ISTDO,'(a)')' .. set'
3759 ERR_CATEGORY='set'
3760
3761 CALL HM_SET(SET ,LSUBMODEL ,INV_GROUP ,MAP_TABLES ,IPART ,
3762 * IGRSURF ,IGRNOD ,IGRSLIN ,IGRPART ,IGRBRIC ,
3763 * IGRQUAD ,IGRSH4N ,IGRSH3N ,IGRTRUSS ,IGRBEAM ,
3764 * IGRSPRING,IXS ,IXS10 ,IXC ,IXTG ,
3765 * KNOD2ELS ,NOD2ELS ,KNOD2ELC ,NOD2ELC ,KNOD2ELTG ,
3766 * NOD2ELTG ,IPARTC ,IPARTG ,IPARTS ,SH4TREE ,
3767 * SH3TREE ,IXQ ,KNOD2ELQ ,NOD2ELQ ,X ,
3768 * IXT ,IXP ,IXR ,IXX ,KXX ,
3769 * KXSP ,IXS20 ,IXS16 ,GEO ,ITABM1 ,
3770 * IBOX ,SKEW ,IPARTQ ,IPARTT ,IPARTP ,
3771 * IPARTR ,SUBSETS ,RBY_MSN ,ISKWN ,RTRANS ,
3772 * UNITAB ,RWORK ,SBUFSF ,SISKWN ,SSKEW ,
3773 * ROOTNAM ,ROOTLEN ,INFILE_NAME ,INFILE_NAME_LEN )
3774
3775
3776C IF(ALLOCATED(RBY_MSN)) DEALLOCATE(RBY_MSN)
3777 ENDIF
3778
3779 IF (NSURF+NSETS > 0) THEN
3780 IF(SBUFSF > 0) THEN
3781 ALLOCATE(BUFSF(SBUFSF) ,STAT=stat)
3782 BUFSF = RWORK(1:SBUFSF)
3783 IF(STAT /= 0) THEN
3784 CALL ANCMSG(MSGID=727,
3785 . MSGTYPE=MSGERROR,
3786 . ANMODE=ANSTOP,
3787 . C1='bufsf')
3788 ENDIF
3789 ENDIF
3790 ELSE
3791 ALLOCATE(BUFSF(0))
3792 ENDIF
3793 IF(ALLOCATED(RWORK)) DEALLOCATE(RWORK)
3794C--------------------------------------------
3795 CALL STOPTIME(17,1)
3796C--------------------------------------------
3797C READING DRAPES
3798C--------------------------------------------
3799 ERR_MSG='drape'
3800 ERR_CATEGORY='drape'
3801 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
3802 NUMELC_DRAPE = 0
3803 NUMELTG_DRAPE = 0
3804 stack%s_pm2 = 0
3805 IF(NDRAPE > 0) THEN
3806 WRITE(ISTDO,'(a)')' .. drape'
3807 ALLOCATE(DRAPE_WRK(NUMELC + NUMELTG),DRAPEG%INDX(NUMELC + NUMELTG))
3808 DRAPEG%INDX = 0
3809 ALLOCATE(INDXSH(NUMELC + NUMELTG))
3810 INDXSH = 0
3811C-----------------
3812C Stack part Pre orginisation
3813C-------------------------
3814 NUMELC_DRAPE = 0
3815 NUMELTG_DRAPE = 0
3816 STDRAPE = 0
3817 SCDRAPE = 0
3818.OR. IF(IPART_STACK > 0 IPART_PCOMPP > 0) THEN
3819 ALLOCATE(IWORK_T(NUMELC+NUMELTG))
3820 CALL PRE_STACKGROUP(
3821 . IGRSH3N ,IGRSH4N ,IXC ,IXTG ,
3822 . IGEO ,GEO ,IGEO_STACK ,IWORKSH ,
3823 . IWORK_T )
3824 ENDIF
3825 !!
3826 CALL HM_READ_DRAPE(DRAPE_WRK ,IWORK_T ,IWORKSH ,IGRSH3N ,IGRSH4N ,
3827 . IXC ,IXTG ,IGEO ,IGEO_STACK,LSUBMODEL,
3828 . UNITAB ,INDXSH )
3829 IF( NUMELC_DRAPE > 0) SCDRAPE = NUMELC
3830 IF( NUMELTG_DRAPE > 0) STDRAPE = NUMELTG
3831 ALLOCATE(DRAPE(NUMELC_DRAPE +NUMELTG_DRAPE) )
3832 IF( (NUMELC_DRAPE + NUMELTG_DRAPE )> 0) THEN
3833 DRAPEG%NUMSH4 = NUMELC_DRAPE
3834 DRAPEG%NUMSH3 = NUMELTG_DRAPE
3835 DO I=1,NUMELC_DRAPE + NUMELTG_DRAPE
3836 IDSHEL = INDXSH(I)
3837 NPT_DRAPE = DRAPE_WRK(IDSHEL)%NPLY_DRAPE
3838 DRAPE(I)%NPLY_DRAPE = NPT_DRAPE
3839 NPT = IWORKSH(1,IDSHEL)
3840 DRAPE(I)%NPLY = NPT
3841 DRAPEG%INDX(IDSHEL) = I
3842 ALLOCATE(DRAPE(I)%DRAPE_PLY(NPT_DRAPE))
3843 ALLOCATE(DRAPE(I)%INDX_PLY(NPT))
3844 DRAPE(I)%INDX_PLY = 0
3845 DO JJ =1,NPT_DRAPE
3846 IP = DRAPE_WRK(IDSHEL)%INDX_PLY(JJ)
3847 DRAPE(I)%INDX_PLY(IP) = JJ
3848 NSLICE = DRAPE_WRK(IDSHEL)%DRAPE_PLY(IP)%NSLICE
3849 DRAPE(I)%DRAPE_PLY(JJ)%NSLICE = NSLICE
3850 DRAPE(I)%DRAPE_PLY(JJ)%IPID = DRAPE_WRK(IDSHEL)%DRAPE_PLY(IP)%IPID
3851 ALLOCATE(DRAPE(I)%DRAPE_PLY(JJ)%RDRAPE(NSLICE,2))
3852 ALLOCATE(DRAPE(I)%DRAPE_PLY(JJ)%IDRAPE(NSLICE,2))
3853 DO ISL = 1,NSLICE
3854 DRAPE(I)%DRAPE_PLY(JJ)%RDRAPE(ISL,1) = DRAPE_WRK(IDSHEL)%DRAPE_PLY(IP)%RDRAPE(ISL,1)
3855 DRAPE(I)%DRAPE_PLY(JJ)%RDRAPE(ISL,2) = DRAPE_WRK(IDSHEL)%DRAPE_PLY(IP)%RDRAPE(ISL,2)
3856 DRAPE(I)%DRAPE_PLY(JJ)%IDRAPE(ISL,1) = DRAPE_WRK(IDSHEL)%DRAPE_PLY(IP)%IDRAPE(ISL,1)
3857 DRAPE(I)%DRAPE_PLY(JJ)%IDRAPE(ISL,2) = DRAPE_WRK(IDSHEL)%DRAPE_PLY(IP)%IDRAPE(ISL,2)
3858 ENDDO ! nbre of slice
3859 ENDDO
3860 ENDDO
3861 !! Deallocation of work drape memory
3862 DO I=1,NUMELC_DRAPE + NUMELTG_DRAPE
3863 IDSHEL = INDXSH(I)
3864 NPT = IWORKSH(1,IDSHEL)
3865 IF(ALLOCATED(DRAPE_WRK(IDSHEL)%DRAPE_PLY)) THEN
3866 NPT_DRAPE = DRAPE_WRK(IDSHEL)%NPLY_DRAPE
3867 DO JJ=1,NPT_DRAPE
3868 IP = DRAPE_WRK(IDSHEL)%INDX_PLY(JJ)
3869 DEALLOCATE(DRAPE_WRK(IDSHEL)%DRAPE_PLY(IP)%RDRAPE,DRAPE_WRK(IDSHEL)%DRAPE_PLY(IP)%IDRAPE)
3870 ENDDO
3871 DEALLOCATE(DRAPE_WRK(IDSHEL)%DRAPE_PLY)
3872 ENDIF
3873 ENDDO
3874 DEALLOCATE(DRAPE_WRK)
3875 DEALLOCATE(INDXSH )
3876 ENDIF
3877 IF(ALLOCATED(IDRAPEID)) DEALLOCATE(IDRAPEID)
3878
3879.OR. IF(IPART_STACK > 0 IPART_PCOMPP > 0) THEN
3880 CALL STACKGROUP_DRAPE(DRAPE, DRAPEG , IWORK_T , IWORKSH ,
3881 . IGRSH3N ,IGRSH4N ,IXC ,IXTG ,
3882 . IGEO ,GEO ,THKE , STACK ,
3883 . IGEO_STACK ,GEO_STACK , STACK_INFO ,
3884 . NUMGEOSTACK,NPROP_STACK,PLY_INFO)
3885 stack%s_pm2 = size(stack%pm,dim=2)
3886 ELSE
3887 ALLOCATE(STACK%GEO(0,0))
3888 ALLOCATE(STACK%IGEO(0,0))
3889 ALLOCATE(STACK%PM(stack_s_pm1,stack%s_pm2))
3890 ENDIF
3891 ELSE ! with out drape
3892 ALLOCATE(DRAPE(0))
3893 ALLOCATE(DRAPEG%INDX(0))
3894.OR. IF(IPART_STACK > 0 IPART_PCOMPP > 0) THEN
3895 CALL STACKGROUP(
3896 . IGRSH3N ,IGRSH4N ,IXC ,IXTG ,
3897 . IGEO ,GEO ,IWORKSH ,THKE ,
3898 . STACK ,IPM ,IGEO_STACK ,GEO_STACK ,
3899 . STACK_INFO ,NUMGEOSTACK,NPROP_STACK)
3900 stack%s_pm2 = size(stack%pm,dim=2)
3901 ELSE
3902 ALLOCATE(STACK%GEO(0,0))
3903 ALLOCATE(STACK%IGEO(0,0))
3904 ALLOCATE(STACK%PM(stack_s_pm1,stack%s_pm2))
3905 ENDIF
3906 ENDIF
3907C--------------------------------------------
3908 IF(NSUBDOM==0) GOTO 218
3909C--------------------------------------------
3910C MULTIDOMAINS - INTERFACES
3911C--------------------------------------------
3912 WRITE(ISTDO,'(a)')' .. multidomains interfaces detection '
3913 IDXCNT= 1 ! used by temporary local array "IBUFTMP"
3914 IADBUF= 1
3915 IDXCNT= IDXCNT + 1
3916 IDX1 = MOD(IDXCNT,2)
3917 IDX2 = MOD(IDXCNT+1,2)
3918 FLAGG = 0
3919 INNOD = 0
3920 FLG_R2R_ERR = 0
3921 ALE_EULER = 0
3922 NSPCOND0 = NSPCOND
3923! tmp +++
3924 RSIBUFSSG=NUMNOD+NSUBDOM
3925.OR. IF(RSIBUFSSG > INTMAX RSIBUFSSG < ZERO) THEN
3926 SIBUFSSG = INTMAX
3927 ELSE
3928 SIBUFSSG = INT(RSIBUFSSG)
3929 ENDIF
3930 ALLOCATE(IBUFTMP(IDX1)%ptr(SIBUFSSG),STAT=stat)
3931 IF(STAT /= 0) THEN
3932 CALL ANCMSG(MSGID=727,
3933 . MSGTYPE=MSGERROR,
3934 . ANMODE=ANSTOP,
3935 . C1='buffsg')
3936 ENDIF
3937! tmp ---
3938C---
3939 ALLOCATE(TAGNO(2*NUMNOD+NPART),STAT=stat)
3940 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3941 . MSGTYPE=MSGERROR,
3942 . C1='tagno')
3943 TAGNO(:) = 0
3944 ALLOCATE(NALE_R2R(ALE%GLOBAL%SNALE),STAT=stat)
3945 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3946 . MSGTYPE=MSGERROR,
3947 . C1='nale_r2r')
3948 NALE_R2R(:) = 1
3949 ALLOCATE(DT_R2R(4*NSUBDOM),STAT=stat)
3950 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
3951 . MSGTYPE=MSGERROR,
3952 . C1='dt_r2r')
3953 DT_R2R(:) = 0
3954C--- First pass-> count
3955 CALL R2R_GROUP(NGRNOD,
3956 1 INNOD,FLAGG,IPARTS,IPARTQ,IPARTC,IPARTT,IPARTP,
3957 2 IPARTR,IPARTG,IPARTSP,IXS10,IXS20,IXS16,1,
3958 3 IBUFTMP(IDX1)%ptr,IXR_KJ,INOM_OPT,IPART,
3959 4 IADBUF,NALE_R2R,FLG_R2R_ERR ,
3960 5 STACK%PM ,IWORKSH ,IGRBRIC ,IGRQUAD ,IGRSH4N ,
3961 6 IGRSH3N ,IGRTRUSS ,IGRBEAM ,IGRSPRING ,IGRNOD ,
3962 7 IGRSURF ,IGRSLIN, LSUBMODEL,ALE_EULER ,IGEO ,
3963 8 NLOC_DMG ,DETONATORS,SEATBELT_SHELL_TO_SPRING,
3964 9 NB_SEATBELT_SHELLS,MAT_ELEM%MAT_PARAM,NEBCS)
3965C---
3966 ALLOCATE(IBUFTMP(IDX2)%ptr(SIBUFSSG+INNOD) ,STAT=stat)
3967 IF(STAT /= 0) THEN
3968 CALL ANCMSG(MSGID=727,
3969 . MSGTYPE=MSGERROR,
3970 . ANMODE=ANSTOP,
3971 . C1='buffsg')
3972 ENDIF
3973 IBUFTMP(IDX2)%ptr = 0
3974 DO I=1,SIBUFSSG
3975 IBUFTMP(IDX2)%ptr(I) = IBUFTMP(IDX1)%ptr(I)
3976 ENDDO
3977 SIBUFSSG = SIBUFSSG+INNOD
3978 DEALLOCATE(IBUFTMP(IDX1)%ptr)
3979
3980 FLAGG = 1
3981
3982C--- Second Pass -> interface creation
3983 CALL R2R_GROUP(NGRNOD,
3984 1 INNOD,FLAGG,IPARTS,IPARTQ,IPARTC,IPARTT,IPARTP,
3985 2 IPARTR,IPARTG,IPARTSP,IXS10,IXS20,IXS16,2,
3986 3 IBUFTMP(IDX2)%ptr,IXR_KJ,INOM_OPT,IPART,
3987 4 IADBUF,NALE_R2R,FLG_R2R_ERR ,
3988 5 STACK%PM ,IWORKSH ,IGRBRIC ,IGRQUAD ,IGRSH4N ,
3989 6 IGRSH3N ,IGRTRUSS ,IGRBEAM ,IGRSPRING ,IGRNOD ,
3990 7 IGRSURF ,IGRSLIN, LSUBMODEL,ALE_EULER ,IGEO ,
3991 8 NLOC_DMG ,DETONATORS,SEATBELT_SHELL_TO_SPRING,
3992 9 NB_SEATBELT_SHELLS,MAT_ELEM%MAT_PARAM,NEBCS)
3993C--------------------------------------------
3994C MULTIDOMAINS - ARRAY SPLITTING
3995C--------------------------------------------
3996 WRITE(ISTDO,'(a)')' .. multidomains DATA split '
3997C--- First pass-> count
3998 CALL R2R_SPLIT(
3999 1 NSLIN,
4000 2 NSURF,0,EANI,IBUFTMP(IDX2)%ptr,IXR_KJ,
4001 3 INOM_OPT,RESERVEP,NALE_R2R,NSPCOND0,
4002 4 SUBSETS,IGRSURF,IGRNOD,IGRBRIC,IGRQUAD,
4003 5 IGRSH4N,IGRSH3N,IGRTRUSS,IGRBEAM,IGRSPRING,
4004 6 IGRPART,IGRSLIN,LSUBMODEL,RBY_MSN,IWORKSH,
4005 7 SEATBELT_SHELL_TO_SPRING,NB_SEATBELT_SHELLS)
4006C--- second pass-> split
4007 CALL R2R_SPLIT(
4008 1 NSLIN,
4009 2 NSURF,1,EANI,IBUFTMP(IDX2)%ptr,IXR_KJ,
4010 3 INOM_OPT,RESERVEP,NALE_R2R,NSPCOND0,
4011 4 SUBSETS,IGRSURF,IGRNOD,IGRBRIC,IGRQUAD,
4012 5 IGRSH4N,IGRSH3N,IGRTRUSS,IGRBEAM,IGRSPRING,
4013 6 IGRPART,IGRSLIN,LSUBMODEL,RBY_MSN,IWORKSH,
4014 7 SEATBELT_SHELL_TO_SPRING,NB_SEATBELT_SHELLS)
4015 DEALLOCATE(IBUFTMP(IDX2)%ptr)
4016C--------------------------------------------
4017C MULTIDOMAINS - DATA STRUCTURE UPDATE
4018C--------------------------------------------
4019
4020 WRITE(ISTDO,'(a)')' .. multidomains DATA update '
4021 DEALLOCATE(KNOD2ELS,KNOD2ELC,KNOD2ELTG,KNOD2EL1D,KNOD2ELIG3D,KNOD2ELQ)
4022 DEALLOCATE(NOD2ELS,NOD2ELC,NOD2ELTG,NOD2EL1D,NOD2ELIG3D,NOD2ELQ)
4023 DEALLOCATE(XYZREF)
4024 ALLOCATE(XYZREF(3*NUMNOD) ,STAT=stat)
4025 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
4026 . MSGTYPE=MSGERROR,
4027 . C1='xyzref')
4028 FLAG_GOTO = 1
4029
4030C-----reallocating FRONT array-------------
4031 CALL INI_IFRONT()
4032 IENTRY2(1:NUMNOD) = -1
4033 FLAGKIN(1:NUMNOD) = 0
4034
4035cc r2r with new IFRONT
4036 DO I=1,NUMNOD
4037 IF(FRONT_R2R(I)==1)THEN
4038 CALL IFRONTPLUS(I,1)
4039 !FLAGKIN array to identify boundary nodes with
4040 !kinematic constraints (old FRONT TAG=10)
4041 IF(FLAGKIN_R2R(I)==1)FLAGKIN(I)=1
4042 ENDIF
4043 ENDDO
4044
4045 DEALLOCATE(FRONT_R2R,FLAGKIN_R2R)
4046 SFRONTB_R2R = NUMNOD
4047 SNOM_OPT_OLD = SNOM_OPT
4048 IN10 = INOM_OPT(10)
4049 IN20 = INOM_OPT(20)
4050
4051C-----ARRAY size update & rebuild THKEC--
4052 GOTO 208
4053209 CONTINUE
4054
4055C----- OPTION name update ----------
4056 GOTO 210
4057211 CONTINUE
4058 CALL R2R_NOM_OPT(NOM_OPT,INOM_OPT,IN10,IN20,SNOM_OPT_OLD)
4059
4060C-----repointing IXS10,20,16 arrays--
4061 GOTO 212
4062213 CONTINUE
4063
4064C-----reallocating NOD2EL----------------
4065 GOTO 214
4066215 CONTINUE
4067
4068C-----repointing IPART arrays--------
4069 GOTO 216
4070217 CONTINUE
4071
4072C-----recalculating inverse connectivities--------
4073
4074 CALL BUILD_CNEL(
4075 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
4076 3 IXR ,IXTG ,IXS10 ,IXS20 ,
4077 4 IXS16 ,IXTG1 ,IGEO ,KNOD2ELS ,KNOD2ELC ,
4078 5 KNOD2ELTG ,NOD2ELS ,NOD2ELC ,NOD2ELTG ,NOD2EL1D ,
4079 6 KNOD2EL1D ,KXX ,IXX ,X ,LELX ,
4080 7 IXIG3D ,KXIG3D ,KNOD2ELIG3D,NOD2ELIG3D,KNOD2ELQ,
4081 8 NOD2ELQ )
4082 IF(ALLOCATED(IWORK)) DEALLOCATE(IWORK)
4083
4084C-----reinitializing user pointers-------
4085 CALL SAV_BUF_POINT(PM ,1)
4086 CALL SAV_BUF_POINT(BUFMAT ,2)
4087 CALL SAV_BUF_POINT(GEO ,3)
4088 CALL SAV_BUF_POINT(ISKWN ,7)
4089 CALL SAV_BUF_POINT(SKEW ,8)
4090 CALL SAV_BUF_POINT(IPM ,11)
4091 CALL SAV_BUF_POINT(IGEO,12)
4092
4093C--------------------------------------------
4094
4095218 CONTINUE
4096.NOT. IF( ALLOCATED(TAGNO)) ALLOCATE(TAGNO(0))
4097.NOT. IF( ALLOCATED(NALE_R2R)) ALLOCATE(NALE_R2R(0))
4098.NOT. IF( ALLOCATED(DT_R2R)) ALLOCATE(DT_R2R(0))
4099C--------------------------------------------
4100C MULTIDOMAINS - INTERFACE CHECK
4101C--------------------------------------------
4102
4103C--- Check multidomains datas
4104 IF(NR2RLNK/=0) THEN
4105 CALL R2R_CHECK(IEXLNK,IGRNOD,IPART)
4106 ENDIF
4107C--- Allocation of FRONTB_R2R
4108 ALLOCATE(FRONTB_R2R(SFRONTB_R2R,NSPMD),STAT=stat)
4109 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
4110 . MSGTYPE=MSGERROR,
4111 . C1='front_r2r')
4112 FRONTB_R2R = 0
4113
4114C ------------------------------------------------
4115C Sorting of surfaces for airbags and modification files
4116C ------------------------------------------------
4117 CALL SORT_SURF(IGRSURF,IXS,IXC,IXTG,IXQ,IXP,IXR,IXT, KXX,NIXX)
4118C--------------------------------------------
4119 CALL PRINTGROUP(
4120 1 ITAB ,ITABM1 ,IGRNOD ,NINICRACK,BUFSF ,
4121 2 IGRSURF ,IGRSLIN ,INICRACK ,IXS ,IXQ ,
4122 3 IXC ,IXT ,IXP ,IXR ,IXTG ,
4123 4 IXS10 ,IXS20 ,IXS16 ,IPART ,
4124 5 KXX ,IXIG3D ,KXIG3D ,
4125 6 IGRQUAD ,IGRBRIC ,IGRSH4N ,IGRSH3N ,IGRTRUSS,
4126 7 IGRBEAM ,IGRSPRING,IGRPART )
4127 CALL TRACE_OUT1()
4128 DEALLOCATE(KXX,IXX,LELX)
4129C--------------------------------------------
4130C TRANSFORMATIONS
4131C--------------------------------------------
4132 ERR_MSG='transformations'
4133 ERR_CATEGORY='transformations'
4134 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
4135 CALL LECTRANS(X ,IGRNOD ,ITAB ,ITABM1 ,UNITAB,
4136 . LSUBMODEL,RTRANS ,IGRSURF,ISKWN ,SKEW ,
4137 . LISKN ,LSKEW ,NSPCOND,NUMSPH ,SISKWN,
4138 . SSKEW )
4139 CALL TRACE_OUT1()
4140 CLOSE(UNIT=IUSBM)
4141C--------------------------------------------
4142C READING OF /MERGE/NODE
4143C--------------------------------------------
4144 ERR_MSG='/merge/node'
4145 ERR_CATEGORY='/merge/node'
4146C
4147 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
4148C
4149 ALLOCATE(MERGE_NODE_TAB(4*NB_MERGE_NODE),STAT=stat)
4150 ALLOCATE(MERGE_NODE_TOL(NB_MERGE_NODE),STAT=stat)
4151 MERGE_NODE_TAB = 0
4152 MERGE_NODE_TOL = ZERO
4153 NMERGE_NODE_CAND = 0
4154 NMERGE_NODE_DEST = 0
4155 IF(STAT /= 0) THEN
4156 CALL ANCMSG(MSGID=268,ANMODE=ANINFO,MSGTYPE=MSGERROR,
4157 . C1='imerge')
4158 ENDIF
4159 IF(NB_MERGE_NODE > 0) THEN
4160 CALL HM_READ_MERGE_NODE(X,LSUBMODEL,UNITAB,IGRNOD,MERGE_NODE_TAB,
4161 . MERGE_NODE_TOL,NMERGE_NODE_CAND,NMERGE_NODE_DEST)
4162 ENDIF
4163C
4164 CALL TRACE_OUT1()
4165C--------------------------------------------
4166C MERGE OF NODES (cnodes + /MERGE/NODE)
4167C--------------------------------------------
4168 ERR_MSG='merging nodes'
4169 ERR_CATEGORY='merging nodes'
4170 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
4171C
4172 NMERGE_TOT = NUMCNOD + NMERGE_NODE_DEST
4173 ALLOCATE(IMERGE(3*NMERGE_TOT),STAT=stat)
4174 ALLOCATE(IMERGE2(NUMNOD+1),STAT=stat)
4175 ALLOCATE(IADMERGE2(NUMNOD+1),STAT=stat)
4176 IF(STAT /= 0) THEN
4177 CALL ANCMSG(MSGID=268,ANMODE=ANINFO,MSGTYPE=MSGERROR,
4178 . C1='imerge')
4179 ENDIF
4180C
4181 IMERGE = 0
4182 IMERGE2 = 0
4183 IADMERGE2 =0
4184 NMERGED = 0
4185C
4186C-- CNODE merging
4187 IF(NUMCNOD > 0)
4188 . CALL MERGE(X ,ITAB ,ITABM1 ,CMERGE ,IMERGE,
4189 . IMERGE2,IADMERGE2,NMERGE_TOT)
4190 DEALLOCATE(CMERGE)
4191C
4192C-- /MERGE/NODE merging
4193 IF(NB_MERGE_NODE > 0)
4194 . CALL MERGE_NODE(X ,ITAB ,ITABM1 ,IMERGE,IMERGE2,
4195 . IADMERGE2,NMERGE_TOT,MERGE_NODE_TAB,MERGE_NODE_TOL,
4196 . NMERGE_NODE_CAND,NMERGE_NODE_DEST,IXS,IXS10,IXS20,
4197 . IXS16,IXQ,IXC,IXT,IXP,
4198 . IXR,IXTG,EANI,IGRNOD)
4199C
4200 CALL TRACE_OUT1()
4201C--------------------------------------------
4202C Reinitialize merged connectivities / groups
4203C--------------------------------------------
4204 ERR_MSG='reinit connectivity'
4205 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
4206 IF(NMERGED > 0) THEN
4207 CALL RECONNECT(
4208 . IXS ,IXS10 ,IXS20 ,IXS16 ,IXQ ,
4209 . IXC ,IXT ,IXP ,IXR ,IXTG ,
4210 . IGRNOD ,IGRSURF ,IGRSLIN ,
4211 . ISKWN ,IMERGE ,NMERGE_TOT)
4212C
4213 KNOD2ELS = 0
4214 KNOD2ELC = 0
4215 KNOD2ELTG = 0
4216 KNOD2EL1D = 0
4217 KNOD2ELIG3D = 0
4218 NOD2ELS = 0
4219 NOD2ELC = 0
4220 NOD2ELTG = 0
4221 NOD2EL1D = 0
4222 NOD2ELIG3D = 0
4223 KNOD2ELQ = 0
4224 NOD2ELQ = 0
4225 CALL BUILD_CNEL(
4226 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
4227 3 IXR ,IXTG ,IXS10 ,IXS20 ,
4228 4 IXS16 ,IXTG1 ,IGEO ,KNOD2ELS ,KNOD2ELC ,
4229 5 KNOD2ELTG ,NOD2ELS ,NOD2ELC ,NOD2ELTG ,NOD2EL1D ,
4230 6 KNOD2EL1D ,KXX ,IXX ,X ,LELX ,
4231 7 IXIG3D ,KXIG3D ,KNOD2ELIG3D,NOD2ELIG3D,KNOD2ELQ,
4232 8 NOD2ELQ )
4233 ENDIF
4234 CALL TRACE_OUT1()
4235C--------------------------------------------
4236C READING RANDOM NOISE
4237C--------------------------------------------
4238 ERR_MSG='random noise'
4239 ERR_CATEGORY='random noise'
4240 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
4241
4242 CALL INIT_RANDOM( )
4243
4244 IF(RAND_STRUCT%CMD) NRAND = NRAND + 1
4245 ALLOCATE(IRAND(NRAND),STAT=stat)
4246 ALLOCATE(ALEA(NRAND) ,STAT=stat)
4247 ALLOCATE(XSEED(NRAND),STAT=stat)
4248
4249 CALL HM_READ_RAND(X ,IGRNOD ,ITAB,IRAND,ALEA,XSEED,
4250 . UNITAB,LSUBMODEL)
4251
4252 CALL TRACE_OUT1()
4253C--------------------------------------------
4254C READING SLIPRINGS AND RETRACTORS
4255C--------------------------------------------
4256 ERR_MSG='seatbelts'
4257 ERR_CATEGORY='seatbelts'
4258 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
4259C
4260 NB_MAT_SEATBELT = 0
4261 CALL HM_OPTION_COUNT('/mat/law114',NB_MAT)
4262 NB_MAT_SEATBELT = NB_MAT_SEATBELT + NB_MAT
4263 CALL HM_OPTION_COUNT('/mat/spr_seatbelt',NB_MAT)
4264 NB_MAT_SEATBELT = NB_MAT_SEATBELT + NB_MAT
4265 CALL HM_OPTION_COUNT('/mat/law119',NB_MAT)
4266 NB_MAT_SEATBELT = NB_MAT_SEATBELT + NB_MAT
4267 CALL HM_OPTION_COUNT('/mat/sh_seatbelt',NB_MAT)
4268 NB_MAT_SEATBELT = NB_MAT_SEATBELT + NB_MAT
4269C
4270 IF(NSLIPRING + NRETRACTOR > 0) WRITE(ISTDO,'(a)')' .. slipring/retractor'
4271 IF(NSLIPRING > 0) CALL HM_READ_SLIPRING(
4272 1 LSUBMODEL,ITABM1,IXR,ITAB,UNITAB,
4273 2 X,NPC1,NOM_OPT(LNOPT1*INOM_OPT(31)+1),ALEA,IGRNOD,
4274 2 IGRSH4N,IXC,IPM)
4275 IF(NRETRACTOR > 0) CALL HM_READ_RETRACTOR(
4276 1 LSUBMODEL,ITABM1,IXR,ITAB,UNITAB,
4277 2 X,NPC1,NOM_OPT(LNOPT1*INOM_OPT(32)+1),ALEA,IPM)
4278 CALL TRACE_OUT1()
4279C--------------------------------------------
4280C READING BOUNDARY CONDITIONS
4281C--------------------------------------------
4282 ERR_MSG='bcs'
4283 ERR_CATEGORY='bcs'
4284 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
4285 IF(NBCSCYC>0) THEN
4286 CALL HM_PREREAD_BCSCYC(IGRNOD ,NOM_OPT(LNOPT1*INOM_OPT(16)+1),LSUBMODEL,SLBCSCYC)
4287 END IF
4288 SIBCSCYC = 4*NBCSCYC
4289 ALLOCATE(IBCSCYC(SIBCSCYC),LBCSCYC(SLBCSCYC),STAT=stat)
4290 LBCSCYC = 0
4291.OR..OR. IF(NUMBCS /= 0 NALEBCS /= 0 NUMBCSN /= 0) THEN
4292 WRITE(ISTDO,'(a)')TITRE(13)
4293C READ /BCS & /BCS/LAGMUL
4294 CALL HM_READ_BCS(ICODE ,ISKEW ,ITAB ,ITABM1 ,D ,
4295 . IGRNOD ,IBCSLAG ,LAG_NCF ,LAG_NKF ,LAG_NHF,
4296 . IKINE1LAG,ISKWN,NOM_OPT(LNOPT1*INOM_OPT(16)+1),
4297 . UNITAB ,LSUBMODEL,IBCSCYC,LBCSCYC)
4298C READ /ALE/BCS
4299 CALL HM_READ_ALEBCS(ICODE ,ISKEW ,ITAB ,ITABM1 ,D ,
4300 . IGRNOD ,IBCSLAG ,LAG_NCF ,LAG_NKF ,LAG_NHF,
4301 . IKINE1LAG,ISKWN,NOM_OPT(LNOPT1*INOM_OPT(16)+1),
4302 . LSUBMODEL)
4303C READ /NBCS
4304 CALL HM_READ_NBCS(ICODE ,ISKEW ,ITAB ,ITABM1 ,D ,
4305 . IGRNOD ,IBCSLAG ,LAG_NCF ,LAG_NKF ,LAG_NHF,
4306 . IKINE1LAG,ISKWN,NOM_OPT(LNOPT1*INOM_OPT(16)+1),LSUBMODEL)
4307C PRINT /BCS
4308 CALL PRINTBCS(ICODE ,ISKEW ,ITAB ,ITABM1 ,D ,
4309 . IGRNOD ,IBCSLAG ,LAG_NCF ,LAG_NKF ,LAG_NHF,
4310 . IKINE1LAG,ISKWN,NOM_OPT(LNOPT1*INOM_OPT(16)+1), NBCSLAG)
4311 ENDIF
4312
4313C--------------------------------------
4314C
4315 ALLOCATE(ICODEP(0),ISKEWP(0))
4316 CALL TRACE_OUT1()
4317C Adaptive meshing : Sending down the bcs
4318 ERR_MSG='adaptive meshing bcs'
4319 ERR_CATEGORY='adaptive meshing bcs'
4320 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
4321 IF(NADMESH/=0)THEN
4322 CALL ADMBCS(IXC ,IPARTC,IXTG,IPARTG,IPART ,
4323 . ICODE,ISKEW,ITAB,SH4TREE,SH3TREE)
4324 END IF
4325 CALL TRACE_OUT1()
4326C--------------------------------------------------------------------------
4327C SORTING BRICKS AND QUADS, CLASSIFICATION BY LAW
4328C--------------------------------------------------------------------------
4329 ERR_MSG='solids sort'
4330 ERR_CATEGORY='internal'
4331 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
4332 SIWORK = 2*MAX(NUMELS,NUMELQ)
4333 ALLOCATE(IWORK(SIWORK) ,STAT=stat)
4334 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
4335 . MSGTYPE=MSGERROR,
4336 . C1='iwork')
4337 IF(NUMELS /= 0)
4338 . CALL LCE16S3(
4339 . IXS ,BID13 ,PM ,IWORK ,ITAB ,ITABM1 ,
4340 . ICODE ,IPARTS ,IGRBRIC ,GEO ,EANI ,
4341 . IXS10 ,IPART ,IXS20 ,IXS16 ,KNOD2ELS,NOD2ELS ,
4342 . IGRSURF,SPH2SOL ,SOL2SPH )
4343 IF(NUMELQ /= 0)
4344 . CALL LCE16Q3(
4345 . IXQ ,BID13 ,PM ,IWORK ,ITAB ,ITABM1 ,
4346 . ICODE ,IPARTQ ,IGRQUAD ,IPM ,IGEO )
4347 IF(ALLOCATED(IWORK)) DEALLOCATE(IWORK)
4348 CALL TRACE_OUT1()
4349C--------------------------------------------
4350C MULTI-POINT CONSTRAINTS (1)
4351C--------------------------------------------
4352 ERR_MSG='mpcs 1'
4353 ERR_CATEGORY='mpcs 1'
4354 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
4355 IF(NUMMPC > 0) THEN
4356 CALL HM_READ_MPC0 (LMPC,LSUBMODEL)
4357 ELSE
4358 LMPC=0
4359 ENDIF
4360 SRBMPC = LMPC
4361 ALLOCATE(RBMPC(SRBMPC) ,STAT=stat)
4362 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
4363 . MSGTYPE=MSGERROR,
4364 . C1='rbmpc')
4365 IF(SRBMPC > 0) RBMPC = ZERO
4366 CALL TRACE_OUT1()
4367C--------------------------------------------
4368C DYNAMIC REAL STORAGE
4369C--------------------------------------------
4370 ERR_MSG='dynamic storage real'
4371 ERR_CATEGORY='internal'
4372 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
4373 SGJBUFR = LKJNR*NGJOINT
4374 SW = 3*NUMNOD*IALE
4375 NUMELSK8 = NUMELS
4376 NUMELQK8 = NUMELQ
4377 SVEUL = (LVEUL*NUMELS+10*NUMELQ)*IEULER
4378 SVEUL8 = (INT(LVEUL,KIND(SVEUL8))*NUMELSK8+10*NUMELQK8)*INT(IEULER,KIND(SVEUL8))
4379 SFILL = NMULT*NUMNOD
4380 SDFILL = NMULT*NUMNOD
4381 SALPH = 2*NMULT*(NUMELQ+NUMELS)
4382 SWB = 0
4383 IF(ALE%GRID%NWALE == 2) THEN
4384 SWB = 3*NUMNOD
4385 ELSEIF(ALE%GRID%NWALE == 4) THEN
4386 SWB = 4*NUMNOD
4387 ENDIF
4388 ALLOCATE(WB(SWB) ,STAT=stat)
4389 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
4390 . MSGTYPE=MSGERROR,
4391 . C1='wb')
4392 IF(SWB > 0) WB = ZERO
4393 IF(ALE%GRID%NWALE == 4) THEN
4394 WMA => WB(3*NUMNOD+1:SWB)
4395 ELSE
4396 WMA => WB
4397 ENDIF
4398C
4399 SDSAVE = 0
4400 SASAVE = 0
4401.AND. IF(ILAG == 1 (IALE+IEULER) > 0) THEN
4402 SDSAVE = 3*NUMNOD
4403 SASAVE = 3*NUMNOD
4404 ENDIF
4405 ALLOCATE(GJBUFR(SGJBUFR) ,STAT=stat)
4406 IF(STAT /= 0) CALL ANCMSG(MSGID=268,ANMODE=ANINFO,
4407 . MSGTYPE=MSGERROR,
4408 . C1='gjbufr')
4409 ALLOCATE(w(sw) ,stat=stat)
4410 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4411 . msgtype=msgerror,
4412 . c1='W')
4413 ALLOCATE(veul(sveul8) ,stat=stat)
4414 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4415 . msgtype=msgerror,
4416 . c1='VEUL')
4417 ALLOCATE(fill(sfill) ,stat=stat)
4418 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4419 . msgtype=msgerror,
4420 . c1='FILL')
4421 ALLOCATE(dfill(sdfill) ,stat=stat)
4422 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4423 . msgtype=msgerror,
4424 . c1='DFILL')
4425 ALLOCATE(alph(salph) ,stat=stat)
4426 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4427 . msgtype=msgerror,
4428 . c1='ALPH')
4429 ALLOCATE(dsave(sdsave) ,stat=stat)
4430 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4431 . msgtype=msgerror,
4432 . c1='DSAVE')
4433 ALLOCATE(asave(sasave) ,stat=stat)
4434 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4435 . msgtype=msgerror,
4436 . c1='ASAVE')
4437 IF(sgjbufr > 0) gjbufr = zero
4438 IF(sw > 0) w = zero
4439 IF(sveul8 > 0) veul = zero
4440 IF(sfill > 0) fill = zero
4441 IF(sdfill > 0) dfill = zero
4442 IF(salph > 0) alph = zero
4443 IF(sdsave > 0) dsave = zero
4444 IF(sasave > 0) asave = zero
4445 CALL trace_out1()
4446C--------------------------------------------
4447C READING COMPLEX JOINTS (GJOINT)
4448C--------------------------------------------
4449 err_msg='GJOINTS'
4450 err_category='GJOINTS'
4451 CALL trace_in1(err_msg,len_trim(err_msg))
4452 joint_sms = .false.
4453 IF(isms/=0) joint_sms = .true.
4454 IF(ngjoint/=0) CALL hm_read_gjoint(
4455 1 gjbufi ,gjbufr ,itab ,itabm1 ,x ,
4456 2 ms ,in ,lag_ncf ,lag_nkf ,lag_nhf ,
4457 3 d ,unitab ,ikine1lag,nom_opt(lnopt1*inom_opt(18)+1),lsubmodel)
4458 CALL trace_out1()
4459C--------------------------------------------
4460C READER FOR DETONATOR OPTIONS (/DFS/DET*)
4461C--------------------------------------------
4462 err_msg='DETONATORS'
4463 err_category='DETONATORS'
4464 CALL trace_in1(err_msg,len_trim(err_msg))
4465 !new Reader
4466 CALL read_detonators(itabm1 ,itab ,igrnod ,
4467 . pm ,ipm ,x ,unitab ,
4468 . lsubmodel,detonators)
4469 CALL trace_out1()
4470C--------------------------------------------
4471C A.L.E.
4472C ELEMENT NEIGHBOR (OR FACET) ARRAYS
4473C NEIGHBOR NODE ARRAYS
4474C--------------------------------------------
4475 CALL ale_connectivity%ALE_CONNECTIVITY_INIT()
4476 err_msg='ALE LINKS'
4477 err_category='ale'
4478 CALL TRACE_IN1(ERR_MSG,LEN_TRIM(ERR_MSG))
4479 IF(NALELK/=0) THEN
4480 WRITE(ISTDO,'(a)')TITRE(29)
4481 LLINAL = 7 * NALELK
4482 SLINALE=LLINAL
4483 ALLOCATE(LINALE(SLINALE),STAT=stat)
4484 IF(IERR/=0) THEN
4485 WRITE(IOUT,*) ' ** error in memory allocation'
4486 WRITE(istdo,*)' ** ERROR IN MEMORY ALLOCATION'
4487 ENDIF
4488 CALL hm_read_ale_link(icode, iskew, itab, itabm1, d,
4489 . igrnod, ibcslag, lag_ncf, lag_nkf, lag_nhf,
4490 . ikine1lag, linale, lsubmodel, unitab)
4491 ELSE
4492 ALLOCATE(linale(0))
4493 ENDIF
4494 err_msg='ALE NEIGHBOURS'
4495 IF(iale+ieuler+ialelag /= 0)THEN
4496 WRITE(istdo,'(A)')titre(30)
4497 CALL alelec(
4498 1 icode ,ixs ,ixq ,ixc ,ixt ,
4499 2 ixtg ,pm ,igeo ,itab ,geo ,
4500 3 nale_r2r ,nsubdom ,multi_fvm ,ale_connectivity,glob_therm%ITHERM,detonators%IS_SHADOWING_REQUIRED)
4501C ---------------------------------------------------------------
4502C Unplug neighbor elements in case of direct lagrangian coupling
4503C ---------------------------------------------------------------
4504 IF(multi_fvm%IS_USED) THEN
4505 CALL multi_unplug_neighbors(ale_connectivity, ixs, ixq, ixtg)
4506 ENDIF
4507 CALL trace_out1()
4508C--------------------------------------------
4509C MULTIMATERIALS
4510C INITIALIZATION OF NODAL PERCENTAGES
4511C--------------------------------------------
4512 CALL trace_in1(err_msg,len_trim(err_msg))
4513 IF(nmult>0)THEN
4514 WRITE(istdo,'('' .. MULTIMATERIALS'')')
4515 IF(numels>0)
4516 . CALL inimu3(pm ,ixs ,fill ,dfill )
4517 IF(numelq>0)
4518 . CALL inimu2(pm ,ixq ,fill ,dfill )
4519 CALL inimul (pm ,fill ,dfill ,mat20_discrete_fill)
4520 ENDIF
4521 ENDIF
4522 CALL trace_out1()
4523C---------------------------------------------------
4524C DETECTION OF ELEMENT LAW 6 WALL---->LAW 17
4525C---------------------------------------------------
4526 err_msg='CFD BOUNDARY ELEMENTS'
4527 err_category='CFD BOUNDARY ELEMENTS'
4528 CALL trace_in1(err_msg,len_trim(err_msg))
4529 IF(iale+ieuler/=0)
4530 + CALL paroi(pm ,ixs ,ixq ,icode ,ale_connectivity%NALE )
4531 CALL trace_out1()
4532C--------------------------------------------
4533C DYNAMIC INTEGER STORAGE (LOADING)
4534C--------------------------------------------
4535C READING MULTI-PURPOSE ELEMENTS.
4536C---------------------------------------------
4537 err_msg='MULTI-PURPOSE ELEMENTS'
4538 err_category='MULTI-PURPOSE ELEMENTS'
4539 CALL trace_in1(err_msg,len_trim(err_msg))
4540 IF(numelx > 0) THEN
4541 skxx = nixx*numelx
4542 CALL hm_preread_xelem(sixx, igrnod,lsubmodel)
4543 ALLOCATE(kxx(skxx) ,stat=stat)
4544 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4545 . msgtype=msgerror,
4546 . c1='KXX')
4547 ALLOCATE(ixx(sixx+150) ,stat=stat)
4548 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4549 . msgtype=msgerror,
4550 . c1='IXX')
4551 kxx = 0
4552 ixx = 0
4553 ALLOCATE(lelx(numelx) ,stat=stat)
4554 lelx(1:numelx) = 0
4555 CALL hm_read_xelem(igrnod ,itab ,itabm1 ,ipart ,ipartx,
4556 . ipm ,igeo ,kxx ,ixx ,lsubmodel)
4557 ELSE
4558 skxx = 0
4559 sixx = 0
4560 ALLOCATE(kxx(skxx) ,stat=stat)
4561 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4562 . msgtype=msgerror,
4563 . c1='KXX')
4564 ALLOCATE(ixx(sixx) ,stat=stat)
4565 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4566 . msgtype=msgerror,
4567 . c1='IXX')
4568 ALLOCATE(lelx(numelx) ,stat=stat)
4569 ENDIF
4570 CALL trace_out1()
4571C--------------------------------------------
4572C READING SPH SYMMETRY CONDITIONS.
4573C---------------------------------------------
4574 err_msg='SPH SYM'
4575 err_category='SPH SYM'
4576 CALL trace_in1(err_msg,len_trim(err_msg))
4577 sispsym = nspcond*numsph
4578 sispcond = nspcond*nispcond
4579 ALLOCATE(ispsym(sispsym) ,stat=stat)
4580 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4581 . msgtype=msgerror,
4582 . c1='ISPSYM')
4583 ALLOCATE(ispcond(sispcond) ,stat=stat)
4584 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4585 . msgtype=msgerror,
4586 . c1='ISPCOND')
4587 IF(nspcond > 0) THEN
4588 ispsym = 0
4589 ispcond = 0
4590 WRITE(istdo,'(A)')' .. SPH SYMMETRY CONDITIONS'
4591 CALL hm_read_spcnd(ispcond ,iskew ,itab ,itabm1 ,d ,
4592 . igrnod ,nod2sp ,iframe ,nom_opt(lnopt1*inom_opt(23)+1),
4593 . lsubmodel)
4594 ENDIF
4595 CALL trace_out1()
4596C---------------------------------------------
4597C READING SPH INLET/OUTLET.
4598C---------------------------------------------
4599 err_msg='SPH I/O'
4600 err_category='SPH I/O'
4601 CALL trace_in1(err_msg,len_trim(err_msg))
4602 lwaspio=0
4603 sisphio = nisphio*nsphio
4604 ssphveln= nsphio*numsph*2
4605 ALLOCATE(isphio(sisphio) ,stat=stat)
4606 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4607 . msgtype=msgerror,
4608 . c1='ISPHIO')
4609 ALLOCATE(sphveln(ssphveln) ,stat=stat)
4610 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4611 . msgtype=msgerror,
4612 . c1='SPHVELN')
4613 lvsphio = 0
4614 IF(nsphio > 0)THEN
4615 WRITE(istdo,'(A)')' .. SPH INLET/OUTLET DEFINITION'
4616 isphio = 0
4617 nseg_io = 0
4618 CALL hm_preread_sphio(igrsurf ,svsphio ,
4619 . nom_opt(lnopt1*inom_opt(22)+1),
4620 . lsubmodel)
4621 ALLOCATE(vsphio(svsphio) ,stat=stat)
4622 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4623 . msgtype=msgerror,
4624 . c1='VSPHIO')
4625 vsphio(1:svsphio)=zero
4626
4627c ALLOCATE(VSPHIO2(SVSPHIO2) ,STAT=stat)
4628c VSPHIO2(1:SVSPHIO2)=ZERO
4629
4630 CALL hm_read_sphio(isphio ,vsphio ,ipart ,igrsurf ,
4631 . nod2sp ,ipartsp ,itab ,x ,
4632 . lvsphio ,lwaspio ,itabm1 ,unitab ,
4633 . lsubmodel,rtrans ,nrtrans )
4634C---- -----------------------------------------
4635C PREPARING SORTED LIST of ON/OFF PARTICLES by PART.
4636C---------------------------------------------
4637 slprtsph = 2*(npart+1)
4638 slonfsph = numsph
4639 ALLOCATE(lprtsph(slprtsph) ,stat=stat)
4640 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4641 . msgtype=msgerror,
4642 . c1='LPRTSPH')
4643 ALLOCATE(lonfsph(slonfsph) ,stat=stat)
4644 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4645 . msgtype=msgerror,
4646 . c1='LONFSPH')
4647 lprtsph = 0
4648 lonfsph = 0
4649 CALL sphonf0(kxsp ,ixsp ,nod2sp ,ipart ,ipartsp ,
4650 . lprtsph ,lonfsph )
4651 sphveln = zero
4652 IF(nspmd > 1)THEN
4653c CALL ANSTCKC(27,'SPH INLET/OUTLET DEFINITION')
4654c CALL ANCERR(755,ANINFO)
4655 END IF
4656 ELSE
4657 slprtsph = 0
4658 slonfsph = 0
4659 svsphio = 0
4660c SVSPHIO2 = 0
4661 ALLOCATE(lprtsph(slprtsph) ,stat=stat)
4662 ALLOCATE(lonfsph(slonfsph) ,stat=stat)
4663 ALLOCATE(vsphio(svsphio) ,stat=stat)
4664c ALLOCATE(VSPHIO2(SVSPHIO2) ,STAT=stat)
4665 ENDIF
4666 IF(numsph > 0)THEN
4667C---------------------------------------------
4668C FILLING SPBUF(2) = H
4669C---------------------------------------------
4670 CALL spinih(kxsp ,ipart ,ipartsp ,spbuf ,pm,
4671 . ixsp ,nod2sp ,x ,lprtsph,lonfsph,
4672 . snod2sp ,slonfsph,numnod,npart,itab)
4673C---------------------------------------------
4674C STARTER SORTING : Filling IXSP
4675C---------------------------------------------
4676 pre_search = 0
4677 sz_intp_dist = 1 ! Array MAX_INTP_DIST_PART not used for full search siz=1
4678 CALL sptri(kxsp ,ixsp ,nod2sp ,x ,spbuf ,
4679 . lprtsph ,lonfsph ,ipartsp ,sz_intp_dist,max_intp_dist_part,
4680 . pre_search)
4681 END IF
4682 CALL trace_out1()
4683C---------------------------------------------
4684C Fluid nodal masses
4685C---------------------------------------------
4686 err_msg='FLUID NODAL MASSES'
4687 err_category='FLUID NODAL MASSES'
4688 CALL trace_in1(err_msg,len_trim(err_msg))
4689 smsnf = numnod*max(iale,ieuler,ialelag)
4690 ALLOCATE(msnf(smsnf) ,stat=stat)
4691 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4692 . msgtype=msgerror,
4693 . c1='MSNF')
4694 msnf = zero
4695 CALL trace_out1()
4696C--------------------------------------------
4697C PRE-READING CONCENTRATED FORCES & PRESSURES
4698C--------------------------------------------
4699 err_msg='CONCENTRED LOADS'
4700 err_category='CONCENTRED LOADS'
4701 CALL trace_in1(err_msg,len_trim(err_msg))
4702 numcld = nconld
4703 numpres = npreld
4704 loads%NLOAD_CLOAD = 0
4705 loads%NLOAD_PLOAD = 0
4706 IF(nsubdom>0) ALLOCATE(nncl(nconld+npreld))
4707 CALL hm_preread_cload(numcld, igrnod ,igrsurf,lsubmodel)
4708 CALL hm_preread_pload(numpres,igrnod ,igrsurf,lsubmodel)
4709 sibcl = (numcld + numpres)*nibcld
4710 sforc = (numcld + numpres)*lfaccld
4711 ALLOCATE(ibcl(sibcl) ,stat=stat)
4712 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4713 . msgtype=msgerror,
4714 . c1='IBCL')
4715 ALLOCATE(forc(sforc) ,stat=stat)
4716 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4717 . msgtype=msgerror,
4718 . c1='FORC')
4719 ALLOCATE(dpl0cld(6*(numcld+numpres)) ,stat=stat)
4720 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4721 . msgtype=msgerror,
4722 . c1='DPL0CLD')
4723 ALLOCATE(vel0cld(6*(numcld+numpres)) ,stat=stat)
4724 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4725 . msgtype=msgerror,
4726 . c1='VEL0CLD')
4727 IF(numpres>0) THEN
4728 ipres => ibcl(numcld*nibcld+1:sibcl)
4729 ELSE
4730 ipres => ibcl
4731 END IF
4732 ibcl = 0
4733 forc = zero
4734 dpl0cld = zero
4735 vel0cld = zero
4736C--------------------------------------------
4737C READING CONCENTRATED FORCES
4738C--------------------------------------------
4739 IF(nconld/=0) THEN
4740 WRITE(istdo,'(A)')titre(33)
4741C NCONLD AND NPRELD are modified in LECCLD and LECPRE
4742 CALL hm_read_cload(ibcl ,forc ,nconld,itab ,itabm1 ,
4743 . igrnod ,ibcl ,unitab,iskwn ,lsubmodel,
4744 . loads )
4745 IF(nconld*lfaccld<sforc) THEN
4746 pres => forc(nconld*lfaccld+1:sforc)
4747 ELSE
4748 pres => forc
4749 ENDIF
4750 ENDIF
4751 IF(nconld*lfaccld<sforc) THEN
4752 pres => forc(nconld*lfaccld+1:sforc)
4753 ELSE
4754 pres => forc
4755 END IF
4756 CALL trace_out1()
4757C--------------------------------------------
4758C READING PRESSURES
4759C--------------------------------------------
4760 err_msg='PRESSURE LOADS'
4761 err_category='PRESSURE LOADS'
4762 CALL trace_in1(err_msg,len_trim(err_msg))
4763 IF(npreld/=0)THEN
4764 WRITE(istdo,'(A)')titre(34)
4765 CALL hm_read_pload(ipres ,pres ,npreld ,itab ,itabm1,
4766 . igrsurf ,unitab ,lsubmodel ,loads )
4767 nconld=nconld+npreld
4768 ENDIF
4769C NCONLD AND NPRELD are modified in LECCLD and LECPRE
4770 CALL trace_out1()
4771 IF(nsubdom>0) DEALLOCATE(nncl)
4772c
4773c pressure load in cylindrical coordinates
4774c
4775 CALL hm_read_pcyl(loads ,igrsurf ,sensors%NSENSOR,sensors%SENSOR_TAB ,table ,
4776 . iframe ,unitab ,lsubmodel,number_load_cyl )
4777C--------------------------------------------
4778C "LOAD FIELDS"
4779C--------------------------------------------
4780 err_msg = 'LOAD FIELDS'
4781 err_category = 'LOAD FIELDS'
4782 CALL trace_in1(err_msg,len_trim(err_msg))
4783C
4784C CENTRIFUGAL LOADS
4785 CALL hm_preread_load_centri(numcfield,igrnod,igrsurf,lsubmodel)
4786 scfield = lfacload*nloadc
4787 sicfield = sizfield*nloadc
4788 slcfield = numcfield
4789C
4790C PFLUID & PBLAST
4791 numloadp=0
4792 nintloadp=0
4793 CALL hm_preread_pfluid(numloadp,igrnod,igrsurf,lsubmodel)
4794 CALL hm_preread_pblast(pblast,numloadp,igrsurf,lsubmodel,nsurf)
4795 CALL hm_preread_load_pressure(numloadp,igrsurf,lsubmodel)
4796 nloadp = nloadp_f+pblast%NLOADP_B+nloadp_hyd
4797 sloadp = lfacload*nloadp
4798 siloadp = sizloadp*nloadp
4799 slloadp = numloadp
4800C
4801 CALL trace_out1()
4802c------------------------------------------------------
4803c IMPOSED DISPLACEMENTS, VELOCITIES AND ACCELERATIONS
4804c------------------------------------------------------
4805 err_msg='IMPOSED VELOCITIES'
4806 err_category='IMPOSED VELOCITIES'
4807 CALL trace_in1(err_msg,len_trim(err_msg))
4808c
4809 nfvlag = 0 ! Lagrangian multiplier flag
4810C---
4811c Input : NFXVEL = number of input cards : /IMDISP + /IMPVEL + /IMPACC
4812c Output : NFXVEL = number of imposed nodes (disp + vel + acc)
4813c
4814c--- Calculate number of nodes with imposed disp, vel, acc for allocation
4815c
4816 IF(nfxvel > 0) THEN
4817 nfv0 = nfxvel
4818c
4819 CALL hm_preread_impdisp(nimpdisp ,igrnod ,ipart ,ipartr ,
4820 . unitab ,lsubmodel)
4821c
4822 CALL hm_preread_impvel(nimpvel ,igrnod ,ipart ,ipartr , nfvlag,
4823 . unitab ,lsubmodel)
4824c
4825 CALL hm_preread_impacc(nimpacc ,igrnod ,lsubmodel)
4826c
4827 nfxvel = nimpdisp + nimpvel + nimpacc
4828 ELSE
4829 nfv0 = 0
4830 nimpdisp = 0
4831 nimpvel = 0
4832 nimpacc = 0
4833 nimpv_lagm = 0
4834 ENDIF
4835c---
4836 sibfv = nfxvel * nifv
4837 svel = nfxvel * lfxvelr
4838 nfxvel0 = nfxvel
4839 ALLOCATE(ibfv(sibfv) ,stat=stat)
4840 ALLOCATE(vel(svel ) ,stat=stat)
4841 ibfv(1:sibfv) = 0
4842 vel(1:svel) = zero
4843c------------------------------------------------------
4844c
4845 IF(nfxvel > 0) THEN
4846c
4847 WRITE(istdo,'(A)')titre(44)
4848c
4849 CALL hm_read_impvel(
4850 . vel ,ibfv ,d ,ikine1lag,
4851 . itab ,itabm1 ,igrnod ,x ,ixr ,
4852 . ipart ,ipartr ,iskwn ,nom_opt(lnopt1*inom_opt(15)+1),
4853 . nimpdisp ,nimpvel ,unitab ,lsubmodel)
4854
4855 ENDIF
4856c------------------------------------------------------
4857c IMPOSED ACCELERATIONS
4858c------------------------------------------------------
4859 IF(nimpacc > 0) THEN
4860 CALL hm_read_impacc(
4861 . vel ,ibfv ,nfxvel0 ,itab ,itabm1 ,
4862 . d ,igrnod ,iskwn ,unitab ,lsubmodel,
4863 . nfxvel ,nimpacc )
4864 ENDIF
4865c
4866C /BCS/CYCLIC ini&check
4867 IF(nbcscyc > 0) THEN
4868 ALLOCATE(itagcyc(numnod) ,stat=stat)
4869 CALL ini_bcscyc(ibcscyc,lbcscyc,skew,x,itab,icode,ibfv,itagcyc)
4870 ELSE
4871 ALLOCATE(itagcyc(0))
4872 END IF
4873C--------------------------------------------
4874 sfsav = nthvki * (ninter+nrwall+nrbody+nsect+njoint+nrbag+nvolu+nmonvol+nfxbody+nintsub)
4875 ALLOCATE(fsav(sfsav) ,stat=stat)
4876 fsav = zero
4877 CALL trace_out1()
4878C ***************************************************************** C
4879C Check if ALE or EULER materials are used with lagrangian thermics
4880C ***************************************************************** C
4881C
4882C--------------------------------------------
4883C READ INITIAL TEMPERATURE
4884C--------------------------------------------
4885 nintemp = glob_therm%NINTEMP
4886 IF (iale + ieuler /= 0) THEN
4887 IF (glob_therm%ITHERM_FE == 0 .AND. (glob_therm%NIMTEMP /= 0 .OR. nintemp /= 0)) THEN
4888 CALL ancmsg(msgid=1724, anmode=aninfo, msgtype=msgwarning)
4889 ENDIF
4890 ENDIF
4891 err_msg='INITIAL TEMPERATURES'
4892 err_category='INITIAL TEMPERATURES'
4893 CALL trace_in1(err_msg,len_trim(err_msg))
4894!
4895 IF (glob_therm%NINTEMP > 0) THEN
4896 WRITE(istdo,'(A)')titre(35)
4897 ALLOCATE(temp(numnod))
4898 temp(1:numnod) = zero
4899 ALLOCATE(intids(nintemp))
4900 CALL hm_read_initemp(temp ,nintemp ,glob_therm%ITHERM_FE,itab ,itabm1 ,
4901 . igrnod ,intids ,unitab,lsubmodel )
4902 DEALLOCATE(intids)
4903 END IF
4904!
4905 IF (glob_therm%ITHERM_FE > 0 ) THEN
4906 ALLOCATE(mcp(numnod))
4907 IF (.NOT.ALLOCATED(temp)) THEN
4908 ALLOCATE(temp(numnod))
4909 temp(1:numnod) = zero
4910 END IF
4911 mcp(1:numnod) = zero
4912C
4913 CALL hm_preread_imptemp(igrsurf, igrnod, igrbric, unitab, lsubmodel,
4914 . glob_therm%NIMTEMP,glob_therm%NFXTEMP)
4915c
4916 CALL hm_preread_convec(igrsurf, igrnod, igrbric, unitab, lsubmodel,
4917 . glob_therm%NCONVEC ,glob_therm%NUMCONV )
4918c
4919 CALL hm_preread_radiation(igrsurf, igrnod, igrbric,unitab, lsubmodel,
4920 . glob_therm%NRADIA ,glob_therm%NUMRADIA)
4921c
4922 CALL hm_preread_impflux(igrsurf, igrnod, igrbric,unitab, lsubmodel,
4923 . glob_therm%NIMPFLUX,glob_therm%NFXFLUX)
4924c
4925
4926 ALLOCATE(ibcv(glob_therm%NICONV*glob_therm%NUMCONV) ,stat=stat)
4927 ALLOCATE(fconv(glob_therm%LFACTHER*glob_therm%NUMCONV) ,stat=stat)
4928 ALLOCATE(ibftemp(glob_therm%NIFT*glob_therm%NFXTEMP) ,stat=stat)
4929 ALLOCATE(fbftemp(glob_therm%LFACTHER*glob_therm%NFXTEMP),stat=stat)
4930 ALLOCATE(ibfflux(glob_therm%NITFLUX*glob_therm%NFXFLUX) ,stat=stat)
4931 ALLOCATE(fbfflux(glob_therm%LFACTHER*glob_therm%NFXFLUX),stat=stat)
4932 ALLOCATE(ibcr(glob_therm%NIRADIA*glob_therm%NUMRADIA) ,stat=stat)
4933 ALLOCATE(fradia(glob_therm%LFACTHER*glob_therm%NUMRADIA),stat=stat)
4934 .
4935 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4936 . msgtype=msgerror,
4937 . c1='THERMAL DATA')
4938 ibcr(1:glob_therm%NIRADIA*glob_therm%NUMRADIA) = 0
4939C
4940 IF (glob_therm%NUMCONV > 0 ) THEN
4941 ibcv = 0
4942 fconv = zero
4943 CALL hm_read_convec(ibcv,fconv,itab,ixs,igrsurf,unitab,lsubmodel,
4944 . glob_therm%NCONVEC ,glob_therm%NICONV,glob_therm%NUMCONV,glob_therm%LFACTHER)
4945 ENDIF
4946C
4947 IF (glob_therm%NUMRADIA > 0 ) THEN
4948 CALL hm_read_radiation(ibcr,fradia,itab,ixs,igrsurf,unitab,lsubmodel,
4949 . glob_therm%NRADIA ,glob_therm%NUMRADIA,glob_therm%NIRADIA,glob_therm%LFACTHER)
4950 ENDIF
4951C
4952 IF (glob_therm%NFXTEMP > 0) THEN
4953 ibftemp = 0
4954 fbftemp = zero
4955 CALL hm_read_imptemp(ibftemp,fbftemp,glob_therm%NFXTEMP,itabm1,
4956 . igrnod ,ibftemp,itab ,unitab,lsubmodel,
4957 . glob_therm%NIMTEMP,glob_therm%NIFT,glob_therm%LFACTHER)
4958 ENDIF
4959C
4960 IF (glob_therm%NFXFLUX > 0 ) THEN
4961 ibfflux = 0
4962 fbfflux = zero
4963 CALL hm_read_impflux(ibfflux ,fbfflux ,itab ,ixs ,igrsurf ,
4964 . unitab ,igrnod ,igrbric, lsubmodel,
4965 . glob_therm%NIMPFLUX,glob_therm%NITFLUX,glob_therm%LFACTHER)
4966 ENDIF
4967C
4968 ELSE
4969 ALLOCATE(mcp(0))
4970 ALLOCATE(ibcv(0),fconv(0),ibftemp(0),fbftemp(0),
4971 . ibfflux(0),fbfflux(0),ibcr(0),fradia(0))
4972 IF (.NOT. ALLOCATED(temp)) ALLOCATE(temp(0))
4973 ENDIF
4974C
4975 CALL trace_out1()
4976C--------------------------------------------
4977 IF(isigi==2 .OR. isigi==4) THEN
4978 sfzero = 3*numnod
4979 ELSEIF(iabs(isigi)==5) THEN
4980 sfzero = 3*4*(numelc+numeltg)
4981 ELSE
4982 sfzero = 0
4983 ENDIF
4984 ALLOCATE(fzero(sfzero) ,stat=stat)
4985 IF(sfzero > 0) fzero = zero
4986C--------------------------------------------
4987C READING LASER IMPACTS
4988C--------------------------------------------
4989 err_msg='LASER IMPACTS'
4990 err_category='LASER IMPACTS'
4991 CALL trace_in1(err_msg,len_trim(err_msg))
4992 CALL leclas(lsubmodel)
4993 CALL trace_out1()
4994C-------------------------------------------------
4995C GENERATING EXTERNAL FACETS (ANIM FILES)
4996C ALE-EULER SEULEMENT
4997C-------------------------------------------------
4998 nfacx=0
4999 err_msg='ELEMENTARY BOUNDARY CONDITIONS'
5000 err_category='ELEMENTARY BOUNDARY CONDITIONS'
5001 CALL trace_in1(err_msg,len_trim(err_msg))
5002 ebcs_tag_cell_spmd(1:numelq+numeltg+numels)=0
5003 CALL read_ebcs(igrsurf,multi_fvm,npc1,lsubmodel,ebcs_tab,n2d)
5004 IF(nebcs > 0)THEN
5005 !allocate & count
5006 IF(.NOT. ALLOCATED(sensor_tmp)) ALLOCATE( sensor_tmp(0) )
5007 CALL iniebcs(ale_connectivity, 0, igrsurf, ixs, ixq, ixtg,
5008 . pm, igeo, x, sensor_tmp, monvol, multi_fvm%IS_USED,
5009 . ebcs_tab, ebcs_tag_cell_spmd, itabm1)
5010 DEALLOCATE(sensor_tmp)
5011 ENDIF
5012 CALL trace_out1()
5013C--------------------------------------------
5014C READING ACCELEROMETERS
5015C--------------------------------------------
5016 err_msg='ACCELEROMETERS'
5017 err_category='ACCELEROMETERS'
5018 CALL trace_in1(err_msg,len_trim(err_msg))
5019 saccelm = naccelm * llaccelm
5020 ALLOCATE(accelm(saccelm) ,stat=stat)
5021 IF(saccelm > 0) accelm = zero
5022 IF(naccelm > 0) CALL lecacc(
5023 1 laccelm,accelm ,itabm1 ,unitab,ixc,
5024 2 iskwn,nom_opt(lnopt1*inom_opt(1)+1), lsubmodel)
5025 CALL trace_out1()
5026C--------------------------------------------
5027C READING GAUGES
5028C--------------------------------------------
5029 err_msg='GAUGES'
5030 err_category='GAUGES'
5031 CALL trace_in1(err_msg,len_trim(err_msg))
5032 ALLOCATE(lgauge(3*nbgauge) ,stat=stat)
5033 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5034 . msgtype=msgerror,
5035 . c1='LGAUGE')
5036 IF(nbgauge > 0) lgauge=0
5037 ALLOCATE(gauge(llgauge*nbgauge) ,stat=stat)
5038 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5039 . msgtype=msgerror,
5040 . c1='GAUGE')
5041 IF(nbgauge > 0) gauge=zero
5042 IF(nbgauge > 0) CALL hm_read_gauge(lgauge,gauge,itabm1,unitab,ixc,nom_opt(lnopt1*inom_opt(27)+1),lsubmodel)
5043 CALL trace_out1()
5044C--------------------------------------------
5045C READING SENSORS
5046C--------------------------------------------
5047 err_msg='SENSORS'
5048 err_category='SENSORS'
5049 CALL trace_in1(err_msg,len_trim(err_msg))
5050c
5051 ! -------------
5052 ! size initialization for user sensor
5053 CALL sensor_user_init(sensor_user_struct)
5054 ! -------------
5055c
5056 python%NB_SENSORS = 0
5057 CALL hm_read_sensors(python,
5058 . sensors ,laccelm ,itabm1 ,ipart ,lgauge ,
5059 . subsets ,nsets ,igrnod ,
5060 . iskwn ,unitab ,lsubmodel ,hm_nsensor,
5061 . sensor_user_struct)
5062 ! -----------------
5063 ! check if a user sensor is used with a list of node
5064 ! convert the list of User node ID into Local node ID
5065
5066 IF(sensor_user_struct%IS_USED) THEN
5067 IF(sensor_user_struct%POINTER_NODE > 0) THEN
5068 CALL sensor_user_convert_local_id(
5069 . itabm1,sensor_user_struct%POINTER_NODE,sensor_user_struct%NUMBER_NODE,
5070 . sensor_user_struct%NODE_LIST,1,ipart)
5071 ENDIF
5072 ENDIF
5073 ! -----------------
5074 CALL trace_out1()
5075
5076C--------------------------------------------
5077C READING INITIAL VELOCITIES
5078C--------------------------------------------
5079 err_msg='INITIAL VELOCITIES'
5080 err_category='INITIAL VELOCITIES'
5081 CALL trace_in1(err_msg,len_trim(err_msg))
5082C
5083 IF(nrbody > 0) THEN
5084 ALLOCATE(rby_iniaxis(7,nrbody))
5085 rby_iniaxis = zero
5086 ELSE
5087 ALLOCATE(rby_iniaxis(0,0))
5088 ENDIF
5089C
5090 ninivelt = 0 ! /INIVEL w/ T_start
5091 IF(ninvel > 0 ) CALL hm_preread_inivel(lsubmodel,unitab,hm_ninvel,ninivelt)
5092 loads%NINIVELT = ninivelt
5093 IF(ninvel/=0.OR.isigi>=3)THEN
5094 siwork = ninvel
5095 ALLOCATE(iwork(siwork) ,stat=stat)
5096 iwork = 0
5097 WRITE(istdo,'(A)')titre(35)
5098 ALLOCATE(fvm_inivel(ninvel))
5099 DO i = 1, ninvel
5100 fvm_inivel(i)%FLAG = .false.
5101 ENDDO
5102 ALLOCATE(loads%INIVELT(ninivelt) ,stat=stat)
5103C
5104 CALL hm_read_inivel(v , w , itab , itabm1 , vr ,
5105 . igrnod , igrbric, iskwn , skew , iwork ,
5106 . x , unitab , lsubmodel, rtrans , xframe ,
5107 . iframe , vflow , wflow , kxsp , multi_fvm ,
5108 . fvm_inivel, igrquad, igrsh3n , rby_msn, rby_iniaxis,
5109 . sensors ,ninivelt,loads%INIVELT)
5110 CALL inivel(v, vr, svr_1, itabm1)
5111C
5112 IF(ALLOCATED(iwork)) DEALLOCATE(iwork)
5113 ninvel = siwork
5114C
5115 ELSE
5116 ALLOCATE(fvm_inivel(0:0))
5117 ENDIF
5118C
5119 IF(ALLOCATED(rby_msn)) DEALLOCATE(rby_msn)
5120C
5121 CALL trace_out1()
5122
5123C--------------------------------------------
5124C /BCS/WALL - SLIDING BOUNDARY CONDITION
5125C (COLLOCATED SCHEME / LAW 151)
5126C--------------------------------------------
5127 IF(bcs%NUM_WALL /= 0) THEN
5128C READ /BCS/WALL
5129 CALL hm_read_bcs_wall(unitab, lsubmodel, igrnod, ngrnod, sensors, itabm1, numnod, multi_fvm)
5130 ENDIF
5131C--------------------------------------------
5132C /BCS/NRF - NON REFLECTING BOUNDARY CONDITION
5133C--------------------------------------------
5134 IF(bcs%NUM_NRF /= 0) THEN
5135C READ /BCS/WALL
5136 CALL hm_read_bcs_nrf(lsubmodel, igrnod, ngrnod, itabm1, numnod, multi_fvm)
5137 ENDIF
5138
5139C--------------------------------------------
5140C READING PRELOADS
5141C--------------------------------------------
5142 err_msg='BOLT PRELOADING'
5143 err_category='BOLT PRELOADING'
5144 CALL trace_in1(err_msg,len_trim(err_msg))
5145c
5146 npreload_a = npreload
5147 CALL hm_pre_read_preload_axial(ngrspri,igrspring,npreload_a,lsubmodel)
5148 numpreload = npreload
5149 IF(npreload > npreload_a) THEN
5150 IF(nsect /= 0)THEN
5151 CALL prelecsec4bolt(snstrf,ssecbuf,igrnod,itabm1,0,
5152 . nom_opt(lnopt1*inom_opt(8)+1),igrbric,lsubmodel)
5153 ALLOCATE(nstrf(snstrf) ,stat=stat)
5154 ALLOCATE(secbuf(ssecbuf) ,stat=stat)
5155 nstrf = 0
5156 secbuf = zero
5157 CALL lecsec4bolt(ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
5158 2 ixtg ,x ,nstrf ,itab ,itabm1 ,
5159 3 igrnod ,secbuf ,
5160 4 ipari ,ixs10 ,ixs20 ,ixs16 ,unitab ,
5161 5 iskwn ,xframe ,eani,nom_sect,rtrans,
5162 6 lsubmodel,nom_opt(lnopt1*inom_opt(8)+1),igrbric)
5163 ENDIF
5164 CALL hm_pre_read_preload(nstrf,lsubmodel) !to calculate NUMPRELOAD = NUMPRELOAD + NN (NN = NSTRF(K0+7) = NSEGS)
5165 sipreload = 3*numpreload !! sb - A ajuster
5166 spreload = 6*numpreload !! sb - A ajuster
5167 ALLOCATE(ipreload(sipreload) ,stat=stat)
5168 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5169 . msgtype=msgerror,
5170 . c1='IPRELOAD')
5171 ALLOCATE(preload(spreload) ,stat=stat)
5172 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5173 . msgtype=msgerror,
5174 . c1='PRELOAD')
5175 ALLOCATE(iflag_bpreload(numels) ,stat=stat)
5176 IF(stat /= 0) CALL ancmsg(msgid= 268,anmode=aninfo,
5177 . msgtype= msgerror,
5178 . c1= 'IFLAG_BPRELOAD')
5179 ALLOCATE(ipreload_fun(2*numpreload) ,stat=stat)
5180 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5181 . msgtype=msgerror,
5182 . c1='IPRELOAD_FUN')
5183 ipreload = 0
5184 iflag_bpreload = 0
5185 preload = zero
5186 ipreload_fun = 0
5187
5188 WRITE(istdo,'(A)')titre(34)
5189 CALL hm_read_preload(ixs ,ixs10 ,ipreload ,preload,iflag_bpreload,
5190 . nstrf ,sensors ,unitab ,x ,
5191 . eani ,itab ,lsubmodel,
5192 . snpc ,npc ,ipreload_fun)
5193c
5194 IF(ALLOCATED(nstrf)) DEALLOCATE(nstrf)
5195 IF(ALLOCATED(secbuf)) DEALLOCATE(secbuf)
5196 snstrf = 0
5197 ssecbuf = 0
5198 ELSE
5199 ALLOCATE(ipreload(0) ,stat=stat)
5200 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5201 . msgtype=msgerror,
5202 . c1='IPRELOAD')
5203 ALLOCATE(preload(0) ,stat=stat)
5204 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5205 . msgtype=msgerror,
5206 . c1='PRELOAD')
5207 ALLOCATE(iflag_bpreload(0) ,stat=stat)
5208 IF(stat /= 0) CALL ancmsg(msgid= 268,anmode=aninfo,
5209 . msgtype= msgerror,
5210 . c1= 'IFLAG_BPRELOAD')
5211 ALLOCATE(ipreload_fun(0))
5212 ENDIF
5213! /PRELOAD/AXIAL 2 int 2 real per preload, itag_spring...
5214 ALLOCATE(preload_a(npreload_a) ,stat=stat)
5215 ALLOCATE(itagprld_spring(numelr) ,stat=stat)
5216 ALLOCATE(itagprld_beam(numelp) ,stat=stat)
5217 ALLOCATE(itagprld_truss(numelt) ,stat=stat)
5218 IF(stat /= 0) CALL ancmsg(msgid= 268,anmode=aninfo,
5219 . msgtype= msgerror,
5220 . c1= 'PRELOAD_AXIAL')
5221! itagprld_spring(nsprint), itagpre_beam(nbeam) : id of preload/axial; used for element grouping
5222 itagprld_spring = 0
5223 itagprld_beam = 0
5224 itagprld_truss = 0
5225 IF (npreload_a > 0) THEN
5226 CALL hm_read_preload_axial(
5227 . npreload_a, ngrspri, igrspring, itagprld_spring,
5228 . unitab , lsubmodel, preload_a, numelr ,
5229 . snpc , npc , nfunct , sensors ,
5230 . ngrbeam , igrbeam , numelp , itagprld_beam ,
5231 . ngrtrus , igrtruss , numelt , itagprld_truss ,
5232 . iout )
5233 npreload = npreload - npreload_a
5234 END IF
5235 CALL trace_out1()
5236C-------------------------------------------------
5237C READING RIGID LINKS
5238C--------------------------------------------
5239 err_msg='RIGID LINKS'
5240 err_category='RIGID LINKS'
5241 CALL trace_in1(err_msg,len_trim(err_msg))
5242 CALL hm_pre_read_link(numlink, igrnod,lsubmodel)
5243 snnlink = 10*nlink
5244 slnlink = numlink
5245 ALLOCATE(nnlink(snnlink) ,stat=stat)
5246 ALLOCATE(lnlink(slnlink) ,stat=stat)
5247 IF(snnlink > 0) nnlink = 0
5248 IF(slnlink > 0) lnlink = 0
5249 IF(nlink > 0) THEN
5250 CALL hm_read_link(
5251 1 nnlink ,lnlink ,itab ,itabm1 ,d ,
5252 2 igrnod ,iskwn ,iframe ,nom_opt(lnopt1*inom_opt(9)+1),lsubmodel)
5253 ENDIF
5254C
5255 sfbvel = 3*nibvel
5256 sgrav = lfacgrv*ngrav
5257 sfr_wave = numnod*ifrwv
5258 sparts0 = npart
5259 ALLOCATE(fbvel(sfbvel) ,stat=stat)
5260 ALLOCATE(grav(sgrav ) ,stat=stat)
5261 ALLOCATE(fr_wave(sfr_wave) ,stat=stat)
5262 ALLOCATE(parts0(sparts0) ,stat=stat)
5263 IF(sfbvel > 0) fbvel = zero
5264 IF(sgrav > 0) grav = zero
5265 IF(sfr_wave > 0) fr_wave = zero
5266 IF(sparts0 > 0) parts0 = zero
5267c--------------------------------------------
5268 CALL trace_out1()
5269C--------------------------------------------
5270C READING OLD WEIGHTS
5271C--------------------------------------------
5272 CALL prelec_ddw(filnam,len_filnam,marqueur3)
5273 IF(marqueur3) THEN
5274 WRITE(iout,'(A)')' '
5275 WRITE(iout,'(A)')
5276 . ' --------------------------------------'
5277 WRITE(iout,'(A)')
5278 . ' DDW OPTION FOR THE DOMAIN DECOMPOSITION'
5279 WRITE(iout,'(A)')
5280 . ' --------------------------------------'
5281 WRITE(istdo,*)
5282 . '.. DDW OPTION FOR THE DOMAIN DECOMPOSITION'
5283
5284 ALLOCATE(tab_ump_old(7,taille_old),stat=stat)
5285 ALLOCATE(cputime_mp_old(taille_old),stat=stat)
5286 tab_ump_old = 0
5287 cputime_mp_old = zero
5288
5289 CALL lec_ddw(filnam,len_filnam,tab_ump_old,cputime_mp_old)
5290
5291 CALL prelec_ddw_poin(filnam,len_filnam)
5292 ALLOCATE(poin_ump_old(nummat_old), stat=stat)
5293 poin_ump_old = 0
5294
5295 CALL lec_ddw_poin(filnam,len_filnam,poin_ump_old)
5296 ELSE
5297 ALLOCATE(tab_ump_old(0,0),stat=stat)
5298 ALLOCATE(cputime_mp_old(0),stat=stat)
5299 ALLOCATE(poin_ump_old(0), stat=stat)
5300 ENDIF
5301C--------------------------------------------
5302C USER S WINDOW
5303C--------------------------------------------
5304 err_msg='USER WINDOWS'
5305 err_category='USER WINDOWS'
5306 CALL trace_in1(err_msg,len_trim(err_msg))
5307C
5308 IF(user_windows%HAS_USER_WINDOW /= 0 ) THEN
5309!
5310!==============
5311 CALL hm_read_window_user(user_windows,lsubmodel,itab,
5312 * x, v, vr, ms, in)
5313!==============
5314!
5315 ENDIF
5316 CALL trace_out1()
5317C---------------------------
5318C Calculate ELEM RBY ON/OFF for domdec
5319C---------------------------
5320 err_msg='RIGID BODIES ON'
5321 err_category='RIGID BODIES'
5322 CALL trace_in1(err_msg,len_trim(err_msg))
5323 IF(numels /=0) isoloff = 0
5324 IF(numelc /=0) isheoff = 0
5325 IF(numelt /=0) itruoff = 0
5326 IF(numelp /=0) ipouoff = 0
5327 IF(numelr /=0) iresoff = 0
5328 IF(numeltg /=0) itrioff = 0
5329 IF(numelq /=0) iquaoff = 0
5330 CALL setrbyon(
5331 1 ixs ,ixc ,ixtg ,igrnod ,igrnrby ,
5332 2 isoloff ,isheoff ,itrioff,knod2els,knod2elc,
5333 5 knod2eltg,nod2els ,nod2elc,nod2eltg,ixq ,
5334 6 iquaoff ,knod2elq,nod2elq,lsubmodel)
5335 CALL trace_out1()
5336C---------------------------
5337C Calculate ELEM OFF (RBE2) for domdec
5338C---------------------------
5339 err_msg='RBE2 ON'
5340 err_category='RBE2'
5341 CALL trace_in1(err_msg,len_trim(err_msg))
5342 CALL setrb2on(
5343 1 ixs ,ixc ,ixtg ,igrnod ,
5344 2 igrnrb2,isoloff,isheoff,itrioff,itabm1,
5345 3 lsubmodel)
5346 CALL trace_out1()
5347C---------------------------------------------
5348C Calculate FLEXIBLE BODY - ELEM OFF for domdec
5349C---------------------------------------------
5350 err_msg='FLEXIBLE BODIES ON'
5351 err_category='FLEXIBLE BODIES'
5352 CALL trace_in1(err_msg,len_trim(err_msg))
5353 IF(nfxbody > 0)THEN
5354 lenmod=0
5355 CALL hm_setfxrbyon(itabm1,ixs,isoloff,ixc,isheoff,
5356 1 ixt,itruoff,ixp,ipouoff,ixr,iresoff,
5357 2 ixtg,itrioff,fxbipm,lsubmodel)
5358 ENDIF
5359 CALL trace_out1()
5360C--------------------------------------------
5361C READING ELEMENT CLUSTERS
5362C--------------------------------------------
5363 err_msg='CLUSTERS'
5364 err_category='CLUSTERS'
5365 ALLOCATE(clusters(ncluster), stat=stat)
5366 CALL hm_read_cluster(
5367 . clusters ,unitab ,iskwn ,igrbric ,igrspring,
5368 . ixs ,ixr ,nom_opt(lnopt1*inom_opt(28)+1),
5369 . lsubmodel)
5370C--------------------------------------------
5371C READING INITIAL VOLUME FRACTIONS
5372C--------------------------------------------
5373 CALL hm_read_inivol(inivol, kvol, igrsurf ,ipart, multi_fvm, bufmat,
5374 * ipm, nbsubmat, lsubmodel, unitab,
5375 * n2d ,numeltg,numels,numelq,nummat,
5376 * npart,nsurf,lipart1,npropmi,sipart,sinivol,
5377 * nsubdom,sbufmat,igrnod,ngrnod)
5378C--------------------------------------------
5379C Surfaces fictives IGE
5380C--------------------------------------------
5381 IF(tagsurfige>0) THEN
5382 snige = iadtabige
5383 nige => nige_tmp(idxige2)%ptr
5384C--------------------------------------------
5385 srige = iadtabige
5386 rige => rige_tmp(idxige2)%ptr2
5387C--------------------------------------------
5388 sxige = iadtabige
5389 xige => xige_tmp(idxige2)%ptr2
5390C--------------------------------------------
5391 svige = iadtabige
5392 vige => vige_tmp(idxige2)%ptr2
5393 ENDIF
5394 CALL trace_out1()
5395
5396
5397C -------------------------------------------------
5398C Check surfaces for airbags
5399C -------------------------------------------------
5400 CALL check_surf(igrsurf)
5401C----------------------------------
5402C READER FOR MONITORED VOLUMES
5403C----------------------------------
5404 err_msg='MONITORED VOLUMES'
5405 err_category='MONITORED VOLUMES'
5406 CALL trace_in1(err_msg,len_trim(err_msg))
5407 ibagsurf = 0
5408 libagale = 0
5409 lrbagale = 0
5410 nventtot = 0
5411 ALLOCATE(t_monvol(nvolu + nmonvol))
5412 CALL monvol_allocate(nvolu + nmonvol, t_monvol, t_monvol_metadata)
5413 IF(nvolu + nmonvol> 0) THEN
5414 WRITE(istdo,'(A)') ' .. MONITORED VOLUMES '
5415
5416 CALL read_monvol(t_monvol, t_monvol_metadata, itab, itabm1, ipm, igeo,
5417 . x, pm, geo, ixc, ixtg, sensors,
5418 . unitab, npc1, npc, tf, igrsurf, igrbric, nom_opt(lnopt1*inom_opt(2)+1),iframe, xframe,
5419 . lsubmodel)
5420
5421 CALL init_monvol(t_monvol, t_monvol_metadata,
5422 3 ixc , ixtg ,x ,npc1 ,
5423 4 itab , igrsurf ,
5424 5 sensors , igrbric ,sbufale ,
5425 6 ixs , v ,libagale,
5426 7 lrbagale )
5427
5428 libagjet=0
5429 lrbagjet=0
5430 libaghol=0
5431 lrbaghol=0
5432 lrcbag = 0
5433 licbag = nicbag * nvolu * nvolu
5434 DO ii = 1, nvolu
5435 libagjet = libagjet + nibjet * t_monvol(ii)%NJET
5436 lrbagjet = lrbagjet + nrbjet * t_monvol(ii)%NJET
5437 libaghol = libaghol + nibhol * t_monvol(ii)%NVENT
5438 lrbaghol = lrbaghol + nrbhol * t_monvol(ii)%NVENT
5439 IF(t_monvol(ii)%TYPE == 5 .OR. t_monvol(ii)%TYPE == 9) THEN
5440 lrcbag = lrcbag + t_monvol(ii)%NCA * nrcbag
5441 ENDIF
5442 ENDDO
5443
5444 svolmon0 = nrvolu * nvolu + lrcbag + lrbagjet + lrbaghol
5445 svolmon = svolmon0 + sbufale + 1
5446 ALLOCATE(volmon(svolmon), stat = stat)
5447 volmon(1:svolmon) = zero
5448
5449 smonvol = nimv * nvolu + licbag + libagjet + libaghol + libagale
5450 ALLOCATE(monvol(smonvol), stat = stat)
5451 monvol(1:smonvol) = 0
5452 ELSE
5453 ALLOCATE(monvol(0))
5454 ALLOCATE(volmon(0))
5455 ENDIF
5456 CALL trace_out1()
5457C---------------------------
5458C Calculate DOF for implicit domdec
5459C---------------------------
5460 err_msg='IMPLICIT DOMAIN DECOMPOSITION'
5461 err_category='IMPLICIT DOMAIN DECOMPOSITION'
5462 CALL trace_in1(err_msg,len_trim(err_msg))
5463 CALL dsdim0(
5464 1 dsdof,ixs , ixq, ixc , ixt,
5465 2 ixp ,ixr , ixtg, kxx,
5466 3 ixx ,geo )
5467C---------------------------
5468C DOMAIN DECOMPOSITION ON COMPLETE MODEL
5469C CEP array giving the associated processor for each element.
5470C Allocation of size NELEM
5471C---------------------------
5472C IDDLEVEL indicates the domdec level :
5473C 0 == level 1) interfaces not taken into account (input v31)
5474C 1 == level 2) interfaces taken into account in dd (input v41)
5475C---------------------------
5476 iddlevel = 0
5477 nelemint = 0
5478 ifixin = 1
5479 ifiend = 1
5480 DO i = 1, numnod
5481 iwcont(i) = 0
5482 iwcont(numnod+i) = 0
5483 iwcin2(i)= 0
5484 iwcin2(numnod+i)= 0
5485c save IENTRY
5486c replace save of old FRONT
5487c FRONT(I,NSPMD+1) = FRONT(I,1)
5488 ientry2(i) = ifront%IENTRY(i)
5489 ENDDO
5490 DO i=0,maxlaw
5491 sol1tnl(i,1)=zero
5492 sol1tnl(i,2)=zero
5493 sol1tnl(i,3)=zero
5494
5495 sol8tnl(i,1)=zero
5496 sol8tnl(i,2)=zero
5497 sol8tnl(i,3)=zero
5498
5499 DO j=0,3
5500 shtnl(i,j,1)=zero
5501 shtnl(i,j,2)=zero
5502 shtnl(i,j,3)=zero
5503
5504 tritnl(i,j,1)=zero
5505 tritnl(i,j,2)=zero
5506 tritnl(i,j,3)=zero
5507 ENDDO
5508 ENDDO
5509 DO i=1,10
5510 soltelt(i)=zero
5511 shtelt(i)=zero
5512 tritelt(i)=zero
5513 ENDDO
5514 tpsref = zero
5515C Save lagmult array lengths
5516 lag_ncf0 = lag_ncf
5517 lag_nkf0 = lag_nkf
5518 lag_nhf0 = lag_nhf
5519 lag_ncl0 = lag_ncl
5520 lag_nkl0 = lag_nkl
5521 CALL trace_out1()
5522C-----------------
5523C Update stack Due to DRAPE
5524C-------------------------
5525 IF(ndrape > 0 .AND. (ipart_stack > 0 .OR. ipart_pcompp > 0)) THEN
5526 CALL shellthk_upd(drape ,stack ,thke ,ixc ,ixtg ,
5527 . igeo ,iworksh ,drapeg%INDX)
5528 ENDIF
5529C-----------------------------------------------------
5530C READING /PERTURB( random noise on shell/part thicknesses )
5531C-----------------------------------------------------
5532 err_msg='PERTURB'
5533 err_category='PERTURB'
5534 CALL trace_in1(err_msg,len_trim(err_msg))
5535
5536 IF(iperturb /= 0) THEN
5537 srnoise1=nperturb
5538 srnoise2=numelc+numeltg+numels+numsph
5539 ALLOCATE(rnoise(nperturb,numelc+numeltg+numels+numsph))
5540 rnoise(1:nperturb,1:numelc+numeltg+numels+numsph) = zero
5541 ALLOCATE(perturb(nperturb))
5542 perturb(1:nperturb) = 0
5543 ALLOCATE(qp_iperturb(nperturb,6))
5544 qp_iperturb(1:nperturb,1:6) = 0
5545 ALLOCATE(qp_rperturb(nperturb,4))
5546 qp_rperturb(1:nperturb,1:4) = zero
5547 CALL hm_read_perturb(mat_elem%MAT_PARAM,
5548 . ipart ,rnoise ,ipartc ,ipartg ,ipartsp ,
5549 . igrpart ,ipm ,iparts ,perturb ,qp_iperturb,
5550 . qp_rperturb ,lsubmodel,unitab )
5551 ELSE
5552 srnoise1=1
5553 srnoise2=1
5554 ALLOCATE(rnoise(1,1))
5555 rnoise(1,1) = zero
5556 ALLOCATE(perturb(1))
5557 perturb(1) = 0
5558 ALLOCATE(qp_iperturb(0,0))
5559 ALLOCATE(qp_rperturb(0,0))
5560 ENDIF
5561
5562 CALL trace_out1()
5563C-----------------
5564C Global Mat for PID 11 and PID51 (for shell)
5565C-------------------------
5566
5567 CALL globmat(igeo , geo ,pm ,stack%PM, stack%GEO,stack%IGEO,
5568 . mat_elem%MAT_PARAM)
5569
5570C-------------------------
5571C Fill index to renumber Solid elements after Domain Decomposition
5572C Array has 2 parts :
5573C PERMUTATION%SOLID(1:NUMELS) : INDEX(NEW ID)=OLD_ID
5574C PERMUTATION%SOLID(NUMELS+1:2*NUMELS) : INDEX(OLD)=NEW_ID
5575 ALLOCATE(permutation%SOLID(max(2*numels,1)))
5576 ALLOCATE(permutation%SHELL(max(2*numelc,1)))
5577 ALLOCATE(permutation%TRIANGLE(max(2*numeltg,1)))
5578 permutation%TRIANGLE = 0
5579 permutation%SHELL = 0
5580 permutation%SOLID = 0
5581
5582C------------------------------------------------------------------------
5583C REPLACING EXTERNAL IDS OF FCTS AND SKEW BY SYSTEM IDS
5584C------------------------------------------------------------------------
5585 err_msg='USER TO SYSTEM RENUMBERING'
5586 err_category='INTERNAL'
5587 CALL trace_in1(err_msg,len_trim(err_msg))
5588 CALL fsdcod(python, bufmat ,pm ,geo ,ibcl ,ipres ,
5589 . ibfv ,iskew ,iskwn ,sensors ,mat_elem%MAT_PARAM ,
5590 . itabm1 ,skew ,laccelm ,bid13 ,bufgeo ,
5591 . ibcslag ,igeo ,ipm ,
5592 . ibftemp ,ibcv ,ibfv ,
5593 . ibcr ,table ,npc1 ,npc ,tf ,
5594 . nom_opt(lnopt1*inom_opt(3)+1),ibfflux ,glob_therm,nimpvel,nimpdisp,
5595 . nimpacc)
5596C
5597c------------------------------------------------------------------------
5598c Update & check parameters of material laws
5599c------------------------------------------------------------------------
5600 CALL updmat(bufmat ,pm ,ipm ,table ,npc1 ,
5601 . npc ,tf ,sensors ,nloc_dmg ,mlaw_tag ,
5602 . mat_elem%MAT_PARAM)
5603c
5604 CALL updfail(mat_elem%MAT_PARAM ,nummat ,nfunct ,ntable ,npc1 ,table ,
5605 . fail_fractal,ngrshel ,ngrsh3n,igrsh4n ,igrsh3n ,
5606 . nixc ,ixc ,nixtg ,ixtg ,numelc ,numeltg ,
5607 . iworksh ,stack ,igeo ,npropgi ,numgeo ,fail_brokmann)
5608C
5609 CALL trace_out1()
5610C------------------------------------------------------------------------
5611C OPTIONS SPH:
5612C REPLACING EXTERNAL IDS OF FCTS
5613C------------------------------------------------------------------------
5614 CALL trace_in1(err_msg,len_trim(err_msg))
5615 IF(nsphio/=0)
5616 . CALL sphdcod(npc1,isphio,nom_opt(lnopt1*inom_opt(22)+1))
5617 CALL trace_out1()
5618C
5619C------------------------------------------------------------------------
5620C
5621CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
5622C
5623C 100 return address for domain decomposition after reading of contact interfaces or AMS element selection
5624C
5625CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
5626
5627 100 CONTINUE
5628
5629 CALL init_permutation()
5630C
5631 IF(iddlevel==1) THEN
5632 totaddmas = zero
5633 ms = zero
5634 in = zero
5635 mcp = zero
5636 msnf = zero
5637C
5638 IF((nsubdom>0)) THEN
5639C For multidomains - Mass and inertia must be nonzero for coupled nodes
5640 DO i=1,numnod
5641 IF(tagno(i+n_part) > 1) THEN
5642 ms(i)=1e-20
5643 IF(iroddl==1) in(i)=1e-20
5644 ENDIF
5645 END DO
5646 ENDIF
5647C
5648 ENDIF
5649C
5650c-----------------------------------------------------------------------
5651c Create seatbelt entities + domdec
5652c-----------------------------------------------------------------------
5653C
5654 n_seatbelt = 0
5655 IF(nb_mat_seatbelt > 0) THEN
5656 err_msg='SEATBELTS'
5657 err_category='SEATBELTS'
5658 CALL trace_in1(err_msg,len_trim(err_msg))
5659 WRITE(istdo,'(A)')' .. SEATBELT INITIALIZATION'
5660 CALL create_seatbelt(ixr,itab,knod2el1d,nod2el1d,ipm,
5661 . x,sensors,bufmat,pm,geo,
5662 . iddlevel,knod2elc,nod2elc,ixc,igeo,
5663 . iskwn ,tf ,npc)
5664 CALL trace_out1()
5665 ENDIF
5666C
5667C------------------------------------------------------------------
5668C RAYLEIGH DAMPING
5669C--------------------------------------------
5670 IF (ndamp > 0) THEN
5671 IF(iddlevel==0)THEN
5672 err_msg='DAMPING'
5673 err_category='DAMPING'
5674 CALL trace_in1(err_msg,len_trim(err_msg))
5675 IF(ndamp > 0) CALL hm_read_damp(dampr,igrnod,iskwn,lsubmodel,unitab,
5676 . snpc1,npc1,ndamp_vrel_rby,igrpart,damp_range_part)
5677 CALL trace_out1()
5678 ENDIF
5679 ENDIF
5680C
5681c-----------------------------------------------------------------------
5682C
5683 IF(isms == 0) THEN
5684 IF(.NOT. ALLOCATED(tagprt_sms)) THEN
5685 ALLOCATE(tagprt_sms(0))
5686 ALLOCATE(nativ_sms(0))
5687 ALLOCATE(t2main_sms(4,0))
5688 ENDIF
5689 ELSEIF(isms/=0)THEN
5690 err_msg='AMS'
5691 err_category='AMS'
5692 WRITE(istdo,'(A)')' .. AMS INITIALIZATION'
5693 IF(iddlevel==0) THEN
5694C
5695 err_msg='AMS INITIALIZATION PHASE I'
5696 CALL trace_in1(err_msg,len_trim(err_msg))
5697C
5698 ALLOCATE(tagprt_sms(npart),nativ_sms(numnod),t2main_sms(4,numnod),stat=stat)
5699C
5700 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5701 . msgtype=msgerror,
5702 . c1='TAGPRT_SMS / NATIV_SMS / T2MAIN_SMS')
5703 tagprt_sms=0
5704 nativ_sms(1:numnod)=0
5705 t2main_sms=0
5706C
5707 CALL inisms(igrpart ,iparts ,ipartq ,ipartc ,
5708 . ipartt ,ipartp ,ipartr ,ipartg ,
5709 . ipartx ,tagprt_sms )
5710C
5711 CALL trace_out1()
5712C
5713 ELSE
5714C
5715C AMS Prepare DOMETIS
5716C
5717 err_msg='AMS INITIALIZATION PHASE II'
5718 CALL trace_in1(err_msg,len_trim(err_msg))
5719C
5720 ALLOCATE(kinwork(numnod),stat=stat)
5721 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5722 . msgtype=msgerror,
5723 . c1='KINWORK')
5724 CALL kinrem(d ,kinwork ,rwbuf ,itab ,nprw ,
5725 . lprw ,npby ,lpby )
5726C
5727 ALLOCATE(tagrel_sms(ngroup),tagslv_rby_sms(numnod),tagmsr_rby_sms(numnod),
5728 . kad_sms(numnod+1), jad_sms(numnod+1), iad_sms(numnod+1), lad_sms(numnod+1),
5729 . jadc_sms(4*numelc),
5730 . jads_sms(8*numels), jads10_sms(6*numels10),
5731 . jadt_sms(2*numelt),
5732 . jadp_sms(2*numelp),
5733 . jadr_sms(3*numelr),
5734 . jadtg_sms(3*numeltg), jadrb_sms(nrbody),
5735 . stat=stat)
5736 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5737 . msgtype=msgerror,
5738 . c1='TAGREL_SMS')
5739C
5740C
5741 CALL sms_init(
5742 1 ixs ,ixq ,ixc ,ixt ,ixp ,
5743 2 ixr ,ixtg ,ixtg1 ,ixs10 ,ixs16 ,
5744 3 ixs20 ,iparg ,dsdof ,
5745 4 icodt ,icodr ,kinwork ,
5746 5 iparts ,ipartq ,ipartc ,
5747 6 ipartt ,ipartp ,ipartr ,ipartg ,
5748 7 ipartx ,tagprt_sms ,itab ,irbe2 ,
5749 8 irbe3 ,lrbe2 ,lrbe3 ,nprw ,lprw ,
5750 9 ipart ,igeo ,ipm ,nativ_sms,npby ,
5751 a lpby ,tagmsr_rby_sms,tagslv_rby_sms,nom_opt)
5752C
5753 CALL sms_ini_kad(
5754 1 ixs ,ixq ,ixc ,ixt ,ixp ,
5755 2 ixr ,ixtg ,ixtg1 ,ixs10 ,ixs16 ,
5756 3 ixs20 ,iparg ,ms ,ms0 ,dsdof ,
5757 4 icodt ,icodr ,kinet ,
5758 5 kad_sms ,iparts ,ipartq ,
5759 6 ipartc ,ipartt ,ipartp ,ipartr ,
5760 7 ipartg ,ipartx ,tagprt_sms,tagrel_sms,itab ,
5761 8 irbe2 ,irbe3 ,lrbe2 ,lrbe3 ,
5762 9 nprw ,lprw ,ipart ,igeo ,nativ_sms)
5763
5764C
5765 ALLOCATE(kdi_sms(knz_sms),pk_sms(knz_sms),
5766 . stat=stat)
5767 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5768 . msgtype=msgerror,
5769 . c1='KDI_SMS')
5770C
5771 CALL sms_ini_kdi(
5772 2 ixc ,iparg ,ixs ,ixt ,ixp ,
5773 3 ixr ,ixtg ,ixs10 ,dsdof ,kad_sms ,
5774 4 kdi_sms ,jadc_sms,jads_sms ,jads10_sms ,
5775 5 jadt_sms ,jadp_sms,
5776 6 jadr_sms,jadtg_sms,tagprt_sms,iad_sms ,
5777 7 tagrel_sms,iparts ,ipartq ,ipartc ,ipartt ,
5778 8 ipartp ,ipartr ,ipartg ,ipartx ,
5779 9 npby ,lpby ,kinet ,tagslv_rby_sms,ipari ,
5780 a intbuf_tab,lad_sms ,ipart ,igeo ,nativ_sms)
5781C
5782 ALLOCATE(idi_sms(nnz_sms),jdi_sms(nnz_sms),stat=stat)
5783 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5784 . msgtype=msgerror,
5785 . c1='JDI_SMS')
5786C
5787 CALL sms_ini_jad_1(
5788 2 ixc ,iparg ,ixs ,ixt ,ixp ,
5789 3 ixr ,ixtg ,ixs10 ,dsdof ,jadc_sms ,
5790 4 jads_sms ,jads10_sms,jadt_sms ,jadp_sms,jadr_sms ,
5791 5 jadtg_sms,tagprt_sms,kad_sms,kdi_sms ,pk_sms ,
5792 6 tagrel_sms,iparts ,ipartq ,ipartc ,ipartt ,
5793 7 ipartp ,ipartr ,ipartg ,ipartx ,
5794 8 npby ,lpby ,kinet ,tagslv_rby_sms,ipari ,
5795 9 intbuf_tab,lad_sms ,ipart ,igeo ,nativ_sms ,
5796 a iad_sms ,idi_sms,jad_sms ,jdi_sms ,t2main_sms)
5797
5798 DEALLOCATE(jdi_sms)
5799
5800 ALLOCATE(jdi_sms(nnz_sms),stat=stat)
5801 IF(stat/=0) THEN
5802 CALL ancmsg(msgid=268,anmode=aninfo,
5803 . msgtype=msgerror,
5804 . c1='JDI_SMS')
5805 CALL arret(2)
5806 ENDIF
5807
5808 CALL sms_ini_jad_2(
5809 2 ixc ,iparg ,ixs ,ixt ,ixp ,
5810 3 ixr ,ixtg ,ixs10 ,dsdof ,jadc_sms ,
5811 4 jads_sms ,jads10_sms,jadt_sms,jadp_sms,jadr_sms ,
5812 5 jadtg_sms,tagprt_sms,kad_sms,kdi_sms ,
5813 7 tagrel_sms,iparts ,ipartq ,ipartc ,ipartt ,
5814 8 ipartp ,ipartr ,ipartg ,ipartx ,
5815 9 npby ,lpby ,kinet ,tagslv_rby_sms,ipari ,
5816 a intbuf_tab,lad_sms ,nprw ,lprw ,tagmsr_rby_sms,
5817 c intstamp ,ipart ,igeo ,nativ_sms,irbe2 ,
5818 d lrbe2 ,iad_sms ,idi_sms,jad_sms ,jdi_sms ,
5819 e t2main_sms)
5820
5821 DEALLOCATE(jdi_sms)
5822
5823 ALLOCATE(jdi_sms(nnz_sms),stat=stat)
5824 IF(stat/=0) THEN
5825 CALL ancmsg(msgid=268,anmode=aninfo,
5826 . msgtype=msgerror,
5827 . c1='JDI_SMS')
5828 CALL arret(2)
5829 ENDIF
5830 ALLOCATE(jsm_sms(nnz_sms),stat=stat)
5831 IF(stat/=0) THEN
5832 CALL ancmsg(msgid=268,anmode=aninfo,
5833 . msgtype=msgerror,
5834 . c1='JSM_SMS')
5835 CALL arret(2)
5836 ENDIF
5837C
5838 CALL sms_ini_jad_3(
5839 2 ixc ,iparg ,ixs ,ixt ,ixp ,
5840 3 ixr ,ixtg ,ixs10 ,dsdof ,jadc_sms,
5841 4 jads_sms ,jads10_sms,jadt_sms ,jadp_sms,jadr_sms ,
5842 5 jadtg_sms,tagprt_sms,kad_sms ,kdi_sms ,
5843 6 tagrel_sms,iparts ,ipartq ,ipartc ,ipartt ,
5844 7 ipartp ,ipartr ,ipartg ,ipartx ,
5845 8 npby ,lpby ,kinet ,
5846 9 tagslv_rby_sms,ipari ,intbuf_tab,
5847 a lad_sms ,jsm_sms ,intstamp ,ipart ,
5848 b igeo ,tagmsr_rby_sms,nativ_sms,
5849 c iad_sms ,idi_sms,jad_sms ,jdi_sms ,t2main_sms)
5850C
5851 DEALLOCATE(kinwork)
5852 DEALLOCATE(t2main_sms)
5853 CALL trace_out1()
5854C
5855C If no element selected AMS is deactivated
5856 IF((isms_selec >= 2).AND.(nnz_sms == 0)) isms_selec = 0
5857C
5858 END IF
5859C
5860 END IF
5861C-----
5862 nelem = numelc+numeltg+numels+numelr
5863 + + numelp+numelt+numelq+numelx+numelig3d
5864C
5865
5866 ALLOCATE(ielem21(nelem),stat=stat)
5867 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5868 . msgtype=msgerror,
5869 . c1='IELEM21')
5870 ielem21=0
5871C
5872 err_msg='DOMAIN DECOMPOSITION'
5873 err_category='DOMAIN DECOMPOSITION'
5874 CALL trace_in1(err_msg,len_trim(err_msg))
5875 IF(iddlevel==1) THEN
5876 ngroup = 0
5877 lbufel = 0
5878 segindx=0
5879c treatment for new IFRONT
5880c reinit
5881 CALL ini_ifront()
5882c reset with savec IENTRY2
5883 DO i=1,numnod
5884 IF(ientry2(i)/=-1)THEN
5885 CALL ifrontplus(i,1)
5886 ENDIF
5887 ENDDO
5888C Update of FRONT for processors different from 0
5889C You have to take into account the options or front (i, p) = 1, p <> 1
5890C Type 2 sensors modify front on p<>1
5891 ELSEIF(iddlevel==0) THEN
5892 IF(nelem+nconld+glob_therm%NUMCONV+glob_therm%NUMRADIA+glob_therm%NFXFLUX+slcfield>0) THEN
5893 scep = nelem+nconld+glob_therm%NUMCONV+glob_therm%NUMRADIA+glob_therm%NFXFLUX+slloadp+number_load_cyl
5894 scel = nelem+nconld+glob_therm%NUMCONV+glob_therm%NUMRADIA+glob_therm%NFXFLUX+slloadp+number_load_cyl
5895 ALLOCATE(cep(scep))
5896 ALLOCATE(cel(scel))
5897 ELSE
5898 scep = 1
5899 scel = 1
5900 ALLOCATE(cep(scep))
5901 ALLOCATE(cel(scel))
5902 ENDIF
5903 ENDIF
5904 emax = max(numelc,numeltg,numels,numelr,
5905 . numelp,numelt,numelq,numelx,numelig3d)
5906 k1 = 1
5907 k2 = k1+emax
5908 k3 = k2+emax
5909 k4 = k3+2*emax
5910 k5 = k4+2*emax
5911 k6 = k5 + nelem
5912 k7 = k6 + nelem
5913 k8 = k7 + nelem
5914C Average allowance normally sufficient if average group size> NVSIZ/2
5915 ldd_iad = ((nelem+numsph)/nvsiz/2)*(nspmd+1)
5916 ALLOCATE(dd_tmp(ldd_iad) ,stat=stat)
5917 dd_tmp = 0
5918 idx = 1
5919
5920 ALLOCATE(iwork(k8) ,stat=stat)
5921 IF(emax>0) THEN
5922 itri1 => iwork(1:k2)
5923 itri2 => iwork(k2+1:k3)
5924 index1 => iwork(k3+1:k4)
5925 index2 => iwork(k4+1:k5)
5926 ELSE
5927 itri1 => iwork
5928 itri2 => iwork
5929 index1 => iwork
5930 index2 => iwork
5931 END IF
5932 IF(nelem>0) THEN
5933 inum => iwork(k5+1:k6)
5934 iwd => iwork(k6+1:k7)
5935 iweig => iwork(k7+1:k8)
5936 ELSE
5937 inum => iwork
5938 iwd => iwork
5939 iweig => iwork
5940 END IF
5941
5942 IF(.NOT.ALLOCATED(inter_cand%IXINT)) ALLOCATE(inter_cand%IXINT(inter_cand%S_IXINT_1,inter_cand%S_IXINT_2))
5943 IF(.NOT. ALLOCATED(npby)) ALLOCATE(npby(0))
5944 IF(.NOT. ALLOCATED(lpby)) ALLOCATE(lpby(0))
5945 IF(.NOT. ALLOCATED( rby)) ALLOCATE( rby(0))
5946
5947 CALL dometis(
5948 1 ixs ,ixq ,ixc ,ixt ,ixp ,
5949 2 ixr ,ixtg ,cep ,geo ,
5950 3 itri1 ,itri2 ,index1 ,index2 ,inum ,
5951 4 iwd ,iwcont ,nelem ,iddlevel,nelemint ,
5952 5 inter_cand,pm ,x ,kxx ,ixx ,
5953 6 addcne ,igeo ,eani ,iwcin2 ,dsdof ,
5954 7 isoloff ,isheoff ,itrioff ,itruoff ,ipouoff ,
5955 8 iresoff ,ielem21 ,ipm ,ixs10 ,d ,
5956 9 clusters ,kxig3d ,ixig3d ,cost_r2r,bufmat,
5957 1 taille ,poin_ump,tab_ump ,
5958 2 poin_ump_old,tab_ump_old,cputime_mp_old,
5959 3 nsnt, nmnt_2,tabmp_l,iquaoff,
5960 4 igrsurf , fvmain,
5961 5 itab ,ipart ,ipartc ,ipartg ,iparts,
5962 6 poin_part_shell,poin_part_tri,poin_part_sol,
5963 7 mid_pid_shell,mid_pid_tri,mid_pid_sol,t_monvol,
5964 8 ebcs_tag_cell_spmd,npby,lpby,mat_elem%MAT_PARAM)
5965
5966 DEALLOCATE(iwork)
5967C---------------------------
5968C Domdec SPH
5969C---------------------------
5970 IF(numsph > 0)THEN
5971 IF(iddlevel==0) THEN
5972 ALLOCATE(cepsp(numsph),stat=stat)
5973 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5974 . msgtype=msgerror,
5975 . c1='CEPSP')
5976
5977 ALLOCATE(celsph(numsph),stat=stat)
5978 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5979 . msgtype=msgerror,
5980 . c1='CELSPH')
5981 END IF
5982
5983 CALL spdometis(kxsp, ixsp, nod2sp, cepsp, reservep,
5984 . sph2sol, cep)
5985 ELSE
5986 IF(iddlevel==0) ALLOCATE(celsph(1))
5987 IF(.NOT.(ALLOCATED(cepsp))) ALLOCATE(cepsp(0),stat=stat)
5988 END IF
5989C---------------------------
5990C IMPACTS LASER TRAITEMENT SPMD 1ere Phase
5991C---------------------------
5992 IF(nlaser>0) THEN
5993 CALL laserp1(ilas ,cep,ixq )
5994 ENDIF
5995 off = 1
5996 CALL trace_out1()
5997C---------------------------
5998C DEFINE ELEMENT GROUPS
5999C---------------------------
6000 err_msg='ELEMENTS GROUPS'
6001 err_category='ELEM/PROP/MAT COMPATIBILITY'
6002 CALL trace_in1(err_msg,len_trim(err_msg))
6003
6004 numelck8 = numelc
6005 numeltgk8 = numeltg
6006 numelsk8 = numels
6007 numelrk8 = numelr
6008 numelpk8 = numelp
6009 numeltk8 = numelt
6010 numelqk8 = numelq
6011 numelxk8 = numelx
6012 numelig3dk8 = numelig3d
6013 numsphk8 = numsph
6014! working int8 to avoid integer overflow for large models
6015 emax = max(24*numelck8,25*numeltgk8+1,30*numelsk8+1,19*numelrk8,
6016 . 19*numelpk8+1,17*numeltk8,19*numelqk8,
6017 . 15*numelxk8+1,24*numelig3dk8+1,numsphk8) + 1
6018
6019 ALLOCATE(ipargtmp(nparg,numel) ,stat=stat)
6020 ipargtmp = 0
6021 ALLOCATE(iwork(emax) ,stat=stat)
6022 IF(stat /= 0) THEN
6023 CALL ancmsg(msgid=727,
6024 . msgtype=msgerror,
6025 . anmode=anstop,
6026 . c1='IPARG')
6027 ENDIF
6028C REPLACEMENT OF OUR EXTERNALS OF SS-MATERIAUX BY OUR SYSTEMS
6029 IF(iddlevel == 0) CALL m20dcod(mlaw_tag,ipm, pm, mat_elem%MAT_PARAM)
6030C
6031C Temporary address of DD_IAD
6032C Number of super groups
6033 nspgroup = 0
6034C Buffer Max (super group)
6035 lb_max = 0
6036C
6037 WRITE(istdo,'(A)')titre(37)
6038C---------------------------------
6039C- PRE-SORTING + SUPER GROUPS
6040C---------------------------------
6041 ngr_sol = 0
6042 IF(numels/=0) THEN
6043 k0 = 1
6044 k1 = k0 + numels*16
6045 k2 = k1 + numels
6046 k3 = k2 + numels+1
6047 k4 = k3 + numels*2
6048 k5 = k4 + numels*8
6049 !K5B= K4 + NUMELS
6050 k6 = k5 + numels
6051 !warning: please also update any index change
6052 ! for MODIF option (MODIF_SPMD.F)
6053 iwork = 0
6054 inum => iwork(1:k1)
6055 itri1 => iwork(k1+1:k2)
6056 eadd => iwork(k2+1:k3)
6057 index1 => iwork(k3+1:k4)
6058 itri2 => iwork(k4+1:k5)
6059 itri3 => iwork(k5+1:k6)
6060C
6061C
6062 CALL sgrhead(
6063 1 ixs ,pm ,geo ,inum ,bid13 ,
6064 2 itri1 ,eadd ,index1 ,itri2 ,iparts ,
6065 3 nd ,igrsurf,igrbric,eani ,
6066 4 cep(off),itri3 ,ixs10 ,ixs20 ,ixs16 ,
6067 5 igeo ,ipm ,nod2els,isoloff ,
6068 6 tagprt_sms,sph2sol,sol2sph,mat_elem%MAT_PARAM,
6069 7 sol2sph_typ ,iflag_bpreload, clusters ,
6070 8 rnoise(1,min(srnoise2,numelc+numeltg+1)),
6071 9 damp_range_part,trimat)
6072C---------------------------------
6073C- GROUPAGE SPMD
6074C---------------------------------
6075C LDD_IAD Non -Department Test
6076 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6077 ALLOCATE(dd_tmp2(idx-1))
6078 DO i = 1, idx-1
6079 dd_tmp2(i)=dd_tmp(i)
6080 END DO
6081 DEALLOCATE(dd_tmp)
6082 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6083 DO i = 1, idx-1
6084 dd_tmp(i)=dd_tmp2(i)
6085 END DO
6086 DEALLOCATE(dd_tmp2)
6087 END IF
6088C
6089 grsol_id1 = ngroup
6090 CALL sgrtails(
6091 1 ixs ,pm ,ipargtmp ,geo ,
6092 2 eadd ,nd ,iparts ,dd_tmp(idx),
6093 3 idx ,eani ,inum ,index1 ,
6094 4 cep(off) ,itri1 ,ixs10 ,igrsurf ,igrbric ,
6095 5 ixs20 ,ixs16 ,igeo ,iddlevel,
6096 6 ipm ,nod2els ,isoloff ,isolnod ,
6097 7 tagprt_sms,inivol ,sph2sol ,sol2sph ,sol2sph_typ,
6098 8 iflag_bpreload, clusters ,mat_elem%MAT_PARAM ,rnoise(1,min(srnoise2,numelc+numeltg+1)),
6099 9 ipri ,damp_range_part,ipreload_fun)
6100 grsol_id2 = ngroup
6101 ngr_sol = grsol_id2 - grsol_id1
6102C
6103 off = off + numels
6104C After IDDLEVEL Finish Indexes - Fill PERMUTATION%SOLID(NUMELS+1,PERMUTATION%SOLID(2*NUMELS)
6105 DO i=1,numels
6106 n=permutation%SOLID(i)
6107 permutation%SOLID(numels+n)=i
6108 ENDDO
6109! already done in SGRHEAD / SGRTAILS
6110! CALL APPLYSORT2CLUSTER(CLUSTERS,PERMUTATION%SOLID(NUMELS+1:2*NUMELS))
6111 CALL applysort2flux(ibfflux,glob_therm%NITFLUX,glob_therm%NFXFLUX,permutation%SOLID(numels+1:2*numels))
6112 CALL applysort2flux(ibcr,glob_therm%NIRADIA,glob_therm%NUMRADIA,permutation%SOLID(numels+1:2*numels))
6113 CALL applysort2flux(ibcv,glob_therm%NICONV,glob_therm%NUMCONV,permutation%SOLID(numels+1:2*numels))
6114 ENDIF
6115
6116C
6117C---- QUADS
6118C
6119 IF(numelq/=0) THEN
6120 k1 = 9*numelq
6121 k2 = 10*numelq
6122 k3 = 11*numelq+1
6123 k4 = 13*numelq+1
6124 k5 = 18*numelq+1
6125 k6 = 19*numelq+1
6126 !warning: please also update any index change
6127 ! for MODIF option (MODIF_SPMD.F)
6128 iwork = 0
6129 inum => iwork(1:k1)
6130 itr1 => iwork(k1+1:k2)
6131 eadd => iwork(k2+1:k3)
6132 index1 => iwork(k3+1:k4)
6133 itri1 => iwork(k4+1:k5)
6134 xep => iwork(k5+1:k6)
6135C
6136 CALL qgrhead(
6137 1 ixq ,pm ,geo ,inum ,bid13 ,
6138 2 itr1 ,eadd ,index1 ,itri1 ,ipartq ,
6139 4 nd ,igrsurf ,igrquad ,cep(off) ,mat_elem%MAT_PARAM,
6140 5 xep ,igeo ,ipm ,iquaoff ,trimat)
6141C---------------------------------
6142C- GROUPAGE SPMD
6143C---------------------------------
6144C LDD_IAD Non -Department Test
6145 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6146 ALLOCATE(dd_tmp2(idx-1))
6147 DO i = 1, idx-1
6148 dd_tmp2(i)=dd_tmp(i)
6149 END DO
6150 DEALLOCATE(dd_tmp)
6151 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6152 DO i = 1, idx-1
6153 dd_tmp(i)=dd_tmp2(i)
6154 END DO
6155 DEALLOCATE(dd_tmp2)
6156 END IF
6157C
6158 CALL qgrtails(
6159 1 ixq ,pm ,ipargtmp ,geo ,
6160 2 eadd ,nd ,dd_tmp(idx),idx ,
6161 3 inum ,index1 ,cep(off) ,ipartq ,
6162 4 itr1 ,igrsurf ,igrquad ,mat_elem%MAT_PARAM,
6163 5 igeo ,ipm ,iquaoff ,inivol, ipri)
6164 off = off + numelq
6165 ENDIF
6166C
6167C---- COQUES
6168C
6169 IF(numelc/=0) THEN
6170C---------------------------------
6171C- PRE-SORTING + SUPER GROUPS
6172C---------------------------------
6173 k0 = 1
6174 k1 = 9*numelc
6175 k2 = 11*numelc
6176 k3 = 12*numelc+1
6177 k4 = 14*numelc+1
6178 k5 = 22*numelc+1
6179 k6 = 23*numelc+1
6180 k7 = 24*numelc+1
6181 !warning: please also update any index change
6182 ! for MODIF option (MODIF_SPMD.F)
6183 iwork = 0
6184 inum => iwork(1:k1)
6185 itr1 => iwork(k1+1:k1+numelc)
6186 itr2 => iwork(k1+numelc+1:k2)
6187 eadd => iwork(k2+1:k3)
6188 index1 => iwork(k3+1:k4)
6189 itri1 => iwork(k4+1:k5)
6190 xep => iwork(k5+1:k6)
6191 ALLOCATE(xnum(numelc) ,stat=stat)
6192 xnum = zero
6193C
6194 CALL cgrhead(
6195 1 ixc ,pm ,geo ,inum ,bid13 ,
6196 2 itr1 ,eadd ,index1 ,itri1 ,xnum ,
6197 3 ipartc ,nd ,thke ,igrsurf ,igrsh4n ,
6198 4 cep(off),xep ,igeo ,ipm ,
6199 5 ipart ,sh4tree ,nod2elc ,isheoff ,sh4trim ,
6200 6 tagprt_sms,lgauge,iworksh ,mat_elem%MAT_PARAM,
6201 7 stack ,drape ,rnoise ,sh4ang,drapeg, ptshel,
6202 8 damp_range_part)
6203C---------------------------------
6204C- GROUPAGE SPMD
6205C---------------------------------
6206c
6207C LDD_IAD Non -Department Test
6208 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6209 ALLOCATE(dd_tmp2(idx-1))
6210 DO i = 1, idx-1
6211 dd_tmp2(i)=dd_tmp(i)
6212 END DO
6213 DEALLOCATE(dd_tmp)
6214 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6215 DO i = 1, idx-1
6216 dd_tmp(i)=dd_tmp2(i)
6217 END DO
6218 DEALLOCATE(dd_tmp2)
6219 END IF
6220
6221C
6222 CALL cgrtails(
6223 1 ixc ,pm ,ipargtmp ,geo ,
6224 2 eadd ,nd ,ipartc ,dd_tmp ,
6225 3 idx ,inum ,itr1 ,
6226 4 index1 ,cep(off) ,thke ,xnum ,
6227 5 igrsurf ,igrsh4n ,igeo ,ipm ,
6228 6 ipart ,sh4tree ,nod2elc ,isheoff ,
6229 7 sh4trim ,tagprt_sms, lgauge,iworksh ,
6230 8 stack ,drape ,rnoise ,mat_elem%MAT_PARAM,
6231 9 sh4ang, iddlevel , drapeg,ipri, ptshel,damp_range_part)
6232
6233 off = off + numelc
6234
6235 DO i=1,numelc
6236 n=permutation%SHELL(i)
6237 permutation%SHELL(numelc+n)=i
6238 ENDDO
6239
6240 DEALLOCATE(xnum)
6241 ENDIF
6242C------
6243 IF(numelt/=0) THEN
6244 k1 = 7*numelt
6245 k2 = 8*numelt
6246 k3 = 9*numelt+1
6247 k4 = 11*numelt+1
6248 k5 = 16*numelt+1
6249 k6 = 17*numelt+1
6250 !warning: please also update any index change
6251 ! for MODIF option (MODIF_SPMD.F)
6252 iwork = 0
6253 inum => iwork(1:k1)
6254 itr1 => iwork(k1+1:k2)
6255 eadd => iwork(k2+1:k3)
6256 index1 => iwork(k3+1:k4)
6257 itri1 => iwork(k4+1:k5)
6258 xep => iwork(k5+1:k6)
6259C
6260 CALL tgrhead(
6261 1 ixt ,pm ,geo ,inum ,bid13 ,
6262 2 itr1 ,eadd ,index1 ,itri1 ,
6263 3 ipartt ,nd ,igrsurf,igrtruss,
6264 4 cep(off),xep ,itruoff,
6265 5 tagprt_sms,itagprld_truss)
6266C---------------------------------
6267C- GROUPAGE SPMD
6268C---------------------------------
6269C LDD_IAD Non -Department Test
6270 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6271 ALLOCATE(dd_tmp2(idx-1))
6272 DO i = 1, idx-1
6273 dd_tmp2(i)=dd_tmp(i)
6274 END DO
6275 DEALLOCATE(dd_tmp)
6276 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6277 DO i = 1, idx-1
6278 dd_tmp(i)=dd_tmp2(i)
6279 END DO
6280 DEALLOCATE(dd_tmp2)
6281 END IF
6282C
6283 CALL tgrtails(
6284 1 ixt ,ipargtmp,pm ,geo ,
6285 2 eadd ,nd ,dd_tmp ,idx ,
6286 3 inum ,index1 ,cep(off) ,ipartt ,
6287 4 itr1 ,igrsurf ,igrtruss ,itruoff ,
6288 5 tagprt_sms,nod2el1d,ipri,itagprld_truss,
6289 6 preload_a,npreload_a)
6290 off = off + numelt
6291 ENDIF
6292C
6293C-----
6294 IF(numelp > 0) THEN
6295 k1 = 9*numelp
6296 k2 = 10*numelp
6297 k3 = 11*numelp+1
6298 k4 = 13*numelp+1
6299 k5 = 18*numelp+1
6300 k6 = 19*numelp+1
6301 !warning: please also update any index change
6302 ! for MODIF option (MODIF_SPMD.F)
6303 iwork = 0
6304 inum => iwork(1:k1)
6305 itr1 => iwork(k1+1:k2)
6306 eadd => iwork(k2+1:k3)
6307 index1 => iwork(k3+1:k4)
6308 itri1 => iwork(k4+1:k5)
6309 xep => iwork(k5+1:k6)
6310C
6311 ALLOCATE(xnum(3*numelp) ,stat=stat)
6312 xnum(1:3*numelp) = zero
6313C
6314 CALL pgrhead(
6315 1 ixp ,pm ,geo ,inum ,
6316 2 itr1 ,eadd ,index1 ,itri1 ,ipartp ,
6317 3 nd ,igrsurf ,igrbeam ,cep(off) ,
6318 4 xep ,igeo ,ipouoff ,tagprt_sms , ipm ,
6319 5 itagprld_beam,ibeam_vector,rbeam_vector,xnum)
6320C---------------------------------
6321C- GROUPAGE SPMD
6322C---------------------------------
6323C LDD_IAD Non -Department Test
6324 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6325 ALLOCATE(dd_tmp2(idx-1))
6326 DO i = 1, idx-1
6327 dd_tmp2(i)=dd_tmp(i)
6328 END DO
6329 DEALLOCATE(dd_tmp)
6330 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6331 DO i = 1, idx-1
6332 dd_tmp(i)=dd_tmp2(i)
6333 END DO
6334 DEALLOCATE(dd_tmp2)
6335 END IF
6336C
6337 CALL pgrtails(mat_elem%MAT_PARAM,
6338 1 ixp ,ipargtmp,pm ,geo ,
6339 2 eadd ,nd ,dd_tmp ,idx ,
6340 3 inum ,index1 ,cep(off) ,ipartp ,
6341 4 itr1 ,igrsurf ,igrbeam ,igeo ,
6342 5 ipm ,ipouoff ,tagprt_sms,
6343 6 nod2el1d, ipri ,itagprld_beam,preload_a,
6344 7 npreload_a,ibeam_vector,rbeam_vector,xnum)
6345C
6346 off = off + numelp
6347C
6348 DEALLOCATE(xnum)
6349 ENDIF
6350C
6351C-----
6352C
6353 IF(numelr/=0) THEN
6354 k1 = 9*numelr
6355 k2 = 10*numelr
6356 k3 = 11*numelr+1
6357 k4 = 13*numelr+1
6358 k5 = 18*numelr+1
6359 k6 = 19*numelr+1
6360 !warning: please also update any index change
6361 ! for MODIF option (MODIF_SPMD.F)
6362 iwork = 0
6363 inum => iwork(1:k1)
6364 itr1 => iwork(k1+1:k2)
6365 eadd => iwork(k2+1:k3)
6366 index1 => iwork(k3+1:k4)
6367 itri1 => iwork(k4+1:k5)
6368 xep => iwork(k5+1:k6)
6369C
6370 CALL rgrhead(
6371 1 ixr ,geo ,inum ,bid13 ,igeo ,
6372 2 itr1 ,eadd ,index1 ,itri1 ,
6373 4 ipartr ,nd ,igrsurf,igrspring,
6374 5 cep(off),xep ,iresoff,
6375 6 tagprt_sms, clusters,ipm,r_skew,itagprld_spring)
6376C---------------------------------
6377C- GROUPAGE SPMD
6378C---------------------------------
6379C LDD_IAD Non -Department Test
6380 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6381 ALLOCATE(dd_tmp2(idx-1))
6382 DO i = 1, idx-1
6383 dd_tmp2(i)=dd_tmp(i)
6384 END DO
6385 DEALLOCATE(dd_tmp)
6386 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6387 DO i = 1, idx-1
6388 dd_tmp(i)=dd_tmp2(i)
6389 END DO
6390 DEALLOCATE(dd_tmp2)
6391 END IF
6392C
6393 CALL rgrtails(
6394 1 ixr ,ipargtmp ,geo ,eadd ,igeo ,
6395 2 nd ,dd_tmp ,idx ,inum ,
6396 3 index1 ,cep(off) ,ipartr ,itr1 ,
6397 4 igrsurf ,igrspring ,iresoff ,tagprt_sms ,nod2el1d,
6398 5 ipm , clusters,r_skew,ipri ,itagprld_spring,
6399 6 preload_a,npreload_a)
6400 off = off + numelr
6401 ENDIF
6402C
6403 IF(numeltg/=0) THEN
6404C---------------------------------
6405C- PRE-SORTING + SUPER GROUPS
6406C---------------------------------
6407 k1 = 10*numeltg
6408 k2 = 12*numeltg
6409 k3 = 13*numeltg+1
6410 k4 = 15*numeltg+1
6411 k5 = 23*numeltg+1
6412 k6 = 24*numeltg+1
6413 k7 = 25*numeltg+1
6414 k8 = 26*numeltg+1
6415 !warning: please also update any index change
6416 ! for MODIF option (MODIF_SPMD.F)
6417 iwork = 0
6418 inum => iwork(1:k1)
6419 itr1 => iwork(k1+1:k2)
6420 eadd => iwork(k2+1:k3)
6421 index1 => iwork(k3+1:k4)
6422 itri1 => iwork(k4+1:k5)
6423 xep => iwork(k5+1:k6)
6424
6425 ALLOCATE(xnum(numeltg) ,stat=stat)
6426 xnum = zero
6427
6428 IF(numeltg6>0) THEN
6429 CALL cdk6inx(ixtg ,ixtg1 ,eanit )
6430 ENDIF
6431 IF(n2d==0)THEN
6432 CALL c3grhead(
6433 1 ixtg ,pm ,geo ,inum ,bid13 ,
6434 2 itr1 ,eadd ,index1 ,itri1 ,xnum ,
6435 3 ipartg ,nd ,thkec ,igrsurf ,igrsh3n ,
6436 4 cep(off),xep ,ixtg1 ,eanit ,
6437 5 igeo ,ipm ,ipart ,sh3tree ,nod2eltg,
6438 6 itrioff ,sh3trim ,tagprt_sms,
6439 7 iworksh , stack ,drape ,rnoise(1,min(srnoise2,numelc+1)),
6440 8 multi_fvm , sh3ang,drapeg,ptsh3n,mat_elem%MAT_PARAM,
6441 9 damp_range_part)
6442 ELSE
6443 CALL t3grhead(
6444 1 ixtg ,pm ,geo ,inum ,bid13 ,
6445 2 itr1 ,eadd ,index1 ,itri1 ,xnum ,
6446 3 ipartg ,nd ,thkec ,igrsurf ,igrsh3n ,
6447 4 cep(off),xep ,ixtg1 ,eanit ,
6448 5 igeo ,ipm ,ipart ,sh3tree ,nod2eltg,
6449 6 itrioff ,sh3trim ,tagprt_sms,mat_elem%MAT_PARAM,
6450 7 iworksh , stack ,drape ,rnoise(1,min(srnoise2,numelc+1)),
6451 8 multi_fvm ,sh3ang,drapeg,ptsh3n)
6452 ENDIF
6453C---------------------------------
6454C- GROUPAGE SPMD
6455C---------------------------------
6456C LDD_IAD Non -Department Test
6457 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6458 ALLOCATE(dd_tmp2(idx-1))
6459 DO i = 1, idx-1
6460 dd_tmp2(i)=dd_tmp(i)
6461 END DO
6462 DEALLOCATE(dd_tmp)
6463 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6464 DO i = 1, idx-1
6465 dd_tmp(i)=dd_tmp2(i)
6466 END DO
6467 DEALLOCATE(dd_tmp2)
6468 END IF
6469C
6470 IF(n2d==0)THEN
6471 CALL c3grtails(
6472 1 ixtg ,pm ,ipargtmp ,geo ,
6473 2 eadd ,nd ,ipartg ,dd_tmp ,
6474 3 idx ,inum ,index1 ,cep(off) ,
6475 4 thkec ,xnum ,itr1 ,igrsurf ,igrsh3n ,
6476 5 eanit ,igeo ,ipm ,ixtg1 ,
6477 6 ipart ,sh3tree ,nod2eltg ,itrioff ,
6478 7 sh3trim ,tagprt_sms,iworksh ,stack ,
6479 8 drape ,rnoise(1,min(srnoise2,numelc+1)) ,
6480 9 mat_elem%MAT_PARAM,sh3ang,drapeg,ipri ,ptsh3n,damp_range_part)
6481 ELSE
6482 CALL t3grtails(
6483 1 ixtg ,pm ,ipargtmp ,geo ,
6484 2 eadd ,nd ,ipartg ,dd_tmp ,
6485 3 idx ,inum ,index1 ,cep(off) ,
6486 4 thkec ,xnum ,itr1 ,igrsurf ,igrsh3n ,
6487 5 eanit ,igeo ,ipm ,ixtg1 ,
6488 6 ipart ,sh3tree ,nod2eltg ,itrioff ,
6489 7 sh3trim ,tagprt_sms,iworksh ,stack ,
6490 8 drape ,rnoise(1,min(srnoise2,numelc+1)) ,inivol,
6491 9 mat_elem%MAT_PARAM,sh3ang ,drapeg,ipri,ptsh3n)
6492 ENDIF
6493 off = off + numeltg
6494 DO i=1,numeltg
6495 n=permutation%TRIANGLE(i)
6496 permutation%TRIANGLE(numeltg+n)=i
6497 ENDDO
6498
6499 DEALLOCATE(xnum)
6500 ENDIF
6501
6502 CALL applysort2fvm(t_monvol)
6503
6504C---------------------------------
6505 IF(numsph/=0) THEN
6506 if ( .NOT. ALLOCATED(ixsps) ) ALLOCATE(ixsps(kvoisph,numsph),stat=stat)
6507 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6508 . msgtype=msgerror,
6509 . c1='IXSPS')
6510
6511 iwork = 0
6512 eadd => iwork(1:numsph+1)
6513 CALL spgrhead(kxsp ,ixsp ,ipargtmp,pm ,ipart ,
6514 2 ipartsp ,eadd ,cepsp ,nd ,ipm ,
6515 3 igeo ,spbuf ,sph2sol,
6516 4 sol2sph ,irst ,mat_elem%MAT_PARAM,ixsps)
6517C---------------------------------
6518C- GROUPAGE SPMD
6519C---------------------------------
6520C LDD_IAD Non -Department Test
6521 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6522 ALLOCATE(dd_tmp2(idx-1))
6523 DO i = 1, idx-1
6524 dd_tmp2(i)=dd_tmp(i)
6525 END DO
6526 DEALLOCATE(dd_tmp)
6527 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6528 DO i = 1, idx-1
6529 dd_tmp(i)=dd_tmp2(i)
6530 END DO
6531 DEALLOCATE(dd_tmp2)
6532 END IF
6533C
6534 CALL spgrtails(kxsp ,ipargtmp,pm ,ipart ,
6535 2 ipartsp ,eadd ,nd ,cepsp,dd_tmp ,
6536 3 idx ,ixsp ,ipm , igeo ,
6537 4 spbuf ,sph2sol,sol2sph ,
6538 5 irst ,nod2sp ,ipri ,mat_elem%MAT_PARAM,
6539 6 ixsps)
6540 IF (ALLOCATED(ixsps)) DEALLOCATE(ixsps)
6541 ENDIF
6542C---------------------------------
6543 IF(numelx>0) THEN
6544!
6545 k1=6*numelx
6546 k2=k1+numelx
6547 k3=k2+numelx+1
6548 k4=k3+numelx*2
6549 k5=k4+numelx*4
6550 k6=k5+numelx
6551 !warning: please also update any index change
6552 ! for MODIF option (MODIF_SPMD.F)
6553 iwork = 0
6554 inum => iwork(1:k1)
6555 itr1 => iwork(k1+1:k2)
6556 eadd => iwork(k2+1:k3)
6557 index1 => iwork(k3+1:k4)
6558 itri1 => iwork(k4+1:k5)
6559 xep => iwork(k5+1:k6)
6560!
6561 CALL xgrhead(
6562 1 kxx, geo, inum, itr1,
6563 2 eadd, index1, itri1, ipartx,
6564 3 nd, igrsurf,
6565 4 cep(off), xep,ipm)
6566C---------------------------------
6567C- GROUPAGE SPMD
6568C---------------------------------
6569C LDD_IAD Non -Department Test
6570 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6571 ALLOCATE(dd_tmp2(idx-1))
6572 DO i = 1, idx-1
6573 dd_tmp2(i)=dd_tmp(i)
6574 END DO
6575 DEALLOCATE(dd_tmp)
6576 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6577 DO i = 1, idx-1
6578 dd_tmp(i)=dd_tmp2(i)
6579 END DO
6580 DEALLOCATE(dd_tmp2)
6581 END IF
6582C
6583 CALL xgrtails(
6584 1 kxx ,ipargtmp ,geo ,eadd ,
6585 2 nd ,dd_tmp ,idx ,lb_max ,inum ,
6586 3 index1 ,cep(off) ,ipartx ,itr1 ,igrsurf ,
6587 4 ixx ,igeo)
6588 off = off + numelx
6589 ENDIF
6590 CALL trace_out1()
6591C
6592C build Inverse connectivity - update after all element/sph grouping
6593C
6594 knod2els = 0
6595 knod2elc = 0
6596 knod2eltg = 0
6597 knod2el1d = 0
6598 knod2elig3d = 0
6599 nod2els = 0
6600 nod2elc = 0
6601 nod2eltg = 0
6602 nod2el1d = 0
6603 nod2elig3d = 0
6604 knod2elq = 0
6605 nod2elq = 0
6606 CALL build_cnel(
6607 2 ixs ,ixq ,ixc ,ixt ,ixp ,
6608 3 ixr ,ixtg ,ixs10 ,ixs20 ,
6609 4 ixs16 ,ixtg1 ,igeo ,knod2els ,knod2elc ,
6610 5 knod2eltg ,nod2els ,nod2elc ,nod2eltg ,nod2el1d ,
6611 6 knod2el1d ,kxx ,ixx ,x ,lelx ,
6612 7 ixig3d ,kxig3d ,knod2elig3d,nod2elig3d,knod2elq,
6613 8 nod2elq )
6614
6615C---------------------------------
6616 CALL trace_in1(err_msg,len_trim(err_msg))
6617 IF(numelig3d>0) THEN
6618
6619 k1=(nixig3d+1)*numelig3d
6620 k2=k1+numelig3d
6621 k3=k2+numelig3d+1
6622 k4=k3+numelig3d*2
6623 k5=k4+numelig3d*4
6624 k6=k5+numelig3d
6625
6626 iwork = 0
6627 inum => iwork(1:k1)
6628 itr1 => iwork(k1+1:k2)
6629 eadd => iwork(k2+1:k3)
6630 index1 => iwork(k3+1:k4)
6631 itri1 => iwork(k4+1:k5)
6632 xep => iwork(k5+1:k6)
6633C
6634 CALL ig3dgrhead(
6635 1 kxig3d ,geo ,inum ,itr1 ,eadd ,
6636 2 index1 ,itri1 ,ipartig3d ,nd ,igrsurf ,
6637 3 cep(off) ,xep ,igeo ,
6638 4 ipm ,pm ,nige ,knotlocel)
6639C--------------------------------
6640C- GROUPAGE SPMD
6641C---------------------------------
6642C LDD_IAD Non -Department Test
6643 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6644 ALLOCATE(dd_tmp2(idx-1))
6645 DO i = 1, idx-1
6646 dd_tmp2(i)=dd_tmp(i)
6647 END DO
6648 DEALLOCATE(dd_tmp)
6649 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6650 DO i = 1, idx-1
6651 dd_tmp(i)=dd_tmp2(i)
6652 END DO
6653 DEALLOCATE(dd_tmp2)
6654 END IF
6655C
6656 CALL ig3dgrtails(
6657 1 kxig3d ,ipargtmp ,geo ,eadd ,nd ,
6658 2 dd_tmp ,idx ,lb_max ,inum ,index1 ,
6659 3 cep(off) ,ipartig3d ,itr1 ,igrsurf ,
6660 4 ixig3d ,igeo ,
6661 5 pm ,nige ,knotlocel, mat_elem%MAT_PARAM)
6662 off = off + numelig3d
6663 ENDIF
6664 DEALLOCATE(iwork)
6665 CALL trace_out1()
6666
6667C--------------------------------------------
6668C REFERENCE METRIQUE
6669C--------------------------------------------
6670 err_msg='REFERENCE METRICS'
6671 err_category='REFERENCE METRICS'
6672 CALL trace_in1(err_msg,len_trim(err_msg))
6673C
6674 xyzref = x
6675C
6676 IF(iddlevel==0)THEN
6677
6678 IF(nxref > 0 .OR. neref > 0 .OR. irefsta > 0) THEN
6679 ALLOCATE(xrefc(4,3,numelc))
6680 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6681 . msgtype=msgerror,c1='XREFC')
6682 ALLOCATE(xreftg(3,3,numeltg))
6683 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6684 . msgtype=msgerror,c1='XREFTG')
6685 ALLOCATE(xrefs(8,3,numels8))
6686 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6687 . msgtype=msgerror,c1='XREFS')
6688 ALLOCATE(tagxref(numnod))
6689 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6690 . msgtype=msgerror,c1='TAGXREF')
6691 ALLOCATE(tagrefsta(numnod))
6692 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6693 . msgtype=msgerror,c1='TAGREFSTA')
6694 ELSE
6695 ALLOCATE(xrefc(1,1,1))
6696 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6697 . msgtype=msgerror,c1='XREFC')
6698 ALLOCATE(xreftg(1,1,1))
6699 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6700 . msgtype=msgerror,c1='XREFTG')
6701 ALLOCATE(xrefs(1,1,1))
6702 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6703 . msgtype=msgerror,c1='XREFS')
6704 ALLOCATE(tagxref(1))
6705 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6706 . msgtype=msgerror,c1='TAGXREF')
6707 ALLOCATE(tagrefsta(1))
6708 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6709 . msgtype=msgerror,c1='TAGREFSTA')
6710 ENDIF
6711 ENDIF
6712C
6713 tagxref = 0
6714 tagrefsta = 0
6715C
6716 IF(nxref > 0) THEN
6717 WRITE(istdo,'(A)')' .. REFERENCE STATE (XREF)'
6718 CALL hm_read_xref(itabm1 ,ipart ,ipartc ,ipartg ,iparts ,
6719 . unitab ,ixc ,ixtg ,ixs ,x ,
6720 . xrefc ,xreftg ,xrefs ,rtrans ,lsubmodel ,
6721 . tagxref ,iddlevel ,eani ,ipm ,igeo )
6722 ENDIF
6723 IF(irefsta > 0) THEN
6724 WRITE(istdo,'(A)')' .. REFERENCE STATE (REFSTA)'
6725 CALL lecrefsta(itabm1 ,unitab ,ixc ,ixtg ,ixs ,
6726 . xyzref ,xrefc ,xreftg ,xrefs ,tagxref ,
6727 . iddlevel,tagrefsta )
6728C
6729 IF(iddlevel==0 .AND. ((ninter > 0).OR.(isms == 1))) THEN
6730 rewind(iin6)
6731 ELSE
6732 IF(ipid /= 0) CLOSE(iin6)
6733 irefsta = 0
6734C NXREF = NXREF + 1
6735 nxref = 1
6736 ENDIF
6737 ENDIF
6738 IF(neref > 0 ) THEN
6739 WRITE(istdo,'(A)')' .. REFERENCE STATE (EREF)'
6740 CALL hm_read_eref(itabm1 ,ipart ,ipartc ,ipartg ,iparts ,
6741 . ixc ,ixtg ,ixs ,x ,xrefc ,
6742 . xreftg ,xrefs ,lsubmodel,iddlevel,itab ,
6743 . tagxref ,tagrefsta )
6744C
6745 IF(iddlevel ==1 .OR. ((ninter == 0).AND.(isms == 0))) nxref = 1
6746 ENDIF
6747C-------------------------------------------------
6748 !check if a law 151 is associated to any PART
6749 multi_fvm%IS_ASSOCIATED_TO_A_PART = .false.
6750 DO ng=1,ngroup
6751 mlw = ipargtmp(1,ng)
6752 IF(mlw == 151)THEN
6753 multi_fvm%IS_ASSOCIATED_TO_A_PART = .true.
6754 EXIT
6755 ENDIF
6756 ENDDO
6757C-------------------------------------------------
6758 !check if all part are using law 151
6759 multi_fvm%ARE_ALL_PARTS_151 = .true.
6760 nb_euler_groups = 0
6761 DO ng=1,ngroup
6762 mlw = ipargtmp(1,ng)
6763 is_euler = ipargtmp(11,ng)
6764 IF(is_euler == 1 ) nb_euler_groups=nb_euler_groups+1
6765 IF(mlw /= 151 .AND. is_euler == 1)THEN
6766 multi_fvm%ARE_ALL_PARTS_151 = .false.
6767 EXIT
6768 ENDIF
6769 ENDDO
6770 IF(nb_euler_groups == 0)multi_fvm%ARE_ALL_PARTS_151 = .false.
6771C-------------------------------------------------
6772 !copy IPARG <- IPARGTMP, and Deallocate IPARGTMP
6773 siparg = nparg*ngroup
6774 IF(ALLOCATED(iparg))DEALLOCATE(iparg)
6775 ALLOCATE(iparg(siparg) ,stat=stat)
6776 DO j=1,nparg
6777 DO i=1,ngroup
6778 iparg((i-1)*nparg + j) = ipargtmp(j,i)
6779 ENDDO
6780 ENDDO
6781 DEALLOCATE(ipargtmp)
6782C-------------------------------------------------
6783C provisional
6784 IF(isms/=0)THEN
6785 DO n=1,ngroup
6786 iparg(nparg*(n-1)+52)=1
6787 END DO
6788 END IF
6789 nbr_gpmp = ngroup
6790c-----------------------------------------------------------------------
6791!
6792 !---------------------------------------------------
6793 ! element renumbering after domdec for /fail/fractal
6794 !---------------------------------------------------
6795 call fractal_elem_renum(fail_fractal,numelc,numeltg)
6796!
6797 !---------------------------------------------------
6798 ! element renumbering after domdec for /fail/alter + brokmann
6799 !---------------------------------------------------
6800 if (iddlevel==1) call brokmann_elem_renum(fail_brokmann,numelc,numeltg)
6801c-----------------------------------------------------------------------
6802c set default material/property parameters by element group
6803c-----------------------------------------------------------------------
6804 IF(ALLOCATED(group_param_tab)) DEALLOCATE(group_param_tab)
6805 ALLOCATE(group_param_tab(ngroup) ,stat=stat)
6806c
6807 CALL set_elgroup_param(group_param_tab ,iparg ,ngroup ,n2d ,
6808 . ipm ,igeo ,pm ,geo ,bufmat )
6809C-------------------------------------------------
6810 CALL trace_out1()
6811C--------------------------------------------
6812C Itet=2 of S10 : dynamic condensation
6813C--------------------------------------------
6814 IF(numels10>0) THEN
6815 IF(ALLOCATED(itagnd)) DEALLOCATE(itagnd)
6816 ALLOCATE(itagnd(numnod),stat=stat)
6817 itagnd(1:numnod)=0
6818 CALL dim_s10edg(ns10e, ixs10 ,iparg,itagnd)
6819 IF(ns10e>0) THEN
6820 IF(ALLOCATED(icnds10)) DEALLOCATE(icnds10)
6821 ALLOCATE(icnds10(3*ns10e),stat=stat)
6822 icnds10(1:3*ns10e)=0
6823 itagnd(1:numnod)=0
6824 CALL ind_s10edg(icnds10, ixs, ixs10 ,iparg,itagnd)
6825 IF(ipari0/=0) CALL reord_icnd(icnds10, itagnd)
6826 CALL s10edg_rlink(nlink, numlink,nnlink,lnlink,
6827 . itagnd,icnds10,itab,ipri,numnod,ns10e)
6828 END IF
6829 ELSE
6830 IF(ALLOCATED(itagnd)) DEALLOCATE(itagnd)
6831 ALLOCATE(itagnd(0),stat=stat)
6832 END IF
6833
6834C--------------------------------------------
6835C Domain Decomposition 1 (Reconstruction of Tables)
6836C--------------------------------------------
6837C If nspmd = 1 you have to build dd_iad and fr_iad
6838 err_msg='DOMAIN DECOMPOSITION ARRAYS'
6839 err_category='DOMAIN DECOMPOSITION'
6840 CALL trace_in1(err_msg,len_trim(err_msg))
6841 sdd_iad = (nspmd+1)*nspgroup
6842 ALLOCATE(dd_iad(sdd_iad) ,stat=stat)
6843 dd_iad = 0
6844 CALL domdec1(
6845 1 iparg ,ixs ,ixq ,ixc ,ixt ,
6846 2 ixp ,ixr ,ixtg ,dd_iad ,
6847 3 x ,dd_tmp ,ixs10 ,ixs20 ,
6848 4 ixs16 ,kxx ,ixx ,kxsp ,ixsp ,
6849 5 cepsp ,ixtg1)
6850C
6851 DEALLOCATE(dd_tmp)
6852 CALL trace_out1()
6853C--------------------------------------------
6854C Multidomains -> modif domdec
6855C--------------------------------------------
6856 err_msg='MULTIDOMAINS'
6857 err_category='MULTIDOMAINS'
6858 IF((nsubdom>0).AND.(iddom==0).AND.(flg_r2r_err==0)) THEN
6859 WRITE(istdo,'(A)')' .. MULTIDOMAINS DOMDEC SYNCHRONIZATION '
6860 CALL r2r_domdec(iexlnk,igrnod,frontb_r2r,dt_r2r,0)
6861 ENDIF
6862C--------------------------------------------
6863C STOCKAGE DYNAMIQUE (RESOLUTION) REEL
6864C--------------------------------------------
6865 err_msg='ELEMENT BUFFER ALLOCATION'
6866 err_category='INTERNAL'
6867 CALL trace_in1(err_msg,len_trim(err_msg))
6868 selbuf = lbufel
6869 ALLOCATE(elbuf(selbuf) ,stat=stat)
6870 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6871 . msgtype=msgerror,
6872 . c1='ELBUF')
6873 elbuf = zero
6874 CALL trace_out1()
6875C--------------------------------------------
6876C GRAVITY
6877C--------------------------------------------
6878 err_msg='GRAVITY'
6879 err_category='GRAVITY'
6880 CALL trace_in1(err_msg,len_trim(err_msg))
6881c CALL PRELECGRAV(NUMGRAV ,IGRNOD)
6882 CALL hm_preread_grav(numgrav ,igrnod , lsubmodel)
6883 sigrv = nigrv*ngrav
6884 slgrav = numgrav
6885 IF(iddlevel==0)THEN
6886 ALLOCATE(igrv(sigrv) ,stat=stat)
6887 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6888 . msgtype=msgerror,
6889 . c1='IGRV')
6890 ALLOCATE(lgrav(slgrav) ,stat=stat)
6891 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6892 . msgtype=msgerror,
6893 . c1='LGRAV')
6894 END IF
6895 igrv = 0
6896 CALL hm_read_grav(igrv ,lgrav ,grav ,itab ,itabm1 ,
6897 . igrnod ,npc ,sensors ,unitab ,iskwn ,
6898 . itagnd ,lsubmodel)
6899 CALL trace_out1()
6900C----------------------------------
6901C READING OF INIGRAV MAPS
6902C----------------------------------
6903 err_msg='INIGRAV'
6904 err_category='GRAVITY'
6905 CALL trace_in1(err_msg,len_trim(err_msg))
6906 IF(ninigrav > 0) sinigrav = ninigrav
6907 IF(iddlevel == 0) THEN
6908 ALLOCATE(inigrv(04,sinigrav) ,stat=stat)
6909 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6910 . msgtype=msgerror,
6911 . c1='INIGRV')
6912 ALLOCATE(linigrav(11,sinigrav) ,stat=stat)
6913 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6914 . msgtype=msgerror,
6915 . c1='LINIGRAV')
6916 END IF
6917 IF(ninigrav > 0) THEN
6918 IF(iddlevel == 0) THEN
6919 inigrv = 0
6920 WRITE(istdo,'(A)') ' .. INITIAL GRAVITY LOADING'
6921 CALL hm_read_inigrav(igrv ,lgrav ,grav ,itab ,itabm1 ,
6922 . igrpart ,npc ,unitab ,iskwn ,
6923 . itagnd ,igrsurf ,tf ,bufsf ,lsubmodel)
6924 ENDIF
6925 ENDIF
6926 CALL trace_out1()
6927C----------------------------------
6928C READING OF INIMAP1D MAPS
6929C----------------------------------
6930 err_msg = 'INIMAP1D'
6931 err_category= 'INITIALIZATION'
6932 CALL trace_in1(err_msg,len_trim(err_msg))
6933
6934 IF(iddlevel==0 .AND. ninimap1d+ninimap2d>0)WRITE(istdo,'(A)')titre(54)
6935
6936 IF(iddlevel==0)THEN
6937 ALLOCATE(inimap1d(ninimap1d))
6938 IF(ninimap1d > 0) THEN
6939 CALL hm_read_inimap1d(inimap1d ,npc , itabm1, x, igrbric,
6940 . igrquad ,igrsh3n, multi_fvm, unitab, lsubmodel)
6941 IF(.NOT. multi_fvm%IS_USED) THEN
6942 DO kk = 1, ninimap1d
6943 ALLOCATE(inimap1d(kk)%TAGNODE(numnod))
6944 inimap1d(kk)%TAGNODE(1:numnod) = 0
6945 ENDDO
6946 ENDIF
6947 ENDIF
6948 ENDIF
6949 CALL trace_out1()
6950C----------------------------------
6951C Reading INIMAP2D cards
6952C----------------------------------
6953 err_msg = 'INIMAP2D'
6954 err_category= 'INITIALIZATION'
6955 CALL trace_in1(err_msg,len_trim(err_msg))
6956 IF(iddlevel==0)THEN
6957 ALLOCATE(inimap2d(ninimap2d))
6958 IF(ninimap2d > 0) THEN
6959 CALL hm_read_inimap2d(inimap2d, func2d, itabm1, x, igrbric,
6960 . igrquad , igrsh3n, unitab, lsubmodel)
6961 IF(.NOT. multi_fvm%IS_USED) THEN
6962 DO kk = 1, ninimap2d
6963 ALLOCATE(inimap2d(kk)%TAGNODE(numnod))
6964 inimap2d(kk)%TAGNODE(1:numnod) = 0
6965 ENDDO
6966 ENDIF
6967 ENDIF
6968 ENDIF
6969 CALL trace_out1()
6970C--------------------------------------------
6971C "LOAD FIELDS" : CENTRIFUGAL,FLUID,BLAST
6972C--------------------------------------------
6973 !ALLOCATIONS
6974 err_msg='LOAD FIELDS'
6975 err_category='LOAD FIELDS'
6976 CALL trace_in1(err_msg,len_trim(err_msg))
6977 IF(iddlevel == 0)THEN
6978C
6979C Centrifugal Loads
6980 ALLOCATE(icfield(sicfield) ,stat=stat)
6981 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='ICFIELD')
6982 ALLOCATE(lcfield(slcfield) ,stat=stat)
6983 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='LCFIELD')
6984 ALLOCATE(cfield(scfield) ,stat=stat)
6985 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='CFIELD')
6986!INITIALIZATIONS
6987 IF(ALLOCATED(icfield)) icfield(:) = 0
6988 IF(ALLOCATED(lcfield)) lcfield(:) = 0
6989 IF(ALLOCATED(cfield )) cfield(:) = zero
6990!READING CARDS & STORING DATA
6991 IF(nloadc/=0)THEN
6992 CALL hm_read_load_centri(icfield ,lcfield ,cfield ,itab ,itabm1 ,
6993 . igrnod ,npc ,sensors ,unitab ,iframe ,
6994 . lsubmodel)
6995 END IF
6996C
6997C PFLUID & PBLAST & LOAD PRESSURE
6998 ALLOCATE(iloadp(siloadp) ,stat=stat)
6999 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='ILOADP')
7000 ALLOCATE(lloadp(slloadp) ,stat=stat)
7001 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='LLOADP')
7002 ALLOCATE(loadp(sloadp) ,stat=stat)
7003 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='LOADP')
7004 ALLOCATE(interloadp(nintloadp) ,stat=stat)
7005 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='INTERLOADP')
7006 ALLOCATE(intgaploadp(nintloadp) ,stat=stat)
7007 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='INTGAPLOADP')
7008
7009 s_loadpinter = 0
7010 IF(nintloadp > 0) THEN
7011 s_loadpinter = ninter*nloadp_hyd
7012 ALLOCATE(kloadpinter(ninter + 1) ,stat=stat)
7013 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='KLOADPINTER')
7014 ALLOCATE(loadpinter(s_loadpinter) ,stat=stat)
7015 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='LOADPINTER')
7016 ALLOCATE(dgapint(ninter) ,stat=stat)
7017 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='DGAPINT')
7018 ALLOCATE(dgaploadint(s_loadpinter) ,stat=stat)
7019 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='DGAPLOADINT')
7020 ELSE
7021 ALLOCATE(kloadpinter(0))
7022 ALLOCATE(loadpinter(0))
7023 ALLOCATE(dgapint(0))
7024 ALLOCATE(dgaploadint(0))
7025 ENDIF
7026
7027!INITIALIZATIONS
7028 IF(ALLOCATED(iloadp )) iloadp(:) = 0
7029 IF(ALLOCATED(lloadp )) lloadp(:) = 0
7030 IF(ALLOCATED(loadp )) loadp(:) = zero
7031 IF(ALLOCATED(interloadp )) interloadp(:) = 0
7032 IF(ALLOCATED(kloadpinter )) kloadpinter(:) = 0
7033 IF(ALLOCATED(loadpinter )) loadpinter(:) = 0
7034 IF(ALLOCATED( intgaploadp )) intgaploadp(:)=zero
7035 IF(ALLOCATED( dgapint )) dgapint(:)=zero
7036 IF(ALLOCATED( dgaploadint )) dgaploadint(:)=zero
7037!READING CARDS & STORING DATA
7038 numloadp=0
7039 nintloadp = 0
7040 nintloadp21 = 0
7041 IF(nloadp_f/=0)THEN
7042 CALL hm_read_pfluid(numloadp ,iloadp ,lloadp ,loadp ,npc ,
7043 . sensors ,igrsurf ,unitab ,iframe ,lsubmodel)
7044 END IF
7045 IF(pblast%NLOADP_B/=0)THEN
7046 CALL hm_read_pblast( pblast,
7047 . itab ,itabm1 ,unitab ,igrsurf, numloadp,
7048 . iloadp ,lloadp ,loadp ,x , bufsf ,
7049 . lsubmodel,rtrans)
7050 ENDIF
7051 IF(nloadp_hyd/=0)THEN
7052 CALL hm_read_load_pressure(
7053 . numloadp ,iloadp ,lloadp ,interloadp ,loadp ,
7054 . kloadpinter,loadpinter ,npc ,sensors ,igrsurf ,
7055 . unitab ,iskwn ,lsubmodel ,dgapint ,intgaploadp,
7056 . dgaploadint,s_loadpinter,pblast)
7057
7058 END IF
7059
7060 DEALLOCATE( interloadp,intgaploadp )
7061 ENDIF
7062 CALL trace_out1()
7063C--------------------------------------------
7064C Reading RBE2 constraints
7065C--------------------------------------------
7066 err_msg='RBE2'
7067 err_category='RBE2'
7068 CALL trace_in1(err_msg,len_trim(err_msg))
7069 CALL hm_preread_rbe2(sirbe2,slrbe2,igrnod,lsubmodel)
7070 IF(iddlevel==0)THEN
7071 ALLOCATE(irbe2(sirbe2) ,stat=stat)
7072 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7073 . msgtype=msgerror,
7074 . c1='IRBE2')
7075 END IF
7076 IF(iddlevel==0)THEN
7077 ALLOCATE(lrbe2(slrbe2) ,stat=stat)
7078 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7079 . msgtype=msgerror,
7080 . c1='LRBE2')
7081 END IF
7082 IF(sirbe2 > 0) THEN
7083 irbe2 = 0
7084 lrbe2 = 0
7085 CALL hm_read_rbe2(
7086 . irbe2 ,lrbe2 ,itab ,itabm1 ,igrnod,
7087 . iskwn ,d ,iddlevel ,nom_opt(lnopt1*inom_opt(13)+1),itagnd,
7088 . icnds10 ,lsubmodel)
7089 ENDIF
7090
7091
7092 CALL c_new_hash(grnod_uid,ngrnod)
7093 DO i=1,ngrnod
7094 CALL c_hash_insert(grnod_uid,igrnod(i)%ID,i)
7095 ENDDO
7096
7097C--------------------------------------------
7098C READING RBE3 Interpolation Constraints
7099C--------------------------------------------
7100 CALL trace_out1()
7101 err_msg='RBE3'
7102 err_category='RBE3'
7103 CALL trace_in1(err_msg,len_trim(err_msg))
7104 CALL hm_preread_rbe3(sirbe3,slrbe3,igrnod,grnod_uid,lsubmodel)
7105 lxintd = 0
7106 slrbe3 = 2*slrbe3
7107 sfrbe3 = (3+1)*slrbe3
7108 IF(iddlevel==0)THEN
7109 ALLOCATE(irbe3(sirbe3) ,stat=stat)
7110 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7111 . msgtype=msgerror,
7112 . c1='IRBE3')
7113 ALLOCATE(lrbe3(slrbe3), frbe3(sfrbe3) ,stat=stat)
7114 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7115 . msgtype=msgerror,
7116 . c1='LRBE3')
7117 END IF
7118 IF(sirbe3 > 0) THEN
7119 irbe3 = 0
7120 lrbe3 = 0
7121 frbe3 = zero
7122 CALL hm_read_rbe3(irbe3 ,lrbe3 ,frbe3 ,itab ,itabm1 ,
7123 . igrnod ,iskwn ,lxintd ,d ,iddlevel,
7124 . nom_opt(lnopt1*inom_opt(14)+1),itagnd ,
7125 . grnod_uid,unitab,lsubmodel)
7126 ENDIF
7127
7128 CALL c_delete_hash(grnod_uid)
7129
7130 CALL trace_out1()
7131
7132C---------------------------------------------
7133C CHECK ENGINE FILE : DYNAIN FILE
7134C-------------------------------------------
7135 dynain_data%DYNAIN_CHECK = 0
7136 CALL check_dynain(ipart,ipartc,ipartg,ixc,ixtg,dynain_data%DYNAIN_CHECK)
7137
7138C---------------------------------------------
7139C CHECK ENGINE FILE /H3D/?/TMAX initialization
7140C-------------------------------------------
7141 CALL ini_h3dtmax_engine(iparg,ipart,iparts,ipartc,ipartg,iddlevel)
7142C---------------------------------------------
7143C CHECK ENGINE FILE DYNAIN or STATE if to use F.I. total strain for QEPH
7144C-------------------------------------------
7145 istr_24 = 0
7146 IF(numelc/=0) CALL check_qeph_stra(istr_24)
7147 IF (isigi < 0) istr_24=1
7148C--------------------------------------------
7149C Reading deactivatable elements
7150C--------------------------------------------
7151 err_msg='ELEMENTS DEACTIVATION'
7152 err_category='ELEMENTS DEACTIVATION'
7153 CALL trace_in1(err_msg,len_trim(err_msg))
7154 siactiv = lactiv*nactiv
7155 IF(iddlevel==0)THEN
7156 ALLOCATE(iactiv(siactiv), factiv(lractiv*nactiv) ,stat=stat)
7157 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7158 . msgtype=msgerror, c1='IACTIV')
7159 END IF
7160 iactiv = 0
7161 IF(nactiv > 0) CALL hm_read_activ(iactiv ,factiv ,sensors,igrbric,
7162 . igrquad ,igrsh4n ,igrsh3n ,igrtruss,igrbeam,
7163 . igrspring,lsubmodel,unitab)
7164C--------------------------------------------
7165 sibmpc = nummpc + lmpc*3
7166 IF(iddlevel==0)THEN
7167 ALLOCATE(ibmpc(sibmpc) ,stat=stat)
7168 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7169 . msgtype=msgerror,
7170 . c1='IBMPC')
7171 END IF
7172 ibmpc = 0
7173 IF(lmpc>0) THEN
7174 ibmpc2 => ibmpc(nummpc+1:nummpc+lmpc)
7175 ibmpc3 => ibmpc(nummpc+lmpc+1:nummpc+lmpc*2)
7176 ibmpc4 => ibmpc(nummpc+lmpc*2+1:sibmpc)
7177 ELSE
7178 ibmpc2 => ibmpc
7179 ibmpc3 => ibmpc
7180 ibmpc4 => ibmpc
7181 END IF
7182
7183 skinet = numnod
7184 IF(iddlevel==0)THEN
7185 ALLOCATE(kinet(skinet) ,stat=stat)
7186 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7187 . msgtype=msgerror,
7188 . c1='KINET')
7189 END IF
7190 kinet = 0
7191
7192 sipari = npari*ninter
7193 IF(iddlevel==0)THEN
7194 ALLOCATE(ipari(sipari) ,stat=stat)
7195 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7196 . msgtype=msgerror,
7197 . c1='IPARI')
7198 END IF
7199 ipari = 0
7200 CALL trace_out1()
7201C--------------------------------------------
7202C External faces of solid elements
7203C--------------------------------------------
7204 err_msg='SOLID ELEMENTS FACES'
7205 err_category='SOLID ELEMENTS FACES'
7206 CALL trace_in1(err_msg,len_trim(err_msg))
7207 ALLOCATE(fastag(numels) ,stat=stat)
7208 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7209 . msgtype=msgerror,
7210 . c1='FASTAG')
7211 CALL ani_fasolfr1(ixs,ixc,ixtg,fastag,isolnod)
7212 sfasolfr = 2*nfasolfr
7213 IF(iddlevel==0)THEN
7214 ALLOCATE(fasolfr(sfasolfr),stat=stat)
7215 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7216 . msgtype=msgerror,
7217 . c1='FASOLFR')
7218 END IF
7219 CALL ani_fasolfr2(fastag,fasolfr,isolnod)
7220 DEALLOCATE(fastag)
7221 CALL trace_out1()
7222C--------------------------------------------
7223C External Segs of quad elements
7224C--------------------------------------------
7225 err_msg='QUAD ELEMENTS SEGS'
7226 err_category='QUAD ELEMENTS SEGS'
7227 CALL trace_in1(err_msg,len_trim(err_msg))
7228 ALLOCATE(segtag(4*numelq) ,stat=stat)
7229 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7230 . msgtype=msgerror,
7231 . c1='SEGTAG')
7232 segtag(1:4*numelq) = 0
7233 CALL ani_segquadfr1(ixq ,segtag ,knod2elq ,nod2elq ,x ,nsegquadfr)
7234 ssegquadfr = 2*nsegquadfr
7235 IF(iddlevel==0)THEN
7236 ALLOCATE(segquadfr(ssegquadfr),stat=stat)
7237 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7238 . msgtype=msgerror,
7239 . c1='SEGTAG')
7240 END IF
7241 CALL ani_segquadfr2(segtag,segquadfr)
7242 DEALLOCATE(segtag)
7243 CALL trace_out1()
7244C--------------------------------------------
7245C MULTI-POINT CONSTRAINTS (2)
7246C--------------------------------------------
7247 err_msg='MPCS 2'
7248 err_category='MPCS'
7249 CALL trace_in1(err_msg,len_trim(err_msg))
7250 IF(nummpc > 0) CALL hm_read_mpc (
7251 1 rbmpc ,ibmpc ,ibmpc2 ,ibmpc3 ,ibmpc4 ,
7252 2 iskwn ,itab ,itabm1 ,lag_ncf ,lag_nkf ,
7253 3 lag_nhf ,d ,ikine1lag,
7254 4 nom_opt(lnopt1*inom_opt(17)+1),itagnd,
7255 5 lsubmodel,unitab)
7256 CALL trace_out1()
7257C--------------------------------------------
7258C OPTIMIZATION (Part 3 & 4)
7259C--------------------------------------------
7260 IF(ALLOCATED(tagprt_fric)) DEALLOCATE(tagprt_fric)
7261 ALLOCATE(tagprt_fric(npart),stat=stat)
7262 tagprt_fric(1:npart) = 0
7263
7264C--------------------------------------------!
7265C FRICTION MODEL : BUFFER STRUCTURE ALLOCATION, Lectur of option
7266C--------------------------------------------!
7267 iorthfricmax = 0
7268 npfricorth = 0
7269 IF(ninterfric > 0) THEN
7270
7271 IF(iddlevel == 0) ALLOCATE(intbuf_fric_tab(ninterfric), stat=stat)
7272
7273C 1st step : counting number of set of parts in friction models
7274 ALLOCATE(tabcoupleparts_fric_tmp(1),stat=stat)
7275 ALLOCATE(tabcoef_fric_tmp(1),stat=stat)
7276 ALLOCATE(ifricorth_tmp(1),stat=stat)
7277 ALLOCATE(lengrpf(npart),stat=stat)
7278 lengrpf(1:npart) = 0
7279
7280 leng = 0
7281 DO n=1,ngrpart
7282 leng = max(leng,igrpart(n)%NENTITY)
7283 ENDDO
7284
7285 flagf = 0
7286 nsetfrictot = 0
7287 coefslen = 0
7288 ngrpf = 0
7289 nsetmax = 0
7290
7291 CALL hm_read_friction_models(
7292 1 nom_opt(lnopt1*inom_opt(29)+1),unitab,igrpart ,ipart ,tagprt_fric,
7293 2 tabcoupleparts_fric_tmp ,tabcoef_fric_tmp ,intbuf_fric_tab,nsetfrictot ,
7294 3 flagf ,coefslen , iorthfricmax ,ifricorth_tmp ,ngrpf ,
7295 4 lengrpf ,leng , nsetmax ,lsubmodel )
7296
7297 DEALLOCATE(tabcoupleparts_fric_tmp)
7298 DEALLOCATE(tabcoef_fric_tmp)
7299 DEALLOCATE(ifricorth_tmp)
7300
7301C 2nd step : storing parts ids and coefficients in temperarly tabs :
7302 ALLOCATE(tabcoupleparts_fric_tmp(2*ninterfric*nsetmax),stat=stat)
7303 coefslen = ninterfric*(2*nsetmax+1)
7304 ALLOCATE(tabcoef_fric_tmp(8*coefslen),stat=stat)
7305 tabcoupleparts_fric_tmp(1:2*ninterfric*nsetmax) = 0
7306 tabcoef_fric_tmp(1:8*coefslen) = zero
7307
7308 ALLOCATE(ifricorth_tmp(ninterfric*nsetmax),stat=stat)
7309 ifricorth_tmp(1:ninterfric*nsetmax) = 0
7310
7311 flagf = 1
7312 nsetfrictot = 0
7313 coefslen = 0
7314 nsetmax = 0
7315
7316 CALL hm_read_friction_models(
7317 1 nom_opt(lnopt1*inom_opt(29)+1),unitab,igrpart ,ipart ,tagprt_fric,
7318 2 tabcoupleparts_fric_tmp ,tabcoef_fric_tmp ,intbuf_fric_tab,nsetfrictot ,
7319 3 flagf ,coefslen , iorthfricmax ,ifricorth_tmp ,ngrpf ,
7320 4 lengrpf ,leng , nsetmax , lsubmodel )
7321
7322C 3rd step : Tri of tabs
7323
7324 coefslen = ninterfric*(2*nsetmax+1)
7325 ALLOCATE(nsetinit(ninterfric),stat=stat)
7326 ALLOCATE(tabparts_fric_tmp(2*ninterfric*nsetmax),stat=stat)
7327 nsetinit(1:ninterfric) = 0
7328 tabparts_fric_tmp(1:2*ninterfric*nsetmax) = 0
7329
7330 CALL triintfric(
7331 . tabcoupleparts_fric_tmp ,tabcoef_fric_tmp ,intbuf_fric_tab ,
7332 . tabparts_fric_tmp,nsetfrictot,nsetinit,iorthfricmax,ifricorth_tmp,
7333 . nsetmax )
7334
7335C 4th step : ALLOCATION OF NEW BUFFER FOR INTERFACE FRICTION
7336
7337 IF(iddlevel == 0) CALL intbuf_fric_ini_starter(intbuf_fric_tab )
7338
7339C 4th step : Final storing of structures in buffer
7340 CALL intbuf_fric_copy(
7341 . tabcoupleparts_fric_tmp ,tabcoef_fric_tmp,tabparts_fric_tmp ,
7342 . nsetinit ,ifricorth_tmp , intbuf_fric_tab )
7343
7344 DEALLOCATE(tabcoupleparts_fric_tmp)
7345 DEALLOCATE(tabcoef_fric_tmp)
7346 DEALLOCATE(tabparts_fric_tmp )
7347
7348 DEALLOCATE( nsetinit )
7349 DEALLOCATE(ifricorth_tmp)
7350 DEALLOCATE(lengrpf )
7351
7352C------/FRICTION/ORIENTATION READING FOR ORTHOTROPIC FRICTION
7353
7354 IF(iorthfricmax > 0) THEN
7355
7356 flagf = 0
7357 npfricorth = 0
7358c KFRICORIENT = 0
7359 IF(.NOT.ALLOCATED(pfricorth))ALLOCATE(pfricorth(npart),stat=stat)
7360 IF(.NOT.ALLOCATED(irepforth))ALLOCATE(irepforth(1),stat=stat)
7361 IF(.NOT.ALLOCATED(vforth))ALLOCATE(vforth(1),stat=stat)
7362 IF(.NOT.ALLOCATED(phiforth))ALLOCATE(phiforth(1),stat=stat)
7363
7364 pfricorth(1:npart) = 0
7365
7366 CALL hm_read_friction_orientations (intbuf_fric_tab ,
7367 1 npfricorth ,igrpart ,ipart ,pfricorth ,
7368 2 irepforth ,iskwn ,phiforth ,vforth ,skew ,
7369 3 flagf ,tagprt_fric ,rtrans ,lsubmodel ,unitab )
7370
7371 DEALLOCATE(irepforth,vforth,phiforth)
7372
7373 ALLOCATE(irepforth(npfricorth),stat=stat)
7374 ALLOCATE(vforth(3*npfricorth),stat=stat)
7375 ALLOCATE(phiforth(npfricorth),stat=stat)
7376
7377 irepforth(1:npfricorth) = 0
7378 vforth(1:3*npfricorth) = zero
7379 phiforth(1:npfricorth) = zero
7380
7381 flagf = 1
7382 CALL hm_read_friction_orientations (intbuf_fric_tab ,
7383 1 npfricorth ,igrpart ,ipart ,pfricorth ,
7384 2 irepforth ,iskwn ,phiforth ,vforth ,skew ,
7385 3 flagf ,tagprt_fric ,rtrans ,lsubmodel ,unitab )
7386 ENDIF
7387
7388 ELSEIF(iddlevel == 0) THEN !NINTERFRIC = 0
7389 ALLOCATE(intbuf_fric_tab(0))
7390 ENDIF
7391 IF(.NOT.ALLOCATED(pfricorth))ALLOCATE(pfricorth(0))
7392 IF(.NOT.ALLOCATED(irepforth))ALLOCATE(irepforth(1))
7393 IF(.NOT.ALLOCATED(vforth)) ALLOCATE(vforth(1))
7394 IF(.NOT.ALLOCATED(phiforth)) ALLOCATE(phiforth(1))
7395
7396
7397C--------------------------------------------
7398C ALE CONNECTIVITY
7399C--------------------------------------------
7400 CALL ale_connectivity%ALE_CONNECTIVITY_INIT()
7401 IF(ale_connectivity%has_ne_connect) THEN
7402 CALL ale_connectivity%ALE_COMPUTE_CONNECTIVITY(numnod, numelq, numeltg, numels,
7403 . nixq, nixtg, nixs,
7404 . ixq, ixtg, ixs)
7405 ENDIF
7406 CALL ale_connectivity%ALE_COMPUTE_EE_CONNECTIVITY(pm,igeo,
7407 . npropgi,numgeo, npropm, nummat , numnod, numelq, numeltg, numels, n2d,
7408 . iale , ieuler, glob_therm%ITHERM, ialelag,detonators%IS_SHADOWING_REQUIRED,
7409 . nixq , nixtg , nixs ,
7410 . ixq , ixtg , ixs )
7411C--------------------------------------------
7412 IF(nsubdom > 0) THEN
7413C---------------Deactivation of ALE flags if no more ALE elements in domain -------------C
7414 IF(ale_euler == 0) THEN
7415 iale = 0
7416 ieuler = 0
7417 ENDIF
7418 ENDIF
7419C
7420C--------------------------------------------
7421C shell offset projection thke could be overwritten by /INI
7422C--------------------------------------------
7423C--------------------------------------------
7424C check if need offset treatment
7425C--------------------------------------------
7426 CALL chk_shell_offset(
7427 . ngroup, nparg, iparg, npropg,
7428 . numgeo, geo, defaults%SHELL%IOFFSET)
7429 IF (defaults%SHELL%IOFFSET>0) THEN
7430
7431 IF (iddlevel == 0) THEN
7432 NULLIFY(x_c)
7433 IF (defaults%SHELL%IOFFSET==1) THEN
7434 ALLOCATE(itagoset(numelc+numeltg), stat=stat)
7435 ALLOCATE(xyz(3*numnod), stat=stat)
7436 ELSE
7437 ALLOCATE(itagoset(0), stat=stat)
7438 END IF
7439 END IF
7440
7441 NULLIFY(x_c)
7442 IF (defaults%SHELL%IOFFSET==1) THEN
7443 xyz(1:3*numnod) = x(1:3*numnod)
7444 x_c=>xyz
7445 ELSE
7446 x_c=>x
7447 END IF
7448
7449
7450 itagoset = 0
7451 CALL shell_offsetp(
7452 . ngroup, nparg, iparg, npropg,
7453 . numgeo, geo, numelc, nixc,
7454 . ixc, numeltg, nixtg, ixtg,
7455 . numnod, x_c, thke, itagoset,
7456 . defaults%SHELL)
7457 ELSEIF (iddlevel == 0) THEN
7458 NULLIFY(x_c)
7459 x_c=>x
7460 END IF
7461C
7462C--------------------------------------------
7463C Reading interfaces
7464C--------------------------------------------
7465 err_msg='INTERFACES'
7466 err_category='INTERFACES'
7467 CALL trace_in1(err_msg,len_trim(err_msg))
7468 nintstamp=0
7469 nmnt = 0
7470 interfaces%PARAMETERS%ISTIF_DT = 0
7471C Also initialized in Engine (RDRESA)
7472 probint=half
7473 interfaces%PARAMETERS%INT25_EROSION_SOLID = 0
7474
7475 IF(ninter == 0.AND.ninterfric > 0 )THEN
7476 CALL ancmsg(msgid=1593,
7477 . msgtype=msgwarning,
7478 . anmode=aninfo_blind_1)
7479 ENDIF
7480
7481 IF(ninter > 0)THEN
7482 IF(iddlevel == 0) THEN
7483 ALLOCATE(xfiltr(ninter) ,stat=stat)
7484 ALLOCATE(stfac(ninter) ,stat=stat)
7485 ALLOCATE(fric_p(10*ninter) ,stat=stat)
7486 ALLOCATE(i2rupt(6*ninter) ,stat=stat)
7487 ALLOCATE(areasl(ninter) ,stat=stat)
7488 ALLOCATE(frigap(nparir*ninter),stat=stat)
7489 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7490 . msgtype=msgerror,
7491 . c1='XFILTR')
7492 END IF
7493 xfiltr = zero
7494 stfac = zero
7495 fric_p = zero
7496 frigap = zero
7497 i2rupt = zero
7498 areasl = zero
7499C
7500 IF(iddlevel == 0) CALL startime(10,1)
7501 IF(iddlevel == 1) CALL startime(11,1)
7502
7503 WRITE(istdo,'(A)')titre(38)
7504 IF(nintsub/=0)THEN
7505 CALL hm_read_intsub(igrnod ,igrsurf,nom_opt(lnopt1*inom_opt(3)+1),igrslin,lsubmodel)
7506 END IF
7507 ids = 117
7508 i = 0
7509c CALL ANCNTS(IDS, I)
7510C
7511 nsn_multi_connec = 0
7512 ALLOCATE(t2_nb_connec(numnod))
7513 t2_nb_connec(1:numnod) = 0
7514C------------------------------------------------------------
7515C INTERFACE READING
7516C--------------------------------------------------------------
7517 ninter25 = 0
7518 CALL hm_read_interfaces(
7519 1 ipari ,frigap ,itab ,itabm1 ,
7520 2 igrnod ,igrsurf ,igrslin ,igrbric ,igrsh3n ,
7521 3 igrtruss ,npc ,iskwn ,xfiltr ,stfac ,
7522 4 fric_p ,i2rupt ,areasl ,unitab ,nom_opt(lnopt1*inom_opt(3)+1) ,
7523 5 def_inter ,npc1 ,sensors ,multi_fvm ,nom_opt(lnopt1*inom_opt(29)+1),
7524 6 intbuf_fric_tab ,lsubmodel,tf ,npts ,npari ,
7525 7 kloadpinter ,dgapint ,interfaces ,sitab ,nparir ,
7526 8 sitabm1 ,siskwn ,liskn ,snpc ,snpc1 ,
7527 9 glob_therm%ITHERM_FE,glob_therm%INTHEAT)
7528C
7529 IF(.NOT. ALLOCATED(ale_connectivity%NALE)) ALLOCATE(ale_connectivity%NALE(0))
7530
7531 IF(ninter > 0) THEN
7532 ALLOCATE(list_nin25(ninter))
7533 list_nin25(1:ninter) = 0
7534 ENDIF
7535 IF(ninter25 >0.AND.numels > 0) THEN
7536 ALLOCATE(flag_elem_inter25(ninter25,numels))
7537 flag_elem_inter25(1:ninter25,1:numels) = 0
7538 ELSE
7539 ALLOCATE(flag_elem_inter25(0,0))
7540 ENDIF
7541
7542 CALL lecint (ipari ,ninter ,ipm ,bufmat ,
7543 . nmnt ,itab ,itabm1 ,geo ,
7544 . pm ,x ,igrnod ,igrsurf ,igrslin ,
7545 . npc ,probint ,lag_ncf ,
7546 . lag_nkf ,lag_ncl ,lag_nkl ,lag_nhf ,maxrtm ,
7547 . iskwn ,maxrtms ,igeo ,
7548 . xfiltr ,stfac ,fric_p ,frigap ,
7549 . i2rupt ,areasl ,unitab ,ixs ,nom_opt(lnopt1*inom_opt(3)+1),
7550 . itag ,ixc ,ixtg ,knod2elc ,knod2eltg,
7551 . nod2elc ,nod2eltg ,knod2els ,nod2els ,ixs10 ,
7552 . ixs16 ,ixs20 ,def_inter ,maxnsne ,
7553 . npc1 ,multi_fvm ,nom_opt(lnopt1*inom_opt(29)+1),intbuf_fric_tab,
7554 . igrbric ,igrsh3n ,igrtruss ,maxrtm_t2 ,nsn_multi_connec,
7555 . t2_nb_connec,iddlevel ,ale_connectivity%NALE ,interfaces ,snpc1 ,
7556 . flag_elem_inter25 ,list_nin25)
7557
7558 !need to allocate only once at first passage in lectur
7559 flag_allocate = 1
7560 !PROC argument is used only for call in ddsplit
7561 proc_bid = 0
7562
7563 IF(iddlevel == 0) THEN
7564 !--------------------------------------------!
7565 ! NEW INTERFACE BUFFER STRUCTURE ALLOCATION
7566 !--------------------------------------------!
7567 ALLOCATE(intbuf_tab(ninter), stat=stat)
7568 !--------------------------------------------!
7569
7570 !--------------------------------------------!
7571 !NEW INTERFACE BUFFER STRUCTURE INITIALIZATION
7572 !--------------------------------------------!
7573 CALL intbuf_ini_starter(intbuf_tab, ipari, numnod,
7574 . i11flag, flag_allocate, proc_bid ,intbuf_fric_tab)
7575 !--------------------------------------------!
7576
7577 CALL int8_ini(intbuf_tab,ipari,nbt8)
7578 ALLOCATE(intert8(nspmd,nbt8))
7579 DO p = 1,nspmd
7580 DO i = 1,nbt8
7581 ALLOCATE(intert8(p,i)%BUFFER(nspmd))
7582 DO j=1,nspmd
7583 intert8(p,i)%BUFFER(j)%NBMAIN = -1
7584 intert8(p,i)%BUFFER(j)%NBSECND_TOT = 0
7585 ENDDO
7586 ENDDO
7587 ENDDO
7588 ! -------------------
7589 ! allocation of arrays for the interface 18 with law 151
7590 CALL int18_law151_alloc(npari,ninter,numnod,numels,multi_fvm,ipari)
7591 ! -------------------
7592 END IF
7593C
7594C-----Allocation structures INTSTAMP
7595C
7596 IF(nintstamp/=0)THEN
7597 IF(iddlevel == 0) THEN
7598 ALLOCATE(intstamp(nintstamp) ,stat=stat)
7599 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7600 . msgtype=msgerror,
7601 . c1='INTSTAMP')
7602 CALL intstamp_zero(intstamp)
7603 END IF
7604 ELSE
7605 IF(iddlevel == 0) THEN
7606 ALLOCATE(intstamp(0))
7607 ENDIF
7608 END IF
7609C
7610 CALL lecins(ipari ,itab ,pm ,ipm ,bufmat ,
7611 . igrnod ,igrsurf ,igrslin ,xfiltr ,stfac ,
7612 . fric_p ,frigap ,i2rupt ,areasl ,lixint ,
7613 . x ,ninter ,ixs ,nom_opt(lnopt1*inom_opt(3)+1),
7614 . ixc ,ixtg ,knod2elc ,knod2eltg ,nod2elc,
7615 . nod2eltg ,intbuf_tab,knod2els ,nod2els ,ixs10 ,
7616 . ixs16 ,ixs20 ,nige ,rige ,xige ,
7617 . vige ,igrbric ,multi_fvm,ale_connectivity%NALE ,igeo ,
7618 . interfaces,s_nod2els,s_nod2eltg,flag_elem_inter25 ,list_nin25)
7619C
7620cc DEALLOCATE(XFILTR)
7621cc DEALLOCATE(STFAC)
7622cc DEALLOCATE(FRIC_P)
7623C DEALLOCATE(FRIGAP)
7624cc DEALLOCATE(I2RUPT)
7625cc DEALLOCATE(AREASL)
7626C----
7627c CALL ANCNTG(IDS, I, J)
7628 ids = 60
7629c CALL ANCHECK(IDS)
7630 IF(nintsub/=0)THEN
7631 CALL inintsub(
7632 . itab ,igrnod ,igrsurf ,
7633 . ipari ,maxrtm,nom_opt(lnopt1*inom_opt(3)+1),
7634 . intbuf_tab,maxrtms ,igrslin ,maxnsne)
7635 ENDIF
7636C----
7637 IF(iddlevel == 0) THEN
7638 ALLOCATE(inscr(ninter) ,stat=stat)
7639 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7640 . msgtype=msgerror,
7641 . c1='INSCR')
7642
7643 ENDIF
7644
7645 CALL prescrint(ipari,intbuf_tab,inscr)
7646
7647 IF(iddlevel == 0) THEN
7648
7649 DO i=1,ninter
7650 ALLOCATE(inscr(i)%WA(inscr(i)%SINSCR) ,stat=stat)
7651 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7652 . msgtype=msgerror,
7653 . c1='INSCR')
7654 inscr(i)%WA = 0
7655 ENDDO
7656 ELSE
7657 DO i=1,ninter
7658 inscr(i)%WA = 0
7659 ENDDO
7660 END IF
7661 CALL scrint(ipari ,inscr, intbuf_tab)
7662
7663 IF(iddlevel == 0) CALL stoptime(10,1)
7664 IF(iddlevel == 1) CALL stoptime(11,1)
7665
7666 WRITE(istdo,'(A)')titre(68)
7667C-----
7668 aux = max( numnod , numelt+numelp+numelr+numeltg+numelc+100 ,
7669 . maxrtm+100 )
7670 ns_i7 = 2*numnod + 2002 + 4*aux
7671C
7672 ns_i11 = 2002 + nmnt
7673 aux = 2002 + 8*maxrtms
7674 ns_i11 = max(ns_i11,aux)
7675C
7676C Max size for interface type2 - i2buc1
7677 aux = max( numnod , maxrtm_t2+100 )
7678 ns_i2 = 2*numnod + 2002 + 4*aux
7679C
7680 ifip=max(ns_i7,ns_i11,
7681 . numnod+2+4*numelc+4*numeltg+8*numels
7682 . +2*numelt+2*numelp+2*numelr)
7683C-----
7684 siwork = max(ns_i7,ns_i11,numnod+2+4*numelc+4*numeltg+8*numels
7685 . + 2*numelt+2*numelp+2*numelr+16*numels10+ 2*(sixx-1)
7686 . + maxnsne,ns_i2)
7687C
7688 srwork = max(6000,numnod)
7689 ALLOCATE(iwork(siwork) ,stat=stat)
7690 ALLOCATE(rwork(srwork) ,stat=stat)
7691 iwork = 0
7692 rwork = zero
7693C-----
7694 IF(lxintd>0.AND.nspmd>1) lixint = lixint + lxintd
7695
7696 inter_cand%S_IXINT_2 = lixint
7697 IF(iddlevel==0)THEN
7698 IF( ALLOCATED(inter_cand%IXINT) ) DEALLOCATE( inter_cand%IXINT )
7699 ALLOCATE(inter_cand%IXINT(inter_cand%S_IXINT_1,inter_cand%S_IXINT_2))
7700 ALLOCATE(xtmp(3*numnod) ,stat=stat)
7701 xtmp = d(1:3*numnod)
7702 ENDIF
7703 ifixin = ifip
7704 ifiend = ifixin
7705 nelemint = 0
7706 lixint = 0
7707C
7708C read /INIBRI/FILL before interfaces stiffness
7709 IF(.NOT.ALLOCATED(fillsol)) ALLOCATE(fillsol(numels),stat=stat)
7710 IF(stat/=0) CALL ancmsg(msgid=268,anmode=aninfo,
7711 . msgtype=msgerror,
7712 . c1='FILLSOL')
7713 IF(numels/=0) CALL lecfill(ixs,fillsol,unitab,lsubmodel)
7714
7715 IF(iddlevel == 0) CALL startime(12,1)
7716 IF(iddlevel == 1) CALL startime(13,1)
7717
7718 CALL int18_law151_init(multi_fvm%S_APPEND_ARRAY,ninter,npari,
7719 1 numnod,numels,ngrbric,
7720 2 multi_fvm,igrbric,ipari,ixs,
7721 4 x ,v ,ms ,kinet ,
7722 5 multi_fvm%X_APPEND,multi_fvm%V_APPEND,multi_fvm%MASS_APPEND,multi_fvm%KINET_APPEND)
7723
7724C
7725C fill interface structure to be used by sorting
7726c set INTERCEP for INT7 only to avoid bug with INT20 due to renumbering
7727c in I20NLG (other interface types still done in SET_INTERCEP)
7728 CALL fill_intercep(ipari,intbuf_tab,intercep)
7729C
7730 CALL inintr(ipari ,inscr ,x_c ,v ,ixs ,ixq ,
7731 2 ixc ,pm ,geo ,itab ,ms ,
7732 3 iwork ,rwork ,ixtg ,d ,ixt ,
7733 4 ixp ,ixr ,ale_connectivity ,nelemint ,iddlevel ,
7734 5 lixint ,igrbric ,iwcont ,iwcin2 ,knod2els ,
7735 7 knod2elc ,knod2eltg ,nod2els ,nod2elc ,nod2eltg ,
7736 8 igrsurf ,ielem21 ,sh4tree ,sh3tree ,ipart ,
7737 9 ipartc ,ipartg ,thke ,thk_part ,nod2el1d ,
7738 a knod2el1d ,ixs10 ,inter_cand ,frigap ,ixs16 ,
7739 b ixs20 ,ipm ,nom_opt(lnopt1*inom_opt(3)+1),iparts ,siskwn ,
7740 c kxx ,ixx ,igeo ,intercep ,lelx ,
7741 d intbuf_tab,fillsol ,stack ,iworksh ,nsnt ,
7742 e nmnt_2 ,kxig3d ,ixig3d ,knod2elq ,nod2elq ,
7743 f segquadfr ,tagprt_fric,intbuf_fric_tab ,ipartt ,
7744 g ipartp ,ipartx ,ipartr ,nsn_multi_connec ,t2_nb_connec,
7745 h sicode ,icode ,iskew ,multi_fvm ,s_nod2els ,
7746 i sitab ,sitabm1 ,flag_elem_inter25 ,list_nin25 ,iresp )
7747 IF(iddlevel == 0) CALL stoptime(12,1)
7748 IF(iddlevel == 1) CALL stoptime(13,1)
7749
7750 idel_solid = 0
7751 DO i=1,ninter
7752 IF(ipari(npari*(i-1)+7)==25.AND.ipari(npari*(i-1)+100)>0) THEN
7753 idel_solid = idel_solid + 1
7754 ENDIF
7755 ENDDO
7756 IF(idel_solid == 0) interfaces%PARAMETERS%INT25_EROSION_SOLID = 0
7757
7758 DEALLOCATE (flag_elem_inter25)
7759 DEALLOCATE (list_nin25)
7760
7761 DEALLOCATE (t2_nb_connec)
7762 DEALLOCATE (rwork)
7763 DEALLOCATE (iwork)
7764
7765 IF(iddlevel==1) THEN
7766 DEALLOCATE(xfiltr)
7767 DEALLOCATE(fric_p)
7768 DEALLOCATE(frigap)
7769 END IF
7770C------------ RBE3 uses IXINT-POUR opt.
7771 IF(lxintd>0.AND.nspmd>1)THEN
7772 IF(lixint+lxintd > inter_cand%S_IXINT_2)THEN
7773 CALL upgrade_ixint(inter_cand,nelemint,lxintd)
7774 ENDIF
7775
7776 CALL update_weight_rbe3(nelemint,lixint,slrbe3,nrbe3l,nrbe3,
7777 . lrbe3,irbe3,inter_cand)
7778 ENDIF
7779 CALL trace_out1()
7780C-----
7781 IF(iddlevel==0)THEN
7782 d(1:3*numnod) = xtmp(1:3*numnod)
7783 DEALLOCATE(xtmp)
7784 END IF
7785C
7786 ELSEIF(iddlevel == 0) THEN !NINTER = 0
7787
7788 sinscr = 0
7789 ALLOCATE(intstamp(0))
7790
7791 !--------------------------------------------!
7792 ! NEW INTERFACE BUFFER STRUCTURE ALLOCATION
7793 !--------------------------------------------!
7794 ALLOCATE(intbuf_tab(0), stat=stat)
7795 !--------------------------------------------!
7796C
7797 ENDIF
7798
7799
7800C--------------------------------------------
7801C Reading rigid walls
7802C--------------------------------------------
7803 err_msg='RIGID WALLS'
7804 err_category='RIGID WALLS'
7805 CALL trace_in1(err_msg,len_trim(err_msg))
7806 snprw = nrwall*nnprw
7807 siwork = nrwall*numnod
7808 slprw = 0
7809 IF(iddlevel==0) THEN
7810 ALLOCATE(nprw(snprw) ,stat=stat)
7811 END IF
7812 ALLOCATE(iwork(siwork) ,stat=stat)
7813 nprw = 0
7814 iwork = 0
7815C
7816 srwbuf = nrwlp*nrwall
7817 srwsav = 0
7818 srwork = 3*numnod*nrwall+srwbuf
7819 ALLOCATE(rwork(srwork) ,stat=stat)
7820 rwork = zero
7821 nrwlag = 0
7822 sln_pen = 0
7823c
7824 IF(nrwall > 0) THEN
7825 WRITE(istdo,'(A)')titre(39)
7826 CALL read_rwall(
7827 1 rwork ,nprw ,iwork ,slprw ,ms ,
7828 2 v ,itab ,itabm1 ,x ,ixs ,
7829 3 ixq ,npc1 ,d ,igrnod ,
7830 4 srwbuf ,imerge ,unitab ,
7831 5 ikine1lag,iddlevel ,lsubmodel ,rtrans ,
7832 6 nom_opt(lnopt1*inom_opt(5)+1),itagnd ,sln_pen )
7833 ENDIF
7834C
7835
7836 IF(iddlevel==0) THEN
7837 ALLOCATE(lprw(slprw) ,stat=stat)
7838 CALL my_alloc(rwstif_pen,sln_pen)
7839 rwstif_pen = zero
7840 END IF
7841 lprw = iwork(1:slprw)
7842 DEALLOCATE(iwork)
7843 IF(iddlevel==0) THEN
7844 ALLOCATE(rwbuf(srwbuf) ,stat=stat)
7845 IF(stat /= 0) THEN
7846 CALL ancmsg(msgid=727,
7847 . msgtype=msgerror,
7848 . anmode=anstop,
7849 . c1='RWBUF')
7850 ENDIF
7851 END IF
7852 rwbuf = rwork(1:srwbuf)
7853 DEALLOCATE(rwork)
7854 IF(ALLOCATED(rwsav)) DEALLOCATE(rwsav)
7855 ALLOCATE(rwsav(srwsav) ,stat=stat)
7856 CALL trace_out1()
7857C
7858C--------------------------------------------
7859C Reading added masses
7860C--------------------------------------------
7861 err_msg='ADDED MASSES'
7862 err_category='ADDED MASSES'
7863 CALL trace_in1(err_msg,len_trim(err_msg))
7864 IF(nodmas > 0)THEN
7865 WRITE(istdo,'(A)')titre(43)
7866 IF(iddlevel==0) THEN
7867 ALLOCATE(ipmas(nodmas),stat=stat)
7868 ipmas(1:nodmas)%NPART = 0
7869 ipmas(1:nodmas)%WEIGHT_FLAG = 0
7870 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7871 . msgtype=msgerror,
7872 . c1='IPMAS')
7873 ENDIF
7874!---
7875 flagg = 0
7876!---
7877 CALL hm_read_admas(
7878 . ms ,itabm1 ,igrnod ,unitab ,igrsurf,
7879 . ipart ,ipmas ,totaddmas,flagg ,igrpart,
7880 . x ,lsubmodel)
7881!---
7882 flagg = 1
7883!---
7884 CALL hm_read_admas(
7885 . ms ,itabm1 ,igrnod ,unitab ,igrsurf,
7886 . ipart ,ipmas ,totaddmas,flagg ,igrpart,
7887 . x ,lsubmodel)
7888!---
7889 IF(ns10e>0) CALL addmast10(icnds10, ms )
7890C---
7891 ELSE
7892 IF(iddlevel==0) THEN
7893 ALLOCATE(ipmas(0))
7894 ENDIF
7895 ENDIF
7896 CALL trace_out1()
7897C--------------------------------------------
7898C Reading rigid structures
7899C--------------------------------------------
7900 err_msg='RIGID ENTITIES'
7901 err_category='RIGID BODY'
7902 CALL trace_in1(err_msg,len_trim(err_msg))
7903 CALL hm_preread_rbody (slpby ,igrnod ,lsubmodel)
7904 CALL preread_rbody_lagmul(slpbyl ,igrnod ,lsubmodel)
7905 CALL hm_preread_merge(smgrby, slpby, igrnod, lsubmodel)
7906 snpby = nnpby*nrbykin
7907 snpbyl = nnpby*nrbylag
7908 snrbody = snpby + snpbyl
7909 slrbody = slpby + slpbyl
7910 srby = nrby*nrbody
7911 IF(iddlevel==0) THEN
7912 IF(ALLOCATED(npby)) DEALLOCATE(npby)
7913 IF(ALLOCATED(lpby)) DEALLOCATE(lpby)
7914 IF(ALLOCATED(rby)) DEALLOCATE(rby)
7915 ALLOCATE(npby(snrbody),stat=stat)
7916 ALLOCATE(lpby(slrbody),stat=stat)
7917 ALLOCATE(rby(srby) ,stat=stat)
7918 END IF
7919 IF(nrbmerge > 0) THEN
7920 ALLOCATE(mgrby(nmgrby*smgrby),stat=stat)
7921 ELSE
7922 ALLOCATE(mgrby(0),stat=stat)
7923 ENDIF
7924 npby = 0
7925 lpby = 0
7926 mgrby = 0
7927 rby = zero
7928 IF(snpby<snrbody) THEN
7929 npbyl => npby(snpby+1:snrbody)
7930 ELSE
7931 npbyl => npby
7932 END IF
7933 IF(slpby<slrbody) THEN
7934 lpbyl => lpby(slpby+1:slrbody)
7935 ELSE
7936 lpbyl => lpby
7937 END IF
7938 IF(nrby *nrbykin<srby) THEN
7939 rbyl => rby(nrby *nrbykin+1:srby)
7940 ELSE
7941 rbyl => rby
7942 END IF
7943C
7944 IF(nrbody > 0) WRITE(istdo,'(A)')titre(41)
7945 IF(nrbykin > 0) THEN
7946 CALL hm_read_rbody(
7947 1 rby ,npby ,lpby ,itab ,itabm1 ,
7948 2 igrnod ,igrsurf ,ibfv ,igrv ,lgrav ,
7949 3 sensors ,imerge ,unitab ,iskwn ,nom_opt ,
7950 4 slrbody ,knod2els,knod2elc,knod2eltg,knod2el1d,
7951 5 knod2elq ,itagnd ,icnds10 ,lsubmodel,icfield ,
7952 6 lcfield )
7953 ENDIF
7954C--------------------------------------------
7955C Reading rigid body merges
7956C--------------------------------------------
7957 IF(nrbmerge > 0) THEN
7958 CALL hm_read_merge(
7959 . mgrby,smgrby ,npby,lpby ,slrbody,
7960 . rby ,nom_opt,inom_opt(30),igrnod ,
7961 . itab ,itabm1 ,lgrav ,igrv ,
7962 . lsubmodel)
7963 ENDIF
7964C--------------------------------------------
7965C rigid body hierarchy
7966C--------------------------------------------
7967 IF(nrbykin > 0) THEN
7968 call hierarchy_rbody(nrbykin ,nnpby ,npby ,slrbody ,lpby ,
7969 . nrby ,rby ,numnod,iout )
7970 ENDIF
7971C--------------------------------------------
7972C Checking rigid structures
7973C--------------------------------------------
7974 IF(nrbykin > 0) THEN
7975 CALL checkrby(
7976 1 rby ,npby ,lpby ,itab ,
7977 2 d ,iddlevel,nom_opt,slrbody)
7978 ENDIF
7979C--------------------------------------------
7980C READING RB LAGRANGE
7981C--------------------------------------------
7982 IF(nrbylag > 0) THEN
7983 CALL hm_read_rbody_lagmul(rbyl ,npbyl ,lpbyl ,igrnod ,lsubmodel ,
7984 . itab ,itabm1 ,d ,ikine1lag,nom_opt)
7985 ENDIF
7986 CALL trace_out1()
7987C--------------------------------------------
7988 IF(ninter > 0) THEN
7989C--------------------------------------------
7990C
7991 IF(nintstamp/=0)THEN
7992 err_msg='INTERFACES TYPE21'
7993 err_category='INTERFACES'
7994 CALL trace_in1(err_msg,len_trim(err_msg))
7995c IF(IDDLEVEL==0)THEN
7996 CALL lecstamp(ipari ,intstamp ,unitab, npby,
7997 . icode ,nom_opt(lnopt1*inom_opt(3)+1),lsubmodel)
7998c ENDIF
7999 CALL trace_out1()
8000 END IF
8001C--------------------------------------------
8002C OPTIMISATION INTERFACE SPMD
8003C--------------------------------------------
8004 err_category='INTERNAL'
8005 IF(iddlevel==0)THEN
8006 IF(iale+ieuler/=0)
8007 + CALL paroi(pm ,ixs ,ixq ,icode ,ale_connectivity%NALE )
8008 IF(numels/=0)
8009 + CALL lce16s4(ixs ,pm ,icode )
8010C
8011 lag_ncf = lag_ncf0
8012 lag_nkf = lag_nkf0
8013 lag_nhf = lag_nhf0
8014 lag_ncl = lag_ncl0
8015 lag_nkl = lag_nkl0
8016 ENDIF
8017 ENDIF
8018
8019C--------------------------------------------
8020C
8021C After IDDLEVEL - we do not enter inintr anymore
8022C set I11FLAG to 1
8023 i11flag = 1
8024
8025 DEALLOCATE(ielem21)
8026C
8027C---------------------------------
8028 IF((seani > 0).AND.(iddlevel==1)) eani = 0
8029C---------------------------------
8030#ifdef DNC
8031C--------------------------------------------
8032C READING AND PREPARATION OF FINITE ELEMENTS TO SEND TO MADYMO:
8033C "EXTENDED COUPLING".
8034C--------------------------------------------
8035 err_msg='MADYMO INTERFACED FEM'
8036 err_category='MADYMO INTERFACED FEM'
8037 CALL trace_in1(err_msg,len_trim(err_msg))
8038 IF(nexmad/=0) THEN
8039 siwork2 = max(npart,numnod,2*numnod+numelc+numeltg+numels)
8040 siwork = npart+numnod+2*(numelc+numeltg+numels)
8041
8042 ALLOCATE(iwork(siwork+siwork2),stat=stat)
8043 iwork = 0
8044 IF(siwork<siwork+siwork2) THEN
8045 iwork2 => iwork(siwork+1:siwork+siwork2)
8046 ELSE
8047 iwork2 => iwork
8048 ENDIF
8049 ENDIF
8050 IF(ALLOCATED(iconx)) DEALLOCATE(iconx)
8051 IF(nexmad/=0) THEN
8052 WRITE(istdo,'(A)')' .. FEM INTERFACED TO MADYMO'
8053 CALL hm_read_madymo_exfem(iwork(7*nconx+1),itab ,itabm1 ,ipart ,ipartc,
8054 . ipartg ,iparts ,ixc ,ixtg ,ixs ,
8055 . iwork2 ,geo ,pm ,iwork ,igeo ,
8056 . ipm ,lsubmodel)
8057
8058 smadprt = nmadprt
8059 smadsh4 = nmadsh4
8060 smadsh3 = nmadsh3
8061 smadsol = nmadsol
8062 smadnod = nmadnod
8063
8064 smadfail= numelc+numeltg+numels
8065
8066 siextag = 2*nmadnod+nmadsh4+nmadsh3+nmadsol
8067
8068 siexmad = nmadprt+nmadsh4+nmadsh3+nmadsol+nmadnod
8069 . + numelc+numeltg+numels
8070
8071 siconx = 7*nconx+siexmad+siextag
8072 ALLOCATE(iconx(siconx),stat=stat)
8073 iconx(1:siconx) = 0
8074 DO i=1,7*nconx+siexmad
8075 iconx(i) = iwork(i)
8076 ENDDO
8077 ELSE
8078 siconx = 7*nconx
8079 ALLOCATE(iconx(siconx),stat=stat)
8080 IF(siconx > 0)THEN
8081 iconx(1:7*nconx)=iwork(1:7*nconx)
8082 ENDIF
8083 ENDIF
8084 IF(ALLOCATED(iwork)) DEALLOCATE(iwork)
8085 CALL trace_out1()
8086#else
8087 IF(.NOT. ALLOCATED(iconx)) ALLOCATE(iconx(0))
8088#endif
8089C---------------------------------------------
8090C Reading flexible bodies
8091C---------------------------------------------
8092 err_msg='FLEXIBLE BODIES'
8093 err_category='FLEXIBLE BODIES'
8094 CALL trace_in1(err_msg,len_trim(err_msg))
8095C
8096
8097 IF(nfxbody == 0) THEN
8098 IF(iddlevel==0) THEN
8099 ALLOCATE(fxbnod(0),fxb_matrix(0),fxb_matrix_add(4,0))
8100 ALLOCATE(fxbglm(0), fxbcpm(0) , fxbrpm(0),
8101 . fxbcps(0) , fxblm(0) , fxbfls(0),
8102 . fxbdls(0), fxbdep(0), fxbvit(0),
8103 . fxbacc(0), fxbmod(0), fxbelm(0),
8104 . fxbsig(0), fxbgrvi(0), fxbgrvr(0))
8105 ENDIF
8106 ELSE IF(nfxbody>0) THEN
8107C
8108 IF(iddlevel==1) THEN
8109C-- length must be reset for second pass
8110 lenglm=0
8111 lencp=0
8112 lenlm=0
8113 lenfls=0
8114 lendls=0
8115 lenvar=0
8116 lenrpm=0
8117 lenmcd=0
8118 lenelm=0
8119 lensig=0
8120 lengrvi=0
8121 lengrvr=0
8122 ENDIF
8123C
8124 IF(iddlevel==0) THEN
8125 INQUIRE(iolength=rclen) flrec6
8126 OPEN(unit=ifxm,status='SCRATCH',
8127 . access='DIRECT',recl=rclen)
8128 OPEN(unit=ifxs,status='SCRATCH',
8129 . access='DIRECT',recl=rclen)
8130 WRITE(istdo,'(A)')titre(51)
8131 ALLOCATE(fxbnod(lennod),fxb_matrix(lenmat),fxb_matrix_add(4,lenmat))
8132 ENDIF
8133C
8134 CALL hm_read_fxb1(nom_opt(lnopt1*inom_opt(11)+1),fxbnod,fxbipm,fxb_matrix,fxb_matrix_add,
8135 . nmanim,itab,itabm1,fxbfile_tab,lsubmodel)
8136C
8137 DO nfx=1,nfxbody
8138 aipm=(nfx-1)*nbipm
8139 anod=fxbipm(aipm+6)
8140 nbno=fxbipm(aipm+3)
8141 nbmo=fxbipm(aipm+4)+fxbipm(aipm+17)
8142 fxbipm(aipm+19)=lenelm+1
8143 fxbipm(aipm+20)=lensig+1
8144 fxbipm(aipm+26)=lengrvi+1
8145 fxbipm(aipm+27)=lengrvr+1
8146C
8147 CALL fxbtagn(
8148 . fxbnod(anod), nbno, fxbipm(aipm+18), ibcl , ipres ,
8149 . ixs , ixc , ixt , ixp , ixr ,
8150 . ixtg , iparg , fxbtag, nbmo, fxbipm(aipm+4),
8151 . nels , nelc, neltg, igrv ,lgrav ,
8152 . nlgrav , ipari , intbuf_tab , fxbipm(aipm+29), nelt,
8153 . nelp)
8154 fxbipm(aipm+21)=nels
8155 fxbipm(aipm+22)=nelc
8156 fxbipm(aipm+23)=neltg
8157 fxbipm(aipm+34)=nelt
8158 fxbipm(aipm+35)=nelp
8159 fxbipm(aipm+24)=0
8160 fxbipm(aipm+25)=nlgrav
8161 ENDDO
8162C
8163 IF(iddlevel==0) THEN
8164 ALLOCATE(fxbglm(lenglm), fxbcpm(lencp) , fxbrpm(lenrpm),
8165 . fxbcps(lencp) , fxblm(lenlm) , fxbfls(lenfls),
8166 . fxbdls(lendls), fxbdep(lenvar), fxbvit(lenvar),
8167 . fxbacc(lenvar), fxbmod(lenmod*6), fxbelm(lenelm),
8168 . fxbsig(lensig), fxbgrvi(lengrvi), fxbgrvr(lengrvr))
8169 ENDIF
8170C
8171 fxbelm(1:lenelm)= 0
8172 DO nfx=1,nfxbody
8173 aipm=(nfx-1)*nbipm
8174 anod=fxbipm(aipm+6)
8175 nbno=fxbipm(aipm+3)
8176 alm=fxbipm(aipm+19)
8177 IF(fxbipm(aipm+4)>0) CALL fxbelnum(
8178 . fxbnod(anod), nbno, iparg , fxbtag, fxbelm(alm),
8179 . ixs , ixc , ixtg , iparts ,ipartc ,
8180 . ipartg , ixt , ixp , ipartt ,ipartp )
8181 ENDDO
8182C
8183 CALL hm_read_fxb2(fxbipm, fxbrpm, fxbnod, fxbglm,
8184 . fxbcpm, fxbcps, fxblm, fxbfls, fxbdls,
8185 . fxbmod, itab , itabm1 , nom_opt(lnopt1*inom_opt(11)+1),fxb_last_address,
8186 . lsubmodel)
8187C
8188C
8189 ELSEIF(iddlevel==0) THEN
8190 ALLOCATE(fxbnod(0) , fxbmod(0), fxbglm(0), fxbgrvi(0),
8191 . fxbcpm(0) , fxbcps(0), fxblm(0) , fxbfls(0) ,
8192 . fxbdls(0) , fxbdep(0), fxbvit(0), fxbacc(0) ,
8193 . fxbrpm(0) , fxbelm(0), fxbsig(0),
8194 . fxbgrvr(0))
8195 ENDIF
8196C
8197 CALL trace_out1()
8198 err_msg='EIGEN MODES'
8199 err_category='EIGEN MODES'
8200 CALL trace_in1(err_msg,len_trim(err_msg))
8201 IF(neig>0) THEN
8202C
8203 INQUIRE(iolength=rclen) flrec6
8204 OPEN(unit=ieigm,status='SCRATCH',
8205 . access='DIRECT',recl=rclen)
8206C
8207 WRITE(istdo,'(A)')titre(52)
8208 CALL hm_preread_eig(igrnod ,nnt ,lsubmodel)
8209 neipm=17
8210 nerpm=4
8211 leibuf = nnt
8212 IF(iddlevel==0) THEN
8213 ALLOCATE(eigipm(neipm*neig), eigibuf(nnt))
8214 ALLOCATE(eigrpm(nerpm*neig))
8215 eigipm = 0
8216 eigibuf = 0
8217 eigrpm = zero
8218 ENDIF
8219C
8220 CALL hm_read_eig(eigipm, eigibuf, eigrpm, igrnod ,itabm1 ,
8221 . unitab, lsubmodel)
8222 ELSEIF(iddlevel==0) THEN
8223 ALLOCATE(eigipm(0), eigibuf(0))
8224 ALLOCATE(eigrpm(0))
8225 ENDIF
8226 CALL trace_out1()
8227 CALL trace_in1(err_msg,len_trim(err_msg))
8228 IF(ndsolv==1) THEN
8229 WRITE(6,*) "ERROR Deprecated Linear solver"
8230 CALL arret(5)
8231 ELSEIF(iddlevel==0) THEN
8232 nslevel=0
8233 ALLOCATE(ceptmp(0), neldom(0), eldom(0,0,0),
8234 . elsub(0,0))
8235 ENDIF
8236 CALL trace_out1()
8237C
8238C shell composite xfem
8239C
8240 err_msg='COMPOSITE SHELLS'
8241 err_category='COMPOSITE SHELLS'
8242 CALL trace_in1(err_msg,len_trim(err_msg))
8243C
8244 IF(iddlevel==0) THEN
8245 IF(iplyxfem > 0) THEN
8246 ALLOCATE(ms_ply0(numnod*nplymax),stat=stat)
8247 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8248 . msgtype=msgerror,
8249 . c1='MS_PLY0')
8250 ms_ply0=zero
8251 ALLOCATE(zi_ply0(numnod*nplymax),stat=stat)
8252 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8253 . msgtype=msgerror,
8254 . c1='ZI_PLY0')
8255 zi_ply0=zero
8256 ALLOCATE(msz20(numnod),stat=stat)
8257 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8258 . msgtype=msgerror,
8259 . c1='MSZ20')
8260 msz20=zero
8261 ALLOCATE(itagnd_shxfem(numnod),stat=stat)
8262 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8263 . msgtype=msgerror,
8264 . c1='ITAGND_SHXFEM')
8265 itagnd_shxfem=0
8266 ALLOCATE(itagsh(numelc),stat=stat)
8267 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8268 . msgtype=msgerror,
8269 . c1='ITAGSH')
8270 itagsh=0
8271 ALLOCATE(inod_pxfem(numnod),stat=stat)
8272 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8273 . msgtype=msgerror,
8274 . c1='INOD_PXFEM')
8275 inod_pxfem=0
8276 ALLOCATE(iel_pxfem(numelc),stat=stat)
8277 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8278 . msgtype=msgerror,
8279 . c1='IEL_PXFEM')
8280 iel_pxfem=0
8281 ELSE
8282 ALLOCATE(ms_ply0(0),zi_ply0(0),itagnd_shxfem(0),
8283 . itagsh(0),inod_pxfem(0),iel_pxfem(0))
8284 ALLOCATE(ms_ply(0),zi_ply(0),msz20(0))
8285 ENDIF
8286 ENDIF
8287C
8288 CALL trace_out1()
8289C
8290C-----------------------------------------------------------
8291C
8292 err_msg='ARRAYS ALLOCATION FOR INTIA'
8293 err_category='INTERNAL'
8294 CALL trace_in1(err_msg,len_trim(err_msg))
8295C
8296C tab masse
8297 IF(iddlevel == 0) THEN
8298 ALLOCATE(msc(numelc) ,stat=stat)
8299 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8300 . msgtype=msgerror,
8301 . c1='MSC')
8302 ALLOCATE(mstg(numeltg) ,stat=stat)
8303 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8304 . msgtype=msgerror,
8305 . c1='MSTG')
8306 ALLOCATE(inc(numelc) ,stat=stat)
8307 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8308 . msgtype=msgerror,
8309 . c1='INC')
8310 ALLOCATE(intg(numeltg) ,stat=stat)
8311 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8312 . msgtype=msgerror,
8313 . c1='INTG')
8314 ALLOCATE(ptg(3,numeltg) ,stat=stat)
8315 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8316 . msgtype=msgerror,
8317 . c1='PTG')
8318 IF(glob_therm%ITHERM_FE > 0)THEN
8319 ALLOCATE(mcpc(numelc) ,stat=stat)
8320 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8321 . msgtype=msgerror,
8322 . c1='MCPC')
8323 ALLOCATE(mcptg(numeltg) ,stat=stat)
8324 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8325 . msgtype=msgerror,
8326 . c1='MCPTG')
8327 ELSE
8328 ALLOCATE(mcpc(0),mcptg(0))
8329 END IF
8330 ENDIF
8331C
8332 msc = zero
8333 mstg = zero
8334 inc = zero
8335 intg = zero
8336 ptg = zero
8337 mcpc = zero
8338 mcptg = zero
8339C
8340C-------------------------------------------------------
8341C
8342 IF(iddlevel == 0) THEN
8343 IF(irest_mselt/=0)THEN
8344 ALLOCATE(mssa(numels) ,stat=stat)
8345 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8346 . msgtype=msgerror,
8347 . c1='MSSA')
8348 ALLOCATE(msrt(numelr) ,stat=stat)
8349 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8350 . msgtype=msgerror,
8351 . c1='MSRT')
8352 ELSE
8353 ALLOCATE(mssa(0) ,stat=stat)
8354 ALLOCATE(msrt(0) ,stat=stat)
8355 ENDIF
8356C-------------------------------------------------------
8357 IF(i7stifs/=0)THEN
8358 ALLOCATE(stifint(numnod+numfakenodigeo) ,stat=stat)
8359 ALLOCATE(stifintr(numnod) ,stat=stat)
8360 ELSE
8361 ALLOCATE(stifint(0) ,stat=stat)
8362 ALLOCATE(stifintr(0) ,stat=stat)
8363 ENDIF
8364C-------------------------------------------------------
8365 IF(irigid_mat > 0) THEN
8366 ALLOCATE(slnrbm(numnod) ,nslnrbm(numnod))
8367 ALLOCATE( rmstifn(numnod), rmstifr(numnod))
8368 ELSE
8369 ALLOCATE( slnrbm(0),nslnrbm(0),rmstifn(0), rmstifr(0))
8370 ALLOCATE( front_rm(0))
8371 ENDIF
8372C-------------------------------------------------------
8373 ALLOCATE(fxani(2,nmanim), mbufel(lbufel,nmanim),
8374 . mdepl(3*numnod,nmanim))
8375 ALLOCATE(stiffn(numnod*2) ,stat=stat)
8376 ENDIF
8377C
8378 stifint = zero
8379 stifintr = zero
8380 slnrbm= 0
8381 nslnrbm=0
8382 IF(numnod > 0) stiffn = em20
8383C
8384 CALL trace_out1()
8385C--------------------------------------------
8386 ! still need for *Y00, *sty files - not yet covered by CFG files (hm_reader)
8387 IF(iddlevel == 0) CALL yctrl(igrbric)
8388!
8389 IF (iddlevel == 0) CALL hm_yctrl(unitab,lsubmodel,igrbric,ixc,ixtg, ptshel,ptsh3n,nusphcel)
8390C
8391C----------------------------------------------------------
8392C
8393C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8394C The following is executed with iddlevel=0 only for AMS with automatic element selection
8395C or if no contact interfaces and no ams
8396 IF((iddlevel == 1).OR.(isms_selec >= 3).OR.((ninter == 0).AND.(isms == 0))) THEN
8397C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8398C
8399C--------------------------------------------
8400C ELEMENT BUFFER INTIALIZATION
8401C--------------------------------------------
8402 err_msg='ELEMENT BUFFER INITIALIZATION'
8403 err_category='INTERNAL'
8404 CALL trace_in1(err_msg,len_trim(err_msg))
8405 WRITE(istdo,'(A)')titre(45)
8406 numel=2*(numelc+numelq+numelt+numels+numelp+numelr+
8407 & numeltg+numelx+numsph+numelig3d)
8408C
8409C--------------------------------------------
8410C NEW ELEMENT BUFFER STRUCTURE ALLOCATION
8411C--------------------------------------------
8412c
8413 flag_xfem = 0
8414 ALLOCATE(elbuf_tab(ngroup), stat=stat)
8415C
8416 CALL elbuf_ini(elbuf_tab,mat_elem%MAT_PARAM,
8417 . mlaw_tag ,prop_tag ,fail_tag ,
8418 . igeo ,ipm ,iparg ,ipart ,
8419 . ipartsp ,ixs ,ixq ,ixc ,ixtg ,
8420 . flag_xfem,ipartig3d,stack ,igeo_stack ,
8421 . ixt ,ixp ,ixr ,kxx ,geo ,
8422 . eos_tag ,istr_24 ,ipri ,defaults)
8423C---
8424C if xfem
8425c---
8426 IF(icrack3d > 0) THEN
8427 flag_xfem = 1
8428
8429 ALLOCATE(xfem_tab(ngroup,nxel), stat=stat)
8430c
8431 DO ixel=1,nxel
8432 CALL elbuf_ini(xfem_tab(1:ngroup,ixel),mat_elem%MAT_PARAM,
8433 . mlaw_tag ,prop_tag ,fail_tag ,
8434 . igeo ,ipm ,iparg ,ipart ,
8435 . ipartsp ,ixs ,ixq ,ixc ,ixtg ,
8436 . flag_xfem ,ipartig3d,stack ,igeo_stack,
8437 . ixt ,ixp ,ixr ,kxx ,geo ,
8438 . eos_tag ,istr_24 ,ipri ,defaults)
8439 ENDDO
8440 ELSE
8441 ALLOCATE(xfem_tab(0,0), stat=stat)
8442 ENDIF
8443C--------------------------------------------
8444C WARNING FOR PTHICKFAIL
8445C--------------------------------------------
8446 CALL check_pthickfail(elbuf_tab,mat_elem%MAT_PARAM ,iparg ,geo ,
8447 . ipm ,stack ,igeo ,nummat ,numgeo ,
8448 . ngroup ,nparg ,npropmi ,npropgi ,npropg )
8449C--------------------------------------------
8450C CHECK MATERIAL / PROPERTY COMPATIBILITY
8451C--------------------------------------------
8452 CALL check_mat_elem_prop_compatibility(
8453 . elbuf_tab,iparg ,ipm ,igeo ,nummat ,numgeo ,
8454 . ngroup ,nparg ,npropmi ,npropgi ,mat_elem%MAT_PARAM ,
8455 . n2d ,ixt ,numelt ,ixp ,numelp ,ixr ,
8456 . numelr ,kxx ,numelx )
8457C
8458C--------------------------------------------
8459C CHECK COMPATIBILITY /DTTSH
8460C--------------------------------------------
8461 IF(numels>0) THEN
8462 CALL chk_dttsh(elbuf_tab,ixs ,iparg ,d )
8463 END IF
8464!-------ini of shell offset treatment
8465 IF (defaults%SHELL%IOFFSET>0) THEN
8466 IF (defaults%SHELL%IOFFSET==1) CALL inter_offset_itag(
8467 . ninter, ipari, npari, igrsurf,
8468 . nsurf, numelc, numeltg, itagoset)
8469 CALL shell_offset_ini(
8470 . ngroup, nparg, iparg, npropg,
8471 . numgeo, geo, numelc, numeltg,
8472 . npropgi, igeo, itagoset, elbuf_tab,
8473 . defaults%SHELL )
8474 END IF
8475C-----------------------------------------------------------
8476C ALLOCATION OF ARRAYS FOR INITIA - DEALLOCATED AFTER INTIA
8477C-----------------------------------------------------------
8478C
8479 nsigs =11
8480 lsigsh = 0
8481 lsigsp = 0
8482 lsigsph = 0
8483 lsigi = max(numels+numelq,numsol+numquad)
8484 lsigrs = 0
8485 lsigbeam = 0
8486 lsigtruss = 0
8487 nsigi = 0
8488 nsigsph= 12
8489 nsigsh = 0
8490 nsigrs = 0
8491 nsigbeam = 0
8492 nsigtruss = 0
8493 IF(isigi/=0)THEN
8494 nsigsh = nvshell
8495 nsigrs = nvspri
8496 nsigbeam = nvbeam
8497 nsigtruss = nvtruss
8498 IF(nubeam > 0) nsigbeam = nsigbeam + nubeam
8499 IF(iushell/=0) nsigsh = nsigsh + nushell
8500 IF(iortshel/=0) nsigsh = nsigsh + nortshel
8501 IF(nvshell1/=0)nsigsh = nsigsh + nvshell1
8502 IF(nvshell2 /= 0)nsigsh = nsigsh + nvshell2 + 3
8503 IF(nusphcel /= 0)nsigsph = nsigsph + nusphcel
8504 nsigi= nvsolid1 + nvsolid2 + nvsolid3 + nusolid + 4 + nvsolid4 +
8505 . nvsolid5 + nvsolid6 + 7
8506
8507
8508 IF(iabs(isigi) == 3 .OR. iabs(isigi) == 4 .OR.
8509 . iabs(isigi) == 5) THEN
8510 lsigsh = numshel+numsh3n
8511 lsigsp = max(numsol+numquad,numels+numelq)
8512 lsigsph = numsphy
8513 lsigrs = numspri
8514 lsigbeam = numbeam
8515 lsigtruss = numtrus
8516 ELSE
8517 lsigsh = numelc+numeltg
8518 lsigsp = numels+numelq
8519 lsigsph = numsph
8520 lsigrs = numelr
8521 lsigbeam = numelp
8522 lsigtruss = numelt
8523 END IF
8524 END IF
8525C
8526 IF(abs(isigi)==3.OR.abs(isigi)==4.OR.abs(isigi)==5)THEN
8527 imax = max(numels,numelq,numelc,numelt,numelp,numelr,
8528 . numeltg,numsol,numquad,numshel,numsh3n,
8529 . numsphy,numspri,numbeam,numtrus)
8530 ELSE
8531 imax = max(numels,numelq,numelc,numelt,numelp,numelr,
8532 . numeltg,numelig3d)
8533 END IF
8534 sindex = 2*imax
8535 sitri = imax
8536 IF(abs(isigi)==3.OR.abs(isigi)==4.OR.abs(isigi)==5)THEN
8537 jmax=max(numelc,numsol,numquad,numshel,numsh3n,numsphy,
8538 . numelr,numspri,numelp,numbeam,numtrus)
8539 ELSE
8540 jmax=0
8541 END IF
8542C
8543C------- refsta
8544 IF(abs(isigi)==3.OR.abs(isigi)==4.OR.abs(isigi)==5)THEN
8545 ALLOCATE (ptsol(numels) ,stat=stat)
8546 ALLOCATE (ptquad(numelq) ,stat=stat)
8547 ALLOCATE (ptsph(numsph) ,stat=stat)
8548 ALLOCATE (ptspri(numelr) ,stat=stat)
8549 ALLOCATE (ptbeam(numelp) ,stat=stat)
8550 ALLOCATE (pttruss(numelt) ,stat=stat)
8551 ptsol = 0
8552 ptquad = 0
8553 ptsph = 0
8554 ptspri = 0
8555 ptbeam = 0
8556 pttruss= 0
8557 ELSE
8558 ALLOCATE (ptsol(0) ,stat=stat)
8559 ALLOCATE (ptquad(0) ,stat=stat)
8560 ALLOCATE (ptsph(0) ,stat=stat)
8561 ALLOCATE (ptspri(0) ,stat=stat)
8562 ALLOCATE (ptbeam(0) ,stat=stat)
8563 ALLOCATE (pttruss(0) ,stat=stat)
8564 END IF
8565C
8566 ico = 0
8567 itet4_10=0
8568 CALL tet4_10(igeo,itet4_10)
8569 IF(numels10/=0.OR.numels16/=0.OR.numels20/=0.OR.itet4_10/=0) THEN
8570 ico=12
8571 ENDIF
8572C
8573C non optimise (12 max(8,10,12)
8574 ALLOCATE(mss(8*numels) ,stat=stat)
8575 ALLOCATE(mssx(ico*numels) ,stat=stat)
8576 ALLOCATE(mssf(8*numels*max(iale,ieuler,ialelag)) ,stat=stat)
8577 ALLOCATE(msq(numelq) ,stat=stat)
8578 IF(.NOT.ALLOCATED(mstr)) ALLOCATE(mstr(numelt) ,stat=stat)
8579 IF(.NOT.ALLOCATED(msp)) ALLOCATE(msp(numelp) ,stat=stat)
8580 ALLOCATE(msr(numelr*3) ,stat=stat)
8581 ALLOCATE(inp(numelp) ,stat=stat)
8582 ALLOCATE(inr(numelr*3) ,stat=stat)
8583 ALLOCATE(ins(numels*8) ,stat=stat)
8584 mss = zero
8585 mssx = zero
8586 mssf = zero
8587 msq = zero
8588 mstr = zero
8589 msp = zero
8590 msr = zero
8591 inp = zero
8592 inr = zero
8593 ins = zero
8594C------
8595C ELSE
8596C ALLOCATE(MSS(0) ,STAT=stat)
8597C ALLOCATE(MSSX(0) ,STAT=stat)
8598C ALLOCATE(MSSF(0) ,STAT=stat)
8599C ALLOCATE(MSQ(0) ,STAT=stat)
8600C ALLOCATE(MSTR(0) ,STAT=stat)
8601C ALLOCATE(MSP(0) ,STAT=stat)
8602C ALLOCATE(MSR(0) ,STAT=stat)
8603C ALLOCATE(INP(0) ,STAT=stat)
8604C ALLOCATE(INR(0) ,STAT=stat)
8605C ALLOCATE(INS(0) ,STAT=stat)
8606C ENDIF
8607C----
8608 ALLOCATE(xelemwa(maxnx*16) ,stat=stat)
8609 xelemwa = zero
8610 IF(i7stifs/=0) THEN
8611 ico = 0
8612 IF(numels10/=0.OR.numels16/=0.OR.numels20/=0.OR.itet4_10/=0) THEN
8613 ico=12
8614 ENDIF
8615 ALLOCATE(vns(numels*8+numelig3d*nctrlmax) ,stat=stat)
8616 ALLOCATE(vnsx(numels*ico) ,stat=stat)
8617 ALLOCATE(stc(numelc) ,stat=stat)
8618 ALLOCATE(stt(numelt) ,stat=stat)
8619 ALLOCATE(stp(numelp) ,stat=stat)
8620 ALLOCATE(str(numelr) ,stat=stat)
8621 ALLOCATE(sttg(numeltg) ,stat=stat)
8622 ALLOCATE(stur(0) ,stat=stat)
8623 ALLOCATE(bns(numels*8+numelig3d*nctrlmax) ,stat=stat)
8624 ALLOCATE(bnsx(numels*ico) ,stat=stat)
8625 ALLOCATE(vnige(numelig3d*nctrlmax) ,stat=stat)
8626 ALLOCATE(bnige(numelig3d*nctrlmax) ,stat=stat)
8627 vns = zero
8628 vnsx = zero
8629 stc = zero
8630 stt = zero
8631 stp = zero
8632 str = zero
8633 sttg = zero
8634 stur = zero
8635 bns = zero
8636 bnsx = zero
8637 vnige = zero
8638 bnige = zero
8639 ELSE
8640 ALLOCATE(vns(0))
8641 ALLOCATE(vnsx(0))
8642 ALLOCATE(stc(0))
8643 ALLOCATE(stt(0))
8644 ALLOCATE(stp(0))
8645 ALLOCATE(str(0))
8646 ALLOCATE(sttg(0))
8647 ALLOCATE(stur(0))
8648 ALLOCATE(bns(0))
8649 ALLOCATE(bnsx(0))
8650 ALLOCATE(vnige(0))
8651 ALLOCATE(bnige(0))
8652 ENDIF
8653 IF(i7stifs/=0)THEN
8654 ALLOCATE(volnod(numnod+numfakenodigeo) ,stat=stat)
8655 ALLOCATE(bvolnod(numnod+numfakenodigeo) ,stat=stat)
8656 ALLOCATE(etnod(numnod) ,stat=stat)
8657 ALLOCATE(nshnod(numnod) ,stat=stat)
8658 volnod = zero
8659 bvolnod = zero
8660 etnod = zero
8661 nshnod = zero
8662 stifint = zero
8663 stifintr = zero
8664 ELSE
8665 ALLOCATE(volnod(0) ,stat=stat)
8666 ALLOCATE(bvolnod(0) ,stat=stat)
8667 ALLOCATE(etnod(0) ,stat=stat)
8668 ALLOCATE(nshnod(0) ,stat=stat)
8669 ENDIF
8670
8671C-- Rot. Stiffness parith/on computation -> allocated even if no interfaces, to avoid "if" in element routines
8672 ALLOCATE(strc(numelc) ,stat=stat)
8673 ALLOCATE(strp(numelp) ,stat=stat)
8674 ALLOCATE(strr(numelr) ,stat=stat)
8675 ALLOCATE(strtg(numeltg) ,stat=stat)
8676 strc = zero
8677 strp = zero
8678 strr = zero
8679 strtg = zero
8680C---
8681 ALLOCATE(index(sindex) ,stat=stat)
8682 ALLOCATE(itri(sitri) ,stat=stat)
8683 ALLOCATE(ksysusr(2*jmax) ,stat=stat)
8684 ALLOCATE(isptag(numsph) ,stat=stat)
8685 IF(sindex > 0) index = 0
8686 IF(sitri > 0) itri = 0
8687 IF(jmax > 0) ksysusr = 0
8688 IF(numsph > 0) isptag = 0
8689C
8690 IF(nrbykin>0) THEN
8691 ALLOCATE(iwa(numnod),stat=stat)
8692 ELSE
8693 ALLOCATE(iwa(0),stat=stat)
8694 ENDIF
8695C
8696 CALL trace_out1()
8697
8698 err_msg='INITIALIZATION'
8699 err_category='ELEMENT INITIALIZATION'
8700 CALL trace_in1(err_msg,len_trim(err_msg))
8701C
8702C----------------------------------
8703C -- READING OF INITIAL STATE DATA
8704C----------------------------------
8705C
8706 ALLOCATE(sigi(nsigs,lsigi) ,stat=stat)
8707 ALLOCATE(sigsh(max(1,nsigsh),max(1,lsigsh)) ,stat=stat)
8708 ALLOCATE(sigsp(nsigi,lsigsp) ,stat=stat)
8709 ALLOCATE(sigsph(nsigsph,lsigsph) ,stat=stat)
8710 ALLOCATE(sigrs(nsigrs,lsigrs) ,stat=stat)
8711 ALLOCATE(sigbeam(nsigbeam,lsigbeam) ,stat=stat)
8712 ALLOCATE(sigtruss(nsigtruss,lsigtruss) ,stat=stat)
8713 ALLOCATE(strsglob(numels) ,stat=stat)
8714 ALLOCATE(straglob(numels) ,stat=stat)
8715 ALLOCATE(orthoglob(numels) ,stat=stat)
8716C
8717 IF(lsigi > 0) sigi = zero
8718 IF(lsigsh > 0) sigsh = zero
8719 IF(lsigsp > 0) sigsp = zero
8720 IF(lsigsph > 0) sigsph = zero
8721 IF(lsigrs > 0) sigrs = zero
8722 IF(lsigbeam > 0)sigbeam= zero
8723 IF(lsigtruss > 0)sigtruss= zero
8724 IF(numels > 0) strsglob = -1
8725 IF(numels > 0) straglob = -1
8726 IF(numels > 0) orthoglob = 0
8727C
8728
8729 IF(.NOT. ALLOCATED(idrape)) ALLOCATE(idrape(0))
8730
8731 CALL lec_inistate( ixs ,ixq ,ixc ,ixt ,
8732 1 ixp ,ixr ,geo ,pm ,kxsp ,
8733 2 ixtg ,index ,itri ,
8734 3 nsigsh ,igeo ,ipm ,nsigs ,nsigsph ,
8735 4 ksysusr ,ptshel ,ptsh3n ,ptsol ,ptquad ,
8736 5 ptsph ,numel ,nsigrs ,unitab ,isolnod ,
8737 6 lsubmodel,rtrans ,idrape ,nsigi ,
8738 7 ptspri ,nsigbeam,ptbeam ,nsigtruss,pttruss ,
8739 8 sigi ,sigsh ,sigsp ,sigsph ,sigrs ,
8740 9 sigbeam ,sigtruss,strsglob,straglob,orthoglob,
8741 a isigsh ,iyldini ,ksigsh3 ,fail_ini,iusolyld,
8742 b iuserl ,igrbric ,map_tables,iparg ,stack ,iworksh,
8743 c mat_elem%MAT_PARAM,numsph,nisp)
8744C
8745C----------------------------------
8746C -- ELEMENT INITIALIZATION
8747C----------------------------------
8748C
8749 ALLOCATE(dtelem(2*numel) ,stat=stat)
8750 IF(stat/=0) THEN
8751 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,
8752 . c1='DTELEM')
8753 ENDIF
8754 IF(numel > 0) dtelem = zero
8755C
8756 CALL startime(14,1)
8757
8758 CALL initia(iparg , elbuf , ms , in , v ,
8759 & x , ixs , ixq , ixc , ixt ,
8760 & ixp , ixr , detonators , geo , pm ,
8761 & rby , npby , lpby , npc , npts ,
8762 & tf , veul , ale_connectivity , skew , fill ,
8763 & ipart , itab , sensors , skvol ,
8764 & ixtg , thke , nloc_dmg , group_param_tab ,glob_therm,
8765 & igrnod , igrsurf , bufsf , vr ,
8766 & bufmat , xlas , ilas , dtelem , mss ,
8767 & msq , msc , mstr , msp , msr ,
8768 & mstg , ptg , inc , nod2eltg , knod2eltg,
8769 & inp , inr , intg , index ,
8770 & itri , kxx , ixx , xelemwa ,
8771 & iwa , nod2elq , knod2elq , nod2els , knod2els ,
8772 & kxsp , ixsp , nod2sp , ispcond , icode ,
8773 & iskew , iskwn , ispsym , xframe , isptag ,
8774 & spbuf , mssx , nsigi ,
8775 & npbyl , lpbyl , rbyl , msnf , mssf ,
8776 & nsigsh , igeo , ipm , nsigs ,
8777 & nsigsph , vns , vnsx , stc , stt ,
8778 & stp , str , sttg , stur , bns ,
8779 & bnsx , volnod , bvolnod , etnod , nshnod ,
8780 & stifint , fxbdep , fxbvit , fxbacc , fxbipm ,
8781 & fxbrpm , fxbelm , fxbsig , fxbmod , ins ,
8782 & ptshel , ptsh3n , ptsol , ptquad ,
8783 & wma , ptsph , fxbnod , mbufel , mdepl ,
8784 & fxani , numel , nsigrs ,
8785 & sh4tree , sh3tree , mcp , temp ,
8786 & imerge2 , iadmerge2 ,
8787 & slnrbm , nslnrbm , rmstifn , rmstifr ,
8788 & ms_ply0 , zi_ply0 , itagnd_shxfem , itagsh , mcpc ,
8789 & mcptg , xrefc , xreftg , xrefs , mssa ,
8790 & msrt , irbe2 , lrbe2 , inivol , kvol , nbsubmat,
8791 & ixs10 , ixs16 , ixs20 , totaddmas ,
8792 & ipmas , stiffn , msz20 , itagn , sitage ,
8793 & itage , ixr_kj , elbuf_tab ,
8794 & nom_opt , inom_opt(13) , inom_opt(21) , inom_opt(20),
8795 & sol2sph , irst , sh3trim , xfem_tab ,
8796 & kxig3d , ixig3d , msig3d , knot , nctrlmax,
8797 & wige , stack ,
8798 & rnoise , drape , sh4ang , sh3ang ,
8799 & geo_stack , igeo_stack , stifintr , strc , strp ,
8800 & strr , strtg , perturb , itagnd , nativ_sms,
8801 & iloadp , loadp , ptspri , nsigbeam ,
8802 & ptbeam , nsigtruss , pttruss ,
8803 & multi_fvm , sigi , sigsh , sigsp ,
8804 & sigsph , sigrs , sigbeam , sigtruss , strsglob ,
8805 & straglob , orthoglob , isigsh , iyldini , ksigsh3 ,
8806 & fail_ini , iusolyld , iuserl , iddlevel , inimap1d ,
8807 & inimap2d , func2d , fvm_inivel , tagprt_sms , igrbric ,
8808 & igrquad , igrsh4n , igrsh3n , igrpart , totmas ,
8809 & knotlocpc , knotlocel , vnige , bnige , fxbglm ,
8810 & fxbcpm , fxbcps , fxblm , fxbfls , fxbdls ,
8811 & fxb_matrix , fxb_matrix_add , fxb_last_address , inom_opt(11) , r_skew ,
8812 & knod2el1d , nod2el1d , ebcs_tab , rby_iniaxis , alea ,
8813 & knod2elc , nod2elc , dr , slrbody , drapeg ,
8814 & ipari , intbuf_tab , interfaces , mat_elem%MAT_PARAM ,
8815 & npreload_a , preload_a , fail_fractal ,fail_brokmann ,defaults ,
8816 & ndamp_freq_range,dampr , ibeam_vector , rbeam_vector ,d ,
8817 & lsigi ,lsigsp , srnoise2 ,nprw ,lprw ,
8818 & rwstif_pen ,sln_pen )
8819
8820
8821 IF(ninter>0.AND.numelig3d>0) THEN
8822 CALL fictivmassigeo(intbuf_tab,nctrlmax,msig3d ,kxig3d)
8823 IF(i7stifs/=0)THEN
8824 CALL bulkfakeigeo3(elbuf_tab,iparg,pm,kxig3d,igrsurf,stifint)
8825 ENDIF
8826 ENDIF
8827C
8828C----------------------------------
8829C
8830 CALL stoptime(14,1)
8831
8832
8833 CALL trace_out1()
8834!---
8835C--------------------------------------------
8836C INITIALIZATION OF BUFFERS --- IGRNOD, IGRBRIC, ..., IGRSURF, ... ---
8837C--------------------------------------------
8838 err_msg='GROUP ENTITIES BUFFER INITIALIZATION'
8839 err_category='INTERNAL'
8840 CALL trace_in1(err_msg,len_trim(err_msg))
8841!! WRITE(ISTDO,'(A)')TITRE(45)
8842!
8843 CALL group_ini(igrnod ,igrbric ,igrquad ,igrsh4n ,igrsh3n,
8844 . igrtruss ,igrbeam ,igrspring ,igrpart )
8845 CALL isurf_ini(igrsurf)
8846 CALL islin_ini(igrslin)
8847!
8848 CALL trace_out1()
8849C---
8850C
8851!! DEALLOCATE(SIGI)
8852!! DEALLOCATE(SIGSH)
8853!! DEALLOCATE(SIGSP)
8854 DEALLOCATE(sigsph)
8855!! DEALLOCATE(SIGRS)
8856!! DEALLOCATE(SIGBEAM)
8857!! DEALLOCATE(SIGTRUSS)
8858 DEALLOCATE(xelemwa)
8859 DEALLOCATE(strsglob)
8860 DEALLOCATE(straglob)
8861 DEALLOCATE(orthoglob)
8862C
8863 IF(ALLOCATED(ptshel))DEALLOCATE(ptshel)
8864 IF(ALLOCATED(ptsh3n))DEALLOCATE(ptsh3n)
8865 DEALLOCATE(ptsol)
8866 DEALLOCATE(ptquad)
8867 DEALLOCATE(ptsph)
8868 DEALLOCATE(ptspri)
8869 DEALLOCATE(ptbeam)
8870 DEALLOCATE(pttruss)
8871 DEALLOCATE(mss)
8872 DEALLOCATE(mssx)
8873 DEALLOCATE(mssf)
8874 DEALLOCATE(msq)
8875 DEALLOCATE(msr)
8876 IF(ALLOCATED(msig3d)) DEALLOCATE(msig3d)
8877 IF(ALLOCATED(tabconpatch)) DEALLOCATE(tabconpatch)
8878 DEALLOCATE(inp)
8879 DEALLOCATE(inr)
8880 DEALLOCATE(ins)
8881 DEALLOCATE(vns)
8882 DEALLOCATE(vnsx)
8883 DEALLOCATE(stc)
8884 DEALLOCATE(stt)
8885 DEALLOCATE(stp)
8886 DEALLOCATE(str)
8887 DEALLOCATE(sttg)
8888 DEALLOCATE(stur)
8889 DEALLOCATE(bns)
8890 DEALLOCATE(bnsx)
8891 DEALLOCATE(volnod)
8892 DEALLOCATE(bvolnod)
8893 DEALLOCATE(etnod)
8894 DEALLOCATE(nshnod)
8895 DEALLOCATE(vnige)
8896 DEALLOCATE(bnige)
8897 DEALLOCATE(strc)
8898 DEALLOCATE(strp)
8899 DEALLOCATE(strr)
8900 DEALLOCATE(strtg)
8901 DEALLOCATE(isptag)
8902 DEALLOCATE(index)
8903 DEALLOCATE(itri)
8904 DEALLOCATE(ksysusr)
8905 DEALLOCATE(iwa)
8906 IF (defaults%SHELL%IOFFSET==1) THEN
8907 DEALLOCATE(itagoset)
8908 DEALLOCATE(xyz)
8909 END IF
8910
8911C
8912C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8913C
8914 ENDIF !IF((IDDLEVEL == 1).OR.(ISMS_SELEC >= 3))
8915C
8916C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8917C
8918 IF((iddlevel == 0).AND.((ninter > 0).OR.(isms == 1))) THEN
8919 iddlevel = 1
8920 WRITE(istdo,*)
8921 . '.. RETURNS TO DOMAIN DECOMPOSITION FOR OPTIMIZATION'
8922C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8923C return to domain decomposition
8924C ---> for interface and AMS - small loop, without INITIA.F
8925C- ---> for AMS with automatic element selection - big loop with INITIA.F
8926C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8927C
8928 IF(iale+ieuler/=0) CALL paroi(pm ,ixs ,ixq ,icode ,ale_connectivity%NALE )
8929 IF(numels/=0) CALL lce16s4(ixs ,pm ,icode )
8930C
8931 lag_ncf = lag_ncf0
8932 lag_nkf = lag_nkf0
8933 lag_nhf = lag_nhf0
8934 lag_ncl = lag_ncl0
8935 lag_nkl = lag_nkl0
8936C
8937 DEALLOCATE(elbuf)
8938 DEALLOCATE(dd_iad)
8939C
8940 IF(isms_selec >= 3) THEN
8941C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8942C Additional treatments for big loop - element buffer deallocation
8943C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8944 DEALLOCATE(dtelem)
8945 flag_xfem = 0
8946 CALL deallocate_elbuf(
8947 . elbuf_tab, igeo ,iparg ,ixs ,ixc ,ixtg ,
8948 . flag_xfem, ixt ,ixp ,ixr ,kxx )
8949 DEALLOCATE(elbuf_tab)
8950C XFEM buffer deallocation
8951 IF(icrack3d > 0) THEN
8952 flag_xfem = 1
8953 DO ixel=1,nxel
8954 CALL deallocate_elbuf(
8955 . xfem_tab(1:ngroup,ixel),igeo ,iparg ,ixs ,ixc ,ixtg ,
8956 . flag_xfem ,ixt ,ixp ,ixr ,kxx )
8957 ENDDO
8958 ENDIF
8959C
8960 rewind(iin4)
8961 rewind(iin5)
8962C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8963 ENDIF
8964C
8965 GOTO 100
8966C
8967 ENDIF
8968C
8969C------------------------------------------------------------------------
8970C
8971C Check tied contacts -> hierarchy + warnings AMS
8972 err_category='INTERFACES'
8973 CALL chktyp2 (ipari, itab ,
8974 . nom_opt(lnopt1*inom_opt(3)+1),intbuf_tab,nativ_sms)
8975c-----------------------------------------------------------------------------------
8976c Initialization of frontwave structure for failure propagation
8977c
8978 CALL failwave_init(failwave,iparg,ixc,ixtg,numnod)
8979c
8980c-----------------------------------------------------------------------------------
8981c
8982C rigid material
8983C
8984
8985 err_msg='RIGID MATERIALS'
8986 err_category='RIGID MATERIALS'
8987 CALL trace_in1(err_msg,len_trim(err_msg))
8988 IF(irigid_mat > 0) THEN
8989C
8990C NFRBYM = 28 (
8991C NIRBYM = 2
8992 ALLOCATE(rbym(nfrbym*nrbym),irbym(nrbym*nirbym),lnrbym(ngslnrbym))
8993 rbym = 0
8994 irbym = 0
8995 lnrbym = 0
8996C
8997 CALL rigid_mat(nrbym ,ngslnrbym ,slnrbm, nslnrbm ,rmstifn,
8998 . rmstifr ,x ,v ,ms , in ,
8999 . rbym ,irbym ,lnrbym ,nom_opt)
9000C
9001 len_rm = nrbym*nspmd
9002 ALLOCATE(front_rm(len_rm))
9003 front_rm = 0
9004 ALLOCATE(weight_rm(nrbym))
9005 weight_rm = 1
9006 ELSE
9007 ALLOCATE( rbym(0),irbym(0),lnrbym(0), weight_rm(0))
9008 ENDIF
9009 CALL trace_out1()
9010 err_msg='DEALLOCATION'
9011 err_category='INTERNAL'
9012 CALL trace_in1(err_msg,len_trim(err_msg))
9013 DEALLOCATE(slnrbm,nslnrbm,rmstifn,rmstifr )
9014C----
9015 IF(ALLOCATED(msig3d)) DEALLOCATE(msig3d)
9016 IF(ALLOCATED(itag)) DEALLOCATE(itag)
9017C
9018C xfem for compostie
9019C
9020 CALL trace_out1()
9021 err_msg='XFEM FOR COMPOSIT'
9022 err_category='XFEM FOR COMPOSIT'
9023 CALL trace_in1(err_msg,len_trim(err_msg))
9024 IF(iplyxfem > 0) THEN
9025 nplyxfe = 0
9026 eplyxfe = 0
9027 DO i=1,numnod
9028 IF(itagnd_shxfem(i) > 0 )THEN
9029 nplyxfe = nplyxfe + 1
9030 inod_pxfem(i) = nplyxfe
9031 ENDIF
9032 ENDDO
9033C
9034 DO i=1,numelc
9035 IF(itagsh(i) > 0) THEN
9036 eplyxfe = eplyxfe + 1
9037 iel_pxfem(i) = eplyxfe
9038 ENDIF
9039 ENDDO
9040 ALLOCATE(ms_ply(nplyxfe*nplymax),stat=stat)
9041 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
9042 . msgtype=msgerror,
9043 . c1='MS_PLY')
9044 ms_ply=zero
9045 ALLOCATE(zi_ply(nplyxfe*nplymax),stat=stat)
9046 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
9047 . msgtype=msgerror,
9048 . c1='ZI_PLY')
9049 zi_ply=zero
9050C
9051 ALLOCATE(msz2(nplyxfe),stat=stat)
9052 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
9053 . msgtype=msgerror,
9054 . c1='MSZ2')
9055 msz2=zero
9056C
9057 CALL preplyxfem(ms_ply0,zi_ply0,iel_pxfem,inod_pxfem,ixc,
9058 . ms_ply,zi_ply,addcne_pxfem,msz20,msz2)
9059 lcne_pxfem = addcne_pxfem(nplyxfe+1) - 1
9060 ALLOCATE(cne_pxfem(lcne_pxfem),cel_pxfem(eplyxfe))
9061 cne_pxfem = 0
9062 cel_pxfem = 0
9063C
9064 CALL fillcne_pxfem(iel_pxfem,inod_pxfem,ixc,cep,addcne_pxfem,
9065 . cne_pxfem, cel_pxfem)
9066C
9067 ENDIF
9068C
9069 DEALLOCATE(ms_ply0,zi_ply0,msz20,itagsh)
9070 DEALLOCATE(itagnd_shxfem)
9071 CALL trace_out1()
9072C-------------------------------------
9073C /DAMP/VREL with RBY
9074C-------------------------------------
9075 IF (ndamp_vrel_rby > 0) THEN
9076 CALL damping_rby_spmdset(igrnod,ngrnod,ndamp,nrdamp,dampr,nnpby,
9077 . nrbody,npby,nrbmerge)
9078 ENDIF
9079c-------------------------------------------------------------------
9080c-------------------------------------------------------------------
9081C XFEM for crack propagation within shell (mono + multi layers)
9082c-------------------------------------------------------------------
9083 err_msg='XFEM FOR SHELLS'
9084 err_category='XFEM FOR SHELLS'
9085 CALL trace_in1(err_msg,len_trim(err_msg))
9086c
9087c------------------------------
9088 ALLOCATE(crklvset(nlevmax) ,stat=stat)
9089 ALLOCATE(crkshell(nlevmax) ,stat=stat)
9090 ALLOCATE(crksky(nlevmax) ,stat=stat)
9091 ALLOCATE(crkavx(nlevmax) ,stat=stat)
9092 ALLOCATE(indx_crk(nlevmax) ,stat=stat)
9093c
9094 indx_crk = 0 ! For Anim
9095 ncrkpart = 0 ! Nombre des parts xfem (local proc)
9096 ncrkxfe = 0 ! number of xfem nodes
9097 ecrkxfe = 0 ! number of xfem elements
9098 ecrkxfec = 0 ! Nombre des shells 4N xfem
9099 ecrkxfetg= 0 ! Nombre des shells 3N xfem
9100c------------------------------
9101 IF(icrack3d > 0) THEN
9102c-----
9103 IF(icrack3d == 1) THEN
9104 WRITE(istdo,'(A)')' .. XFEM MULTI-LAYER SHELL'
9105 ELSEIF(icrack3d == 2)THEN
9106 WRITE(istdo,'(A)')' .. XFEM MONO-LAYER SHELL'
9107 ELSEIF(icrack3d == 3)THEN
9108 WRITE(istdo,'(A)')' .. XFEM MIXED MONO/MULTI-LAYER SHELL'
9109 ENDIF
9110c-----
9111c local numbering of ghost nodes and elements of xfem parts
9112c IEL_CRKXFEM : local system numbering of Xfem shells
9113c INOD_CRKXFEM : local system numbering of Xfem nodes
9114c--------------------------------------------------
9115c build local Xfem node and element tables
9116 CALL pretag_xfem(iparg ,itage ,iel_crkxfem,itagn ,inod_crkxfem)
9117c
9118c build xfem sky address table
9119 CALL precrkxfem(iparg ,ixc ,ixtg ,ncrkxfe ,
9120 . iel_crkxfem ,inod_crkxfem ,addcne_crkxfem)
9121c--------------------------------------------------
9122c Addcne_crkxfem = Sky Xfem addresses table
9123 lcne_crkxfem = addcne_crkxfem(ncrkxfe+1) - 1 ! Table length Sky CNE_CRKXFEM
9124 ALLOCATE(crknodiad(lcne_crkxfem) ,stat=stat)
9125 ALLOCATE(cne_crkxfem(lcne_crkxfem) ,stat=stat)
9126 ALLOCATE(cel_crkxfem(ecrkxfe) ,stat=stat)
9127 ALLOCATE(cep_crkxfem(ecrkxfe) ,stat=stat)
9128 ALLOCATE(nodlevxf(ncrkxfe) ,stat=stat)
9129 ALLOCATE(crkedge(nxlaymax) ,stat=stat)
9130 ALLOCATE(xfem_phantom(nxlaymax) ,stat=stat)
9131 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,msgtype=msgerror,c1='NODLEVXF')
9132 crknodiad = 0
9133 cne_crkxfem = 0
9134 cel_crkxfem = 0
9135 cep_crkxfem = 0 ! Proc num of each xfem element
9136 numelcrk = 0
9137 nodlevxf = 0
9138c--------------------------------------------------
9139 CALL fillcne_xfem(lcne_crkxfem,iparg,
9140 . iel_crkxfem ,inod_crkxfem ,ixc ,ixtg ,cep ,
9141 . addcne_crkxfem,cne_crkxfem ,cel_crkxfem,cep_crkxfem,crknodiad)
9142c
9143 CALL xfem_crack_init(iparg ,ixc ,ixtg ,inod_crkxfem,nodlevxf,
9144 . indx_crk,ncrkpart,crkshell)
9145c--------------------------------------------------
9146 DEALLOCATE(itagn,itage)
9147C NODGLOBXFE
9148 snodglobxfe = 4*ecrkxfe*nlevmax ! NB max of Phant nodes, all folds.fake
9149C
9150 numedges = 0 ! number of global edges (same for all plies)
9151 siedgesh = 4*ecrkxfec + 3*ecrkxfetg
9152c
9153 ALLOCATE(iedgesh(siedgesh),stat=stat)
9154 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,msgtype=msgerror,c1='IEDGESH')
9155 ALLOCATE(ibordedge(siedgesh) ,stat=stat)
9156 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,msgtype=msgerror,c1='IBORDEDGE')
9157 ALLOCATE(nodedge(2*siedgesh),stat=stat)
9158 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,msgtype=msgerror,c1='NODEDGE')
9159 ALLOCATE(iedge(siedgesh),stat=stat)
9160 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,msgtype=msgerror,c1='IEDGE')
9161 ALLOCATE(iedge_tmp0(siedgesh),stat=stat)
9162 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,msgtype=msgerror,c1='IEDGE_TMP0')
9163 iedgesh = 0
9164 ibordedge = 0
9165 nodedge = 0
9166 iedge = 0
9167 iedge_tmp0= 0
9168!
9169 IF(ecrkxfec > 0) THEN
9170 iedgesh4 => iedgesh(1:4*ecrkxfec)
9171 ielcrk4 => iel_crkxfem(1:numelc)
9172 ELSE
9173 iedgesh4 => iedgesh
9174 ielcrk4 => iel_crkxfem
9175 ENDIF
9176!
9177 IF(ecrkxfetg > 0) THEN
9178 iedgesh3 => iedgesh(1+4*ecrkxfec:siedgesh)
9179 ielcrk3 => iel_crkxfem(1+numelc:numelc+numeltg)
9180 ELSE
9181 iedgesh3 => iedgesh
9182 ielcrk3 => iel_crkxfem
9183 ENDIF
9184c--------------------------------------------------
9185 CALL iedge_xfem(
9186 . ibordnode ,ixc ,ixtg ,iedgesh4 ,iedgesh3 ,
9187 . ibordedge ,nodedge ,ielcrk4 ,ielcrk3 ,iedge ,
9188 . cep_crkxfem,iedge_tmp0)
9189c
9190 CALL allocxfem(ixc ,ixtg ,iparg ,lcne_crkxfem,crklvset,
9191 . crksky ,crkavx,crkedge,xfem_phantom)
9192c--------------------------------------------------
9193 IF(ninicrack > 0) ! initial cracks
9194 . CALL inicrkfill (elbuf_tab,xfem_tab,
9195 . ixc ,ixtg ,iparg ,inicrack,
9196 . x ,iel_crkxfem,inod_crkxfem,xrefc ,xreftg ,
9197 . iedgesh4 ,iedgesh3,nodedge ,crklvset,
9198 . crkshell,crkedge ,xfem_phantom ,itab )
9199c--------------------------------------------------
9200 ALLOCATE(iedge_tmp(3,numedges),stat=stat)
9201 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,
9202 . msgtype=msgerror,c1='IEDGE_TMP')
9203 IF(numedges > 0) THEN
9204 DO i=1,numedges
9205 iedge_tmp(1,i) = 0
9206 iedge_tmp(2,i) = 0
9207 iedge_tmp(3,i) = iedge_tmp0(i)
9208 ENDDO
9209 ENDIF
9210 DEALLOCATE(iedge_tmp0)
9211C---
9212 ALLOCATE(elcutc(2*(numelc+numeltg)) ,stat=stat)
9213 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,
9214 . msgtype=msgerror,c1='ELCUTC')
9215 elcutc = 0
9216C---
9217 ALLOCATE(nodenr(ncrkxfe) ,stat=stat)
9218 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,
9219 . msgtype=msgerror,c1='NODENR')
9220 nodenr = 0
9221C---
9222 ALLOCATE(kxfenod2elc(ncrkxfe) ,stat=stat)
9223 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,
9224 . msgtype=msgerror,c1='KXFENOD2ELC')
9225 kxfenod2elc = 0
9226C---
9227 ALLOCATE(enrtag(numnod*ienrnod) ,stat=stat)
9228 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,
9229 . msgtype=msgerror,c1='ENRTAG')
9230 enrtag = 0
9231C---
9232 ELSE
9233 numedges = 0
9234 siedgesh = 0
9235 numelcrk= 0
9236 ALLOCATE(cne_crkxfem(0),cel_crkxfem(0),cep_crkxfem(0))
9237 ALLOCATE(iedgesh(0))
9238 ALLOCATE(ibordedge(0))
9239 ALLOCATE(nodedge(0))
9240 ALLOCATE(iedge(0))
9241 ALLOCATE(iedge_tmp(0,0))
9242 ALLOCATE(crknodiad(0))
9243 ALLOCATE(nodlevxf(0))
9244 ALLOCATE(crkedge(0))
9245C
9246 ALLOCATE(elcutc(0))
9247 ALLOCATE(nodenr(0))
9248 ALLOCATE(kxfenod2elc(0))
9249 ALLOCATE(enrtag(0))
9250 ENDIF ! ICRACK3D > 0 (Xfem)
9251C----------------------------------
9252 CALL trace_out1()
9253C----------------------------------
9254C RBE2 Desactivation des elements initialization for ITRUOFF ...
9255C----------------------------------
9256 err_msg='RIGID BODY ELEMENT DEACTIVATION'
9257 err_category='RIGID BODY'
9258 CALL trace_in1(err_msg,len_trim(err_msg))
9259 CALL seteloff2(ixs ,ixc ,ixt ,ixp ,ixr ,
9260 2 ixtg ,iparg ,isoloff,isheoff,
9261 3 itruoff,ipouoff,iresoff,itrioff,igrnrb2,
9262 4 igrnod ,irbe2 )
9263C----------------------------------
9264C rbody deactivation of rigid body elements (on by default)
9265C----------------------------------
9266 CALL seteloff(ixs ,ixc ,ixt ,ixp ,ixr ,
9267 2 ixtg ,iparg , isoloff,isheoff,
9268 3 itruoff,ipouoff,iresoff,itrioff,igrnrby,
9269 4 igrnod ,elbuf_tab,iquaoff,ixq )
9270 CALL trace_out1()
9271C----------------------------------
9272C Interf Stamp. Tri et initialisations
9273C----------------------------------
9274 err_msg='STAMPING INITIALIZATION'
9275 err_category='INTERFACES'
9276 CALL trace_in1(err_msg,len_trim(err_msg))
9277 IF(ninter/=0)THEN
9278C-----
9279 aux = max( numnod , numelt+numelp+numelr+numeltg+numelc+100 ,
9280 . maxrtm+100 )
9281 ns_i21 = 2*numnod + 2002 + 4*aux
9282 siwork = ns_i21
9283 srwork = max(6000,numnod)
9284 ALLOCATE(iwork(siwork) ,stat=stat)
9285 ALLOCATE(rwork(srwork) ,stat=stat)
9286 iwork = 0
9287 rwork = zero
9288C-----
9289 CALL inintr_thkvar(elbuf_tab,
9290 1 ipari ,intbuf_tab ,inscr ,x ,
9291 2 ixs ,ixc ,pm ,geo ,itab ,
9292 3 iwork ,rwork ,ixtg ,d ,
9293 4 iparg ,knod2els ,
9294 5 knod2elc,knod2eltg,nod2els,nod2elc ,nod2eltg,
9295 6 intstamp,skew ,ms ,in ,v ,
9296 7 vr ,rby ,npby ,lpby ,iparts ,
9297 8 ipartc ,ipartg,thk_part,nom_opt,inom_opt(3))
9298 DEALLOCATE(rwork)
9299 DEALLOCATE(iwork)
9300C-----
9301 END IF
9302C-----
9303
9304 DEALLOCATE(thk_part)
9305 CALL trace_out1()
9306C-------------------------------------------------------------
9307C Set INTERCEP only for INTERFACE24 (flag=0)
9308C-------------------------------------------------------------
9309 CALL set_intercep(ipari,intercep,0,intbuf_tab,itab,cep) ! this call is maintained here to avoid a bug
9310C-------------------------------------------------------------
9311C Interface type 24 - set FRONTPLUS to neighboug surfaces
9312C-------------------------------------------------------------
9313 i24maxnsne = 0
9314 CALL i24setnodes(ipari,intbuf_tab,intercep,itab,i24maxnsne)
9315
9316C-------------------------------------------------------------
9317C----------------------------------
9318C Interf.Type 7 and 21: Assignment of rigidites on the second side
9319C----------------------------------
9320 err_msg='INTERFACES STIFFNESS'
9321 err_category='INTERFACES'
9322 CALL trace_in1(err_msg,len_trim(err_msg))
9323 IF(ninter>0)THEN
9324 IF (i7stifs/=0) THEN
9325 CALL stifint_icontrol(
9326 1 numnod, stifint, npari, ninter,
9327 2 ipari, npropgi, numgeo, igeo,
9328 3 numels, nixs, ixs, numels8,
9329 4 numels10, ixs10, numels16, ixs16,
9330 5 numels20, ixs20, npropm, nummat,
9331 6 pm, intbuf_tab)
9332 CALL inintr1 (ipari ,stifint, intbuf_tab ,stfac)
9333 END IF
9334 DEALLOCATE(stfac)
9335 ENDIF
9336 CALL trace_out1()
9337
9338C--------FRICTION OROTHTROPIC DIRECTIONS COMPUTATION -----
9339 IF(ninter > 0 .AND.ninterfric >0.AND. iorthfricmax > 0) THEN
9340
9341 CALL inintr_orthdirfric(
9342 a ipari ,intbuf_tab,intbuf_fric_tab,igeo ,geo ,
9343 b x , ixtg ,ixc ,ipartg , ipartc ,
9344 c pfricorth,irepforth,phiforth , vforth ,knod2elc ,
9345 d knod2eltg,nod2eltg ,nod2elc ,iworksh ,pm ,
9346 e stack%PM ,thke ,skew ,itab ,ipart )
9347
9348c DEALLOCATE(PFRICORTH ,IREPFORTH , VFORTH ,PHIFORTH )
9349
9350 ENDIF
9351
9352 DEALLOCATE(tagprt_fric)
9353C---------------------------
9354C IMPACTS LASER TRAITEMENT SPMD 2eme Phase
9355C---------------------------
9356 err_msg='LASER IMPACT PHASE 2'
9357 err_msg='LASER'
9358 CALL trace_in1(err_msg,len_trim(err_msg))
9359 IF(nlaser>0) THEN
9360 CALL laserp3(ilas ,iparg )
9361 ENDIF
9362 CALL trace_out1()
9363C----------------------------------
9364C reading rivets
9365C----------------------------------
9366 err_msg='RIVETS'
9367 err_category='RIVETS'
9368 CALL trace_in1(err_msg,len_trim(err_msg))
9369 slrivet = nrivet*4
9370 srivet = nrivet*nrivf
9371 ALLOCATE(lrivet(slrivet) ,stat=stat)
9372 ALLOCATE(rivet(srivet) ,stat=stat)
9373 lrivet = 0
9374 rivet = zero
9375C
9376 IF(nrivet/=0)THEN
9377 WRITE(istdo,'(A)') ' .. RIVETS '
9378 CALL hm_read_rivet(lrivet ,v ,vr ,ms ,in ,
9379 2 rivet ,geo ,itab ,itabm1 ,d ,
9380 3 ipart ,igeo ,lsubmodel)
9381 ENDIF
9382c CALL ANCHECK(81)
9383 CALL trace_out1()
9384C----------------------------------
9385C SEATBELT 2D->1D for SECTIONS
9386C----------------------------------
9387 IF(nb_seatbelt_shells /= 0)THEN
9388 CALL my_alloc(seatbelt_shell_to_spring,numelc,2)
9389 IF(numelc > 0)THEN
9390 seatbelt_shell_to_spring(1:numelc,1) = 0
9391 seatbelt_shell_to_spring(1:numelc,2) = 0
9392 ENDIF
9393c
9394 DO i=1,nb_seatbelt_shells
9395
9396 l0 = 0
9397 IF(seatbelt_converted_elements(2,i) /= 0) THEN
9398 l0 = set_usrtos(seatbelt_converted_elements(1,i),map_tables%ISH4NM,numelc)
9399 ENDIF
9400
9401 l1 = 0
9402 IF(seatbelt_converted_elements(2,i) /= 0) THEN
9403 l1 = set_usrtos(seatbelt_converted_elements(2,i),map_tables%ISPRINGM,numelr)
9404 ENDIF
9405
9406 l2 = 0
9407 IF(seatbelt_converted_elements(3,i) /= 0) THEN
9408 l2 = set_usrtos(seatbelt_converted_elements(3,i),map_tables%ISPRINGM,numelr)
9409 ENDIF
9410
9411 IF(l0 /= 0) THEN
9412 seatbelt_shell_to_spring(l0,1) = l1
9413 seatbelt_shell_to_spring(l0,2) = l2
9414 ENDIF
9415
9416 ENDDO
9417 ELSE
9418 CALL my_alloc(seatbelt_shell_to_spring,1,2)
9419 seatbelt_shell_to_spring(1,1) = 0
9420 seatbelt_shell_to_spring(1,2) = 0
9421 ENDIF
9422C----------------------------------
9423C reading sections
9424C----------------------------------
9425 err_msg='SECTIONS'
9426 err_category='SECTIONS'
9427 CALL trace_in1(err_msg,len_trim(err_msg))
9428 IF(nsect/=0)THEN
9429 WRITE(istdo,'(A)') ' .. SECTIONS'
9430 CALL prelecsec(
9431 1 snstrf ,ssecbuf ,itabm1 ,0 ,nom_opt(lnopt1*inom_opt(8)+1),
9432 2 igrbric ,igrquad ,igrsh4n ,igrsh3n ,igrtruss ,
9433 3 igrbeam ,igrspring ,igrnod ,lsubmodel, seatbelt_shell_to_spring,
9434 4 nb_seatbelt_shells)
9435 ALLOCATE(nstrf(snstrf) ,stat=stat)
9436 ALLOCATE(secbuf(ssecbuf) ,stat=stat)
9437 nstrf = 0
9438 secbuf = zero
9439 CALL lecsec42(ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
9440 2 ixtg ,x ,itab ,itabm1 ,
9441 3 igrnod ,secbuf ,
9442 4 ipari ,ixs10 ,ixs20 ,ixs16 ,unitab ,
9443 5 iskwn ,xframe ,isolnod,nom_sect,rtrans,
9444 6 lsubmodel,nom_opt(lnopt1*inom_opt(8)+1),igrbric,igrquad,igrsh4n,
9445 7 igrtruss ,igrbeam,igrspring,igrsh3n,seatbelt_shell_to_spring,
9446 8 nb_seatbelt_shells)
9447 snstrf = SIZE(nstrf)
9448 ELSE
9449 snstrf = 0
9450 ssecbuf = 0
9451 ALLOCATE(nstrf(snstrf) ,stat=stat)
9452 ALLOCATE(secbuf(ssecbuf) ,stat=stat)
9453 ENDIF
9454 IF(ALLOCATED(seatbelt_shell_to_spring)) DEALLOCATE(seatbelt_shell_to_spring)
9455 CALL trace_out1()
9456C--------------------------------------------
9457C SENSORS INITIALIZATION
9458C--------------------------------------------
9459c
9460 CALL inisen(sensors ,ipari,nom_opt,inom_opt(5),
9461 . inom_opt(8),inom_opt(4),ixr ,r_skew ,numelr,
9462 . nsect ,ninter ,nintsub ,nrwall ,nrbody )
9463c
9464C----------------------------------
9465C reading joints
9466C----------------------------------
9467 err_msg='JOINTS'
9468 err_category='JOINTS'
9469 CALL trace_in1(err_msg,len_trim(err_msg))
9470 CALL hm_prelecjoi(sljoint ,igrnod,lsubmodel)
9471 ALLOCATE(ljoint(sljoint) ,stat=stat)
9472 ljoint = 0
9473
9474 ALLOCATE( cyl_join(njoint) )
9475
9476 IF(njoint/=0)THEN
9477 WRITE(istdo,'(A)') ' .. CYLINDRICAL JOINTS'
9478 CALL init_joint(njoint)
9479 CALL hm_read_cyljoint(ljoint ,itabm1 ,d ,itab ,igrnod ,
9480 . nom_opt(lnopt1*inom_opt(7)+1),lsubmodel)
9481 ENDIF
9482c CALL ANCHECK(83)
9483 CALL trace_out1()
9484C-------------------------------------------------
9485C BLOCKING MAT 11 NODES OUTSIDE COMPUTED DOMAIN
9486C-------------------------------------------------
9487 err_msg='BLOCK BOUNDARY MATERIAL NODES'
9488 err_category='BLOCK BOUNDARY MATERIAL NODES'
9489 CALL trace_in1(err_msg,len_trim(err_msg))
9490 IF(iale+ieuler /= 0 .AND. numelq+numels > 0) THEN
9491 CALL nodm11(pm,ixs,ixq,icode)
9492 ENDIF
9493 CALL trace_out1()
9494C-------------------------------------------------
9495C LISTE DES NOEUDS CORRESPONDANT A ONE MILIEU POREUX
9496C-------------------------------------------------
9497 err_msg='POROUS NODES'
9498 err_category='POROUS NODES'
9499 CALL trace_in1(err_msg,len_trim(err_msg))
9500 IF(iale+ieuler /=0 .AND. numelq+numels >0)THEN
9501 siwork = numnod+4*nfacx
9502 ALLOCATE(iwork(siwork) ,stat=stat)
9503 siwork = 0
9504 CALL pornod(geo ,ixs ,ixq ,iwork ,icode ,
9505 + itab ,npby ,lpby ,igeo)
9506 snodpor = numpor
9507 ALLOCATE(nodpor(snodpor) ,stat=stat)
9508 nodpor = iwork(1:snodpor)
9509 DEALLOCATE(iwork)
9510 ELSE
9511 snodpor = 0
9512 ALLOCATE(nodpor(snodpor) ,stat=stat)
9513 ENDIF
9514 CALL trace_out1()
9515C---
9516 IF(kcontact/=0)THEN
9517 kcontact=1
9518 sicontact=numnod
9519 ALLOCATE(icontact(sicontact))
9520 icontact = 0
9521 ELSE
9522 ALLOCATE(icontact(0))
9523 END IF
9524 IF(nadmesh/=0)THEN
9525 srcontact=numnod
9526 ALLOCATE(rcontact(srcontact))
9527 rcontact = ep30
9528 ALLOCATE(acontact(srcontact))
9529 acontact = ep30
9530 ALLOCATE(pcontact(srcontact))
9531 pcontact = zero
9532 ELSE
9533 ALLOCATE(rcontact(0))
9534 ALLOCATE(acontact(0))
9535 ALLOCATE(pcontact(0))
9536 END IF
9537C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
9538 CALL fvdim(t_monvol)
9539 ALLOCATE(fvdata(nfvbag))
9540
9541C
9542 err_msg='FVMBAG MESHING'
9543 err_category='FVMBAG MESHING'
9544 CALL trace_in1(err_msg,len_trim(err_msg))
9545 IF(tetramesher_used) THEN
9546 CALL fvmesh0(t_monvol, node_coord, ixs_temp, ixc, ixtg, pm,ipm, igrsurf, xyzref ,nb_total_node)
9547 ELSE
9548 CALL fvmesh0(t_monvol, x, ixs, ixc, ixtg, pm,ipm, igrsurf, xyzref ,numnod)
9549 ENDIF
9550
9551 CALL copy_to_volmon(t_monvol, lrcbag, t_monvol_metadata%RCBAG, svolmon, volmon)
9552
9553 CALL copy_to_monvol(t_monvol, licbag, t_monvol_metadata%ICBAG, smonvol, monvol)
9554
9555 CALL trace_out1()
9556 err_msg='BEM FLOW'
9557 err_category='BEM FLOW'
9558 CALL trace_in1(err_msg,len_trim(err_msg))
9559C----------------------------------
9560C reading flows (incompressible fluid or thermal)
9561C----------------------------------
9562 IF(nflow>0) THEN
9563 CALL hm_preread_bem(igrsurf, igrnod , nnft ,
9564 . unitab , nom_opt(lnopt1*inom_opt(12)+1), lsubmodel)
9565C
9566 ALLOCATE(iflow(liflow), rflow(lrflow))
9567 iflow(1:liflow) = 0
9568 rflow(1:lrflow) = zero
9569C
9570 DO i=1,nspmd
9571 memflow(1,i)=0
9572 memflow(2,i)=0
9573 ENDDO
9574C
9575 CALL hm_read_bem(igrsurf, iflow, rflow,
9576 . npc1 , igrnod , memflow(1,1),unitab,
9577 . x, nom_opt(lnopt1*inom_opt(12)+1),lgauge, igrv, lsubmodel,iresp)
9578C
9579 ELSE
9580 ALLOCATE(iflow(0), rflow(0))
9581 ENDIF
9582 CALL trace_out1()
9583 err_msg='EULERIAN BOUNDARY CONDITIONS'
9584 err_category='EULERIAN BOUNDARY CONDITIONS'
9585 CALL trace_in1(err_msg,len_trim(err_msg))
9586c
9587 IF(nebcs > 0)THEN
9588 segindx = 0
9589 !update due to domain decomposition
9590 CALL iniebcs(ale_connectivity, 1,igrsurf, ixs, ixq, ixtg,
9591 . pm, igeo, x, sensors, monvol, multi_fvm%IS_USED, ebcs_tab, ebcs_tag_cell_spmd,itab)
9592 !initialization
9593 CALL iniebcsp0(x, iparg, elbuf_tab, ebcs_tab, ixs, ixq, ixtg, iparts, ipartq, ipartg, pm, ipm, mat_elem%MAT_PARAM)
9594 CALL iniebcs_propellant(ixs,ixq,ixtg,multi_fvm%IS_USED,ebcs_tab,mat_elem%MAT_PARAM,sixs,sixq,sixtg,nummat)
9595 ENDIF
9596 CALL trace_out1()
9597C--------------------------------------------
9598C Multiplier Lagrange
9599C--------------------------------------------
9600 err_msg='LAGRANGE MULTIPLIERS'
9601 err_category='LAGRANGE MULTIPLIERS'
9602 CALL trace_in1(err_msg,len_trim(err_msg))
9603 ncmax = lag_ncf + lag_ncl
9604 nkmax = lag_nkf + lag_nkl
9605 lag_nhl = lag_ncl * 10
9606
9607 IF( ALLOCATED(iadhf) ) DEALLOCATE(iadhf)
9608 IF( ALLOCATED(iadll) ) DEALLOCATE(iadll)
9609 IF( ALLOCATED(lll) ) DEALLOCATE(lll)
9610 IF( ALLOCATED(jll) ) DEALLOCATE(jll)
9611 ALLOCATE(iadhf(lag_ncf + 1))
9612 ALLOCATE(iadll(lag_ncf + 1))
9613 ALLOCATE(lll(lag_nkf))
9614 ALLOCATE(jll(lag_nkf))
9615 IF(lag_ncf > 0) THEN
9616C---
9617 CALL lagm_ini(lag_nhf ,iadhf ,iadll ,jll ,lll ,
9618 2 ipari ,intbuf_tab,igrnod, ibcslag ,
9619 3 ms ,in ,gjbufi ,ibmpc ,ibmpc2 ,
9620 4 ibmpc3 ,ibmpc4 ,ibfv ,vel ,itab ,
9621 5 nom_opt,inom_opt(3),inom_opt(15),inom_opt(16),
9622 6 inom_opt(17),inom_opt(18))
9623 ALLOCATE(jcihf(lag_nhf), stat=stat)
9624 CALL lagm_nhf(lag_ncf, iadll ,jll ,lll ,jcihf )
9625C---
9626 slagbuf = lag_nhf + 3*lag_ncf+2
9627 ALLOCATE(lagbuf(slagbuf), stat=stat)
9628 l1 = lag_ncf + 1
9629 l2 = l1 + lag_nhf
9630 l3 = l2 + lag_ncf + 1
9631 l4 = l3 + lag_nkf
9632 l5 = l4 + lag_nkf
9633 lagbuf = 0
9634 lagbuf(1:l1) = iadhf(1:lag_ncf + 1)
9635 lagbuf(l1+1:l2) = jcihf(1:lag_nhf)
9636 DEALLOCATE(jll)
9637 DEALLOCATE(iadhf)
9638 DEALLOCATE(jcihf)
9639 ELSE
9640 slagbuf = 0
9641 ALLOCATE(lagbuf(slagbuf))
9642 ENDIF
9643C---
9644 IF(nrwlag>0)
9645 . CALL lgmini_rwl(nprw , lprw , ms , itab,
9646 . nom_opt(lnopt1*inom_opt(5)+1))
9647 IF(ninter>0)
9648 . CALL lgmini_i7(ipari ,intbuf_tab , ms , itab , igrnod,
9649 . nom_opt(lnopt1*inom_opt(3)+1))
9650 nhmax = lag_nhf + lag_nhl
9651 lwat = 0
9652 IF(lag_ncl/=0) lwat = max(6*(numels16+numels20),6*numnod)
9653 l_mul_lag1 = 2*ncmax + 4*nkmax + lwat + 2
9654 IF(ncmax>0) THEN
9655 l_mul_lag = max(l_mul_lag1+numnod,
9656 . 11*ncmax + 4*nkmax + 3*nhmax + 6*numnod + 2)
9657 ENDIF
9658
9659 slambda = ncmax
9660 ALLOCATE(lambda(slambda), stat=stat)
9661 IF(slambda > 0) lambda = zero
9662 CALL trace_out1()
9663C----------------------------------
9664C COMPUTATION OF MODAL GRAVITY FORCES
9665C----------------------------------
9666 err_msg='GRAVITY NODAL FORCES'
9667 err_category='GRAVITY NODAL FORCES'
9668 CALL trace_in1(err_msg,len_trim(err_msg))
9669 IF(nfxbody>0) THEN
9670 DO nfx=1,nfxbody
9671 aipm=(nfx-1)*nbipm
9672 anod=fxbipm(aipm+6)
9673 nlgrav=fxbipm(aipm+25)
9674 agrvi=fxbipm(aipm+26)
9675 agrvr=fxbipm(aipm+27)
9676 amod=fxbipm(aipm+7)
9677 IF(nlgrav>0)
9678 . CALL fxbgrav(
9679 . igrv , lgrav , fxbipm(aipm+18), fxbnod(anod),
9680 . fxbgrvi(agrvi), fxbgrvr(agrvr), fxbipm(aipm+3), fxbmod(amod),
9681 . fxbipm(aipm+4), fxbipm(aipm+17), ms , grav ,
9682 . skew , fxbipm(aipm+29), nfx , fxbipm(aipm+30))
9683 ENDDO
9684 ENDIF
9685 CALL trace_out1()
9686
9687C--------------------------------------------
9688C THPARTS TREADING
9689C--------------------------------------------
9690 err_msg='TIME HISTORY PARTS'
9691 err_category='TIME HISTORY'
9692 CALL trace_in1(err_msg,len_trim(err_msg))
9693 IF(nthpart >0) THEN
9694 CALL hm_read_thpart(ipart ,igrbric ,igrquad ,igrsh4n ,igrsh3n,
9695 . igrtruss ,igrbeam ,igrspring, lsubmodel)
9696 ENDIF
9697 CALL trace_out1()
9698
9699 CALL create_map_tables ( map_tables ,2 ,
9700 * lsubmodel ,subsets,
9701 * ipart,
9702 * ixs ,ixq ,ixc ,ixtg ,
9703 * ixt ,ixp ,ixr ,kxsp,lrivet,
9704 * ibid )
9705C----------------------------------
9706C TH GROUP READING
9707C----------------------------------
9708 err_msg='TIME HISTORY GROUPS'
9709 err_category='TIME HISTORY'
9710 CALL trace_in1(err_msg,len_trim(err_msg))
9711c
9712 ! Number of /TH read by hm reader
9713 CALL hm_option_count('/TH' ,nthgrp0)
9714 CALL hm_option_count('/ATH',nthgrp01(1))
9715 CALL hm_option_count('/BTH',nthgrp01(2))
9716 CALL hm_option_count('/CTH',nthgrp01(3))
9717 CALL hm_option_count('/DTH',nthgrp01(4))
9718 CALL hm_option_count('/ETH',nthgrp01(5))
9719 CALL hm_option_count('/FTH',nthgrp01(6))
9720 CALL hm_option_count('/GTH',nthgrp01(7))
9721 CALL hm_option_count('/HTH',nthgrp01(8))
9722 CALL hm_option_count('/ITH',nthgrp01(9))
9723 DO i=1,9
9724 nthgrpmx = max(nthgrp0,nthgrp01(i))
9725 ENDDO
9726c
9727 ! Number of /TH/MONV
9728 nbr_th_monvol = 0
9729 nbr_th_monvol01(1:9) = 0
9730 CALL hm_option_count('/TH/MONV' ,nbr_th_monvol)
9731 CALL hm_option_count('/ATH/MONV',nbr_th_monvol01(1))
9732 CALL hm_option_count('/BTH/MONV',nbr_th_monvol01(2))
9733 CALL hm_option_count('/CTH/MONV',nbr_th_monvol01(3))
9734 CALL hm_option_count('/DTH/MONV',nbr_th_monvol01(4))
9735 CALL hm_option_count('/ETH/MONV',nbr_th_monvol01(5))
9736 CALL hm_option_count('/FTH/MONV',nbr_th_monvol01(6))
9737 CALL hm_option_count('/GTH/MONV',nbr_th_monvol01(7))
9738 CALL hm_option_count('/HTH/MONV',nbr_th_monvol01(8))
9739 CALL hm_option_count('/ITH/MONV',nbr_th_monvol01(9))
9740 DO i=1,9
9741 nbr_th_monvol = max(nbr_th_monvol,nbr_th_monvol01(i))
9742 ENDDO
9743c
9744 output%TH%SITHGRP = (nthgrp0+nbr_th_monvol)*nithgr
9745 lithpart = nthgrpmx*(npart+nthpart)
9746 lithsub = nthgrpmx*nsubs
9747 lithbufmx = 0
9748 lithbufi = 0
9749 nvartot = 0
9750 nvartot0 = 0
9751c
9752 ! New routine to pre-read /TH with hm_reader and old reader
9753 ! (needed to estimate sizes of buffers)
9754 CALL hm_read_prethgrou(lithbufmx,nvartot0,lsubmodel,0,output)
9755 DO i=1,9
9756 CALL hm_read_prethgrou(lithbufi,nvartot,lsubmodel,i,output)
9757 lithbufmx = max(lithbufmx,lithbufi,nvartot,nvartot0)
9758 nvartotmax = max(nvartotmax,nvartot,nvartot0)
9759 ENDDO
9760c
9761 sithvar = nvartot0*10+nvartot*10+nvolu*10
9762 ALLOCATE(ithpart(lithpart) , stat=stat)
9763 ALLOCATE(ithsub(lithsub) , stat=stat)
9764 ALLOCATE(ithbuftmp(lithbufmx), stat=stat)
9765 ALLOCATE(ithvar(sithvar) , stat=stat)
9766 IF(sithvar > 0) ithvar(1:sithvar) = 0
9767 CALL my_alloc(output%TH%ITHGRP,output%TH%SITHGRP)
9768c
9769 output%TH%ITHGRP(1:output%TH%SITHGRP) = 0
9770 ithpart = 0
9771 ithsub = 0
9772 ithbuftmp = 0
9773 output%TH%SITHBUF = 0
9774 ithflag = 10
9775c-----
9776 interfaces%PARAMETERS%INTCAREA =0
9777 ! New routine to read /TH with hm_reader and old reader
9778 CALL hm_read_thgrou(
9779 1 output%TH%ITHGRP ,ithbuftmp,itab ,itabm1 ,ixtg ,
9780 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
9781 3 kxx ,ixx ,ipart ,output%TH%SITHBUF,
9782 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
9783 5 nthgrp ,ithpart ,ithsub ,fxbipm ,ipart ,lipart1 ,
9784 6 8 ,12 ,imerge ,ithvar ,
9785 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
9786 8 inom_opt(5),inom_opt(8),inom_opt(7),
9787 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
9788 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
9789 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
9790 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
9791 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
9792 e map_tables, 0,inom_opt(31),inom_opt(32),sensors ,
9793 f interfaces,ipari ,output%TH%DUMP_THNMS1_FILE,glob_therm%ITHERM_FE,output%CHECKSUM,
9794 g nsubdom,ipri)
9795C
9796 CALL my_alloc(output%TH%ITHBUF,output%TH%SITHBUF)
9797 output%TH%ITHBUF(1:output%TH%SITHBUF) = ithbuftmp(1:output%TH%SITHBUF)
9798
9799 If (lithbufmx < output%TH%SITHBUF) then
9800 print*,'Allocation error :LITHBUFMX, SITHBUF=',lithbufmx,output%TH%SITHBUF
9801 endif
9802 ALLOCATE(rthbuf(srthbuf), stat=stat)
9803 IF(srthbuf > 0) CALL thskewc(
9804 1 rthbuf ,output%TH%ITHGRP ,output%TH%ITHBUF,x ,ixc ,ixtg ,skew,nthgrp)
9805
9806C--------
9807C ithgrpa
9808C--------
9809 IF(nthgrp01(1) > 0) THEN
9810 output%TH%SITHGRPA = (nthgrp01(1)+nbr_th_monvol)*nithgr
9811 CALL my_alloc(output%TH%ITHGRPA,output%TH%SITHGRPA)
9812 output%TH%ITHGRPA = 0
9813 ithpart = 0
9814 ithsub = 0
9815 ithbuftmp = 0
9816 output%TH%SITHBUFA = 0
9817 ithflag = 1
9818c-----
9819 IF(npart+nthpart>0) THEN
9820 ipartthi=>ipartth(1:2*(npart+nthpart))
9821 ELSE
9822 ipartthi=>ipartth
9823 END IF
9824 CALL hm_read_thgrou(
9825 1 output%TH%ITHGRPA ,ithbuftmp,itab ,itabm1 ,ixtg ,
9826 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
9827 3 kxx ,ixx ,ipart ,output%TH%SITHBUFA ,
9828 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
9829 5 nthgrp1(1),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
9830 6 1 ,1 ,imerge ,ithvar ,
9831 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
9832 8 inom_opt(5),inom_opt(8),inom_opt(7),
9833 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
9834 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
9835 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
9836 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
9837 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
9838 e map_tables, 1,inom_opt(31),inom_opt(32),sensors,
9839 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
9840 g nsubdom,ipri)
9841C
9842 CALL my_alloc(output%TH%ITHBUFA,output%TH%SITHBUFA)
9843 output%TH%ITHBUFA = ithbuftmp(1:output%TH%SITHBUFA)
9844 ELSE
9845 output%TH%SITHGRPA = 0
9846 output%TH%SITHBUFA = 0
9847 CALL my_alloc(output%TH%ITHGRPA,output%TH%SITHGRPA)
9848 CALL my_alloc(output%TH%ITHBUFA,output%TH%SITHBUFA)
9849 ENDIF
9850C--------
9851C ithgrpb
9852C--------
9853 IF(nthgrp01(2) > 0) THEN
9854 output%TH%SITHGRPB = (nthgrp01(2)+nbr_th_monvol)*nithgr
9855 CALL my_alloc(output%TH%ITHGRPB,output%TH%SITHGRPB)
9856 output%TH%ITHGRPB = 0
9857 ithpart = 0
9858 ithsub = 0
9859 ithbuftmp = 0
9860 output%TH%SITHBUFB = 0
9861 ithflag = 2
9862c-----
9863 IF(npart+nthpart>0) THEN
9864 ipartthi=>ipartth(1+2*(npart+nthpart):4*(npart+nthpart))
9865 ELSE
9866 ipartthi=>ipartth
9867 END IF
9868 CALL hm_read_thgrou(
9869 1 output%TH%ITHGRPB ,ithbuftmp,itab ,itabm1 ,ixtg ,
9870 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
9871 3 kxx ,ixx ,ipart ,output%TH%SITHBUFB ,
9872 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
9873 5 nthgrp1(2),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
9874 6 1 ,1 ,imerge ,ithvar ,
9875 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
9876 8 inom_opt(5),inom_opt(8),inom_opt(7),
9877 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
9878 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
9879 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
9880 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
9881 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
9882 e map_tables, 2,inom_opt(31),inom_opt(32),sensors,
9883 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
9884 g nsubdom,ipri)
9885C
9886 CALL my_alloc(output%TH%ITHBUFB,output%TH%SITHBUFB)
9887 output%TH%ITHBUFB = ithbuftmp(1:output%TH%SITHBUFB)
9888 ELSE
9889 output%TH%SITHGRPB = 0
9890 output%TH%SITHBUFB = 0
9891 CALL my_alloc(output%TH%ITHGRPB,output%TH%SITHGRPB)
9892 CALL my_alloc(output%TH%ITHBUFB,output%TH%SITHBUFB)
9893 ENDIF
9894C--------
9895C ithgrpc
9896C--------
9897 IF(nthgrp01(3) > 0) THEN
9898 output%TH%SITHGRPC = (nthgrp01(3)+nbr_th_monvol)*nithgr
9899 CALL my_alloc(output%TH%ITHGRPC,output%TH%SITHGRPC)
9900 output%TH%ITHGRPC = 0
9901 ithpart = 0
9902 ithsub = 0
9903 ithbuftmp = 0
9904 output%TH%SITHBUFC = 0
9905 ithflag = 3
9906c-----
9907 IF(npart+nthpart>0) THEN
9908 ipartthi=>ipartth(1+4*(npart+nthpart):6*(npart+nthpart))
9909 ELSE
9910 ipartthi=>ipartth
9911 END IF
9912 CALL hm_read_thgrou(
9913 1 output%TH%ITHGRPC ,ithbuftmp,itab ,itabm1 ,ixtg ,
9914 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
9915 3 kxx ,ixx ,ipart ,output%TH%SITHBUFC ,
9916 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
9917 5 nthgrp1(3),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
9918 6 1 ,1 ,imerge ,ithvar ,
9919 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
9920 8 inom_opt(5),inom_opt(8),inom_opt(7),
9921 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
9922 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
9923 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
9924 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
9925 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
9926 e map_tables, 3,inom_opt(31),inom_opt(32),sensors,
9927 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
9928 g nsubdom,ipri)
9929C
9930 CALL my_alloc(output%TH%ITHBUFC, output%TH%SITHBUFC)
9931 output%TH%ITHBUFC(1:output%TH%SITHBUFC) = ithbuftmp(1:output%TH%SITHBUFC)
9932 ELSE
9933 output%TH%SITHGRPC = 0
9934 output%TH%SITHBUFC = 0
9935 CALL my_alloc(output%TH%ITHBUFC, output%TH%SITHBUFC)
9936 CALL my_alloc(output%TH%ITHGRPC, output%TH%SITHGRPC)
9937 ENDIF
9938C--------
9939C ithgrpd
9940C--------
9941 IF(nthgrp01(4) > 0) THEN
9942 output%TH%SITHGRPD = (nthgrp01(4)+nbr_th_monvol)*nithgr
9943 CALL my_alloc(output%TH%ITHGRPD,output%TH%SITHGRPD)
9944 output%TH%ITHGRPD = 0
9945 ithpart = 0
9946 ithsub = 0
9947 ithbuftmp = 0
9948 output%TH%SITHBUFD = 0
9949 ithflag = 4
9950c-----
9951 IF(npart+nthpart>0) THEN
9952 ipartthi=>ipartth(1+6*(npart+nthpart):8*(npart+nthpart))
9953 ELSE
9954 ipartthi=>ipartth
9955 END IF
9956 CALL hm_read_thgrou(
9957 1 output%TH%ITHGRPD ,ithbuftmp,itab ,itabm1 ,ixtg ,
9958 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
9959 3 kxx ,ixx ,ipart ,output%TH%SITHBUFD ,
9960 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
9961 5 nthgrp1(4),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
9962 6 1 ,1 ,imerge ,ithvar ,
9963 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
9964 8 inom_opt(5),inom_opt(8),inom_opt(7),
9965 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
9966 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
9967 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
9968 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
9969 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
9970 e map_tables, 4,inom_opt(31),inom_opt(32),sensors,
9971 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
9972 g nsubdom,ipri)
9973C
9974 CALL my_alloc(output%TH%ITHBUFD,output%TH%SITHBUFD)
9975 output%TH%ITHBUFD(1:output%TH%SITHBUFD) = ithbuftmp(1:output%TH%SITHBUFD)
9976 ELSE
9977 output%TH%SITHGRPD = 0
9978 output%TH%SITHBUFD = 0
9979 ALLOCATE(output%TH%ITHBUFD(output%TH%SITHBUFD), stat=stat)
9980 ALLOCATE(output%TH%ITHGRPD(output%TH%SITHGRPD), stat=stat)
9981 ENDIF
9982C--------
9983C ithgrpe
9984C--------
9985 IF(nthgrp01(5) > 0) THEN
9986 output%TH%SITHGRPE = (nthgrp01(5)+nbr_th_monvol)*nithgr
9987 CALL my_alloc(output%TH%ITHGRPE,output%TH%SITHGRPE)
9988 output%TH%ITHGRPE = 0
9989 ithpart = 0
9990 ithsub = 0
9991 ithbuftmp = 0
9992 output%TH%SITHBUFE = 0
9993 ithflag = 5
9994c-----
9995 IF(npart+nthpart>0) THEN
9996 ipartthi=>ipartth(1+8*(npart+nthpart):10*(npart+nthpart))
9997 ELSE
9998 ipartthi=>ipartth
9999 END IF
10000c-----
10001 CALL hm_read_thgrou(
10002 1 output%TH%ITHGRPE ,ithbuftmp,itab ,itabm1 ,ixtg ,
10003 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
10004 3 kxx ,ixx ,ipart ,output%TH%SITHBUFE ,
10005 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
10006 5 nthgrp1(5),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
10007 6 1 ,1 ,imerge ,ithvar ,
10008 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
10009 8 inom_opt(5),inom_opt(8),inom_opt(7),
10010 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
10011 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
10012 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
10013 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
10014 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
10015 e map_tables, 5,inom_opt(31),inom_opt(32),sensors,
10016 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
10017 g nsubdom,ipri)
10018C
10019 CALL my_alloc(output%TH%ITHBUFE,output%TH%SITHBUFE)
10020 output%TH%ITHBUFE = ithbuftmp(1:output%TH%SITHBUFE)
10021 ELSE
10022 output%TH%SITHGRPE = 0
10023 output%TH%SITHBUFE = 0
10024 CALL my_alloc(output%TH%ITHBUFE,output%TH%SITHBUFE)
10025 CALL my_alloc(output%TH%ITHGRPE,output%TH%SITHGRPE)
10026 ENDIF
10027C--------
10028C ithgrpf
10029C--------
10030 IF(nthgrp01(6) > 0) THEN
10031 output%TH%SITHGRPF = (nthgrp01(6)+nbr_th_monvol)*nithgr
10032 CALL my_alloc(output%TH%ITHGRPF,output%TH%SITHGRPF)
10033 output%TH%ITHGRPF = 0
10034 ithpart = 0
10035 ithsub = 0
10036 ithbuftmp = 0
10037 output%TH%SITHBUFF = 0
10038 ithflag = 6
10039c-----
10040 IF(npart+nthpart>0) THEN
10041 ipartthi=>ipartth(1+10*(npart+nthpart):12*(npart+nthpart))
10042 ELSE
10043 ipartthi=>ipartth
10044 END IF
10045 CALL hm_read_thgrou(
10046 1 output%TH%ITHGRPF ,ithbuftmp,itab ,itabm1 ,ixtg ,
10047 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
10048 3 kxx ,ixx ,ipart ,output%TH%SITHBUFF ,
10049 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
10050 5 nthgrp1(6),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
10051 6 1 ,1 ,imerge ,ithvar ,
10052 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
10053 8 inom_opt(5),inom_opt(8),inom_opt(7),
10054 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
10055 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
10056 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
10057 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
10058 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
10059 e map_tables, 6,inom_opt(31),inom_opt(32),sensors,
10060 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
10061 g nsubdom,ipri)
10062C
10063 CALL my_alloc(output%TH%ITHBUFF,output%TH%SITHBUFF)
10064 output%TH%ITHBUFF(1:output%TH%SITHBUFF) = ithbuftmp(1:output%TH%SITHBUFF)
10065 ELSE
10066 output%TH%SITHGRPF = 0
10067 output%TH%SITHBUFF = 0
10068 CALL my_alloc(output%TH%ITHBUFF,output%TH%SITHBUFF)
10069 CALL my_alloc(output%TH%ITHGRPF,output%TH%SITHGRPF)
10070 ENDIF
10071C--------
10072C ithgrpg
10073C--------
10074 IF(nthgrp01(7) > 0) THEN
10075 output%TH%SITHGRPG = (nthgrp01(7)+nbr_th_monvol)*nithgr
10076 CALL my_alloc(output%TH%ITHGRPG,output%TH%SITHGRPG)
10077 output%TH%ITHGRPG = 0
10078 output%TH%SITHBUFG = 0
10079 ithpart = 0
10080 ithsub = 0
10081 ithbuftmp = 0
10082 ithflag = 7
10083c-----
10084 IF(npart+nthpart>0) THEN
10085 ipartthi=>ipartth(1+12*(npart+nthpart):14*(npart+nthpart))
10086 ELSE
10087 ipartthi=>ipartth
10088 END IF
10089 CALL hm_read_thgrou(
10090 1 output%TH%ITHGRPG ,ithbuftmp,itab ,itabm1 ,ixtg ,
10091 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
10092 3 kxx ,ixx ,ipart ,output%TH%SITHBUFG ,
10093 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
10094 5 nthgrp1(7),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
10095 6 1 ,1 ,imerge ,ithvar ,
10096 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
10097 8 inom_opt(5),inom_opt(8),inom_opt(7),
10098 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
10099 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
10100 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
10101 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
10102 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
10103 e map_tables, 7,inom_opt(31),inom_opt(32),sensors,
10104 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
10105 g nsubdom,ipri)
10106C
10107 CALL my_alloc(output%TH%ITHBUFG,output%TH%SITHBUFG)
10108 output%TH%ITHBUFG(1:output%TH%SITHBUFG) = ithbuftmp(1:output%TH%SITHBUFG)
10109 ELSE
10110 output%TH%SITHGRPG = 0
10111 output%TH%SITHBUFG = 0
10112 CALL my_alloc(output%TH%ITHBUFG,output%TH%SITHBUFG)
10113 CALL my_alloc(output%TH%ITHGRPG,output%TH%SITHGRPG)
10114 ENDIF
10115C--------
10116C ithgrph
10117C--------
10118 IF(nthgrp01(8) > 0) THEN
10119 output%TH%SITHGRPH = (nthgrp01(8)+nbr_th_monvol)*nithgr
10120 CALL my_alloc(output%TH%ITHGRPH,output%TH%SITHGRPH)
10121 output%TH%ITHGRPH = 0
10122 ithpart = 0
10123 ithsub = 0
10124 ithbuftmp = 0
10125 output%TH%SITHBUFH = 0
10126 ithflag = 8
10127c-----
10128 IF(npart+nthpart>0) THEN
10129 ipartthi=>ipartth(1+14*(npart+nthpart):16*(npart+nthpart))
10130 ELSE
10131 ipartthi=>ipartth
10132 END IF
10133 CALL hm_read_thgrou(
10134 1 output%TH%ITHGRPH ,ithbuftmp,itab ,itabm1 ,ixtg ,
10135 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
10136 3 kxx ,ixx ,ipart ,output%TH%SITHBUFH ,
10137 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
10138 5 nthgrp1(8),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
10139 6 1 ,1 ,imerge ,ithvar ,
10140 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
10141 8 inom_opt(5),inom_opt(8),inom_opt(7),
10142 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
10143 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
10144 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
10145 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
10146 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
10147 e map_tables, 8,inom_opt(31),inom_opt(32),sensors,
10148 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
10149 g nsubdom,ipri)
10150C
10151 CALL my_alloc(output%TH%ITHBUFH,output%TH%SITHBUFH)
10152 output%TH%ITHBUFH(1:output%TH%SITHBUFH) = ithbuftmp(1:output%TH%SITHBUFH)
10153 ELSE
10154 output%TH%SITHGRPH = 0
10155 output%TH%SITHBUFH = 0
10156 CALL my_alloc(output%TH%ITHBUFH,output%TH%SITHBUFH)
10157 CALL my_alloc(output%TH%ITHGRPH,output%TH%SITHGRPH)
10158 ENDIF
10159C--------
10160C ithgrpi
10161C--------
10162 IF(nthgrp01(9) > 0) THEN
10163 output%TH%SITHGRPI = (nthgrp01(9)+nbr_th_monvol)*nithgr
10164 CALL my_alloc(output%TH%ITHGRPI,output%TH%SITHGRPI)
10165 output%TH%ITHGRPI = 0
10166 ithpart = 0
10167 ithsub = 0
10168 ithbuftmp = 0
10169 output%TH%SITHBUFI = 0
10170 ithflag = 9
10171c-----
10172 IF(npart+nthpart>0) THEN
10173 ipartthi=>ipartth(1+16*(npart+nthpart):18*(npart+nthpart))
10174 ELSE
10175 ipartthi=>ipartth
10176 END IF
10177 CALL hm_read_thgrou(
10178 1 output%TH%ITHGRPI ,ithbuftmp,itab ,itabm1 ,ixtg ,
10179 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
10180 3 kxx ,ixx ,ipart ,output%TH%SITHBUFI ,
10181 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
10182 5 nthgrp1(9),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
10183 6 1 ,1 ,imerge ,ithvar ,
10184 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
10185 8 inom_opt(5),inom_opt(8),inom_opt(7),
10186 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
10187 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
10188 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
10189 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
10190 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
10191 e map_tables, 9,inom_opt(31),inom_opt(32),sensors,
10192 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
10193 g nsubdom,ipri)
10194C
10195 CALL my_alloc(output%TH%ITHBUFI,output%TH%SITHBUFI)
10196 output%TH%ITHBUFI = ithbuftmp(1:output%TH%SITHBUFI)
10197 ELSE
10198 output%TH%SITHGRPI = 0
10199 output%TH%SITHBUFI = 0
10200 CALL my_alloc(output%TH%ITHBUFI,output%TH%SITHBUFI)
10201 CALL my_alloc(output%TH%ITHGRPI,output%TH%SITHGRPI)
10202 ENDIF
10203C
10204
10205 IF(ALLOCATED(ithpart)) DEALLOCATE(ithpart)
10206 IF(ALLOCATED(ithsub)) DEALLOCATE(ithsub)
10207 IF(ALLOCATED(ithbuftmp)) DEALLOCATE(ithbuftmp)
10208C
10209C -------------------------------------------------
10210C /TH/SURF : outputting Pressure and Area :
10211C -------------------------------------------------
10212 CALL th_surf_load_pressure(igrsurf , output%TH%TH_SURF , ipres ,iloadp ,lloadp ,
10213 . sizloadp ,nloadp ,slloadp ,nibcld ,npreld ,
10214 . nsurf ,numnod )
10215C
10216C------------------------- CHECK -------------------
10217Cthe nsmat variable (number of materials in th)
10218C is available only after thgrou in block version
10219c CALL ANCHECK(4)
10220C
10221c CALL ANCHECK(8)
10222C
10223c CALL ANCHECK(11)
10224C
10225c CALL ANCHECK(12)
10226C
10227c CALL ANCHECK(16)
10228C
10229c CALL ANCHECK(18)
10230C
10231c CALL ANCHECK(20)
10232C
10233c CALL ANCHECK(24)
10234C
10235c CALL ANCHECK(27)
10236C
10237c CALL ANCHECK(31)
10238C
10239c CALL ANCHECK(34)
10240C
10241c CALL ANCHECK(38)
10242C
10243c CALL ANCHECK(48)
10244C
10245c CALL ANCHECK(45)
10246C
10247c CALL ANCHECK(50)
10248C
10249c CALL ANCHECK(55)
10250C
10251c CALL ANCHECK(57)
10252C
10253c CALL ANCHECK(58)
10254C
10255c CALL ANCHECK(59)
10256C
10257c CALL ANCHECK(61)
10258C
10259c CALL ANCHECK(80)
10260C
10261C
10262C assignment of processor number (spmd)
10263C
10264 CALL thpinit(output%TH%ITHGRP,output%TH%ITHBUF,iparg ,dd_iad ,lrivet ,
10265 . 0 ,nthgrp )
10266 IF(nthgrp01(1) > 0)
10267 . CALL thpinit(output%TH%ITHGRPA,output%TH%ITHBUFA,iparg ,dd_iad ,lrivet ,
10268 . i ,nthgrp1(1) )
10269 IF(nthgrp01(2) > 0)
10270 . CALL thpinit(output%TH%ITHGRPB,output%TH%ITHBUFB,iparg ,dd_iad ,lrivet ,
10271 . i ,nthgrp1(2) )
10272 IF(nthgrp01(3) > 0)
10273 . CALL thpinit(output%TH%ITHGRPC,output%TH%ITHBUFC,iparg ,dd_iad ,lrivet ,
10274 . i ,nthgrp1(3) )
10275 IF(nthgrp01(4) > 0)
10276 . CALL thpinit(output%TH%ITHGRPD,output%TH%ITHBUFD,iparg ,dd_iad ,lrivet ,
10277 . i ,nthgrp1(4) )
10278 IF(nthgrp01(5) > 0)
10279 . CALL thpinit(output%TH%ITHGRPE,output%TH%ITHBUFE,iparg ,dd_iad ,lrivet ,
10280 . i ,nthgrp1(5) )
10281 IF(nthgrp01(6) > 0)
10282 . CALL thpinit(output%TH%ITHGRPF,output%TH%ITHBUFF,iparg ,dd_iad ,lrivet ,
10283 . i ,nthgrp1(6) )
10284 IF(nthgrp01(7) > 0)
10285 . CALL thpinit(output%TH%ITHGRPG,output%TH%ITHBUFG,iparg ,dd_iad ,lrivet ,
10286 . i ,nthgrp1(7) )
10287 IF(nthgrp01(8) > 0)
10288 . CALL thpinit(output%TH%ITHGRPH,output%TH%ITHBUFH,iparg ,dd_iad ,lrivet ,
10289 . i ,nthgrp1(8) )
10290 IF(nthgrp01(9) > 0)
10291 . CALL thpinit(output%TH%ITHGRPI,output%TH%ITHBUFI,iparg ,dd_iad ,lrivet ,
10292 . i ,nthgrp1(9) )
10293 CALL trace_out1()
10294C--------------------------------------------
10295C multidomains -> deallocation of arrays
10296C--------------------------------------------
10297 IF(nsubdom>0) THEN
10298 DEALLOCATE(tag_part,tagmon,tagrby,tagint,tagcyl,taglnk)
10299 DEALLOCATE(tagrb3,tagrb2,tagjoin,tagmpc,tag_mat)
10300 ENDIF
10301C--------------------------------------------
10302C STOCKAGE DYNAMIQUE (CONNEXIONS RIGIDES a MADYMO).
10303C--------------------------------------------
10304 err_msg='DYNAMIC STORAGE MADYMO LINK'
10305 err_category='DYNAMIC STORAGE MADYMO LINK'
10306 CALL trace_in1(err_msg,len_trim(err_msg))
10307 srconx = nconx*nrcnx
10308 ALLOCATE(rconx(srconx) ,stat=stat)
10309 rconx = zero
10310C--------------------------------------------
10311C RECOMPUTATION OF NRBODY (NRBYKIN UPDATED UPSTREAM)
10312C---------------------------------------------------------------------
10313 IF(nrbmerge > 0) THEN
10314 nrbody = nrbykin + nrbylag
10315 ENDIF
10316C--------------------------------------------
10317C TABLEAU DE TRAVAIL WA(LENWA)
10318C part not saved in the restart file
10319C--------------------------------------------
10320 nrcvvois0 = 0
10321C call to generic routine here and in ddsplit
10322 CALL setlenwa(
10323 1 lenwa ,nthwa ,nairwa ,numels ,numelq,
10324 2 numelc,numeltg,numelt ,numelp ,numelr,
10325 3 numnod,nmnt ,l_mul_lag1,l_mul_lag,maxnx ,
10326 4 lwasph,numsph ,lwaspio, nrcvvois0,ngroup,
10327 5 lwamp_l,lwanmp_l ,glob_therm%ITHERM)
10328 lwamp = lwamp_l !< Copy values in common
10329 lwanmp = lwanmp_l !< Copy values in common
10330C init MULTIMAX
10331 ALLOCATE(mwa(lenwa) , stat=stat)
10332 mwa = zero
10333 CALL setmulti(ipari )
10334 CALL trace_out1()
10335C---------------------------------------------------------------------
10336C INITIALIZATION OF INTERFACES SECOND PART
10337C INIT INTERFACE TYPE 6 + BUCKET SORT TYPE 4 STATISTICS
10338C PUT INTERFACE NODES INTO FRONTIERE(1)
10339C---------------------------------------------------------------------
10340 err_msg='INTERFACE INITIALIZATION PHASE 2'
10341 err_category='INTERFACES'
10342 CALL trace_in1(err_msg,len_trim(err_msg))
10343 i2nsnt = 0
10344C Mass and inertia are not modified - a specific array is used
10345 ALLOCATE(ms_b(numnod),stat=stat)
10346 ms_b(1:numnod)=ms(1:numnod)
10347 IF(iroddl==1) THEN
10348 ALLOCATE(in_b(numnod),stat=stat)
10349 in_b(1:numnod)=in(1:numnod)
10350 ELSE
10351 ALLOCATE(in_b(1))
10352 ENDIF
10353C
10354 IF(ns10e>0.AND.n2d==0) CALL stifn0_nd(icnds10,stiffn)
10355 IF(ninter > 0) THEN
10356 CALL inintr2(ipari ,inscr ,x ,
10357 . ixs ,ixq ,ixc ,pm ,geo ,
10358 . inscr ,itab ,ms ,npby ,lpby ,
10359 . mwa ,d ,i2nsnt ,in ,
10360 . stiffn,stifint ,nom_opt(lnopt1*inom_opt(3)+1),inod_pxfem ,ms_ply,
10361 . intbuf_tab,stifintr,itagnd,icnds10,ms_b,in_b,nstrf,itagcyc,
10362 . irbe2 ,irbe3 ,lrbe3 ,
10363 . knod2els ,nod2els , ixs10 ,ixs16 ,ixs20,
10364 . s_nod2els )
10365 ENDIF
10366 CALL trace_out1()
10367C---------------------------------------------
10368C Update of STIFFN for TETRA10 for time step estimation
10369C--------------------------------------------
10370 IF(ns10e>0.AND.n2d==0) CALL stifn1_nd(icnds10,stiffn)
10371 IF(ndamp>0) CALL dampdtnoda(ms_b,in_b,stiffn,stiffn(numnod+1),
10372 1 igrnod,dampr )
10373C--------------------------------------------
10374C sorting and printing of element dt
10375C--------------------------------------------
10376 CALL outri(dtelem,ixs,ixq,ixc,ixt,ixp,ixr,ixtg,
10377 . kxx,kxsp,kxig3d,igeo,numel)
10378C--------------------------------------------
10379C sorting and printing of nodal dt
10380C--------------------------------------------
10381 CALL outrin(ms_b,in_b,stiffn,stiffn(numnod+1),itab,dtnoda)
10382C---------------------------------------------
10383C Target time step estimation - (type2 effect on nodal time step is taken into account in ININTR2)
10384C--------------------------------------------
10385 err_msg='ADDED MASS ESTIMATION'
10386 err_category='ADDED MASS ESTIMATION'
10387 CALL trace_in1(err_msg,len_trim(err_msg))
10388 IF(n2d==0) CALL add_mass_stat(ms_b,in_b,stiffn,stiffn(numnod+1),itab,totmas)
10389C---------------------------------
10390C MULTIDOMAINS SPEEDUP ESTIMATION
10391C---------------------------------
10392 IF(nsubdom>0) THEN
10393 CALL r2r_speedup(dtelem,dtnoda,dt_r2r,cost_r2r,isoloff,
10394 . isheoff,itruoff ,ipouoff ,iresoff ,itrioff,
10395 . iquaoff)
10396 ENDIF
10397C--------------------------------------------
10398 DEALLOCATE(stifint)
10399 DEALLOCATE(stifintr)
10400 DEALLOCATE(ms_b)
10401 DEALLOCATE(in_b)
10402 DEALLOCATE(dtelem)
10403 CALL trace_out1()
10404C--------------------------------------------
10405C INI & CHECK RBE3
10406C--------------------------------------------
10407 err_msg='RBE3 INITIALIZATION'
10408 err_category='RBE3'
10409 CALL trace_in1(err_msg,len_trim(err_msg))
10410 IF(sirbe3 > 0) THEN
10411 CALL inirbe3(irbe3 ,lrbe3 ,frbe3 ,skew ,x ,
10412 . ms ,in ,nom_opt(lnopt1*inom_opt(14)+1),
10413 . stiffn,stiffn(numnod+1),icode,itab )
10414 ENDIF
10415 DEALLOCATE(stiffn)
10416 CALL trace_out1()
10417C--------------------------------------------
10418 err_msg='KINEMATIC CONDITIONS CHECK'
10419 err_category='KINEMATIC CONDITIONS'
10420 CALL trace_in1(err_msg,len_trim(err_msg))
10421C--------------------------------------------
10422C traitement for 2nd pass /RBODY/RBE2 /BCS /IMPVEL w/ Itet2 of S10
10423C--------------------------------------------
10424 IF(ns10e>0) THEN
10425 CALL rigmodif1_nd(npby,lpby,itagnd)
10426 CALL rbe2modif1_nd(irbe2,lrbe2,itagnd)
10427 CALL bcsmodif_nd(icode, itagnd,icnds10,itab,
10428 . nnpby,slrbody,nrbe2l ,slrbe2,
10429 . npby ,lpby ,irbe2 ,lrbe2 )
10430 CALL fixmodif_nd(ibfv , itagnd,icnds10,itab)
10431 CALL bcscycmodif_nd(ibcscyc,lbcscyc,itagnd,itab)
10432 END IF
10433C--------------------------------------------
10434C checking kinematic conditions
10435C--------------------------------------------
10436C d(3,numnod) used in the starter as a flag
10437C DE CONDITION CINEMATIQUE IKINE(NUMNOD)
10438C--------------------------------------------
10439 CALL kinchk(d ,rwbuf ,itab ,nprw ,lprw ,kinet ,
10440 . npby , lpby ,irbe2 ,lrbe2 ,irbe3 ,lrbe3 ,
10441 . nom_opt ,inom_opt(5),inom_opt(13),inom_opt(14) ,
10442 . itagcyc )
10443 IF(ninvel/=0)
10444 . CALL inivchk(d ,rwbuf,itab,nprw,lprw,kinet,
10445 1 npby, lpby,irbe2,lrbe2,irbe3,lrbe3,
10446 2 frbe3,x ,skew ,v ,vr )
10447#ifdef DNC
10448 IF(nexmad/=0)
10449 . CALL madchk(d ,itab ,iconx(7*nconx+1))
10450#endif
10451 CALL trace_out1()
10452C--------------------------------------------
10453C Initial mass
10454C--------------------------------------------
10455 err_msg='MASS ARRAY ALLOCATION'
10456 err_category='INIIAL MASS'
10457 CALL trace_in1(err_msg,len_trim(err_msg))
10458 ALLOCATE(ms0(numnod) ,stat=stat)
10459 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
10460 . msgtype=msgerror,
10461 . c1='MS0')
10462 ms0(1:numnod)=ms(1:numnod)
10463 CALL trace_out1()
10464C--------------------------------------------
10465C Inlet / Outlet
10466C--------------------------------------------
10467c build structure surfaces specific Inlet Outlet
10468 IF(nsphio > 0)THEN
10469 sibufssg_io = 4*nseg_io
10470 ALLOCATE(ibufssg_io(sibufssg_io) ,stat=stat)
10471 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
10472 . msgtype=msgerror,
10473 . c1='IBUFSSG_IO')
10474 ibufssg_io(1:sibufssg_io) = 0
10475 CALL set_ibufssg_io(isphio, igrsurf, ibufssg_io)
10476 ELSE
10477 ALLOCATE(ibufssg_io(1))
10478 sibufssg_io = 0
10479 ENDIF
10480
10481!--------------------------------------------
10482! Split the surface & add the MONVOL nodes
10483! on a given processor
10484!--------------------------------------------
10485 CALL python_duplicate_nodes(itab,numnod,nspmd) ! nodes used in the python functions must be on all processors
10486 CALL igrsurf_split(scep,cep,t_monvol,igrsurf,igrsurf_proc)
10487C--------------------------------------------
10488C DOMAIN DECOMPOSITION 2 (DEFINITION DES FRONTIERES)
10489C--------------------------------------------
10490 err_msg='DOMAIN DECOMPOSITION PHASE 2'
10491 err_category='INTERNAL'
10492 CALL trace_in1(err_msg,len_trim(err_msg))
10493 sfr_iad = (nspmd+1)*2
10494 ALLOCATE(fr_iad(sfr_iad))
10495 IF(i2nsnt>0) THEN
10496 ALLOCATE(celi2(i2nsnt))
10497 ALLOCATE(cepi2(i2nsnt))
10498 ALLOCATE(addcni2(0:numnod+1))
10499 ENDIF
10500 ALLOCATE(iskwp(numskw+1))
10501 ALLOCATE(nskwp(nspmd))
10502 ALLOCATE(isensp(2*sensors%NSENSOR))
10503 ALLOCATE(nsensp(nspmd))
10504 ALLOCATE(iaccp(naccelm))
10505 ALLOCATE(naccp(nspmd))
10506 ALLOCATE(igaup(nbgauge))
10507 ALLOCATE(ngaup(nspmd))
10508 ALLOCATE(tag_skn(numskw+nsubmod+1))
10509 ALLOCATE(skews%MULTIPLE_SKEW(numskw+1))
10510 iskwp(1:numskw+1) = 0
10511 tag_skn(1:numskw+nsubmod+1) = 0
10512 nskwp(1:nspmd) = 0
10513C
10514 IF(.NOT. ALLOCATED(ibvel)) ALLOCATE(ibvel(0)) ! Deprecated option?
10515 IF(.NOT. ALLOCATED(lbvel)) ALLOCATE(lbvel(0)) ! Deprecated option?
10516
10517 CALL domdec2(
10518 1 dd_iad ,ipari ,ibcl ,npby ,
10519 2 lpby ,lrivet ,ibvel ,lbvel ,
10520 3 iparg ,cel ,ixs ,ixs10 ,ixs20 ,
10521 4 ixs16 ,ixq ,ixc ,ixt ,ixp ,
10522 5 ixr ,ixtg ,ixtg1 ,t_monvol ,
10523 6 igrsurf,addcne ,lcne ,geo ,
10524 7 nprw ,lprw ,lcni2g ,addcni2 ,cepi2 ,
10525 8 celi2 ,i2nsnt ,iskwn ,iskwp ,nskwp ,
10526 9 isensp ,nsensp ,iaccp ,naccp ,
10527 a laccelm,ibcv ,irbe3 ,lrbe3 ,front_rm,
10528 b irbym ,lnrbym ,cep ,ibcr ,irbe2 ,
10529 c lrbe2 ,cepsp ,celsph ,iloadp ,lloadp ,
10530 d lgauge ,igaup ,ngaup ,intbuf_tab,ibfflux ,
10531 e icnds10,itagnd ,igeo ,tag_skn ,skews%MULTIPLE_SKEW,
10532 f ibfv ,ibcscyc ,lbcscyc,r_skew ,ipm,
10533 g sensors,scep ,ebcs_tab,loads,iframe,
10534 h glob_therm%NICONV ,glob_therm%NIRADIA ,glob_therm%NITFLUX,
10535 i glob_therm%NUMCONV,glob_therm%NUMRADIA,glob_therm%NFXFLUX,
10536 j sensor_user_struct)
10537
10538C ELSE
10539C set front to 1 i.e. all nodes on proc1, weight 1
10540C In SMP Front => Weight has the same address initialized at 1
10541C SFR_IAD = 0
10542C SDD_FRONT = 0
10543C ALLOCATE(FR_IAD(SFR_IAD))
10544C ALLOCATE(DD_FRONT(SDD_FRONT))
10545C SWEIGHT = NUMNOD
10546C ALLOCATE(WEIGHT(SWEIGHT))
10547C WEIGHT = 1
10548C ENDIF
10549C--------------------------------------------
10550C traitement for DOMDEC, P/ON w/ Itet2 of S10
10551C--------------------------------------------
10552 IF(ns10e>0) THEN
10553 IF(ipari0/=0) THEN
10554 ALLOCATE(celcnd(ns10e))
10555 ALLOCATE(cepcnd(ns10e))
10556 ALLOCATE(addcncnd(0:numnod+1))
10557 CALL pre_cndpon(icnds10,addcncnd,cepcnd,celcnd ,itagnd )
10558 lcncnd = addcncnd(numnod+1)-addcncnd(1)
10559 IF(lcncnd>0) THEN
10560 ALLOCATE(cncnd(lcncnd))
10561 cncnd(1:lcncnd)=0
10562 CALL fillcncnd(cncnd ,addcncnd,icnds10,itagnd)
10563 END IF
10564 END IF
10565 END IF
10566C--------------------------------------------
10567C traitement for hierarchy_rbody
10568C--------------------------------------------
10569 IF(nrbykin > 0) THEN
10570 call hierarchy_rbody_ddm(nrbykin ,nnpby ,npby ,slrbody ,lpby ,
10571 . numnod ,nspmd )
10572 ENDIF
10573C preparation of spmd processing of flows by bem
10574 CALL trace_out1()
10575 err_msg='PROCESS BEM FOR SPMD'
10576 err_category='PROCESS BEM FOR SPMD'
10577 CALL trace_in1(err_msg,len_trim(err_msg))
10578 IF(nflow>0 .AND. nspmd > 1) CALL flowdec(iflow)
10579 CALL trace_out1()
10580C--------------------------------------------
10581C FERMETURE DU FICHIER INPUT TMP
10582C--------------------------------------------
10583 err_msg='CLOSING TMP INPUT FILE'
10584 err_category='INTERNAL'
10585 CALL trace_in1(err_msg,len_trim(err_msg))
10586 IF(ipid/=0) CLOSE (unit=iin)
10587 CALL trace_out1()
10588C--------------------------------------------
10589C ECRITURE FICHIER DESSIN
10590C--------------------------------------------
10591 err_msg='ANIMATION FILE WRITING'
10592 err_category='ANIMATION FILE WRITING'
10593 CALL trace_in1(err_msg,len_trim(err_msg))
10594 WRITE(istdo,'(A)')titre(46)
10595 IF(ioutput>0) CALL desout(
10596 . x ,ixs ,ixq ,ixc ,ixt ,
10597 . ixp ,ixr ,ixtg ,itab ,pm ,
10598 . geo ,ms ,ixs10 ,igeo ,ipm ,
10599 . kxsp ,ipart ,ipartsp,names_and_titles )
10600 mwa = zero
10601C--------------------------------------------
10602C ECRITURE FICHIER ANIM
10603C--------------------------------------------
10604 ifvani=0
10605 IF(anim_vers>=40.AND.(dsanim==1.OR.
10606 . decani==1.OR.
10607 . nmanim>0.OR.ifvani>0)) THEN
10608 nel3d = numels + numsph + 3*numels16 + 27*numelig3d
10609 nel2d = numelc + numeltg + numelq
10610 nel1d = numelt + numelp + 2*numelr
10611 nel = max(nel1d,nel2d,nel3d)
10612C
10613 siad=npart+1
10614 swaft=max(3*numnod,6*nel3d,3*nel2d,9*nel1d)
10615 smas=nel+3*numels16
10616 swa4=3*numnod+2*numels16
10617 smater=npart
10618 sel2fa=nel+1
10619 sxnorm=3*numnod+2*numels16
10620 sinvert=nel2d
10621 IF(numelx>0) THEN
10622 snfacptx=npart
10623 sixedge=2*nanim1d
10624 soffx1=nanim1d
10625 snumx1=nanim1d
10626 sfunc1=10*nanim1d
10627 ELSE
10628 snfacptx=1
10629 sixedge=1
10630 soffx1=1
10631 snumx1=1
10632 sfunc1=1
10633 ENDIF
10634C
10635 ianim=0
10636 nelem=numelc+numeltg+numels+numelr +
10637 . numelp+numelt +numelq+numelx
10638C
10639 CALL my_alloc(dnull,3*numnod)
10640 DO i=1,3*numnod
10641 dnull(i)=zero
10642 ENDDO
10643C
10644 DO i=1,mx_ani
10645 anim_n(i)=0
10646 anim_v(i)=0
10647 anim_ce(i)=0
10648 anim_ct(i)=0
10649 anim_se(i)=0
10650 anim_st(i)=0
10651 anim_fe(i)=0
10652 anim_ft(i)=0
10653 ENDDO
10654 anim_m=1
10655 nn_ani=0
10656 nv_ani=nmanim
10657 nce_ani=9*nmanim
10658 nct_ani=2*nmanim
10659 nse_ani=9*nmanim
10660 nst_ani=1*nmanim
10661 nfe_ani=8*nmanim
10662C
10663 CALL genani1(
10664 1 x ,elbuf ,ixs ,ixq ,ixc ,
10665 2 ixt ,ixp ,ixr ,ixtg ,swaft ,
10666 3 iparg ,pm ,geo ,skew ,itab ,
10667 4 lpby ,npby ,nstrf ,rwbuf ,nprw ,
10668 5 ipart ,iparts ,ipartq ,ipartc ,
10669 6 ipartt ,ipartp ,ipartr ,ipartg ,
10670 7 rby ,swa4 ,
10671 8 igrsurf ,bufsf ,ipartx ,kxsp ,ixsp ,
10672 9 ipartsp ,spbuf ,ixs10 ,ixs20 ,ixs16 ,
10673 a ipm, igeo, smater, sel2fa, snfacptx,
10674 b sixedge, soffx1, snumx1, sxnorm, sinvert,
10675 c sfunc1, siad , nmanim, dnull, smas,
10676 d ms ,fxani ,mbufel ,mdepl ,nslevel ,
10677 e elsub, dsanim, nelem, cep, cepsp,
10678 f nom_opt ,inom_opt(5),inom_opt(8),
10679 g elbuf_tab,sph2sol ,subsets )
10680 DEALLOCATE(dnull)
10681
10682 ENDIF
10683C----------------------------------------------
10684C Driver to reader of so-called "engine cards"
10685C----------------------------------------------
10686C NGINE = 0 ! Number of Engine "cards", to be counted in contrl.F
10687 IF((is_dyna /= 0 .OR. nb_dyna_include /= 0) .AND. (ngine+nanim_eng /= 0))THEN
10688 CALL read_engine_driver(igrpart,is_dyna,nb_dyna_include)
10689 END IF
10690C----------------------------------------------
10691C Driver to QAPRINT
10692C----------------------------------------------
10693 CALL st_qaprint_driver(
10694 1 igeo ,geo ,bufgeo ,ipm ,pm ,
10695 2 bufmat ,nom_opt ,inom_opt(1) ,numloadp ,iloadp ,
10696 3 lloadp ,loadp ,ibcl ,forc ,ipres ,
10697 4 pres ,npby ,lpby ,rby ,ibcr ,
10698 5 fradia ,ibcv ,fconv ,ibftemp ,fbftemp ,
10699 6 igrv ,lgrav ,grav ,ibfflux ,fbfflux ,
10700 7 itab ,v , vr ,w ,icode ,
10701 8 iskew ,icfield ,lcfield ,cfield ,dampr ,
10702 9 temp ,ibcslag ,ipari ,intbuf_tab ,clusters ,
10703 a ibox ,ipmas ,ibfv ,vel ,nimpacc ,
10704 b laccelm ,accelm ,nom_sect ,nstrf ,secbuf ,
10705 c skew ,iskwn ,xframe ,t_monvol ,t_monvol_metadata,
10706 d i2rupt ,areasl ,intbuf_fric_tab ,npfricorth ,mat_elem ,
10707 e pfricorth ,irepforth ,phiforth ,vforth ,xrefc ,
10708 f xreftg ,xrefs ,tagxref ,ixs ,ixc ,
10709 g ixtg ,rwbuf ,nprw ,lprw ,ithvar ,
10710 h ipart ,subsets ,ipartth ,nthgrpmx ,nimpdisp ,
10711 m nimpvel ,detonators ,ibcscyc ,npc ,tf ,
10712 n table ,npts ,irbe3 ,lrbe3 ,frbe3 ,
10713 p mgrby ,ixs10 ,isolnod ,ixr ,r_skew ,
10714 o ixp ,ixt ,x ,thke ,sh4ang ,
10715 q thkec ,sh3ang ,set ,lsubmodel ,igrnod ,
10716 r igrpart ,igrbric ,igrsh4n ,igrsh3n ,igrquad ,
10717 s igrbeam ,igrtruss ,igrspring ,igrsurf ,igrslin ,
10718 t ixq ,ispcond ,rtrans ,irand ,alea ,
10719 u xseed ,xlas ,ilas ,irbe2 ,lrbe2 ,
10720 v kxsp ,ipartsp ,drape ,ixr_kj ,iactiv ,
10721 w factiv ,unitab ,npbyl ,lpbyl ,rbyl ,
10722 x xyzref ,sensors ,func2d ,
10723 y inicrack ,ipreload ,preload ,iflag_bpreload,ibmpc ,
10724 z ibmpc2 ,ibmpc3 ,ibmpc4 ,rbmpc ,ljoint ,
10725 a nnlink ,lnlink ,bufsf ,sbufsf ,stack%PM ,
10726 b stack%GEO ,stack%IGEO ,iparg ,ipadmesh ,padmesh ,
10727 c liflow ,lrflow ,iflow ,rflow ,
10728 d sh4tree ,sh3tree ,sh4trim ,sh3trim ,qp_iperturb ,
10729 e qp_rperturb ,llinal ,linale ,fvm_inivel ,gjbufi ,
10730 f gjbufr ,ms ,in ,lgauge ,gauge ,
10731 g kxx ,ixx ,ipartx ,lrivet ,ixs16 ,
10732 h iconx ,fxbipm ,fxbfile_tab ,eigipm ,eigrpm ,
10733 i isphio ,vsphio ,ebcs_tab ,inimap1d ,inimap2d ,
10734 j nsigsh ,sigsh ,nsigi ,sigsp ,nsigs ,
10735 k sigi ,nsigbeam ,sigbeam ,nsigtruss ,sigtruss ,
10736 l nsigrs ,sigrs ,merge_node_tab ,merge_node_tol,
10737 m imerge ,nmerge_tot ,iexlnk ,drapeg ,user_windows ,output ,
10738 n defaults ,glob_therm ,pblast ,ibeam_vector ,rbeam_vector ,
10739 o damp_range_part)
10740!
10741 DEALLOCATE(sigi)
10742 DEALLOCATE(sigsh)
10743 DEALLOCATE(sigsp)
10744 DEALLOCATE(sigrs)
10745 DEALLOCATE(sigbeam)
10746 DEALLOCATE(sigtruss)
10747 DEALLOCATE(ibeam_vector)
10748 DEALLOCATE(rbeam_vector)
10749C--------------------------------------------
10750C DELETE HM_MODEL IN MEMORY
10751C--------------------------------------------
10752 CALL cpp_delete_model()
10753C
10754 IF(ninter > 0) THEN
10755 DEALLOCATE(i2rupt)
10756 DEALLOCATE(areasl)
10757 ENDIF
10758 IF(nrbmerge > 0) THEN
10759 DEALLOCATE(mgrby)
10760 ENDIF
10761C -------------------
10762C Memory deallocation
10763C -------------------
10764 IF(nfunc2d > 0) THEN
10765 DO kk = 1, nfunc2d
10766 DEALLOCATE(func2d(kk)%XVAL, func2d(kk)%FVAL)
10767 ENDDO
10768 DEALLOCATE(func2d)
10769 ENDIF
10770 IF(ALLOCATED(rnoise)) DEALLOCATE(rnoise)
10771 IF(ALLOCATED(perturb)) DEALLOCATE(perturb)
10772 IF(ALLOCATED(qp_iperturb)) DEALLOCATE(qp_iperturb)
10773 IF(ALLOCATED(qp_rperturb)) DEALLOCATE(qp_rperturb)
10774
10775C--------FRICTION OROTHTROPIC DIRECTIONS dealloc now after qa print -----
10776 IF(ninter > 0 .AND.ninterfric >0.AND. iorthfricmax > 0) THEN
10777
10778 DEALLOCATE(pfricorth ,irepforth , vforth ,phiforth )
10779
10780 ENDIF
10781C
10782C----------------------------------------------
10783 CALL trace_out1()
10784 err_msg='RESTART FILE(S) WRITING'
10785 err_category='RESTART FILE(S) WRITING'
10786 CALL trace_in1(err_msg,len_trim(err_msg))
10787 IF(ierr==0) THEN
10788C--------------------------------------------m
10789C SPMD : SPLIT + ECRITURE FICHIER RESTART PAR PROC
10790C--------------------------------------------
10791 IF(restart_file==1) WRITE(istdo,'(A)')titre(50)
10792 IF(restart_file==0) WRITE(istdo,'(A)')check_message(1)( 1:len_trim(check_message(1)) )
10793C--------------------------------------------
10794C global connectivity matrix
10795C--------------------------------------------
10796 ilen = max(numels,numelq,numelc,numelt,numelp,numelr,numeltg)
10797 IF(lcne>0) ALLOCATE(cne(lcne),stat=stat)
10798 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='CNE')
10799 CALL fillcne(
10800 1 cne ,lcne ,ixs ,ixs10 ,ixs20 ,
10801 2 ixs16 ,ixq ,ixc ,ixt ,ixp ,
10802 3 ixr ,ixtg ,ixtg1 ,t_monvol ,
10803 4 igrsurf,ibcl ,addcne ,cep ,
10804 5 ilen ,geo ,ibcv ,ibcr ,ibfflux ,
10805 6 iloadp ,lloadp ,cel ,ebcs_tab,loads,
10806 7 glob_therm%NICONV ,glob_therm%NIRADIA ,glob_therm%NITFLUX,
10807 8 glob_therm%NUMCONV,glob_therm%NUMRADIA,glob_therm%NFXFLUX)
10808 IF(i2nsnt>0) THEN
10809 IF(lcni2g>0) ALLOCATE(cni2(lcni2g))
10810 CALL fillcni2(
10811 1 cni2 ,lcni2g,addcni2,ipari, intbuf_tab )
10812 ENDIF
10813C--------------------------------------------
10814C XDP ARRAY IN STARTER FOR SINGLE PRECISION
10815 ALLOCATE(xdp(1))
10816
10817 lenvolu = nimv*nvolu+licbag+libagjet+libaghol+libagale
10818C
10819 lnom_opt=snom_opt
10820 lenpor = snodpor
10821
10822 lenthg = output%TH%SITHBUF
10823 lenthgr = srthbuf
10824Clength of bufmat and bufgeo
10825 lbufmat = sbufmat
10826 lbufgeo = sbufgeo
10827 lbufsf = sbufsf
10828 pm1shf = 1
10829 pm1sph = 1
10830
10831C----------------------------------------------------------------------
10832 ! Allocation and filling of specific ADDCNE and CNE for non-local
10833 IF(nloc_dmg%IMOD>0) THEN
10834 ! Allocation of ADDCNE for non-local nodes
10835 IF(.NOT.ALLOCATED(nloc_dmg%ADDCNE)) ALLOCATE(nloc_dmg%ADDCNE(0:nloc_dmg%NNOD+1))
10836 nloc_dmg%ADDCNE(0:nloc_dmg%NNOD+1) = 0
10837 ! Filling ADDCNE for non-local nodes
10838 CALL build_addcnel_sub(addcne ,cne ,nloc_dmg%ADDCNE,nloc_dmg%INDX,nloc_dmg%NNOD)
10839 ! Allocation of CNE for non-local nodes
10840 IF(.NOT.ALLOCATED(nloc_dmg%CNE)) ALLOCATE(nloc_dmg%CNE(nloc_dmg%ADDCNE(nloc_dmg%NNOD+1)-1))
10841 nloc_dmg%CNE(1:nloc_dmg%ADDCNE(nloc_dmg%NNOD+1)-1) = 0
10842 ! Filling CNE for non-local nodes
10843 CALL build_cnel_sub(nloc_dmg%CNE,nloc_dmg%ADDCNE,cne,addcne,nloc_dmg%INDX,nloc_dmg%NNOD)
10844 ENDIF
10845C--------------------------------------------
10846C multidomains -> transfer of domdec
10847C--------------------------------------------
10848 IF((nsubdom>0).AND.(flg_r2r_err==0)) THEN
10849 CALL r2r_clean_inter(ipari,intbuf_tab,ipartc,ipartg,iparts,isolnod)
10850 IF(iddom>0) THEN
10851 WRITE(istdo,'(A)')' .. MULTIDOMAINS DOMDEC SYNCHRONIZATION '
10852 CALL r2r_domdec(iexlnk,igrnod,frontb_r2r,dt_r2r,1)
10853 ELSE
10854 CALL r2r_domdec(iexlnk,igrnod,frontb_r2r,dt_r2r,2)
10855 ENDIF
10856 ENDIF
10857
10858C deallocation of arrays that are not needed anymore
10859C The memory peak is in ddsplit: we need to deallocate everything that is not
10860C needed anmyre before ddsplit.
10861
10862 DEALLOCATE(ikine1lag)
10863 DEALLOCATE(iwcont)
10864 DEALLOCATE(iwcin2)
10865 DEALLOCATE(dsdof)
10866
10867
10868
10869
10870C-------------------------------------------------------------
10871C INTERFACE ROUTINES CALLED BEFORE DOMAIN DECOMPOSITION
10872C-------------------------------------------------------------
10873
10874C-------------------------------------------------------------
10875C Set INTERCEP (for all INTERFACES except TYPE24) (flag=1)
10876C-------------------------------------------------------------
10877
10878 CALL set_intercep(ipari,intercep,1,intbuf_tab,itab,cep)
10879
10880C ! this call is maintened here to avoid a bug
10881C-------------------------------------------------------------
10882 IF(nspmd > 1 .AND. iddlevel > 0) THEN
10883 CALL set_front8(ipari,intercep,intbuf_tab,intert8,nbt8,itab)
10884 ENDIF
10885C--------------------------------------------
10886C /Inter/Type25 Connectivit Sommets => Segments
10887C-------------------------------------------------------------
10888C
10889C Dimensioning (computes NUMNOR == Nb of normals or vertices wrt ALL Interfaces TYPE25)
10890C and Initialization of IRT>LM(3:4,1:NSN)
10891 CALL prepare_int25(intbuf_tab, ipari, intercep, nrtmt_25)
10892 CALL prepare_split_i25e2e(nspmd,intbuf_tab,ipari,intercep)
10893
10894C
10895 ALLOCATE(addcsrect(numnor+1),csrect(4*nrtmt_25),stat=stat)
10896 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
10897 . msgtype=msgerror,
10898 . c1='CSRECT')
10899 addcsrect(1:numnor+1)=0
10900C
10901 IF(ninter25 /= 0)
10902 . CALL build_csrect(intbuf_tab,ipari,csrect,addcsrect)
10903C
10904C--------------------------------------------
10905C LINES : SET A CPU for splitting
10906! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
10907! /\
10908! / \
10909! / | \
10910! / | \
10911! / o \
10912! /__________\
10913!
10914! /LINE are not used in the engine and the split is wrong in
10915! case of useless line (ie. when a line is defined but not
10916! used by an interface or other stuffs) -->
10917! 2 nodes (defining a segment) can be on 2 different processors
10918! in this case, the segment is not written in the restart file
10919! one could also define the nodes on the same processor but
10920! it will increase the comm.
10921! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
10922 CALL line_decomp(igrslin)
10923!--------------------------------------------
10924C--------------------------------------------
10925C Computation of SPMD global variables
10926C--------------------------------------------
10927C CARE TO be computed right before DDSPLIT
10928C This routine computes array sizes for Animation file.
10929C There should not be any call to frontplus beside this point.
10930C--------------------------------------------
10931 CALL globvars(igeo,ixr ,nstrf )
10932 IF(nplymax > 0)THEN
10933 CALL spmd_anim_ply_init(igeo, geo ,iparg ,ixc ,ixtg ,
10934 . ipartc,ipartq,ipartg ,stack )
10935 ENDIF
10936C--------------------------------------------
10937
10938c start CPU timer for ddsplit
10939 CALL startime(3,1)
10940! compute the size of TAG_SCRATCH and check if /INTER/24 or /25 is used
10941 CALL get_size_inter24(i24maxnsne2,ninter,npari,ipari,flag_24_25)
10942! compute the local number of element
10943 CALL get_size_numnod_local(numnod,numnod_l)
10944
10945 ALLOCATE( ale_elm(nspmd) )
10946 IF( (numels>0).AND.(iale+ieuler+glob_therm%ITHERM+ialelag/=0) ) THEN
10947 CALL split_cfd_solide(numels,ale_connectivity,ixs,ale_elm,size_ale_elm)
10948 ELSE
10949 size_ale_elm(1:nspmd) = 0
10950 ENDIF
10951 ! -----------------------------------------
10952 ! reverse connectivity for FVM solver : useful to ensure the parith/on
10953 IF(iale+ieuler+glob_therm%ITHERM+ialelag/=0) THEN
10954 ALLOCATE( indx_s(numels) )
10955 ALLOCATE( indx_q(numelq) )
10956 ALLOCATE( indx_tg(numeltg) )
10957 ALLOCATE( face_elm_s(6*numels,2) )
10958 ALLOCATE( face_elm_q(4*numelq,2) )
10959 ALLOCATE( face_elm_tg(3*numeltg,2) )
10960
10961 indx_s(1:numels) = 0
10962 indx_q(1:numelq) = 0
10963 indx_tg(1:numeltg) = 0
10964 face_elm_s(1:6*numels,1:2) = 0
10965 face_elm_q(1:4*numelq,1:2) = 0
10966 face_elm_tg(1:3*numeltg,1:2) = 0
10967 bool_ale_tg = (n2d/=0.AND.multi_fvm%IS_USED)
10968 CALL multi_connectivity( indx_s,indx_q,indx_tg,
10969 1 face_elm_s,face_elm_q,face_elm_tg,
10970 2 ixs,ixq,ixtg,cep,ale_connectivity,bool_ale_tg)
10971
10972 ELSE
10973 ALLOCATE( indx_s(0) )
10974 ALLOCATE( indx_q(0) )
10975 ALLOCATE( indx_tg(0) )
10976 ALLOCATE( face_elm_s(0,0) )
10977 ALLOCATE( face_elm_q(0,0) )
10978 ALLOCATE( face_elm_tg(0,0) )
10979 ENDIF
10980 ! -----------------------------------------
10981
10982 ! -----------------------------------------
10983 ! split the LOADS structure on the different processors
10984 CALL split_pcyl(loads%NLOAD_CYL,loads,loads_per_proc)
10985 ! -----------------------------------------
10986
10987 ! -----------------------------------------
10988 ! split the BCs data structure
10989 CALL split_bcs_wall(bcs_per_proc, cep, scep, nspmd)
10990 CALL split_bcs_nrf(bcs_per_proc, cep, scep, nspmd)
10991 ! -----------------------------------------
10992
10993 ! -----------------------------------------
10994 ! prepare the rwall splitting
10995 call alloc_constraint_struct(nrwall,nspmd,constraint_struct)
10996 call split_rwall(nrwall,nspmd,nnprw,slprw,nprw,lprw,constraint_struct)
10997 ! -----------------------------------------
10998
10999C Parallel
11000
11001! -------------------------------------------------------------
11002! RESTART FILE WRITING
11003! if -norst cdl is used or if /RFILE/OFF is used, then
11004! restart files are not generated
11005! -------------------------------------
11006 IF(restart_file==1) THEN
11007C CALL PREPARE_INT25_EDGE(INTBUF_TAB,INTERCEP,NSPMD,IPARI)
11008C----- create TAG_SKINS6 for /H3D/STRESS/TENS/OUTER
11009 ALLOCATE(tag_skins6(numels))
11010 CALL surfext_tagn(ixs ,knod2els,nod2els ,ixs10 ,tag_skins6,itab)
11011 p=0
11012 np=p
11013 IF(.NOT. ALLOCATED(partsav)) ALLOCATE(partsav(0))
11014 IF(.NOT. ALLOCATED(admsms)) ALLOCATE(admsms(0))
11015 IF(.NOT. ALLOCATED(dmelc)) ALLOCATE(dmelc(0))
11016 IF(.NOT. ALLOCATED(dmels)) ALLOCATE(dmels(0))
11017 IF(.NOT. ALLOCATED(dmeltg)) ALLOCATE(dmeltg(0))
11018 IF(.NOT. ALLOCATED(dmeltr)) ALLOCATE(dmeltr(0))
11019 IF(.NOT. ALLOCATED(dmelp)) ALLOCATE(dmelp(0))
11020 IF(.NOT. ALLOCATED(dmelrt)) ALLOCATE(dmelrt(0))
11021 IF(.NOT. ALLOCATED(res_sms)) ALLOCATE(res_sms(0))
11022 IF(.NOT. ALLOCATED(diag_sms)) ALLOCATE(diag_sms(0))
11023 IF(.NOT. ALLOCATED(cne_pxfem)) ALLOCATE(cne_pxfem(0))
11024 IF(.NOT. ALLOCATED(cel_pxfem)) ALLOCATE(cel_pxfem(0))
11025 IF(.NOT. ALLOCATED(msz2)) ALLOCATE(msz2(0))
11026 IF(.NOT. ALLOCATED(xfem_phantom)) ALLOCATE(xfem_phantom(0))
11027!$OMP PARALLEL PRIVATE(ITASK,P,pMEMFLOW,INDX_NM,NINDX_NM,TAG_NM)
11028!$OMP+ PRIVATE(NINDX_SCRT,INDX_SCRT,TAG_SCRATCH)
11029 nindx_nm = 0
11030 nindx_scrt = 0
11031 IF(ninter>0) THEN
11032 ALLOCATE( tag_nm(numnod) )
11033 ALLOCATE( indx_nm(numnod) )
11034 ALLOCATE( tag_scratch(i24maxnsne2+numnod+numels+numfakenodigeo) )
11035 ALLOCATE(indx_scrt(i24maxnsne2+numnod+numels+numfakenodigeo) )
11036 tag_nm(1:numnod) = 0
11037 indx_nm(1:numnod) = 0
11038 tag_scratch(1:i24maxnsne2+numnod+numels+numfakenodigeo) = 0
11039 indx_scrt(1:i24maxnsne2+numnod+numels+numfakenodigeo) = 0
11040 ELSE
11041 ALLOCATE(tag_nm(0))
11042 ALLOCATE(indx_nm(0))
11043 ALLOCATE( tag_scratch(0) )
11044 ALLOCATE(indx_scrt(0) )
11045 ENDIF
11046
11047 220 CONTINUE
11048
11049!$OMP CRITICAL
11050 np=np+1
11051 p=np
11052!$OMP END CRITICAL
11053
11054#if defined(_OPENMP)
11055 itask = omp_get_thread_num()
11056#endif
11057c
11058 IF(p > nspmd) GOTO 221
11059 !Sending clean addresses for unallocated arrays in case P=0
11060 NULLIFY(pmemflow) ; IF(nspmd > 0) pmemflow => memflow(1,p) !MEMFLOW(2,1:NSPMD) ; NSPMD =0 => MEMFLOW(1,0) is undefined
11061
11062
11063 CALL ddsplit(
11064 1 p ,cep ,cel ,igeo ,mat_elem ,
11065 2 ipm ,icode ,iskew ,iskwn ,bid13 ,
11066 3 ibcslag ,ipart ,iparts ,ipartq ,ipartc ,
11067 4 ipartt ,ipartp ,ipartr ,ipartg ,detonators ,
11068 5 ipartx ,npc ,ixtg ,group_param_tab,
11069 6 ixtg1 ,ixs ,ixs10 ,ixs20 ,ixs16 ,
11070 7 ixq ,ixc ,ixt ,ixp ,ixr ,
11071 8 itab ,itabm1 ,gjbufi ,ale_connectivity%NALE ,
11072 9 ale_connectivity,
11073 a kxx ,ixx ,ibcl ,ibfv ,
11074 b ilas ,laccelm ,nnlink ,lnlink ,
11075 c iparg ,igrv ,lgrav ,ibvel ,lbvel ,
11076 d iactiv ,factiv ,kinet ,ipari ,nprw ,
11077 e lprw ,iconx ,npby ,
11078 f lpby ,lrivet ,nstrf ,ljoint ,nodpor ,
11079 g monvol ,icontact ,lagbuf ,
11080 h fr_iad ,x ,d ,v ,vr ,
11081 i dr ,thke ,dampr ,damp ,ms ,
11082 j in ,tf ,pm ,skew ,xframe ,
11083 k geo ,eani ,bufmat ,bufgeo ,bufsf ,
11084 l rbmpc ,gjbufr ,w ,veul ,fill ,
11085 m dfill ,wb ,dsave ,asave ,msnf ,
11086 n spbuf ,forc ,vel ,fsav ,fzero ,
11087 o xlas ,accelm ,fbvel ,grav ,
11088 p fr_wave ,failwave ,parts0 ,elbuf ,
11089 q rwbuf ,rwsav ,rby ,rivet ,
11090 r secbuf ,volmon ,rconx ,nloc_dmg ,
11091 s fvmain ,libagale ,lenthg ,lbufmat ,lbufgeo ,
11092 t lbufsf ,sxlas ,lnom_opt ,silas ,
11093 u lenvolu ,npts ,cne ,lcne ,
11094 v addcne ,cni2 ,lcni2g ,addcni2 ,cepi2 ,
11095 w celi2 ,i2nsnt ,probint ,ddstat(1,p) ,pm1shf,
11096 x dd_iad ,
11097 z kxsp ,ixsp ,nod2sp ,cepsp ,
11098 a nthwa ,nairwa ,nmnt ,l_mul_lag1 ,l_mul_lag ,
11099 b lwaspio ,ipartsp ,ispcond ,pm1sph ,
11100 c wma ,
11101 d eigipm ,eigibuf ,eigrpm ,
11102 e iflow ,rflow ,pmemflow ,iexlnk ,fasolfr ,
11103 f ipartth ,
11104 j fxbipm ,fxbrpm ,fxbnod ,fxbmod ,fxbglm ,
11105 k fxbcpm ,fxbcps ,fxblm ,fxbfls ,fxbdls ,
11106 l fxbdep ,fxbvit ,fxbacc ,fxbelm ,fxbsig ,
11107 m fxbgrvi ,fxbgrvr ,iadll ,lll ,ibmpc ,
11108 n lambda ,lrbagale ,iskwp ,nskwp ,isensp ,
11109 o nsensp ,iaccp ,naccp ,ipart_state ,mcp ,
11110 p temp ,unitab ,intstamp ,iframe ,clusters ,
11111 q partsav ,ibftemp ,fbftemp ,ibcv ,
11112 r fconv ,irbe3 ,lrbe3 ,frbe3 ,front_rm ,
11113 s rbym ,irbym ,lnrbym ,inoise ,fnoise ,
11114 t ms0 ,admsms ,nom_sect ,ispsym ,
11115 u sh4tree ,sh3tree ,ipadmesh ,ibfflux ,fbfflux ,
11116 v sh4trim ,sh3trim ,padmesh ,msc ,mstg ,
11117 w inc ,intg ,ptg ,mcpc ,mcptg ,
11118 x rcontact ,acontact ,pcontact ,mscnd ,incnd ,
11119 y mssa ,mstr ,msp ,msrt ,ibcr ,
11120 z fradia ,dmelc ,dmeltg ,dmels ,dmeltr ,
11121 1 dmelp ,dmelrt ,res_sms ,isphio ,
11122 2 lprtsph ,lonfsph ,vsphio ,sphveln ,alph ,
11123 3 ifill ,ims ,irbe2 ,lrbe2 ,
11124 8 ms_ply,
11125 9 zi_ply ,inod_pxfem ,iel_pxfem ,icodep ,iskewp ,
11126 a addcne_pxfem ,cne_pxfem ,cel_pxfem ,ithvar ,xdp,table ,
11127 b celsph ,icfield ,lcfield ,cfield ,
11128 c msz2 ,itask ,diag_sms,
11129 d iloadp ,lloadp ,loadp,
11130 e inod_crkxfem ,iel_crkxfem ,addcne_crkxfem ,cne_crkxfem ,cel_crkxfem,
11131 f ibufssg_io ,intercep ,ibordnode ,iedgesh ,ibordedge ,
11132 g linale ,nodedge ,iedge ,cep_crkxfem ,iedge_tmp ,
11133 h crknodiad ,elbuf_tab ,nom_opt ,lgauge ,gauge ,
11134 i igaup ,ngaup ,nodlevxf ,frontb_r2r ,dflow ,
11135 j vflow ,wflow ,sph2sol ,sol2sph ,irst ,
11136 k elcutc ,nodenr ,kxfenod2elc ,enrtag ,intbuf_tab ,
11137 m i11flag ,xfem_tab ,lenthgr ,rthbuf ,
11138 n ixig3d ,kxig3d ,knot ,ipartig3d ,wige ,
11139 o ncrkpart ,indx_crk ,crklvset ,crkshell ,crksky ,
11140 p crkavx ,crkedge ,sensors ,
11141 q stack ,xfem_phantom, intert8 ,tab_ump ,poin_ump ,
11142 r sol2sph_typ ,addcsrect ,csrect ,drape ,loads ,
11143 s itagnd ,icnds10 ,addcncnd ,
11144 t cepcnd ,celcnd ,cncnd ,nativ_sms ,i24maxnsne ,
11145 u multi_fvm ,segquadfr ,intbuf_fric_tab,subsets ,igrnod ,
11146 v igrbric ,igrquad ,igrsh4n ,igrsh3n ,igrtruss ,
11147 w igrbeam ,igrspring ,igrpart ,igrsurf ,igrslin ,
11148 x poin_part_shell,poin_part_tri,poin_part_sol,mid_pid_shell,mid_pid_tri ,
11149 y mid_pid_sol , tag_nm ,nindx_nm ,indx_nm ,tag_scratch ,
11150 z nindx_scrt , indx_scrt ,flag_24_25 ,numnod_l(p) ,tag_skn ,
11151 a skews%MULTIPLE_SKEW, igrsurf_proc,knotlocpc ,knotlocel ,ale_elm(p),
11152 b size_ale_elm(p),pinch_data ,tag_skins6 ,ibcscyc ,lbcscyc ,t_monvol,
11153 c indx_s,indx_q,indx_tg,face_elm_s,face_elm_q,face_elm_tg,nbr_th_monvol, ebcs_tab,
11154 d kloadpinter ,loadpinter ,dgaploadint ,s_loadpinter, scep,dynain_data,
11155 e drapeg ,user_windows ,output ,interfaces ,number_load_cyl ,
11156 f loads_per_proc(p), python,dpl0cld,vel0cld ,names_and_titles,
11157 g bcs_per_proc(p),constraint_struct,glob_therm,pblast,rwstif_pen ,sln_pen )
11158 GOTO 220
11159 221 CONTINUE
11160
11161 DEALLOCATE(tag_nm,tag_scratch)
11162 DEALLOCATE(indx_nm,indx_scrt)
11163!$OMP END PARALLEL
11164 DEALLOCATE(tag_skins6)
11165 ENDIF ! <-- end of restart file writing
11166! -------------------------------------------------------------
11167C
11168 CALL deallocate_igrsurf_split(t_monvol,igrsurf_proc)
11169 DEALLOCATE( igrsurf_proc )
11170
11171 IF( (numels>0).AND.(iale+ieuler+glob_therm%ITHERM+ialelag/=0) ) CALL deallocate_split_cfd_solide(ale_elm)
11172
11173 CALL bcs%DEALLOCATE()
11174 DO p=1,nspmd
11175 CALL bcs_per_proc(p)%DEALLOCATE()
11176 ENDDO
11177
11178 DEALLOCATE( ale_elm )
11179
11180 DEALLOCATE( indx_s )
11181 DEALLOCATE( indx_q )
11182 DEALLOCATE( indx_tg )
11183 DEALLOCATE( face_elm_s )
11184 DEALLOCATE( face_elm_q )
11185 DEALLOCATE( face_elm_tg )
11186c stop CPU timer for ddsplit
11187 CALL stoptime(3,1)
11188
11189 CALL trace_out1()
11190 err_msg='CLOSING STARTER'
11191 CALL trace_in1(err_msg,len_trim(err_msg))
11192C----
11193C
11194C Deallocation
11195C
11196 DEALLOCATE(icontact)
11197C
11198 IF(ALLOCATED(cep)) DEALLOCATE(cep)
11199 IF(ALLOCATED(cel)) DEALLOCATE(cel)
11200C
11201 IF(lcne>0)THEN
11202 DEALLOCATE(cne)
11203 END IF
11204C
11205 IF(i2nsnt>0) THEN
11206 DEALLOCATE(celi2)
11207 DEALLOCATE(cepi2)
11208 DEALLOCATE(addcni2)
11209 END IF
11210 DEALLOCATE(iskwp)
11211 DEALLOCATE(nskwp)
11212 DEALLOCATE(isensp)
11213 DEALLOCATE(nsensp)
11214 DEALLOCATE(iaccp)
11215 DEALLOCATE(naccp)
11216 DEALLOCATE(igaup)
11217 DEALLOCATE(ngaup)
11218 DEALLOCATE(ipart_state)
11219 DEALLOCATE(eigipm, eigibuf, eigrpm)
11220 DEALLOCATE(tag_skn)
11221 DEALLOCATE(skews%MULTIPLE_SKEW)
11222 IF(iddlevel ==1 .OR. ((ninter == 0).AND.(isms == 0))) THEN
11223 DEALLOCATE(tagxref)
11224 DEALLOCATE(tagrefsta)
11225 ENDIF
11226C
11227 IF(numsph>0) THEN
11228 DEALLOCATE(cepsp)
11229 END IF
11230 IF(nsphio>0)THEN
11231 DEALLOCATE(ibufssg_io)
11232 DEALLOCATE(reservep)
11233 ENDIF
11234 DEALLOCATE(celsph)
11235C
11236 IF(lag_ncf > 0) THEN
11237 DEALLOCATE(iadll)
11238 DEALLOCATE(lll)
11239 END IF
11240C
11241C IF(ALLOCATED(FVSPMD)) DEALLOCATE(FVSPMD)
11242C
11243 DEALLOCATE(addcsrect)
11244 DEALLOCATE(csrect)
11245 DEALLOCATE(igeo_stack,geo_stack)
11246 IF(ALLOCATED(ply_info))DEALLOCATE(ply_info)
11247 IF(ALLOCATED(fxbfile_tab)) DEALLOCATE(fxbfile_tab)
11248
11249 IF(ALLOCATED(tab_ump)) DEALLOCATE(tab_ump)
11250 IF(ALLOCATED(tab_ump_old)) DEALLOCATE(tab_ump_old)
11251 IF(ALLOCATED(poin_ump)) DEALLOCATE(poin_ump)
11252 IF(ALLOCATED(poin_ump_old)) DEALLOCATE(poin_ump_old)
11253
11254 DEALLOCATE( poin_part_shell )
11255 DEALLOCATE( poin_part_tri )
11256 DEALLOCATE( poin_part_sol )
11257 DO i=1,nummat
11258 IF(ALLOCATED(mid_pid_shell(i)%PID1D))DEALLOCATE( mid_pid_shell(i)%PID1D )
11259 IF(ALLOCATED(mid_pid_shell(i)%COST1D))DEALLOCATE( mid_pid_shell(i)%COST1D )
11260
11261 IF(ALLOCATED(mid_pid_shell(i)%PID1D))DEALLOCATE( mid_pid_tri(i)%PID1D )
11262 IF(ALLOCATED(mid_pid_tri(i)%COST1D))DEALLOCATE( mid_pid_tri(i)%COST1D )
11263 DO j=1,7
11264 IF(ALLOCATED(mid_pid_sol(i,j)%PID1D)) DEALLOCATE( mid_pid_sol(i,j)%PID1D )
11265 IF(ALLOCATED(mid_pid_sol(i,j)%COST1D)) DEALLOCATE( mid_pid_sol(i,j)%COST1D )
11266 ENDDO
11267 ENDDO
11268 DEALLOCATE( mid_pid_shell,mid_pid_tri )
11269 DEALLOCATE( mid_pid_sol )
11270
11271
11272 IF(ALLOCATED(ixig3d)) DEALLOCATE(ixig3d)
11273 IF(ALLOCATED(kxig3d)) DEALLOCATE(kxig3d)
11274 IF(ALLOCATED(msig3d)) DEALLOCATE(msig3d)
11275 IF(ns10e>0.AND.ipari0/=0) THEN
11276 DEALLOCATE(celcnd)
11277 DEALLOCATE(cepcnd)
11278 DEALLOCATE(addcncnd)
11279 IF(lcncnd>0) DEALLOCATE(cncnd)
11280 END IF
11281 IF(ALLOCATED(itagnd)) DEALLOCATE(itagnd)
11282 IF(ns10e>0) DEALLOCATE(icnds10)
11283 CALL monvol_deallocate(nvolu, t_monvol)
11284 IF(ALLOCATED(t_monvol)) DEALLOCATE(t_monvol)
11285 DEALLOCATE(ibcscyc,lbcscyc)
11286 IF(nbcscyc>0) DEALLOCATE(itagcyc)
11287 IF(ALLOCATED(fvm_inivel)) DEALLOCATE(fvm_inivel)
11288C
11289C-- Seatblet structures deallocation
11290 IF(n_seatbelt > 0) THEN
11291 DO i=1,n_seatbelt
11292 DEALLOCATE(seatbelt_tab(i)%SPRING)
11293 ENDDO
11294 DEALLOCATE(seatbelt_tab)
11295 ENDIF
11296C
11297 IF(nslipring > 0) THEN
11298 DO i=1,nslipring
11299 DEALLOCATE(slipring(i)%FRAM)
11300 ENDDO
11301 DEALLOCATE(slipring)
11302 ENDIF
11303C
11304 IF(nretractor > 0) THEN
11305 DO i=1,nretractor
11306 DEALLOCATE(retractor(i)%INACTI_NODE)
11307 DO j=1,2
11308 IF (retractor(i)%IFUNC(j) > 0) THEN
11309 DEALLOCATE(retractor(i)%TABLE(j)%X(1)%VALUES)
11310 DEALLOCATE(retractor(i)%TABLE(j)%X)
11311 DEALLOCATE(retractor(i)%TABLE(j)%Y%VALUES)
11312 DEALLOCATE(retractor(i)%TABLE(j)%Y)
11313 ENDIF
11314 ENDDO
11315 ENDDO
11316 DEALLOCATE(retractor)
11317 ENDIF
11318 IF((ipart_stack > 0 .OR. ipart_pcompp > 0) .AND. ndrape > 0) DEALLOCATE(iwork_t)
11319
11320 IF(ALLOCATED(mparam_r2r))THEN
11321 DO i=1,nummat ; CALL mparam_r2r(i)%DESTRUCT() ; ENDDO
11322 DEALLOCATE(mparam_r2r)
11323 ENDIF
11324
11325 ! -----------------------------------------
11326 ! deallocation of constraint_struct
11327 call dealloc_constraint_struct(nrwall,constraint_struct)
11328 ! -----------------------------------------
11329
11330C --------------------------------------
11331C Starter Memory Printout
11332C --------------------------------------
11333 CALL printstsz(detonators)
11334C --------------------------------------
11335C Stat domdec + evaluation memoire SPMD
11336C --------------------------------------
11337C
11338 IF(restart_file==1) THEN
11339 CALL ddprint(ddstat, memflow)
11340 ELSE
11341 WRITE(iout,*)
11342 WRITE(iout,*) check_message(3)(1:len_trim(check_message(3)))
11343 ENDIF
11344C
11345c ENDIF
11346 ELSE
11347 WRITE(istdo,'(A)')titre(48)
11348 ENDIF
11349C
11350 DEALLOCATE(knod2els,knod2elc,knod2eltg,
11351 . nod2els ,nod2elc ,nod2eltg,
11352 . knod2el1d,nod2el1d,knod2elig3d,
11353 . nod2elig3d,knod2elq,nod2elq)
11354C
11355 DEALLOCATE(msc,mstg,mssa,mstr,msp,msrt)
11356C
11357 DEALLOCATE(mcp,temp)
11358 DEALLOCATE(ibcv, fconv, ibcr, fradia, ibftemp, fbftemp, ibfflux, fbfflux)
11359C
11360 DEALLOCATE(rbym ,irbym ,lnrbym,weight_rm)
11361 DEALLOCATE(ms_ply,zi_ply,icode,iskew)
11362c
11363 IF(ALLOCATED(knotlocpc))DEALLOCATE(knotlocpc)
11364 IF(ALLOCATED(knotlocel))DEALLOCATE(knotlocel)
11365c
11366 CALL trace_out1()
11367 IF(ALLOCATED(ipmas))DEALLOCATE(ipmas)
11368c---------------------------
11369 IF(icrack3d > 0) THEN
11370 DEALLOCATE(inod_crkxfem,iel_crkxfem)
11371 DEALLOCATE(cne_crkxfem)
11372 DEALLOCATE(cel_crkxfem)
11373 DEALLOCATE(cep_crkxfem)
11374 DEALLOCATE(iedgesh)
11375 DEALLOCATE(ibordedge)
11376 DEALLOCATE(nodedge)
11377 DEALLOCATE(iedge)
11378 DEALLOCATE(ibordnode)
11379 END IF
11380 IF(ALLOCATED(iedge_tmp)) DEALLOCATE(iedge_tmp)
11381 IF(ALLOCATED(elcutc)) DEALLOCATE(elcutc)
11382 IF(ALLOCATED(nodenr)) DEALLOCATE(nodenr)
11383 IF(ALLOCATED(kxfenod2elc)) DEALLOCATE(kxfenod2elc)
11384 IF(ALLOCATED(enrtag)) DEALLOCATE(enrtag)
11385 IF(ALLOCATED(addcne_crkxfem))DEALLOCATE(addcne_crkxfem)
11386C----------------------------------------------
11387C ALLOCATION TO REDUCE STACKSIZE
11388C----------------------------------------------
11389 DEALLOCATE(addcne)
11390 DEALLOCATE(addcne_pxfem)
11391 DEALLOCATE(fxbtag)
11392C
11393 DEALLOCATE(isolnod)
11394 DEALLOCATE(isoloff)
11395 DEALLOCATE(isheoff)
11396 DEALLOCATE(itruoff)
11397 DEALLOCATE(ipouoff)
11398 DEALLOCATE(iresoff)
11399 DEALLOCATE(itrioff)
11400 DEALLOCATE(igrnrby)
11401 DEALLOCATE(iquaoff)
11402C
11403 DEALLOCATE(xrefc)
11404 DEALLOCATE(xreftg)
11405 DEALLOCATE(xrefs)
11406 DEALLOCATE(ifront%P,ifront%IENTRY,ientry2)
11407 DEALLOCATE(dflow,vflow,wflow)
11408 DEALLOCATE(permutation%SOLID)
11409 IF(ALLOCATED(fillsol)) DEALLOCATE(fillsol)
11410 IF(ALLOCATED(sh3ang)) DEALLOCATE(sh3ang)
11411 IF(ALLOCATED(sh4ang)) DEALLOCATE(sh4ang)
11412 IF(ALLOCATED(nativ_sms)) DEALLOCATE(nativ_sms)
11413 IF(ALLOCATED(multi_fvm%VEL)) DEALLOCATE(multi_fvm%VEL)
11414 IF(ALLOCATED(multi_fvm%ACC)) DEALLOCATE(multi_fvm%ACC)
11415 CALL ale_connectivity%ALE_DEALLOCATE_CONNECTIVITY()
11416 IF(ipart_stack > 0 .OR. ipart_pcompp > 0) DEALLOCATE(stack_info)
11417 IF(ALLOCATED(ipreload)) DEALLOCATE(ipreload)
11418 IF(ALLOCATED(preload)) DEALLOCATE(preload)
11419 IF(ALLOCATED(iflag_bpreload)) DEALLOCATE(iflag_bpreload)
11420 IF(ALLOCATED(ipreload_fun)) DEALLOCATE(ipreload_fun)
11421 IF(ALLOCATED(eos_tag))DEALLOCATE(eos_tag)
11422 CALL c_delete_hash(h_node)
11423 CALL deallocate_detonators(detonators)
11424 IF(ALLOCATED(xseed)) DEALLOCATE(xseed)
11425 IF(ALLOCATED(alea)) DEALLOCATE(alea)
11426 IF(ALLOCATED(irand)) DEALLOCATE(irand)
11427 IF(ALLOCATED(sensors%SENSOR_TAB)) DEALLOCATE(sensors%SENSOR_TAB )
11428 IF(ALLOCATED(sensors%LOGICAL_SENSORS_LIST)) DEALLOCATE(sensors%LOGICAL_SENSORS_LIST)
11429 IF(ALLOCATED(damp_range_part)) DEALLOCATE(damp_range_part)
11430C
11431 CALL ebcs_tab%destroy()
11432 IF(ninimap1d > 0 .AND. .NOT. multi_fvm%IS_USED) THEN
11433 DO kk = 1, ninimap1d
11434 DEALLOCATE(inimap1d(kk)%TAGNODE)
11435 ENDDO
11436 ENDIF
11437 DEALLOCATE(inimap1d)
11438
11439 IF(ninimap2d > 0 .AND. .NOT. multi_fvm%IS_USED) THEN
11440 DO kk = 1, ninimap2d
11441 DEALLOCATE(inimap2d(kk)%TAGNODE)
11442 ENDDO
11443 ENDIF
11444 DEALLOCATE(inimap2d)
11445
11446
11447 CALL inverted_group_dealloc(inv_group)
11448
11449 CALL deallocate_joint( )
11450
11451 IF(nfxbody>0) THEN
11452 CLOSE(ifxm)
11453 CLOSE(ifxs)
11454 ENDIF
11455
11456 IF(ALLOCATED( dgapint )) DEALLOCATE(dgapint)
11457
11458 IF(ALLOCATED(dpl0cld)) DEALLOCATE(dpl0cld)
11459 IF(ALLOCATED(vel0cld)) DEALLOCATE(vel0cld)
11460 IF(ALLOCATED(ebcs_tag_cell_spmd)) DEALLOCATE(ebcs_tag_cell_spmd)
11461C----------------------------------------------
11462
11463 RETURN
add_mass_stat
subroutine add_mass_stat(ms, in, stifn, stifr, itab, totmas)
Definition add_mass_stat.F:32
addmast10
subroutine addmast10(icnds10, ms)
Definition addmast10.F:29
alelec
subroutine alelec(icode, ixs, ixq, ixc, ixt, ixtg, pm, igeo, itab, geo, nale_r2r, flag_r2r, multi_fvm, ale_connectivity, itherm, ishadow)
Definition alelec.F:40
allocxfem
subroutine allocxfem(ixc, ixtg, iparg, lcne_crkxfem, crklvset, crksky, crkavx, crkedge, xfem_phantom)
Definition allocxfem.F:32
anodin
void anodin(int *nb)
Definition analyse_node.c:357
apartin
void apartin(int *nb)
Definition analyse_part.c:148
ani_fasolfr2
subroutine ani_fasolfr2(fastag, fasolfr, isolnod)
Definition ani_fasolfr.F:340
ani_fasolfr1
subroutine ani_fasolfr1(ixs, ixc, ixtg, fastag, isolnod)
Definition ani_fasolfr.F:32
ani_segquadfr1
subroutine ani_segquadfr1(ixq, segtag, knod2elq, nod2elq, x, nseg)
Definition ani_segquadfr.F:30
ani_segquadfr2
subroutine ani_segquadfr2(segtag, segquadfr)
Definition ani_segquadfr.F:109
build_addcnel_sub
subroutine build_addcnel_sub(addcnel, cnel, addcnel_sub, indx, subsize)
Definition build_addcnel_sub.F:30
build_cnel
subroutine build_cnel(ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixs10, ixs20, ixs16, ixtg1, igeo, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, cnel, addcnel, kxx, ixx, x, lelx, ixig3d, kxig3d, knod2elig3d, nod2elig3d, knod2elq, nod2elq)
Definition build_cnel.F:37
prepare_int25
subroutine prepare_int25(intbuf_tab, ipari, intercep, nrtmt_25)
Definition build_cnel.F:407
build_csrect
subroutine build_csrect(intbuf_tab, ipari, csrect, addcsrect)
Definition build_cnel.F:509
build_cnel_sub
subroutine build_cnel_sub(cnel_sub, addcnel_sub, cnel, addcnel, indx, subsize)
Definition build_cnel_sub.F:30
bulkfakeigeo3
subroutine bulkfakeigeo3(elbuf_tab, iparg, pm, kxig3d, igrsurf, stifint)
Definition bulkfakeigeo3.F:30
c3grhead
subroutine c3grhead(ixtg, pm, geo, inum, isel, itr1, eadd, index, itri, xnum, iparttg, nd, thk, igrsurf, igrsh3n, cep, xep, ixtg1, icnod, igeo, ipm, ipart, sh3tree, nod2eltg, itrioff, sh3trim, tagprt_sms, iworksh, stack, drape, rnoise, multi_fvm, sh3ang, drapeg, ptsh3n, mat_param, damp_range_part)
Definition c3grhead.F:46
c3grtails
subroutine c3grtails(ixtg, pm, iparg, geo, eadd, nd, iparttg, dd_iad, idx, inum, index, cep, thk, xnum, itr1, igrsurf, igrsh3n, icnod, igeo, ipm, ixtg1, ipart, sh3tree, nod2eltg, itrioff, sh3trim, tagprt_sms, iworksh, stack, drape, rnoise, mat_param, sh3ang, drapeg, print_flag, ptsh3n, damp_range_part)
Definition c3grtails.F:49
c_new_hash
void c_new_hash(int *map, int *count)
Definition c_hash_table.cpp:103
c_delete_hash
void c_delete_hash(int *map)
Definition c_hash_table.cpp:116
c_hash_insert
void c_hash_insert(int *map, int *key, int *val)
Definition c_hash_table.cpp:142
cdk6inx
subroutine cdk6inx(ixtg, ixtg1, icnod)
Definition cdk6inx.F:34
cgrhead
subroutine cgrhead(ixc, pm, geo, inum, isel, itr1, eadd, index, itri, xnum, ipartc, nd, thk, igrsurf, igrsh4n, cep, xep, igeo, ipm, ipart, sh4tree, nod2elc, isheoff, sh4trim, tagprt_sms, lgauge, iworksh, mat_param, stack, drape, rnoise, sh4ang, drapeg, ptshel, damp_range_part)
Definition cgrhead.F:45
cgrtails
subroutine cgrtails(ixc, pm, iparg, geo, eadd, nd, ipartc, dd_iad, idx, inum, itr1, index, cep, thk, xnum, igrsurf, igrsh4n, igeo, ipm, ipart, sh4tree, nod2elc, isheoff, sh4trim, tagprt_sms, lgauge, iworksh, stack, drape, rnoise, mat_param, sh4ang, iddlevel, drapeg, print_flag, ptshel, damp_range_part)
Definition cgrtails.F:50
check_dynain
subroutine check_dynain(ipart, ipartc, iparttg, ixc, ixtg, dynain_check)
Definition check_dynain.F:33
check_mat_elem_prop_compatibility
subroutine check_mat_elem_prop_compatibility(elbuf_str, iparg, ipm, igeo, nummat, numgeo, ngroup, nparg, npropmi, npropgi, mat_param, n2d, ixt, numelt, ixp, numelp, ixr, numelr, kxx, numelx)
Definition check_mat_elem_prop_compatibility.F:38
check_pthickfail
subroutine check_pthickfail(elbuf_str, mat_param, iparg, geo, ipm, stack, igeo, nummat, numgeo, ngroup, nparg, npropmi, npropgi, npropg)
Definition check_pthickfail.F:37
check_qeph_stra
subroutine check_qeph_stra(istr_24)
Definition check_qeph_stra.F:30
check_surf
subroutine check_surf(igrsurf)
Definition check_surf.F:31
checkrby
subroutine checkrby(rby, npby, lpby, itab, ikine, iddlevel, nom_opt, numsl)
Definition checkrby.F:37
chktyp2
subroutine chktyp2(ipari, itab, nom_opt, intbuf_tab, nativ_sms)
Definition chktyp2.F:35
ini_h3dtmax_engine
subroutine ini_h3dtmax_engine(iparg, ipart, iparts, ipartc, ipartg, iddlevel)
Definition contrl.F:1799
my_real
#define my_real
Definition cppsort.cpp:32
create_seatbelt
subroutine create_seatbelt(ixr, itab, knod2el1d, nod2el1d, ipm, x, sensors, bufmat, pm, geo, iddlevel, knod2elc, nod2elc, ixc, igeo, iskn, tf, npc)
Definition create_seatbelt.F:38
dampdtnoda
subroutine dampdtnoda(ms, in, stifn, stifr, igrnod, dampr)
Definition dampdtnoda.F:32
ddsplit
subroutine ddsplit(p, cep, cel, igeo, mat_elem, ipm, icode, iskew, iskn, insel, ibcslag, ipart, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, detonators, ipartx, npc, ixtg, group_param_tab, ixtg6, ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, itab, itabm1, gjbufi, nale, ale_connectivity, kxx, ixx, ibcl, ibfv, las, laccelm, nnlink, lllink, iparg, igrav, lgrav, ibvel, lbvel, iactiv, factiv, kinet, ipari, nprw, lprw, iexmad, npby, lpby, ixri, nstrf, ljoint, pornod, monvol, icontact, lagbuf, fr_iad, x, d, v, vr, dr, thke, dampr, damp, ms, in, tf, pm, skew, xframe, geo, eani, bufmat, bufgeo, bufsf, brmpc, gjbufr, w, veul, fill, dfill, wb, dsav, asav, msnf, spbuf, fac, vel, fsav, fzero, xlas, accelm, fbvel, gravfac, fr_wave, failwave, parts0, elbuf, rwl, rwsav, rby, rivet, secbuf, rvolu, rconx, nloc_dmg, fvmain, libagale, lenthg, lbufmat, lbufgeo, lbufsf, lenxlas, lnom_opt, lenlas, lenvolu, npts, cne, lcne, addcne, cni2, lcni2g, addcni2, cepi2, celi2, i2nsnt, probint, ddstat, pm1shf, dd_iad, kxsp, ixsp, nod2sp, cepsp, nthwa, nairwa, nmnt, l_mul_lag1, l_mul_lag, lwaspio, ipartsp, ispcond, pm1sph, wma, eigipm, eigibuf, eigrpm, iflow, rflow, memflow, iexlnk, fasolfr, iparth, fxbipm, fxbrpm, fxbnod, fxbmod, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxbdep, fxbvit, fxbacc, fxbelm, fxbsig, fxbgrvi, fxbgrvr, iadll, lll, ibmpc, lambda, lrbagale, iskwp, nskwp, isensp, nsensp, iaccp, naccp, ipart_state, mcp, temp, unitab, intstamp, iframe, clusters, partsav, ibft, fbft, ibcv, fconv, irbe3, lrbe3, frbe3, front_rm, rbym, irbym, lcrbym, inoise, fnoise, ms0, admsms, nom_sect, ispsym, sh4tree, sh3tree, ipadmesh, ibfflux, fbfflux, sh4trim, sh3trim, padmesh, msc, mstg, inc, intg, ptg, mcpc, mcptg, rcontact, acontact, pcontact, mscnd, incnd, mssa, mstr, msp, msrt, ibcr, fradia, dmelc, dmeltg, dmels, dmeltr, dmelp, dmelrt, res_sms, isphio, lprtsph, lonfsph, vsphio, sphveln, alph, ifill, ims, irbe2, lrbe2, ms_ply, zi_ply, inod_pxfem, iel_pxfem, icodply, iskwply, addcne_pxfem, cne_pxfem, cel_pxfem, ithvar, xdp, table, celsph, icfield, lcfield, cfield, msz2, itask, diag_sms, iloadp, lloadp, loadp, inod_crkxfem, iel_crkxfem, addcne_crkxfem, cne_crkxfem, cel_crkxfem, ibufssg_io, intercep, ibordnode, iedgesh, ibordedge, linale, nodedge, iedge, cep_crkxfem, iedge_tmp, crknodiad, elbuf_tab, nom_opt, lgauge, gauge, igaup, ngaup, nodlevxf, frontb_r2r, dflow, vflow, wflow, sph2sol, sol2sph, irst, elcutc, nodenr, kxfenod2elc, enrtag, intbuf_tab, i11flag, xfem_tab, lenthgr, rthbuf, ixig3d, kxig3d, knot, ipartig3d, wige, ncrkpart, indx_crk, crklvset, crkshell, crksky, crkavx, crkedge, sensors, stack, xfem_phantom, t8, tab_ump, poin_ump, sol2sph_typ, addcsrect, csrect, drape, loads, itagnd, icnds10, addcncnd, cepcnd, celcnd, cncnd, nativ_sms, i24maxnsne, multi_fvm, segquadfr, intbuf_fric_tab, subset, igrnod, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrpart, igrsurf, igrslin, poin_part_shell, poin_part_tri, poin_part_sol, mid_pid_shell, mid_pid_tri, mid_pid_sol, tag_nm, nindx_nm, indx_nm, tag_scratch, nindx_scrt, indx_scrt, flag_24_25, numnod_l, tag_skn, multiple_skew, igrsurf_proc, knotlocpc, knotlocel, ale_elm, size_ale_elm, pinch_data, tag_skins6, ibcscyc, lbcscyc, t_monvol, indx_s, indx_q, indx_tg, face_elm_s, face_elm_q, face_elm_tg, nbr_th_monvol, ebcs_tab, kloadpinter, loadpinter, dgaploadint, s_loadpinter, len_cep, dynain_data, drapeg, user_windows, output, interfaces, number_load_cyl, loads_per_proc, python, dpl0cld, vel0cld, names_and_titles, bcs_per_proc, constraint_struct, glob_therm, pblast, rwstif_pen, sln_pen)
Definition ddsplit.F:337
ini_ifront
subroutine ini_ifront()
Definition ddtools.F:31
fill_intercep
subroutine fill_intercep(ipari, intbuf_tab, intercep)
Definition ddtools.F:973
set_intercep
subroutine set_intercep(ipari, intercep, flag, intbuf_tab, itab, cep)
Definition ddtools.F:713
set_front8
subroutine set_front8(ipari, intercep, intbuf_tab, t8, nbt8, itab)
Definition ddtools.F:407
nlocal
integer function nlocal(n, p)
Definition ddtools.F:350
deallocate_elbuf
subroutine deallocate_elbuf(elbuf_tab, igeo, iparg, ixs, ixc, ixtg, flag_xfem, ixt, ixp, ixr, kxx)
Definition deallocate_buffer.F:36
deallocate_igrsurf_split
subroutine deallocate_igrsurf_split(t_monvol, igrsurf_proc)
This routine deallocates the local IGSURF_PROC arrays.
Definition deallocate_igrsurf_split.F:35
desout
subroutine desout(x, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, itab, pm, geo, ms, ixs10, igeo, ipm, kxsp, ipart, ipartsp, names_and_titles)
Definition desout.F:36
the
end diagonal values have been computed in the(sparse) matrix id.SOL
fillcncnd
subroutine fillcncnd(cncnd, addcncnd, icnds10, itagnd)
Definition dim_s10edg.F:1297
bcscycmodif_nd
subroutine bcscycmodif_nd(ibcscyc, lbcscyc, itagnd, itab)
Definition dim_s10edg.F:1423
pre_cndpon
subroutine pre_cndpon(icnds10, adskycnd, cepcnd, celcnd, itagnd)
Definition dim_s10edg.F:1181
ind_s10edg
subroutine ind_s10edg(icnds10, ixs, ixs10, iparg, itagnd)
Definition dim_s10edg.F:91
stifn1_nd
subroutine stifn1_nd(icnds10, stifn)
Definition dim_s10edg.F:1376
reord_icnd
subroutine reord_icnd(icnds10, itagnd)
Definition dim_s10edg.F:174
rigmodif1_nd
subroutine rigmodif1_nd(npby, lpby, itagnd)
Definition dim_s10edg.F:405
bcsmodif_nd
subroutine bcsmodif_nd(icode, itagnd, icnds10, itab, nnpby, slrbody, nrbe2l, slrbe2, npby, lpby, irbe2, lrbe2)
Definition dim_s10edg.F:666
stifn0_nd
subroutine stifn0_nd(icnds10, stifn)
Definition dim_s10edg.F:1341
rbe2modif1_nd
subroutine rbe2modif1_nd(irbe2, lrbe2, itagnd)
Definition dim_s10edg.F:611
dim_s10edg
subroutine dim_s10edg(nedg, ixs10, iparg, itagnd)
Definition dim_s10edg.F:29
fixmodif_nd
subroutine fixmodif_nd(ibfv, itagnd, icnds10, itab)
Definition dim_s10edg.F:774
domdec1
subroutine domdec1(iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, dd_iad, x, dd_iad_prev, ixs10, ixs20, ixs16, kxx, ixx, kxsp, ixsp, cepsp, ixtg6)
Definition domdec1.F:41
fillcni2
subroutine fillcni2(cni2, lcni2, addcni2, ipari, intbuf_tab)
Definition domdec2.F:2829
ddprint
subroutine ddprint(ddstat, memflow)
Definition domdec2.F:2905
domdec2
subroutine domdec2(dd_iad, ipari, ib, npby, lpby, ixri, ibvel, lbvel, iparg, cel, ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg6, t_monvol, igrsurf, addcne, lcne, geo, nprw, lprw, lcni2, adskyi2, cepi2, celi2, i2nsnt, iskn, iskwp, nskwp, isensp, nsensp, iaccp, naccp, laccelm, ibcv, irbe3, lrbe3, front_rm, irbym, lcrbym, cep, ibcr, irbe2, lrbe2, cepsp, celsph, iloadp, lloadp, lgauge, igaup, ngaup, intbuf_tab, ibfflux, icnds10, itagnd, igeo, tag_skn, multiple_skew, ibfv, ibcscyc, lbcscyc, r_skew, ipm, sensors, len_cep, ebcs_tab, loads, iframe, niconv, niradia, nitflux, numconv, numradia, nfxflux, sensor_user_struct)
Definition domdec2.F:61
fillcne
subroutine fillcne(cne, lcne, ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg6, t_monvol, igrsurf, ib, addcne, cep, ilen, geo, ibcv, ibcr, ibfflux, iloadp, lloadp, cel, ebcs_tab, loads, niconv, niradia, nitflux, numconv, numradia, nfxflux)
Definition domdec2.F:2041
dsdim0
subroutine dsdim0(ndof, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, kxx, ixx, geo)
Definition dsdim.F:32
dtnoda
subroutine dtnoda(nodft, nodlt, neltst, ityptst, itab, ms, in, stifn, stifr, dt2t, dmast, dinert, adt, adm, imsch, weight, a, ar, igrnod, nodadt_therm, adi, rbym, arby, arrby, weight_md, mcp, mcp_off, condn, nale, h3d_data)
Definition dtnoda.F:42
sav_buf_point
void sav_buf_point(int *buf, int *i)
Definition eng_callback_c.c:58
failwave_init
subroutine failwave_init(failwave, iparg, ixc, ixtg, numnod)
Definition failwave_init.F:32
fillcne_xfem
subroutine fillcne_xfem(lcne_crkxfem, iparg, iel_crkxfem, inod_crkxfem, ixc, ixtg, cep, addcne_crkxfem, cne_xfe, cel_xfe, cep_xfe, crknodiad)
Definition fillcne_xfem.F:33
flowdec
subroutine flowdec(iflow)
Definition flowdec.F:31
ifrontplus
subroutine ifrontplus(n, p)
Definition frontplus.F:101
fsdcod
subroutine fsdcod(python, bufmat, pm, geo, ibcl, ipres, ibfv, iskew, iskn, sensors, mat_param, itabm1, skew, laccelm, insel, bufgeo, ibcslag, igeo, ipm, ibft, ibcv, ibfvel, ibcr, table, npc1, npc, pld, nom_opt, ibfflux, glob_therm, nimpvel, nimpdisp, nimpacc)
Definition fsdcod.F:46
m20dcod
subroutine m20dcod(mlaw_tag, ipm, pm, mat_param)
Definition fsdcod.F:2029
fxbelnum
subroutine fxbelnum(fxbnod, nsn, iparg, itag, fxbelm, ixs, ixc, ixtg, iparts, ipartc, iparttg, ixt, ixp, ipartt, ipartp)
Definition fxbelnum.F:33
fxbgrav
subroutine fxbgrav(igrv, ibuf, nsni, fxbnod, fxbgrvi, fxbgrvr, nsn, fxbmod, nbml, nbme, ms, grav, skew, ifile, nfx, ircm0)
Definition fxbgrav.F:32
fxbtagn
subroutine fxbtagn(fxbnod, nsn, ntag, ibcld, ibprl, ixs, ixc, ixt, ixp, ixr, ixtg, iparg, itag, nbmo, nbml, nels, nelc, neltg, igrv, ibuf, nlgrav, ipari, intbuf_tab, ifile, nelt, nelp)
Definition fxbtagn.F:35
genani1
subroutine genani1(x, bufel, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, swaft, iparg, pm, geo, skew, itab, lpby, npby, nstrf, rwbuf, nprw, ipart, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, rby, swa4, igrsurf, bufsf, ipartx, kxsp, ixsp, ipartsp, spbuf, ixs10, ixs20, ixs16, ipm, igeo, smater, sel2fa, snfacptx, sixedge, soffx1, snumx1, sxnorm, sinvert, sfunc1, siad, nmanim, d, smas, ms, fxani, mbufel, mdepl, nlevel, elsub, dsanim, nelem, cep, cepsp, nom_opt, ptr_nopt_rwall, ptr_nopt_sect, elbuf_tab, sph2sol, subset)
Definition genani1.F:98
get_size_inter24
subroutine get_size_inter24(i24maxnsne, ninter, npari, ipari, flag_24_25)
Definition get_size_tag.F:87
get_size_numnod_local
subroutine get_size_numnod_local(numnod, numnod_l)
Definition get_size_tag.F:143
globmat
subroutine globmat(igeo, geo, pm, pm_stack, geo_stack, igeo_stack, mat_param)
Definition globmat.F:32
globvars
subroutine globvars(igeo, ixr, nstrf)
Definition globvars.F:32
lec_ddw
subroutine lec_ddw(filnam, len_filnam, tab_ump_old, cputime_mp_old)
Definition grid2mat.F:3267
prelec_ddw_poin
subroutine prelec_ddw_poin(filnam, len_filnam)
Definition grid2mat.F:3319
lec_ddw_poin
subroutine lec_ddw_poin(filnam, len_filnam, poin_ump_old)
Definition grid2mat.F:3360
dometis
subroutine dometis(ixs, ixq, ixc, ixt, ixp, ixr, ixtg, cep, geo, itri1, itri2, index1, index2, num, wd, iwcont, nelem, iddlevel, nelemint, inter_cand, pm, x, kxx, ixx, adsky, igeo, isolnod, iwcin2, dsdof, isoloff, isheoff, itrioff, itruoff, ipouoff, iresoff, ielem21, ipm, ixs10, ikine, clusters, kxig3d, ixig3d, cost_r2r, bufmat, taille, poin_ump, tab_ump, poin_ump_old, tab_ump_old, cputime_mp_old, nsnt, nmnt, tabmp_l, iquaoff, igrsurf, fvmain, itab, ipart, ipartc, ipartg, iparts, poin_part_shell, poin_part_tri, poin_part_sol, mid_pid_shell, mid_pid_tri, mid_pid_sol, t_monvol, ebcs_tag_cell_spmd, npby, lpby, mat_param)
Definition grid2mat.F:74
spdometis
subroutine spdometis(kxsp, ixsp, nod2sp, cepsp, reservep, sph2sol, cep)
Definition grid2mat.F:2625
prelec_ddw
subroutine prelec_ddw(filnam, len_filnam, marqueur3)
Definition grid2mat.F:3195
hm_option_count
subroutine hm_option_count(entity_type, hm_option_number)
Definition hm_option_count.F:105
hm_pre_read_preload
subroutine hm_pre_read_preload(nstrf, lsubmodel)
Definition hm_pre_read_preload.F:37
hm_pre_read_link
subroutine hm_pre_read_link(num, igrnod, lsubmodel)
Definition hm_pre_read_rlink.F:39
hm_prelecjoi
subroutine hm_prelecjoi(num, igrnod, lsubmodel)
Definition hm_prelecjoi.F:39
hm_preread_cload
subroutine hm_preread_cload(numcld, igrnod, igrsurf, lsubmodel)
Definition hm_preread_cload.F:38
hm_preread_convec
subroutine hm_preread_convec(igrsurf, igrnod, igrbric, unitab, lsubmodel, nconvec, numconv)
Definition hm_preread_convec.F:39
hm_preread_grav
subroutine hm_preread_grav(num, igrnod, lsubmodel)
Definition hm_preread_grav.F:37
hm_preread_impacc
subroutine hm_preread_impacc(num, igrnod, lsubmodel)
Definition hm_preread_impacc.F:38
hm_preread_impdisp
subroutine hm_preread_impdisp(nimpdisp, igrnod, ipart, ipartr, unitab, lsubmodel)
Definition hm_preread_impdisp.F:41
hm_preread_impflux
subroutine hm_preread_impflux(igrsurf, igrnod, igrbric, unitab, lsubmodel, nimpflux, nfxflux)
Definition hm_preread_impflux.F:39
hm_preread_imptemp
subroutine hm_preread_imptemp(igrsurf, igrnod, igrbric, unitab, lsubmodel, nimtemp, nfxtemp)
Definition hm_preread_imptemp.F:40
hm_preread_impvel0
subroutine hm_preread_impvel0(impose_dr, unitab, lsubmodel)
Definition hm_preread_impvel0.F:38
hm_preread_impvel
subroutine hm_preread_impvel(nimpvel, igrnod, ipart, ipartr, nfvlag, unitab, lsubmodel)
Definition hm_preread_impvel.F:42
hm_preread_load_centri
subroutine hm_preread_load_centri(numcentri, igrnod, igrsurf, lsubmodel)
Definition hm_preread_load_centri.F:39
hm_preread_load_pressure
subroutine hm_preread_load_pressure(numloadp, igrsurf, lsubmodel)
Definition hm_preread_load_pressure.F:39
hm_preread_merge
subroutine hm_preread_merge(smgrby, slpby, igrnod, lsubmodel)
Definition hm_preread_merge.F:39
hm_preread_pblast
subroutine hm_preread_pblast(pblast, numloadp, igrsurf, lsubmodel, nsurf)
Definition hm_preread_pblast.F:39
hm_preread_pfluid
subroutine hm_preread_pfluid(numloadp, igrnod, igrsurf, lsubmodel)
Definition hm_preread_pfluid.F:38
hm_preread_pload
subroutine hm_preread_pload(numpres, igrnod, igrsurf, lsubmodel)
Definition hm_preread_pload.F:37
hm_preread_radiation
subroutine hm_preread_radiation(igrsurf, igrnod, igrbric, unitab, lsubmodel, nradia, numradia)
Definition hm_preread_radiation.F:39
hm_preread_rbe3
subroutine hm_preread_rbe3(lnum, lreal, igrnod, grnod_uid, lsubmodel)
Definition hm_preread_rbe3.F:40
hm_preread_rbody
subroutine hm_preread_rbody(slpby, igrnod, lsubmodel)
Definition hm_preread_rbody.F:39
hm_preread_sphio
subroutine hm_preread_sphio(igrsurf, svsphio, nom_opt, lsubmodel)
Definition hm_preread_sphio.F:38
hm_preread_xelem
subroutine hm_preread_xelem(num, igrnod, lsubmodel)
Definition hm_preread_xelem.F:35
hm_read_activ
subroutine hm_read_activ(iactiv, factiv, sensors, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, lsubmodel, unitab)
Definition hm_read_activ.F:41
hm_read_admas
subroutine hm_read_admas(ms, itabm1, igrnod, unitab, igrsurf, ipart, ipmas, totaddmas, flag, igrpart, x, lsubmodel)
Definition hm_read_admas.F:47
hm_read_ale_link
subroutine hm_read_ale_link(icode, iskew, itab, itabm1, ikine, igrnod, ibcslag, lag_ncf, lag_nkf, lag_nhf, ikine1lag, linale, lsubmodel, unitab)
Definition hm_read_ale_link_vel.F:44
hm_read_bem
subroutine hm_read_bem(igrsurf, iflow, rflow, npc, igrnod, memflow, unitab, x, nom_opt, lgauge, igrv, lsubmodel, iresp)
Definition hm_read_bem.F:274
hm_preread_bem
subroutine hm_preread_bem(igrsurf, igrnod, nnft, unitab, nom_opt, lsubmodel)
Definition hm_read_bem.F:41
hm_read_cload
subroutine hm_read_cload(ibcl, forc, num, itab, itabm1, igrnod, nwork, unitab, iskn, lsubmodel, loads)
Definition hm_read_cload.F:46
hm_read_cluster
subroutine hm_read_cluster(clusters, unitab, iskn, igrbric, igrspring, ixs, ixr, nom_opt, lsubmodel)
Definition hm_read_cluster.F:44
hm_read_convec
subroutine hm_read_convec(ib, fac, itab, ixs, igrsurf, unitab, lsubmodel, nconvec, niconv, numconv, lfacther)
Definition hm_read_convec.F:42
hm_read_cyljoint
subroutine hm_read_cyljoint(ljoint, itabm1, ikine, itab, igrnod, nom_opt, lsubmodel)
Definition hm_read_cyljoint.F:48
hm_read_damp
subroutine hm_read_damp(dampr, igrnod, iskn, lsubmodel, unitab, snpc1, npc1, ndamp_vrel_rby, igrpart, damp_range_part)
Definition hm_read_damp.F:44
hm_read_prelecdrape
subroutine hm_read_prelecdrape(idrapeid, lsubmodel)
Definition hm_read_drape.F:37
hm_preread_eig
subroutine hm_preread_eig(igrnod, nnt, lsubmodel)
Definition hm_read_eig.F:39
hm_read_eig
subroutine hm_read_eig(eigipm, eigibuf, eigrpm, igrnod, itabm1, unitab, lsubmodel)
Definition hm_read_eig.F:156
hm_read_eref
subroutine hm_read_eref(itabm1, ipart, ipartc, ipartg, iparts, ixc, ixtg, ixs, x, xrefc, xreftg, xrefs, lsubmodel, iddlevel, itab, tagxref, tagrefsta)
Definition hm_read_eref.F:44
hm_read_friction_models
subroutine hm_read_friction_models(nom_opt, unitab, igrpart, ipart, tagprt_fric, tabcoupleparts_fric_tmp, tabcoef_fric_tmp, intbuf_fric_tab, nsetfrictot, iflag, coefslen, iorthfricmax, ifricorth_tmp, ngrpf, lengrpf, leng, nsetmax, lsubmodel)
Definition hm_read_friction_models.F:45
hm_read_friction_orientations
subroutine hm_read_friction_orientations(intbuf_fric_tab, npfricorth, igrpart, ipart, pfricorth, irepforth, iskn, phiforth, vforth, skew, iflag, tagprt_fric, rtrans, lsubmodel, unitab)
Definition hm_read_friction_orientations.F:46
hm_read_frm
subroutine hm_read_frm(iskn, x, itab, itabm1, xframe, lsubmodel, rtrans, nom_opt, unitab)
Definition hm_read_frm.F:50
hm_read_func2d
subroutine hm_read_func2d(func2d, lsubmodel, unitab)
Definition hm_read_func2d.F:39
hm_read_funct
subroutine hm_read_funct(npc, pld, nfunct, table, npts_alloc, nom_opt, funcrypt, unitab, lsubmodel)
Definition hm_read_funct.F:45
hm_read_fxb1
subroutine hm_read_fxb1(nom_opt, fxbnod, fxbipm, fxb_matrix, fxb_matrix_add, nmanim, itab, itabm1, fxbfile_tab, lsubmodel)
Definition hm_read_fxb.F:47
hm_read_fxb2
subroutine hm_read_fxb2(fxbipm, fxbrpm, fxbnod, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxbmod, itab, itabm1, nom_opt, fxb_last_adress, lsubmodel)
Definition hm_read_fxb.F:499
hm_read_gauge
subroutine hm_read_gauge(lgauge, gauge, itabm1, unitab, ixc, nom_opt, lsubmodel)
Definition hm_read_gauge.F:45
hm_read_gjoint
subroutine hm_read_gjoint(gjbufi, gjbufr, itab, itabm, x, mass, iner, lag_ncf, lag_nkf, lag_nhf, ikine, unitab, ikine1lag, nom_opt, lsubmodel)
Definition hm_read_gjoint.F:46
hm_read_grav
subroutine hm_read_grav(igrv, lgrav, grav, itab, itabm1, igrnod, npc, sensors, unitab, iskn, itagnd, lsubmodel)
Definition hm_read_grav.F:47
hm_read_impacc
subroutine hm_read_impacc(fac, ibfv, nfxvel0, itab, itabm1, ikine, igrnod, iskn, unitab, lsubmodel, num, nimpacc)
Definition hm_read_impacc.F:48
hm_read_impflux
subroutine hm_read_impflux(ib, fac, itab, ixs, igrsurf, unitab, igrnod, igrbric, lsubmodel, nimpflux, nitflux, lfacther)
Definition hm_read_impflux.F:42
hm_read_imptemp
subroutine hm_read_imptemp(ibft, fac, num, itabm1, igrnod, nwork, itab, unitab, lsubmodel, nimtemp, nift, lfacther)
Definition hm_read_imptemp.F:43
hm_read_impvel
subroutine hm_read_impvel(fbfvel, ibfvel, ikine, ikine1lag, itab, itabm1, igrnod, x0, ixr, ipart, ipartr, iskn, nom_opt, nimpdisp, nimpvel, unitab, lsubmodel)
Definition hm_read_impvel.F:45
hm_read_inigrav
subroutine hm_read_inigrav(igrv, ibuf, agrv, itab, itabm1, igrpart, npc, unitab, iskn, itagnd, igrsurf, pld, bufsf, lsubmodel)
Definition hm_read_inigrav.F:42
hm_read_inimap1d
subroutine hm_read_inimap1d(inimap1d, npc, itabm1, x, igrbric, igrquad, igrsh3n, multi_fvm, unitab, lsubmodel)
Definition hm_read_inimap1d.F:46
hm_read_inimap2d
subroutine hm_read_inimap2d(inimap2d, func2d, itabm1, xgrid, igrbric, igrquad, igrsh3n, unitab, lsubmodel)
Definition hm_read_inimap2d.F:47
hm_read_initemp
subroutine hm_read_initemp(temp, nintemp, itherm_fe, itab, itabm1, igrnod, initids, unitab, lsubmodel)
Definition hm_read_initemp.F:44
hm_read_inivel
subroutine hm_read_inivel(v, w, itab, itabm1, vr, igrnod, igrbric, iskn, skew, inivids, x, unitab, lsubmodel, rtrans, xframe, iframe, vflow, wflow, kxsp, multi_fvm, fvm_inivel, igrquad, igrsh3n, rby_msn, rby_iniaxis, sensors, ninivelt, inivel_t)
Definition hm_read_inivel.F:53
hm_read_interfaces
subroutine hm_read_interfaces(ipari, frigap, itab, itabm1, igrnod, igrsurf, igrslin, igrbric, igrsh3n, igrtruss, npc, iskn, xfiltr, stfac, fric_p, i2rupt, areasl, unitab, nom_opt, def_inter, npc1, sensors, multi_fvm, nom_optfric, intbuf_fric_tab, lsubmodel, tf, npts, npari, kloadpinter, dgapint, interfaces, sitab, nparir, sitabm1, siskwn, liskn, snpc, snpc1, itherm_fe, intheat)
Definition hm_read_interfaces.F:54
hm_read_intsub
subroutine hm_read_intsub(igrnod, igrsurf, nom_opt, igrslin, lsubmodel)
Definition hm_read_intsub.F:46
hm_read_load_centri
subroutine hm_read_load_centri(icfield, lcfield, cfield, itab, itabm1, igrnod, npc, sensors, unitab, iframe, lsubmodel)
Definition hm_read_load_centri.F:45
hm_read_load_pressure
subroutine hm_read_load_pressure(numloadp, iloadp, lloadp, interloadp, facloadp, kloadpinter, loadpinter, npc, sensors, igrsurf, unitab, iskn, lsubmodel, dgapint, intgaploadp, dgaploadint, s_loadpinter, pblast)
Definition hm_read_load_pressure.F:48
hm_read_merge
subroutine hm_read_merge(mgrby, smgrby, npby, lpby, slrbody, rby, nom_opt, ptr_nopt_rbmerge, igrnod, itab, itabm1, ibgr, igrv, lsubmodel)
Definition hm_read_merge.F:51
hm_read_move_funct
subroutine hm_read_move_funct(npc, pld, nfunct, table, ntable, funcrypt, unitab, lsubmodel)
Definition hm_read_move_funct.F:38
hm_read_mpc
subroutine hm_read_mpc(rbuf, ibufnc, ibufnn, ibufdl, ibufsk, iskn, itab, itabm, lag_ncf, lag_nkf, lag_nhf, ikine, ikine1lag, nom_opt, itagnd, lsubmodel, unitab)
Definition hm_read_mpc.F:49
hm_read_node
subroutine hm_read_node(x, itab, itabm1, cmerge, unitab, wige, lsubmodel, is_dyna)
Definition hm_read_node.F:44
hm_preread_part
subroutine hm_preread_part(ipart, igeo, lsubmodel)
Definition hm_read_part.F:529
hm_read_part
subroutine hm_read_part(ipart, pm, geo, ipm, igeo, iwa, thk_part, unitab, lsubmodel, multi_fvm, mlaw_tag, mat_param, glob_therm)
Definition hm_read_part.F:48
hm_read_pblast
subroutine hm_read_pblast(pblast, itab, itabm1, unitab, igrsurf, numloadp, iloadp, lloadp, facloadp, x, bufsf, lsubmodel, rtrans)
Definition hm_read_pblast.F:47
hm_read_pcyl
subroutine hm_read_pcyl(loads, igrsurf, nsensor, sensor_tab, table, iframe, unitab, lsubmodel, number_load_cyl)
Definition hm_read_pcyl.F:44
hm_read_perturb
subroutine hm_read_perturb(mat_param, ipart, rnoise, ipartc, ipartg, ipartsp, igrpart, ipm, iparts, perturb, qp_iperturb, qp_rperturb, lsubmodel, unitab)
Definition hm_read_perturb.F:42
hm_read_pfluid
subroutine hm_read_pfluid(numloadp, iloadp, lloadp, facloadp, npc, sensors, igrsurf, unitab, iframe, lsubmodel)
Definition hm_read_pfluid.F:43
hm_read_pload
subroutine hm_read_pload(ipres, pres, nprel, itab, itabm1, igrsurf, unitab, lsubmodel, loads)
Definition hm_read_pload.F:43
hm_read_preload
subroutine hm_read_preload(ixs, ixs10, ipreload, preload, iflag_bpreload, nstrf, sensors, unitab, x, isolnod, itab, lsubmodel, snpc, npc, ipreload_fun)
Definition hm_read_preload.F:43
hm_read_prethgrou
subroutine hm_read_prethgrou(ifi, nvartot, lsubmodel, iflag, output)
Definition hm_read_prethgrou.F:38
hm_read_properties
subroutine hm_read_properties(geo, x, ix, pm, itabm1, bufgeo, lbufgeo, iskn, igeo, ipm, npc, pld, unitab, rtrans, lsubmodel, prop_tag, ipart, knot, idrapeid, stack_info, numgeo_stack, nprop_stack, multi_fvm, iadbuf, defaults, mat_param)
Definition hm_read_properties.F:80
hm_read_quad
subroutine hm_read_quad(ixq, itab, itabm1, ipart, ipartq, ipm, igeo, unitab, lsubmodel)
Definition hm_read_quad.F:39
hm_read_radiation
subroutine hm_read_radiation(ib, fac, itab, ixs, igrsurf, unitab, lsubmodel, nradia, numradia, niradia, lfacther)
Definition hm_read_radiation.F:42
setrb2on
subroutine setrb2on(ixs, ixc, ixtg, igrnod, igrnrb2, isoloff, isheoff, itrioff, itabm1, lsubmodel)
Definition hm_read_rbe2.F:1181
seteloff2
subroutine seteloff2(ixs, ixc, ixt, ixp, ixr, ixtg, iparg, isoloff, isheoff, itruoff, ipouoff, iresoff, itrioff, igrnrb2, igrnod, irbe2)
Definition hm_read_rbe2.F:1075
hm_read_rbe2
subroutine hm_read_rbe2(irbe2, lrbe2, itab, itabm1, igrnod, iskn, ikine, iddlevel, nom_opt, itagnd, icdns10, lsubmodel)
Definition hm_read_rbe2.F:49
hm_preread_rbe2
subroutine hm_preread_rbe2(lnum, lreal, igrnod, lsubmodel)
Definition hm_read_rbe2.F:328
inirbe3
subroutine inirbe3(irbe3, lrbe3, frbe3, skew, x, ms, in, nom_opt, stifn, stifr, icode, itab)
Definition hm_read_rbe3.F:388
hm_read_rbe3
subroutine hm_read_rbe3(irbe3, lrbe3, frbe3, itab, itabm1, igrnod, iskn, lxintd, ikine, iddlevel, nom_opt, itagnd, grnod_uid, unitab, lsubmodel)
Definition hm_read_rbe3.F:48
setrbyon
subroutine setrbyon(ixs, ixc, ixtg, igrnod, igrnrby, isoloff, isheoff, itrioff, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, ixq, iquaoff, knod2elq, nod2elq, lsubmodel)
Definition hm_read_rbody.F:565
seteloff
subroutine seteloff(ixs, ixc, ixt, ixp, ixr, ixtg, iparg, isoloff, isheoff, itruoff, ipouoff, iresoff, itrioff, igrnrby, igrnod, elbuf_str, iquaoff, ixq)
Definition hm_read_rbody.F:752
hm_read_rbody
subroutine hm_read_rbody(rby, npby, lpby, itab, itabm1, igrnod, igrsurf, ibfv, igrv, ibgr, sensors, imerge, unitab, iskn, nom_opt, numsl, knod2els, knod2elc, knod2eltg, knod2el1d, knod2elq, itagnd, icdns10, lsubmodel, icfield, lcfield)
Definition hm_read_rbody.F:56
hm_read_rbody_lagmul
subroutine hm_read_rbody_lagmul(rbyl, npbyl, lpbyl, igrnod, lsubmodel, itab, itabm1, ikine, ikine1lag, nom_opt)
Definition hm_read_rbody_lagmul.F:46
hm_read_rivet
subroutine hm_read_rivet(ixri, v, vr, ms, in, rivet, geo, itab, itabm1, ikine, ipart, igeo, lsubmodel)
Definition hm_read_rivet.F:43
hm_read_link
subroutine hm_read_link(nnlink, lllink, itab, itabm1, ikine, igrnod, iskn, iframe, nom_opt, lsubmodel)
Definition hm_read_rlink.F:46
lecsec42
subroutine lecsec42(ixs, ixq, ixc, ixt, ixp, ixr, ixtg, x0, itab, itabm1, igrnod, secbuf, ipari, ixs10, ixs20, ixs16, unitab, iskn, xframe, isolnod, nom_sect, rtrans, lsubmodel, nom_opt, igrbric, igrquad, igrsh4n, igrtruss, igrbeam, igrspring, igrsh3n, seatbelt_shell_to_spring, nb_seatbelt_shells)
Definition hm_read_sect.F:67
lecsec0
subroutine lecsec0(lsubmodel)
Definition hm_read_sect.F:996
hm_read_sensors
subroutine hm_read_sensors(python, sensors, laccelm, itabm1, ipart, lgauge, subset, nsets, igrnod, iskwn, unitab, lsubmodel, hm_nsens, sensor_user_struct)
Definition hm_read_sensors.F:67
hm_read_skw
subroutine hm_read_skw(skew, iskn, x, itab, itabm1, nsn, lsubmodel, rtrans, nom_opt, unitab)
Definition hm_read_skw.F:49
inisms
subroutine inisms(igrpart, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, tagprt_sms)
Definition hm_read_sms.F:242
hm_read_solid
subroutine hm_read_solid(ixs, pm, itab, itabm1, ipart, iparts, isolnod, ixs10, ixs20, ixs16, igeo, lsubmodel, is_dyna, x)
Definition hm_read_solid.F:42
lce16s4
subroutine lce16s4(ixs, pm, icode)
Definition hm_read_solid.F:816
hm_read_spcnd
subroutine hm_read_spcnd(ispcond, iskew, itab, itabm1, ikine, igrnod, nod2sp, iframe, nom_opt, lsubmodel)
Definition hm_read_spcnd.F:44
hm_read_sphio
subroutine hm_read_sphio(isphio, vsphio, ipart, igrsurf, nod2sp, ipartsp, itab, x, mfi, lwaspio, itabm1, unitab, lsubmodel, rtrans, nrtrans)
Definition hm_read_sphio.F:48
hm_read_table2
subroutine hm_read_table2(ntable, table, nfunct, unitab, lsubmodel)
Definition hm_read_table.F:130
hm_read_table1
subroutine hm_read_table1(ntable, table, nfunct, npc, pld, nom_opt, unitab, lsubmodel)
Definition hm_read_table.F:39
hm_read_thgrou
subroutine hm_read_thgrou(ithgrp, ithbuf, itab, itabm1, ixtg, ixs, ixq, ixc, ixt, ixp, ixr, kxx, ixx, ipart, ifi, nthwa, kxsp, ixri, iskwn, iframe, nthgrp2, pathid, suthid, fxbipm, iparth, nparth, nvparth, nvsubth, imerge, ithvar, flagabf, nvarabf, nom_opt, ptr_nopt_fxby, ptr_nopt_inter, ptr_nopt_rwall, ptr_nopt_sect, ptr_nopt_joint, ptr_nopt_monv, ptr_nopt_acc, ptr_nopt_skw, ptr_nopt_gau, ptr_nopt_clus, ptr_nopt_sphio, isphio, rfi, t_monvol, igrsurf, subset, ithflag, npby, lsubmodel, iparg, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartg, ipartx, ipartsp, ipartig3d, lithbufmx, map_tables, iflag, ptr_nopt_slipring, ptr_nopt_retractor, sensors, interfaces, ipari, dump_thnms1_file, itherm_fe, checksum, nsubdom, ipri)
Definition hm_read_thgrou.F:78
hm_read_thpart
subroutine hm_read_thpart(ipart, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, lsubmodel)
Definition hm_read_thpart.F:43
hm_read_window_user
subroutine hm_read_window_user(user_windows, lsubmodel, itab, x, v, vr, ms, in)
Definition hm_read_window_user.F:42
hm_read_xelem
subroutine hm_read_xelem(igrnod, itab, itabm1, ipart, ipartx, ipm, igeo, kxx, ixx, lsubmodel)
Definition hm_read_xelem.F:38
hm_read_xref
subroutine hm_read_xref(itabm1, ipart, ipartc, ipartg, iparts, unitab, ixc, ixtg, ixs, x, xrefc, xreftg, xrefs, rtrans, lsubmodel, tagxref, iddlevel, isolnod, ipm, igeo)
Definition hm_read_xref.F:47
hm_setfxrbyon
subroutine hm_setfxrbyon(itabm1, ixs, isoloff, ixc, isheoff, ixt, itruoff, ixp, ipouoff, ixr, iresoff, ixtg, itrioff, fxbipm, lsubmodel)
Definition hm_setfxrbyon.F:43
hm_yctrl
subroutine hm_yctrl(unitab, lsubmodel, igrbric, ixc, ixtg, ptshel, ptsh3n, nusphcel)
Definition hm_yctrl.F:41
i24setnodes
subroutine i24setnodes(ipari, intbuf_tab, intercep, itab, i24maxnsne)
Definition i24setnodes.F:38
iedge_xfem
subroutine iedge_xfem(ibordnode, ixc, ixtg, iedgesh4, iedgesh3, ibordedge, nodedge, ielcrkc, ielcrktg, iedge, cep_crk, iedge_tmp0)
Definition iedge_xfem.F:36
ig3dgrhead
subroutine ig3dgrhead(kxig3d, geo, inum, itr1, eadd, index, itri, ipartig3d, nd, igrsurf, cep, xep, igeo, ipm, pm, nige, knotlocel)
Definition ig3dgrhead.F:36
ig3dgrtails
subroutine ig3dgrtails(kxig3d, iparg, geo, eadd, nd, dd_iad, idx, lb_max, inum, index, cep, ipartig3d, itr1, igrsurf, ixig3d, igeo, pm, nige, knotlocel, matparam_tab)
Definition ig3dgrtails.F:38
igrsurf_split
subroutine igrsurf_split(scep, cep, t_monvol, igrsurf, igrsurf_proc)
Definition igrsurf_split.F:34
inicrkfill
subroutine inicrkfill(elbuf_tab, xfem_tab, ixc, ixtg, iparg, inicrack, x, iel_crk, inod_crk, xrefc, xreftg, iedgesh4, iedgesh3, nodedge, crklvset, crkshell, crkedge, xfem_phantom, itab)
Definition inicrkfill.F:36
iniebcs
subroutine iniebcs(ale_connectivity, iflag, igrsurf, ixs, ixq, ixtg, pm, igeo, x, sensors, ivolu, multi_fvm_is_used, ebcs_tab, ebcs_tag_cell_spmd, itab)
Definition iniebcs.F:39
iniebcsp0
subroutine iniebcsp0(x, iparg, elbuf_str, ebcs_tab, ixs, ixq, ixtg, iparts, ipartq, iparttg, pm, ipm, mat_param)
Definition iniebcsp0.F:35
inimu2
subroutine inimu2(pm, ix, f, df)
Definition inimu2.F:29
inimu3
subroutine inimu3(pm, ix, f, df)
Definition inimu3.F:30
inimul
subroutine inimul(pm, f, df, m20_discrete_fill)
Definition inimul.F:29
inintr1
subroutine inintr1(ipari, stifint, intbuf_tab, stfac)
Definition inintr1.F:35
inintr2
subroutine inintr2(ipari, inscr, x, ixs, ixq, ixc, pm, geo, intc, itab, ms, npby, lpby, mwa, ikine, i2nsnt, in, stifn, stifint, nom_opt, inod_pxfem, ms_ply, intbuf_tab, stifintr, itagnd, icnds10, ms_b, in_b, nstrf, itagcyc, irbe2, irbe3, lrbe3, knod2els, nod2els, ixs10, ixs16, ixs20, s_nod2els)
Definition inintr2.F:58
inintr
subroutine inintr(ipari, inscr, x, v, ixs, ixq, ixc, pm, geo, itab, ms, mwa, rwa, ixtg, ikine, ixt, ixp, ixr, ale_connectivity, nelemint, iddlevel, ifiend, igrbric, iwcont, iwcin2, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf, ielem21, sh4tree, sh3tree, ipart, ipartc, iparttg, thk, thk_part, nod2el1d, knod2el1d, ixs10, inter_cand, frigap, ixs16, ixs20, ipm, nom_opt, iparts, siskwn, kxx, ixx, igeo, intercep, lelx, intbuf_tab, fillsol, stack, iworksh, nsnt, nmnt, kxig3d, ixig3d, knod2elq, nod2elq, segquadfr, tagprt_fric, intbuf_fric_tab, ipartt, ipartp, ipartx, ipartr, nsn_multi_connec, t2_nb_connec, sicode, icode, iskew, multi_fvm, s_nod2els, sitab, sitabm1, flag_elem_inter25, list_nin25, iresp)
Definition inintr.F:65
inintr_orthdirfric
subroutine inintr_orthdirfric(ipari, intbuf_tab, intbuf_fric_tab, igeo, geo, x, ixtg, ixc, iparttg, ipartc, pfricorth, irepforth, phiforth, vforth, knod2elc, knod2eltg, nod2eltg, nod2elc, iworksh, pm, pm_stack, thk, skew, itab, ipart)
Definition inintr_orthdirfric.F:39
inintr_thkvar
subroutine inintr_thkvar(elbuf_tab, ipari, intbuf_tab, inscr, x, ixs, ixc, pm, geo, itab, mwa, rwa, ixtg, ikine, iparg, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, intstamp, skew, ms, in, v, vr, rby, npby, lpby, iparts, ipartc, ipartg, thk_part, nom_opt, ptr_nopt_inter)
Definition inintr_thkvar.F:109
inintsub
subroutine inintsub(itab, igrnod, igrsurf, ipari, maxrtm, nom_opt, intbuf_tab, maxrtms, igrslin, maxnsne)
Definition inintsub.F:40
inisen
subroutine inisen(sensors, ipari, nom_opt, ptr_nopt_rwall, ptr_nopt_sect, ptr_nopt_inter, ixr, r_skew, numelr, nsect, ninter, nintsub, nrwall, nrbody)
Definition inisen.F:37
init_joint
subroutine init_joint(njoint)
Definition init_joint.F:31
init_mlaw_tag
subroutine init_mlaw_tag(mlaw_tag, my_size)
Definition init_mlaw_tag.F:31
initia
subroutine initia(iparg, elbuf, ms, in, v, x, ixs, ixq, ixc, ixt, ixp, ixr, detonators, geo, pm, rby, npby, lpby, npc, npts, pld, veul, ale_connectivity, skew, fill, ipart, itab, sensors, skvol, ixtg, thk, nloc_dmg, group_param_tab, glob_therm, igrnod, igrsurf, bufsf, vr, bufmat, xlas, las, dtelem, mss, msq, msc, mst, msp, msr, mstg, ptg, inc, nod2eltg, knod2eltg, inp, inr, intg, index, itri, kxx, ixx, xelemwa, iwa, nod2elq, knod2elq, nod2els, knod2els, kxsp, ixsp, nod2sp, ispcond, icode, iskew, iskn, ispsym, xframe, isptag, spbuf, mssx, nsigi, npbyl, lpbyl, rbyl, msnf, mssf, nsigsh, igeo, ipm, nsigs, nsigsph, vns, vnsx, stc, stt, stp, str, sttg, stur, bns, bnsx, volnod, bvolnod, etnod, nshnod, stifint, fxbdep, fxbvit, fxbacc, fxbipm, fxbrpm, fxbelm, fxbsig, fxbmod, ins, ptshel, ptsh3n, ptsol, ptquad, wma, ptsph, fxbnod, mbufel, mdepl, fxani, numel, nsigrs, sh4tree, sh3tree, mcp, temp, imerge2, iadmerge2, slnrbm, nslnrbm, rmstifn, rmstifr, ms_layer, zi_layer, itag, itagel, mcpc, mcptg, xrefc, xreftg, xrefs, mssa, msrt, irbe2, lrbe2, inivol, kvol, nbsubmat, ixs10, ixs16, ixs20, totaddmas, ipmas, stifn, msz2, itagn, sitage, itage, ixr_kj, elbuf_tab, nom_opt, ptr_nopt_rbe2, ptr_nopt_adm, ptr_nopt_fun, sol2sph, irst, sh3trim, xfem_tab, kxig3d, ixig3d, msig3d, knot, nctrlmax, wige, stack, rnoise, drape, sh4ang, sh3ang, geo_stack, igeo_stack, stifintr, strc, strp, strr, strtg, perturb, itagnd, nativ_sms, iloadp, facload, ptspri, nsigbeam, ptbeam, nsigtruss, pttruss, multi_fvm, sigi, sigsh, sigsp, sigsph, sigrs, sigbeam, sigtruss, strsglob, straglob, orthoglob, isigsh, iyldini, ksigsh3, fail_ini, iusolyld, iuser, iddlevel, inimap1d, inimap2d, func2d, fvm_inivel, tagprt_sms, igrbric, igrquad, igrsh4n, igrsh3n, igrpart, totmas, knotlocpc, knotlocel, vnige, bnige, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxb_matrix, fxb_matrix_add, fxb_last_adress, ptr_nopt_fxb, r_skew, knod2el1d, nod2el1d, ebcs_tab, rby_iniaxis, alea, knod2elc, nod2elc, dr, slrbody, drapeg, ipari, intbuf_tab, interfaces, mat_param, npreload_a, preload_a, fail_fractal, fail_brokmann, defaults, ndamp_freq_range, dampr, ibeam_vector, rbeam_vector, ikine, lsigi, lsigsp, srnoise, nprw, lprw, rwstif_pen, sln_pen)
Definition initia.F:198
inivel
subroutine inivel(v, vr, svr, itabm1)
Definition inivel.F:35
int18_law151_alloc
subroutine int18_law151_alloc(npari, ninter, numnod, numels, multi_fvm, ipari)
Definition int18_law151_alloc.F:30
i2rupt
subroutine i2rupt(x, v, a, ms, in, stifn, fsav, weight, irect, nsv, msr, irtl, irupt, crst, mmass, miner, smass, siner, area, uvar, xsm0, dsm, fsm, prop, ipari, nsn, nmn, nuvar, igtyp, pid, npf, tf, itab, fncont, pdama2, isym, inorm, h3d_data, fncontp, ftcontp)
Definition int2rupt.F:122
intbuf_fric_ini_starter
subroutine intbuf_fric_ini_starter(intbuf_fric_tab)
Definition intbufFric_ini_starter.F:32
intbuf_fric_copy
subroutine intbuf_fric_copy(tabcoupleparts_fric_tmp, tabcoef_fric_tmp, tabparts_fric_tmp, nsetinit, ifricorth_tmp, intbuf_fric_tab)
Definition intbuf_fric_copy.F:33
int8_ini
subroutine int8_ini(intbuf_tab, ipari, nbt8)
Definition intbuf_ini_starter.F:2152
intbuf_ini_starter
subroutine intbuf_ini_starter(intbuf_tab, ipari, numn, i11flag, flag_allocate, proc, intbuf_fric_tab)
Definition intbuf_ini_starter.F:34
inverted_group_dealloc
subroutine inverted_group_dealloc(inv_group)
Definition inverted_group_dealloc.F:31
set_usrtos
integer function set_usrtos(iu, ipartm1, npart)
Definition ipartm1.F:128
islin_ini
subroutine islin_ini(igrslin)
Definition islin_ini.F:30
isurf_ini
subroutine isurf_ini(igrsurf)
Definition isurf_ini.F:30
kinchk
subroutine kinchk(ikine, rwl, itab, nprw, lprw, kinet, npby, lpby, irbe2, lrbe2, irbe3, lrbe3, nom_opt, ptr_nopt_rwall, ptr_nopt_rbe2, ptr_nopt_rbe3, itagcyc)
Definition kinchk.F:38
inivchk
subroutine inivchk(ikine, rwl, itab, nprw, lprw, kinet, npby, lpby, irbe2, lrbe2, irbe3, lrbe3, frbe3, x, skew, v, vr)
Definition kinchk.F:1297
kinrem
subroutine kinrem(ikine, ikinew, rwl, itab, nprw, lprw, npby, lpby)
Definition kinchk.F:1222
lagm_ini
subroutine lagm_ini(nhf, iadhf, iadll, jll, lll, ipari, intbuf_tab, igrnod, ibcslag, mass, iner, gjbufi, ibufnc, ibufnn, ibufdl, ibufsk, ibfv, vel, itab, nom_opt, ptr_nopt_inter, ptr_nopt_fxv, ptr_nopt_bcs, ptr_nopt_mpc, ptr_nopt_gjoint)
Definition lagm_ini.F:43
lagm_nhf
subroutine lagm_nhf(ncf, iadll, jll, lll, jcihf)
Definition lagm_nhf.F:29
laserp1
subroutine laserp1(las, cep, ixq)
Definition laserp.F:32
laserp3
subroutine laserp3(las, iparg)
Definition laserp.F:111
lec_inistate
subroutine lec_inistate(ixs, ixq, ixc, ixt, ixp, ixr, geo, pm, kxsp, ixtg, index, itri, nsigsh, igeo, ipm, nsigs, nsigsph, ksysusr, ptshel, ptsh3n, ptsol, ptquad, ptsph, numel, nsigrs, unitab, isolnodd00, lsubmodel, rtrans, idrape, nsigi, ptspri, nsigbeam, ptbeam, nsigtruss, pttruss, sigi, sigsh, sigsp, sigsph, sigrs, sigbeam, sigtruss, strsglob, straglob, orthoglob, isigsh, iyldini, ksigsh3, fail_ini, iusolyld, iuser, igrbric, map_tables, iparg, stack, iworksh, mat_param, numsph, nisp)
Definition lec_inistate.F:49
lecacc
subroutine lecacc(laccelm, accelm, itabm1, unitab, ixc, iskn, nom_opt, lsubmodel)
Definition lecacc.F:45
ini_bcscyc
subroutine ini_bcscyc(ibcscyc, lbcscyc, skew, x, itab, icode, ibfv, itagcyc)
Definition lecbcscyc.F:139
lecextlnk
subroutine lecextlnk(iexter, ipart, lsubmodel)
Definition lecextlnk.F:41
lecfill
subroutine lecfill(ixs, fillsol, unitab, lsubmodel)
Definition lecfill.F:42
lecins
subroutine lecins(ipari, itab, pm, ipm, bufmat, igrnod, igrsurf, igrslin, xfiltr, stfac, fric_p, frigap, i2rupt, areasl, lixint, x, linter, ixs, nom_opt, ixc, ixtg, knod2elc, knod2eltg, nod2elc, nod2eltg, intbuf_tab, knod2els, nod2els, ixs10, ixs16, ixs20, nige, rige, xige, vige, igrbric, multi_fvm, nale, igeo, interfaces, s_nod2els, s_nod2eltg, flag_elem_inter25, list_nin25)
Definition lecins.F:58
lecint
subroutine lecint(ipari, linter, ipm, bufmat, nmnt, itab, itabm1, geo, pm, x, igrnod, igrsurf, igrslin, npc, probint, lag_ncf, lag_nkf, lag_ncl, lag_nkl, lag_nhf, maxrtm, iskn, maxrtms, igeo, xfiltr, stfac, fric_p, frigap, i2rupt, areasl, unitab, ixs, nom_opt, itag, ixc, ixtg, knod2elc, knod2eltg, nod2elc, nod2eltg, knod2els, nod2els, ixs10, ixs16, ixs20, def_inter, maxnsne, npc1, multi_fvm, nom_optfric, intbuf_fric_tab, igrbric, igrsh3n, igrtruss, maxrtm_t2, nsn_multi_connec, t2_nb_connec, iddlevel, nale, interfaces, snpc1, flag_elem_inter25, list_nin25)
Definition lecint.F:66
leclas
subroutine leclas(lsubmodel)
Definition leclas.F:41
lecrefsta
subroutine lecrefsta(itabm1, unitab, ixc, ixtg, ixs, xyzref, xrefc, xreftg, xrefs, tagnod, iddlevel, tagref)
Definition lecrefsta.F:39
lecsec4bolt
subroutine lecsec4bolt(ixs, ixq, ixc, ixt, ixp, ixr, ixtg, x0, nstrf, itab, itabm1, igrnod, secbuf, ipari, ixs10, ixs20, ixs16, unitab, iskn, xframe, isolnod, nom_sect, rtrans, lsubmodel, nom_opt, igrbric)
Definition lecsec4bolt.F:57
lecstack_ply
subroutine lecstack_ply(geo_stack, x, ix, pm, itabm1, iskn, igeo_stack, ipm, npc, pld, unitab, rtrans, lsubmodel, ipart, idrapeid, ply_info, stack_info, numgeo_stack, nprop_stack, defaults)
Definition lecstack_ply.F:50
lecstamp
subroutine lecstamp(ipari, intstamp, unitab, npby, icode, nom_opt, lsubmodel)
Definition lecstamp.F:45
lecsubmod
subroutine lecsubmod(isubmod, x, unitab, itabm1, rtrans, itab, lsubmodel, is_dyna, iskwn, liskn, skew, lskew, siskwn, sskew)
Definition lecsubmod.F:45
lectranssub
subroutine lectranssub(x, igrnod, itab, itabm1, unitab, rtrans, lsubmodel, is_dyna, iskwn, liskn, nspcond, numsph, siskwn)
Definition lectranssub.F:47
lgmini_i7
subroutine lgmini_i7(ipari, intbuf_tab, mass, itab, igrnod, nom_opt)
Definition lgmini_i7.F:34
lgmini_rwl
subroutine lgmini_rwl(nprw, lprw, mass, itab, nom_opt)
Definition lgmini_rwl.F:34
line_decomp
subroutine line_decomp(igrslin)
Definition line_decomp.F:33
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
create_map_tables
subroutine create_map_tables(map_tables, mode, lsubmodel, subset, ipart, ixs, ixq, ixc, ixtg, ixt, ixp, ixr, kxsp, lrivet, rby_msn)
Definition map_tables.F:44
merge
subroutine merge(x, itab, itabm1, cmerge, imerge, imerge2, iadmerge2, nmerge_tot)
Definition merge.F:36
multi_connectivity
subroutine multi_connectivity(indx_s, indx_q, indx_tg, face_elm_s, face_elm_q, face_elm_tg, ixs, ixq, ixtg, cep, ale_connectivity, bool_ale_tg)
Definition multi_connectivity.F:32
multi_unplug_neighbors
subroutine multi_unplug_neighbors(ale_connectivity, ixs, ixq, ixtg)
Definition multi_unplug_neighbors.F:32
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
ale_ebcs_mod
Definition ale_ebcs_mod.F:40
ale_ebcs_mod::nebcs
integer nebcs
Definition ale_ebcs_mod.F:43
ale_mod
Definition ale_mod.F:150
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:253
alefvm_mod
Definition alefvm_mod.F:88
alefvm_mod::alefvm_buffer
type(alefvm_buffer_), target alefvm_buffer
Definition alefvm_mod.F:120
alefvm_mod::alefvm_param
type(alefvm_param_), target alefvm_param
Definition alefvm_mod.F:121
bpreload_mod
Definition bpreload_mod.F:40
bpreload_mod::iflag_bpreload
integer, dimension(:), allocatable iflag_bpreload
Definition bpreload_mod.F:48
bpreload_mod::ipreload
integer, dimension(:), allocatable ipreload
Definition bpreload_mod.F:46
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
cluster_mod
Definition cluster_mod.F:40
ddweights_mod
Definition ddweights_mod.F:40
detonators_mod
Definition detonators_mod.F:80
detonators_mod::deallocate_detonators
subroutine deallocate_detonators(detonators)
Definition detonators_mod.F:181
drape_mod
Definition drape_mod.F:54
dsgraph_mod
Definition dsgraph_mod.F:31
elbuftag_mod
Definition elbuftag_mod.F:230
elbuftag_mod::maxeos
integer, save maxeos
Definition elbuftag_mod.F:372
failwave_mod
Definition failwave_mod.F:61
front_mod
Definition front_mod.F:84
front_mod::flagkin
integer, dimension(:), allocatable flagkin
Definition front_mod.F:105
front_mod::ifront
type(my_front) ifront
Definition front_mod.F:93
front_mod::sifront
integer sifront
Definition front_mod.F:107
front_mod::ientry2
integer, dimension(:), allocatable ientry2
Definition front_mod.F:104
func2d_mod
Definition func2d_mod.F:35
fvbag_mod
Definition fvbag_mod.F:44
fvbag_mod::fvdata
type(fvbag_data), dimension(:), allocatable fvdata
Definition fvbag_mod.F:128
fvbag_mod::nfvbag
integer nfvbag
Definition fvbag_mod.F:127
fvmbag_meshcontrol_mod
Definition fvmbag_meshcontrol_mod.F:46
fvmbag_meshcontrol_mod::ixs_temp
integer, dimension(:), allocatable ixs_temp
Definition fvmbag_meshcontrol_mod.F:52
fvmbag_meshcontrol_mod::tetramesher_used
logical tetramesher_used
Definition fvmbag_meshcontrol_mod.F:49
fvmbag_meshcontrol_mod::nb_total_node
integer nb_total_node
Definition fvmbag_meshcontrol_mod.F:50
group_mod
Definition group_mod.F:31
group_mod::igrsh4n
type(group_), dimension(:), allocatable, target igrsh4n
Definition group_mod.F:38
group_mod::igrquad
type(group_), dimension(:), allocatable, target igrquad
Definition group_mod.F:37
group_mod::igrbeam
type(group_), dimension(:), allocatable, target igrbeam
Definition group_mod.F:41
group_mod::igrsurf
type(surf_), dimension(:), allocatable, target igrsurf
Definition group_mod.F:46
group_mod::igrpart
type(group_), dimension(:), allocatable, target igrpart
Definition group_mod.F:43
group_mod::igrtruss
type(group_), dimension(:), allocatable, target igrtruss
Definition group_mod.F:40
group_mod::igrsh3n
type(group_), dimension(:), allocatable, target igrsh3n
Definition group_mod.F:39
group_mod::igrspring
type(group_), dimension(:), allocatable, target igrspring
Definition group_mod.F:42
group_mod::igrbric
type(group_), dimension(:), allocatable, target igrbric
Definition group_mod.F:36
group_mod::igrslin
type(surf_), dimension(:), allocatable, target igrslin
Definition group_mod.F:47
group_mod::subsets
type(subset_), dimension(:), allocatable, target subsets
Definition group_mod.F:45
group_mod::igrnod
type(group_), dimension(:), allocatable, target igrnod
Definition group_mod.F:35
groupdef_mod
Definition groupdef_mod.F:668
hm_option_read_mod
Definition hm_option_read_mod.F:412
inigrav::inigrv
integer, dimension(:,:), allocatable inigrv
Definition inigrav_mod.F:38
inimap1d_mod
Definition inimap1d_mod.F:35
inimap2d_mod
Definition inimap2d_mod.F:35
init_monvol_mod
Definition init_monvol.F:28
init_monvol_mod::init_monvol
subroutine init_monvol(t_monvol, t_monvol_metadata, ixc, ixtg, x, npc, itab, igrsurf, sensors, igrbric, mfi, ixs, v, libagale, lrbagale)
Definition init_monvol.F:66
inivol_def_mod
Definition inivol_mod.F:45
inivol_def_mod::inivol
type(inivol_struct_), dimension(:), allocatable inivol
Definition inivol_mod.F:84
inivol_def_mod::skvol
integer skvol
Definition inivol_mod.F:86
inoutfile_mod
Definition inoutfile_mod.F:96
intbufscratch_mod
Definition intbufscratch_mod.F:33
inter_cand_mod
Definition inter_cand_mod.F:38
intstamp_glob_mod
Definition intstamp_glob_mod.F:30
intstamp_glob_mod::ielem21
integer, dimension(:), allocatable ielem21
Definition intstamp_glob_mod.F:41
intstamp_glob_mod::intstamp
type(intstamp_data), dimension(:), allocatable intstamp
Definition intstamp_glob_mod.F:40
inverted_group_mod
Definition inverted_group_mod.F:35
joint_mod
Definition joint_mod.F:35
joint_mod::joint_sms
logical joint_sms
Definition joint_mod.F:62
joint_mod::cyl_join
type(joint_type), dimension(:), allocatable cyl_join
Definition joint_mod.F:61
mapping_option_mod
Definition dichotomy_mod.F:36
meshsurfig3d_mod
Definition meshsurfig3d_mod.F:33
message_mod
Definition message_mod.F:1257
mid_pid_mod
Definition mid_pid_mod.F:36
monvol_struct_mod
Definition monvol_struct_mod.F:66
monvol_struct_mod::copy_to_monvol
subroutine copy_to_monvol(t_monvol, licbag, icbag, smonvol, monvol)
Definition monvol_struct_mod.F:163
monvol_struct_mod::monvol_allocate
subroutine monvol_allocate(nvolu, t_monvol, t_monvol_metadata)
Definition monvol_struct_mod.F:959
monvol_struct_mod::copy_to_volmon
subroutine copy_to_volmon(t_monvol, lrcbag, rcbag, svolmon, volmon)
Definition monvol_struct_mod.F:313
monvol_struct_mod::monvol_deallocate
subroutine monvol_deallocate(nvolu, t_monvol)
Definition monvol_struct_mod.F:1042
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1006
nlocal_reg_mod
Definition nlocal_reg_mod.F:119
nod2el_mod
Definition nod2el_mod.F:36
nod2el_mod::knod2elc
integer, dimension(:), allocatable knod2elc
Definition nod2el_mod.F:58
nod2el_mod::knod2els
integer, dimension(:), allocatable knod2els
Definition nod2el_mod.F:58
nod2el_mod::nod2elig3d
integer, dimension(:), allocatable nod2elig3d
Definition nod2el_mod.F:58
nod2el_mod::knod2el1d
integer, dimension(:), allocatable knod2el1d
Definition nod2el_mod.F:58
nod2el_mod::nod2elq
integer, dimension(:), allocatable nod2elq
Definition nod2el_mod.F:58
nod2el_mod::nod2el1d
integer, dimension(:), allocatable nod2el1d
Definition nod2el_mod.F:58
nod2el_mod::knod2elig3d
integer, dimension(:), allocatable knod2elig3d
Definition nod2el_mod.F:58
nod2el_mod::nod2eltg
integer, dimension(:), allocatable nod2eltg
Definition nod2el_mod.F:58
nod2el_mod::nod2elc
integer, dimension(:), allocatable nod2elc
Definition nod2el_mod.F:58
nod2el_mod::nod2els
integer, dimension(:), allocatable nod2els
Definition nod2el_mod.F:58
nod2el_mod::knod2elq
integer, dimension(:), allocatable knod2elq
Definition nod2el_mod.F:58
nod2el_mod::knod2eltg
integer, dimension(:), allocatable knod2eltg
Definition nod2el_mod.F:58
option_mod
Definition options_mod.F:32
option_mod::ibox
type(box_), dimension(:), allocatable, target ibox
Definition options_mod.F:38
option_mod::ipmas
type(admas_), dimension(:), allocatable, target ipmas
Definition options_mod.F:37
option_mod::inicrack
type(inicrack_), dimension(:), allocatable, target inicrack
Definition options_mod.F:36
optiondef_mod
Definition optiondef_mod.F:90
pinchtype_mod
Definition pinchtype_mod.F:69
pinchtype_mod::npinch
integer npinch
Definition pinchtype_mod.F:73
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tagno
integer, dimension(:), allocatable tagno
Definition r2r_mod.F:132
r2r_mod::tagrby
integer, dimension(:), allocatable tagrby
Definition r2r_mod.F:132
r2r_mod::tagrb2
integer, dimension(:), allocatable tagrb2
Definition r2r_mod.F:138
r2r_mod::tagrb3
integer, dimension(:), allocatable tagrb3
Definition r2r_mod.F:138
r2r_mod::tag_part
integer, dimension(:), allocatable tag_part
Definition r2r_mod.F:134
r2r_mod::tag_mat
integer, dimension(:), allocatable tag_mat
Definition r2r_mod.F:136
r2r_mod::tagint
integer, dimension(:), allocatable tagint
Definition r2r_mod.F:132
r2r_mod::taglnk
integer, dimension(:), allocatable taglnk
Definition r2r_mod.F:138
r2r_mod::front_r2r
integer, dimension(:), allocatable front_r2r
Definition r2r_mod.F:140
r2r_mod::tagjoin
integer, dimension(:), allocatable tagjoin
Definition r2r_mod.F:138
r2r_mod::tagmon
integer, dimension(:), allocatable tagmon
Definition r2r_mod.F:132
r2r_mod::nncl
integer, dimension(:), allocatable nncl
Definition r2r_mod.F:131
r2r_mod::ipart_r2r
integer, dimension(:,:), allocatable ipart_r2r
Definition r2r_mod.F:144
r2r_mod::tagmpc
integer, dimension(:), allocatable tagmpc
Definition r2r_mod.F:140
r2r_mod::tagcyl
integer, dimension(:), allocatable tagcyl
Definition r2r_mod.F:137
random_mod
Definition random_mod.F:33
restmod::irbe3
integer, dimension(:), allocatable irbe3
Definition restart_mod.F:60
restmod::poin_ump
integer, dimension(:), allocatable poin_ump
Definition restart_mod.F:151
restmod::iconx
integer, dimension(:), allocatable iconx
Definition restart_mod.F:60
restmod::igrv
integer, dimension(:), allocatable, target igrv
Definition restart_mod.F:60
restmod::ibcv
integer, dimension(:), allocatable ibcv
Definition restart_mod.F:106
restmod::lagbuf
integer, dimension(:), allocatable lagbuf
Definition restart_mod.F:60
restmod::ixx
integer, dimension(:), allocatable ixx
Definition restart_mod.F:60
restmod::iskewp
integer, dimension(:), allocatable iskewp
Definition restart_mod.F:60
restmod::lpby
integer, dimension(:), allocatable, target lpby
Definition restart_mod.F:60
restmod::ixs
integer, dimension(:), allocatable, target ixs
Definition restart_mod.F:60
restmod::icode
integer, dimension(:), allocatable icode
Definition restart_mod.F:60
restmod::interloadp
integer, dimension(:), allocatable interloadp
Definition restart_mod.F:60
restmod::lgrav
integer, dimension(:), allocatable lgrav
Definition restart_mod.F:83
restmod::npby
integer, dimension(:), allocatable, target npby
Definition restart_mod.F:60
restmod::kxig3d
integer, dimension(:), allocatable kxig3d
Definition restart_mod.F:60
restmod::iframe
integer, dimension(:), pointer iframe
Definition restart_mod.F:108
restmod::nodenr
integer, dimension(:), allocatable nodenr
Definition restart_mod.F:83
restmod::nige
integer, dimension(:), pointer nige
Definition restart_mod.F:108
restmod::nodpor
integer, dimension(:), allocatable nodpor
Definition restart_mod.F:60
restmod::front_rm
integer, dimension(:), allocatable front_rm
Definition restart_mod.F:83
restmod::lrbe3
integer, dimension(:), allocatable lrbe3
Definition restart_mod.F:60
restmod::ipadmesh
integer, dimension(:,:), allocatable ipadmesh
Definition restart_mod.F:181
restmod::lbvel
integer, dimension(:), allocatable lbvel
Definition restart_mod.F:60
restmod::lprtsph
integer, dimension(:), allocatable lprtsph
Definition restart_mod.F:60
restmod::ibcr
integer, dimension(:), allocatable ibcr
Definition restart_mod.F:106
restmod::ixig3d
integer, dimension(:), allocatable ixig3d
Definition restart_mod.F:60
restmod::unitab
type(unit_type_) unitab
Definition restart_mod.F:211
restmod::linale
integer, dimension(:), allocatable linale
Definition restart_mod.F:83
restmod::icodep
integer, dimension(:), allocatable icodep
Definition restart_mod.F:60
restmod::iactiv
integer, dimension(:), allocatable iactiv
Definition restart_mod.F:60
restmod::crknodiad
integer, dimension(:), allocatable crknodiad
Definition restart_mod.F:57
restmod::ibcslag
integer, dimension(:), allocatable ibcslag
Definition restart_mod.F:60
restmod::ibufssg_io
integer, dimension(:), allocatable ibufssg_io
Definition restart_mod.F:57
restmod::sh4tree
integer, dimension(:,:), allocatable sh4tree
Definition restart_mod.F:175
restmod::ispsym
integer, dimension(:), allocatable ispsym
Definition restart_mod.F:60
restmod::sh4trim
integer, dimension(:), allocatable sh4trim
Definition restart_mod.F:185
restmod::addcsrect
integer, dimension(:), allocatable addcsrect
Definition restart_mod.F:83
restmod::ipm
integer, dimension(:), allocatable ipm
Definition restart_mod.F:83
restmod::ipart
integer, dimension(:), allocatable, target ipart
Definition restart_mod.F:60
restmod::isphio
integer, dimension(:), allocatable isphio
Definition restart_mod.F:60
restmod::ipari
integer, dimension(:), allocatable, target ipari
Definition restart_mod.F:60
restmod::igaup
integer, dimension(:), allocatable igaup
Definition restart_mod.F:83
restmod::failwave
type(failwave_str_) failwave
Definition restart_mod.F:155
restmod::ispcond
integer, dimension(:), allocatable ispcond
Definition restart_mod.F:60
restmod::ibordnode
integer, dimension(:), allocatable ibordnode
Definition restart_mod.F:83
restmod::sh3trim
integer, dimension(:), allocatable sh3trim
Definition restart_mod.F:185
restmod::iskew
integer, dimension(:), allocatable iskew
Definition restart_mod.F:60
restmod::iedgesh
integer, dimension(:), allocatable, target iedgesh
Definition restart_mod.F:83
restmod::ixt
integer, dimension(:), allocatable ixt
Definition restart_mod.F:60
restmod::lnlink
integer, dimension(:), allocatable lnlink
Definition restart_mod.F:60
restmod::ibftemp
integer, dimension(:), allocatable ibftemp
Definition restart_mod.F:106
restmod::ibfv
integer, dimension(:), allocatable ibfv
Definition restart_mod.F:60
restmod::inoise
integer, dimension(:), allocatable inoise
Definition restart_mod.F:83
restmod::iaccp
integer, dimension(:), allocatable iaccp
Definition restart_mod.F:83
restmod::iel_crkxfem
integer, dimension(:), allocatable, target iel_crkxfem
Definition restart_mod.F:83
restmod::inod_pxfem
integer, dimension(:), allocatable inod_pxfem
Definition restart_mod.F:83
restmod::kloadpinter
integer, dimension(:), allocatable kloadpinter
Definition restart_mod.F:60
restmod::ixr
integer, dimension(:), allocatable ixr
Definition restart_mod.F:60
restmod::sh3tree
integer, dimension(:,:), allocatable sh3tree
Definition restart_mod.F:175
restmod::lonfsph
integer, dimension(:), allocatable lonfsph
Definition restart_mod.F:60
restmod::xdp
double precision, dimension(:), allocatable xdp
Definition restart_mod.F:162
restmod::iexlnk
integer, dimension(:), allocatable iexlnk
Definition restart_mod.F:60
restmod::ixtg
integer, dimension(:), allocatable, target ixtg
Definition restart_mod.F:60
restmod::lpbyl
integer, dimension(:), pointer lpbyl
Definition restart_mod.F:108
restmod::nnlink
integer, dimension(:), allocatable nnlink
Definition restart_mod.F:60
restmod::ibcl
integer, dimension(:), allocatable, target ibcl
Definition restart_mod.F:60
restmod::monvol
integer, dimension(:), allocatable monvol
Definition restart_mod.F:60
restmod::ifill
integer, dimension(:), allocatable ifill
Definition restart_mod.F:60
restmod::kxfenod2elc
integer, dimension(:), allocatable kxfenod2elc
Definition restart_mod.F:83
restmod::iskwp
integer, dimension(:), allocatable iskwp
Definition restart_mod.F:83
restmod::isensp
integer, dimension(:), allocatable isensp
Definition restart_mod.F:83
restmod::idrape
integer, dimension(:), allocatable idrape
Definition restart_mod.F:83
restmod::irbe2
integer, dimension(:), allocatable irbe2
Definition restart_mod.F:60
restmod::inod_crkxfem
integer, dimension(:), allocatable inod_crkxfem
Definition restart_mod.F:83
restmod::kxsp
integer, dimension(:), allocatable kxsp
Definition restart_mod.F:60
restmod::enrtag
integer, dimension(:), allocatable enrtag
Definition restart_mod.F:83
restmod::nodlevxf
integer, dimension(:), allocatable nodlevxf
Definition restart_mod.F:83
restmod::loadpinter
integer, dimension(:), allocatable loadpinter
Definition restart_mod.F:60
restmod::elcutc
integer, dimension(:), allocatable elcutc
Definition restart_mod.F:83
restmod::nsensp
integer, dimension(:), allocatable nsensp
Definition restart_mod.F:83
restmod::dd_iad
integer, dimension(:), allocatable dd_iad
Definition restart_mod.F:60
restmod::gjbufi
integer, dimension(:), allocatable gjbufi
Definition restart_mod.F:60
restmod::itabm1
integer, dimension(:), allocatable, target itabm1
Definition restart_mod.F:60
restmod::iskwn
integer, dimension(:), allocatable, target iskwn
Definition restart_mod.F:60
restmod::cne_crkxfem
integer, dimension(:), allocatable cne_crkxfem
Definition restart_mod.F:57
restmod::iloadp
integer, dimension(:), allocatable, target iloadp
Definition restart_mod.F:60
restmod::itab
integer, dimension(:), allocatable itab
Definition restart_mod.F:60
restmod::nprw
integer, dimension(:), allocatable nprw
Definition restart_mod.F:60
restmod::ngaup
integer, dimension(:), allocatable ngaup
Definition restart_mod.F:83
restmod::lnrbym
integer, dimension(:), allocatable lnrbym
Definition restart_mod.F:83
restmod::nod2sp
integer, dimension(:), allocatable nod2sp
Definition restart_mod.F:60
restmod::ixp
integer, dimension(:), allocatable ixp
Definition restart_mod.F:60
restmod::laccelm
integer, dimension(:), allocatable laccelm
Definition restart_mod.F:60
restmod::nom_opt
integer, dimension(:), allocatable, target nom_opt
Definition restart_mod.F:60
restmod::bufgeo
double precision, dimension(:), allocatable bufgeo
Definition restart_mod.F:116
restmod::fasolfr
integer, dimension(:), allocatable fasolfr
Definition restart_mod.F:83
restmod::npc
integer, dimension(:), allocatable, target npc
Definition restart_mod.F:60
restmod::igeo
integer, dimension(:), allocatable igeo
Definition restart_mod.F:83
restmod::ibmpc
integer, dimension(:), allocatable, target ibmpc
Definition restart_mod.F:60
restmod::ixtg1
integer, dimension(:), allocatable ixtg1
Definition restart_mod.F:60
restmod::ims
integer, dimension(:), allocatable ims
Definition restart_mod.F:60
restmod::addcni2
integer, dimension(:), allocatable addcni2
Definition restart_mod.F:83
restmod::lbcscyc
integer, dimension(:), allocatable lbcscyc
Definition restart_mod.F:57
restmod::ibvel
integer, dimension(:), allocatable ibvel
Definition restart_mod.F:60
restmod::lrivet
integer, dimension(:), allocatable lrivet
Definition restart_mod.F:60
restmod::npbyl
integer, dimension(:), pointer npbyl
Definition restart_mod.F:108
restmod::icfield
integer, dimension(:), allocatable, target icfield
Definition restart_mod.F:60
restmod::kinet
integer, dimension(:), allocatable kinet
Definition restart_mod.F:60
restmod::icodt
integer, dimension(:), allocatable icodt
Definition restart_mod.F:83
restmod::lgauge
integer, dimension(:), allocatable lgauge
Definition restart_mod.F:60
restmod::nstrf
integer, dimension(:), allocatable nstrf
Definition restart_mod.F:60
restmod::ibcscyc
integer, dimension(:), allocatable ibcscyc
Definition restart_mod.F:57
restmod::irbym
integer, dimension(:), allocatable irbym
Definition restart_mod.F:83
restmod::ixsp
integer, dimension(:,:), allocatable ixsp
Definition restart_mod.F:81
restmod::iparg
integer, dimension(:), allocatable iparg
Definition restart_mod.F:60
restmod::ixq
integer, dimension(:), allocatable ixq
Definition restart_mod.F:60
restmod::iedge
integer, dimension(:), allocatable iedge
Definition restart_mod.F:83
restmod::ibfflux
integer, dimension(:), allocatable ibfflux
Definition restart_mod.F:106
restmod::nodedge
integer, dimension(:), allocatable nodedge
Definition restart_mod.F:83
restmod::ilas
integer, dimension(:), allocatable ilas
Definition restart_mod.F:60
restmod::lloadp
integer, dimension(:), allocatable lloadp
Definition restart_mod.F:83
restmod::segquadfr
integer, dimension(:), allocatable segquadfr
Definition restart_mod.F:83
restmod::lcfield
integer, dimension(:), allocatable lcfield
Definition restart_mod.F:83
restmod::kxx
integer, dimension(:), allocatable kxx
Definition restart_mod.F:60
restmod::nskwp
integer, dimension(:), allocatable nskwp
Definition restart_mod.F:83
restmod::nom_sect
integer, dimension(:), allocatable nom_sect
Definition restart_mod.F:60
restmod::lprw
integer, dimension(:), allocatable lprw
Definition restart_mod.F:60
restmod::icodr
integer, dimension(:), allocatable icodr
Definition restart_mod.F:83
restmod::nloc_dmg
type(nlocal_str_) nloc_dmg
Definition restart_mod.F:156
restmod::iel_pxfem
integer, dimension(:), allocatable iel_pxfem
Definition restart_mod.F:83
restmod::lrbe2
integer, dimension(:), allocatable lrbe2
Definition restart_mod.F:60
restmod::ixc
integer, dimension(:), allocatable ixc
Definition restart_mod.F:60
restmod::ljoint
integer, dimension(:), allocatable ljoint
Definition restart_mod.F:60
restmod::tab_ump
integer, dimension(:,:), allocatable tab_ump
Definition restart_mod.F:152
restmod::naccp
integer, dimension(:), allocatable naccp
Definition restart_mod.F:83
restmod::ithvar
integer, dimension(:), allocatable ithvar
Definition restart_mod.F:60
restmod::iadll
integer, dimension(:), allocatable iadll
Definition restart_mod.F:83
restmod::icontact
integer, dimension(:), allocatable icontact
Definition restart_mod.F:83
restmod::ipart_state
integer, dimension(:), allocatable ipart_state
Definition restart_mod.F:60
seatbelt_mod
Definition seatbelt_mod.F:55
seatbelt_mod::retractor
type(retractor_struct), dimension(:), allocatable retractor
Definition seatbelt_mod.F:155
seatbelt_mod::seatbelt_tab
type(seatbelt_struct), dimension(:), allocatable seatbelt_tab
Definition seatbelt_mod.F:171
seatbelt_mod::slipring
type(slipring_struct), dimension(:), allocatable slipring
Definition seatbelt_mod.F:110
set_mod
Definition set_mod.F:43
set_mod::set
type(set_), dimension(:), allocatable, target set
Definition set_mod.F:54
setdef_mod
Definition setdef_mod.F:107
setdef_mod::nsets
integer nsets
Definition setdef_mod.F:120
sms_mod
Definition sms_mod.F:29
sms_mod::tagslv_rby_sms
integer, dimension(:), allocatable tagslv_rby_sms
Definition sms_mod.F:35
sms_mod::tagprt_sms
integer, dimension(:), allocatable tagprt_sms
Definition sms_mod.F:35
sms_mod::tagmsr_rby_sms
integer, dimension(:), allocatable tagmsr_rby_sms
Definition sms_mod.F:35
sms_mod::nativ_sms
integer, dimension(:), allocatable nativ_sms
Definition sms_mod.F:35
sms_mod::tagrel_sms
integer, dimension(:), allocatable tagrel_sms
Definition sms_mod.F:35
sms_mod::kad_sms
integer, dimension(:), allocatable kad_sms
Definition sms_mod.F:38
sms_mod::lad_sms
integer, dimension(:), allocatable lad_sms
Definition sms_mod.F:38
sms_mod::jadrb_sms
integer, dimension(:), allocatable jadrb_sms
Definition sms_mod.F:38
sms_mod::jsm_sms
integer, dimension(:), allocatable jsm_sms
Definition sms_mod.F:38
sms_mod::jadc_sms
integer, dimension(:), allocatable jadc_sms
Definition sms_mod.F:38
sms_mod::jadt_sms
integer, dimension(:), allocatable jadt_sms
Definition sms_mod.F:38
sms_mod::jad_sms
integer, dimension(:), allocatable jad_sms
Definition sms_mod.F:38
sms_mod::kdi_sms
integer, dimension(:), allocatable kdi_sms
Definition sms_mod.F:38
sms_mod::jadtg_sms
integer, dimension(:), allocatable jadtg_sms
Definition sms_mod.F:38
sms_mod::pk_sms
integer, dimension(:), allocatable pk_sms
Definition sms_mod.F:38
sms_mod::iad_sms
integer, dimension(:), allocatable iad_sms
Definition sms_mod.F:38
sms_mod::jadp_sms
integer, dimension(:), allocatable jadp_sms
Definition sms_mod.F:38
sms_mod::idi_sms
integer, dimension(:), allocatable idi_sms
Definition sms_mod.F:38
sms_mod::jads10_sms
integer, dimension(:), allocatable jads10_sms
Definition sms_mod.F:38
sms_mod::jads_sms
integer, dimension(:), allocatable jads_sms
Definition sms_mod.F:38
sms_mod::jdi_sms
integer, dimension(:), allocatable jdi_sms
Definition sms_mod.F:38
sms_mod::jadr_sms
integer, dimension(:), allocatable jadr_sms
Definition sms_mod.F:38
sph_mod
Definition sph_mod.F:31
sph_mod::sph2sol
integer, dimension(:), allocatable sph2sol
Definition sph_mod.F:34
sph_mod::irst
integer, dimension(:), allocatable irst
Definition sph_mod.F:34
sph_mod::sol2sph_typ
integer, dimension(:), allocatable sol2sph_typ
Definition sph_mod.F:38
sph_mod::sol2sph
integer, dimension(:), allocatable sol2sph
Definition sph_mod.F:34
split_cfd_mod
Definition split_cfd_mod.F:33
stack_mod
Definition stack_mod.F:75
stack_var_mod
Definition stack_var_mod.F:33
stack_var_mod::numgeostack
integer, dimension(:), allocatable numgeostack
Definition stack_var_mod.F:42
stack_var_mod::nprop_stack
integer nprop_stack
Definition stack_var_mod.F:44
stack_var_mod::ply_info
integer, dimension(:,:), allocatable ply_info
Definition stack_var_mod.F:43
stack_var_mod::stack_info
type(stack_info_), dimension(:), pointer stack_info
Definition stack_var_mod.F:41
state_mod
Definition state_mod.F:54
submodel_mod
Definition submodel_mod.F:717
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
table_glob_mod
Definition table_glob_mod.F:34
table_glob_mod::table
type(ttable), dimension(:), allocatable table
Definition table_glob_mod.F:44
user_windows_mod
Definition user_windows_mod.F:48
xfem2def_mod
Definition xfem2def_mod.F:40
nbfunct
subroutine nbfunct(nfunct, ntable, npts, lsubmodel)
Definition nbfunc.F:37
nodm11
subroutine nodm11(pm, ixs, ixq, icode)
Definition nodm11.F:30
noise
subroutine noise(dt2r, in, j, buf, v, a, ixs, elbuf_tab, iparg, weight, ixq)
Definition noise.F:41
outrin
subroutine outrin(ms, in, stifn, stifr, itab, dtnoda)
Definition outri.F:368
outri
subroutine outri(dtelem, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, kxx, kxsp, kxig3d, igeo, numel)
Definition outri.F:34
paroi
subroutine paroi(pm, ixs, ixq, icode, nale)
Definition paroi.F:30
pgrhead
subroutine pgrhead(ixp, pm, geo, inum, itr1, eadd, index, itri, ipartp, nd, igrsurf, igrbeam, cep, xep, igeo, ipouoff, tagprt_sms, ipm, itagprld_beam, ibeam_vector, rbeam_vector, xnum)
Definition pgrhead.F:36
pgrtails
subroutine pgrtails(mat_param, ixp, iparg, pm, geo, eadd, nd, dd_iad, idx, inum, index, cep, ipartp, itr1, igrsurf, igrbeam, igeo, ipm, ipouoff, tagprt_sms, nod2el1d, print_flag, itagprld_beam, preload_a, npreload_a, ibeam_vector, rbeam_vector, xnum)
Definition pgrtails.F:45
pornod
subroutine pornod(geo, ixs, ixq, nodpor, icode, itab, npby, lpby, igeo)
Definition pornod.F:35
precrkxfem
subroutine precrkxfem(iparg, ixc, ixtg, ncrkxfe, iel_crkxfem, inod_crkxfem, addcne_crkxfem)
Definition precrkxfem.F:34
prelecsec4bolt
subroutine prelecsec4bolt(snstrf, ssecbuf, igrnod, itabm1, flag_r2r, nom_opt, igrbric, lsubmodel)
Definition prelecsec4bolt.F:44
prelecsec
subroutine prelecsec(snstrf, ssecbuf, itabm1, flag_r2r, nom_opt, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrnod, lsubmodel, seatbelt_shell_to_spring, nb_seatbelt_shells)
Definition prelecsec.F:52
prepare_split_i25e2e
subroutine prepare_split_i25e2e(nspmd, intbuf_tab, ipari, intercep)
Definition prepare_split_i25e2e.F:36
fillcne_pxfem
subroutine fillcne_pxfem(iel, inod, ixc, cep, addcne, cne, cel)
Definition preplyxfem.F:104
preplyxfem
subroutine preplyxfem(ms_ply0, zi_ply0, iel, inod, ixc, ms_ply, zi_ply, addcne, msz20, msz2)
Definition preplyxfem.F:32
preread_rbody_lagmul
subroutine preread_rbody_lagmul(slpbyl, igrnod, lsubmodel)
Definition preread_rbody_lagmul.F:39
prescrint
subroutine prescrint(ipari, intbuf_tab, inscr)
Definition prescrint.F:33
pretag_xfem
subroutine pretag_xfem(iparg, itage, iel_crkxfem, itagn, inod_crkxfem)
Definition pretag_xfem.F:31
split
void split(mapping_t *, PORD_INT, PORD_INT, PORD_INT, PORD_INT *, PORD_INT *, FLOAT *, PORD_INT)
qgrhead
subroutine qgrhead(ixq, pm, geo, inum, isel, itr1, eadd, index, itri, ipartq, nd, igrsurf, igrquad, cep, mat_param, xep, igeo, ipm, iquaoff, trimat)
Definition qgrhead.F:38
qgrtails
subroutine qgrtails(ixq, pm, iparg, geo, eadd, nd, dd_iad, idx, inum, index, cep, ipartq, itr1, igrsurf, igrquad, mat_param, igeo, ipm, iquaoff, inivol, print_flag)
Definition qgrtails.F:42
r2r_clean_inter
subroutine r2r_clean_inter(ipari2, intbuf_tab, ipartc, ipartg, iparts, isolnod)
Definition r2r_clean_inter.F:34
r2r_domdec
subroutine r2r_domdec(iexter, igrnod, frontb_r2r, dt_r2r, flag)
Definition r2r_domdec.F:39
r2r_matparam_copy
subroutine r2r_matparam_copy(matparam_tab, matparam_ini, nummat0, nummat)
Definition r2r_matparam_copy.F:31
r2r_speedup
subroutine r2r_speedup(dtelem, dtnoda, dt_r2r, cost_r2r, isoloff, isheoff, itruoff, ipouoff, iresoff, itrioff, iquaoff)
Definition r2r_speedup.F:43
r2r_void
subroutine r2r_void(ipartl)
Definition r2r_void.F:39
read_detonators
subroutine read_detonators(itabm1, itab, igrnod, pm, ipm, x, unitab, lsubmodel, detonators)
Definition read_detonators.F:47
read_ebcs
subroutine read_ebcs(igrsurf, multi_fvm, npc1, lsubmodel, ebcs_tab, n2d)
Definition read_ebcs.F:58
read_engine_driver
subroutine read_engine_driver(igrpart, is_dyna, nb_dyna_include)
Definition read_engine_driver.F:35
read_material_models
subroutine read_material_models(mat_elem, mlaw_tag, fail_tag, eos_tag, bufmat, sbufmat, ipm, pm, unitab, multi_fvm, failwave, nloc_dmg, lsubmodel, table, ltitr, userl_avail, mat_number, npc, tf, snpc, npts, buflen)
Definition read_material_models.F:59
read_monvol
subroutine read_monvol(t_monvol, t_monvol_metadata, itab, itabm1, ipm, igeo, x, pm, geo, ixc, ixtg, sensors, unitab, npc, npt, pld, igrsurf, igrbric, nom_opt, iframe, xframe, lsubmodel)
Definition read_monvol.F:66
read_rwall
subroutine read_rwall(rwl, nprw, lprw, ifi, ms, v, itab, itabm1, x, ixs, ixq, npc, ikine, igrnod, mfi, imerge, unitab, ikine1lag, iddlevel, lsubmodel, rtrans, nom_opt, itagnd, lnspen)
Definition read_rwall.F:48
rgrhead
subroutine rgrhead(ixr, geo, inum, isel, igeo, itr1, eadd, index, itri, ipartr, nd, igrsurf, igrspring, cep, xep, iresoff, tagprt_sms, clusters, ipm, r_skew, itagprld_spring)
Definition rgrhead.F:37
rgrtails
subroutine rgrtails(ixr, iparg, geo, eadd, igeo, nd, dd_iad, idx, inum, index, cep, ipartr, itr1, igrsurf, igrspring, iresoff, tagprt_sms, nod2el1d, ipm, clusters, r_skew, print_flag, itagprld_spring, preload_a, npreload_a)
Definition rgrtails.F:41
rigid_mat
subroutine rigid_mat(nrb, gnsl, lsn, nslnrm, stifn, stifr, x, v, ms, in, rbym, irbym, lcrbm, nom_opt)
Definition rigid_mat.F:37
s10edg_rlink
subroutine s10edg_rlink(nlink, numlink, nnlink, lnlink, itagnd, icnds10, itab, ipri, numnod, ns10e)
Definition s10edg_rlink.F:35
chk_dttsh
subroutine chk_dttsh(elbuf_str, ixs, iparg, ikine)
Definition scdtchk3.F:33
scrint
subroutine scrint(ipari, inscr, intbuf_tab)
Definition scrint.F:34
sensor_user_convert_local_id
subroutine sensor_user_convert_local_id(itabm1, pointer_entity, number_entity, list_entity, mode0, ipart)
Definition sensor_user_convert_local_id.F:31
sensor_user_init
subroutine sensor_user_init(sensor_user_struct)
Definition sensor_user_init.F:30
init_mat_weight
subroutine init_mat_weight(nummat)
Definition set_dd_mat_weight.F:65
set_elgroup_param
subroutine set_elgroup_param(group_param_tab, iparg, ngroup, n2d, ipm, igeo, pm, geo, bufmat)
Definition set_elgroup_param.F:33
set_poin_ump
subroutine set_poin_ump(ipart, ipm, tab_ump, poin_ump, taille)
Definition set_poin_ump.F:31
setlenwa
subroutine setlenwa(lenwa0, nthwa0, nairwa0, numels0, numelq0, numelc0, numeltg0, numelt0, numelp0, numelr0, numnod0, nmnt0, l_mul_lag1, l_mul_lag, maxnx0, lwasph0, numsph0, lwaspio, nrcvvois0, ngroup_l, lwamp_l, lwanmp_l, itherm)
Definition setlenwa.F:35
setmulti
subroutine setmulti(ipari)
Definition setlenwa.F:110
sgrhead
subroutine sgrhead(ixs, pm, geo, inum, isel, itr1, eadd, index, itri, iparts, nd, igrsurf, igrbric, isolnod, cep, xep, ixs10, ixs20, ixs16, igeo, ipm, nod2els, isoloff, tagprt_sms, sph2sol, sol2sph, mat_param, sol2sph_typ, iflag_bpreload, clusters, rnoise, damp_range_part, trimat)
Definition sgrhead.F:44
sgrtails
subroutine sgrtails(ixs, pm, iparg, geo, eadd, nd, iparts, dd_iad, idx, isolnod, inum, index, cep, itr1, ixs10, igrsurf, igrbric, ixs20, ixs16, igeo, iddlevel, ipm, nod2els, isoloff, isolnod1, tagprt_sms, inivol, sph2sol, sol2sph, sol2sph_typ, iflag_bpreload, clusters, matparam_tab, rnoise, print_flag, damp_range_part, ipreload_fun)
Definition sgrtails.F:51
shellthk_upd
subroutine shellthk_upd(drape, stack, thk, ixc, ixtg, igeo, iworksh, indx)
Definition shellthk_upd.F:35
spgrhead
subroutine spgrhead(kxsp, ixsp, iparg, pm, ipart, ipartsp, eadd, cepsp, nd, ipm, igeo, spbuf, sph2sol, sol2sph, irst, mat_param, ixsps)
Definition spgrhead.F:36
spgrtails
subroutine spgrtails(kxsp, iparg, pm, ipart, ipartsp, eadd, nd, cepsp, dd_iad, idx, ixsp, ipm, igeo, spbuf, sph2sol, sol2sph, irst, nod2sp, print_flag, mat_param, ixsps)
Definition spgrtails.F:42
sphdcod
subroutine sphdcod(npc, isphio, nom_opt)
Definition sphdcod.F:35
sphonf0
subroutine sphonf0(kxsp, ixsp, nod2sp, ipart, ipartsp, lprtsph, lonfsph)
Definition sphonf0.F:30
spinih
subroutine spinih(kxsp, ipart, ipartsp, spbuf, pm, ixsp, nod2sp, x, lprtsph, lonfsph, snod2sp, slonfsph, numnod, npart, itab)
Definition spinih.F:35
split_cfd_solide
subroutine split_cfd_solide(numels, ale_connectivity, ixs, ale_elm, size_ale_elm)
Definition split_cfd_solide.F:34
deallocate_split_cfd_solide
subroutine deallocate_split_cfd_solide(ale_elm)
Definition split_cfd_solide.F:152
split_pcyl
subroutine split_pcyl(total_number_pcyl, loads, loads_per_proc)
Definition split_pcyl.F:30
sptri
subroutine sptri(kxsp, ixsp, nod2sp, x, spbuf, lprtsph, lonfsph, ipartsp, sz_intp_dist, max_intp_dist_part, pre_search)
Definition sptri.F:51
surfext_tagn
subroutine surfext_tagn(ixs, knod2els, nod2els, ixs10, fastag, itab)
Definition ssurftag.F:550
fictivmassigeo
subroutine fictivmassigeo(intbuf_tab, nctrlmax, msig3d, kxig3d)
Definition ssurftagigeo.F:810
printstsz
subroutine printstsz(detonators)
Definition st_array_size.F:33
st_qaprint_driver
subroutine st_qaprint_driver(igeo, geo, bufgeo, ipm, pm, bufmat, nom_opt, inom_opt, numloadp, iloadp, lloadp, loadp, ibcl, forc, ipres, pres, npby, lpby, rby, ibcr, fradia, ibcv, fconv, ibftemp, fbftemp, igrv, lgrv, agrv, ibfflux, fbfflux, itab, v, vr, w, icode, iskew, icfield, lcfield, cfield, dampr, temp, ibcslag, ipari, intbuf_tab, clusters, ibox, ipmas, ibfvel, fbfvel, nimpacc, laccelm, accelm, nom_sect, nstrf, secbuf, skew, iskwn, xframe, t_monvol, t_monvol_metadata, i2rupt, areasl, intbuf_fric_tab, npfricorth, mat_elem, pfricorth, irepforth, phiforth, vforth, xrefc, xreftg, xrefs, tagxref, ixs, ixc, ixtg, rwbuf, nprw, lprw, ithvar, ipart, subsets, ipartth, nthgrpmx, nimpdisp, nimpvel, detonators, ibcscyc, npc, pld, table, npts, irbe3, lrbe3, frbe3, mgrby, ixs10, isolnod, ixr, r_skew, ixp, ixt, x, thke, sh4ang, thkec, sh3ang, set, lsubmodel, igrnod, igrpart, igrbric, igrsh4n, igrsh3n, igrquad, igrbeam, igrtruss, igrspring, igrsurf, igrslin, ixq, ispcond, rtrans, irand, alea, xseed, xlas, las, irbe2, lrbe2, kxsp, ipartsp, drape, ixr_kj, iactiv, factiv, unitab, npbyl, lpbyl, rbyl, xyzref, sensors, func2d, inicrack, ipreload, preload, iflag_bpreload, ibmpc, ibmpc2, ibmpc3, ibmpc4, rbmpc, ljoint, nnlink, lnlink, bufsf, sbufsf_, pm_stack, geo_stack, igeo_stack, iparg, ipadmesh, padmesh, liflow, lrflow, iflow, rflow, sh4tree, sh3tree, sh4trim, sh3trim, qp_iperturb, qp_rperturb, llinal, linale, fvm_inivel, gjbufi, gjbufr, ms, in, lgauge, gauge, kxx, ixx, ipartx, ixri, ixs16, iexmad, fxbipm, fxbfile_tab, eigipm, eigrpm, isphio, vsphio, ebcs_tab, inimap1d, inimap2d, nsigsh, sigsh, nsigi, sigsp, nsigs, sigi, nsigbeam, sigbeam, nsigtruss, sigtruss, nsigrs, sigrs, merge_node_tab, merge_node_tol, imerge, nmerge_tot, iexlnk, drapeg, user_windows, output, defaults, glob_therm, pblast, ibeam_vector, rbeam_vector, damp_range_part)
Definition st_qaprint_driver.F:120
applysort2fvm
subroutine applysort2fvm(t_monvol)
Definition fvmesh0.F:327
fvmesh0
subroutine fvmesh0(t_monvol, xyzini, ixs, ixc, ixtg, pm, ipm, igrsurf, xyzref, nb_node)
Definition fvmesh0.F:55
fvdim
subroutine fvdim(t_monvol)
Definition fvmesh.F:3458
sms_ini_jad_1
subroutine sms_ini_jad_1(ixc, iparg, ixs, ixt, ixp, ixr, ixtg, ixs10, nodnx_sms, jadc_sms, jads_sms, jads10_sms, jadt_sms, jadp_sms, jadr_sms, jadtg_sms, tagprt_sms, kad_sms, kdi_sms, pk_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, npby, lpby, kinet, tagslv_rby_sms, ipari, intbuf_tab, lad_sms, ipart, igeo, nativ_sms, iad_sms, idi_sms, jad_sms, jdi_sms, t2main_sms)
Definition sms_init.F:1182
sms_ini_jad_2
subroutine sms_ini_jad_2(ixc, iparg, ixs, ixt, ixp, ixr, ixtg, ixs10, nodnx_sms, jadc_sms, jads_sms, jads10_sms, jadt_sms, jadp_sms, jadr_sms, jadtg_sms, tagprt_sms, kad_sms, kdi_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, npby, lpby, kinet, tagslv_rby_sms, ipari, intbuf_tab, lad_sms, nprw, lprw, tagmsr_rby_sms, intstamp, ipart, igeo, nativ_sms, irbe2, lrbe2, iad_sms, idi_sms, jad_sms, jdi_sms, t2main_sms)
Definition sms_init.F:1572
sms_ini_kdi
subroutine sms_ini_kdi(ixc, iparg, ixs, ixt, ixp, ixr, ixtg, ixs10, nodnx_sms, kad_sms, kdi_sms, jadc_sms, jads_sms, jads10_sms, jadt_sms, jadp_sms, jadr_sms, jadtg_sms, tagprt_sms, iad_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, npby, lpby, kinet, tagslv_rby_sms, ipari, intbuf_tab, lad_sms, ipart, igeo, nativ_sms)
Definition sms_init.F:777
sms_ini_kad
subroutine sms_ini_kad(ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs16, ixs20, iparg, ms, ms0, nodnx_sms, icodt, icodr, kinet, kad_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, tagprt_sms, tagrel_sms, itab, irbe2, irbe3, lrbe2, lrbe3, nprw, lprw, ipart, igeo, nativ_sms)
Definition sms_init.F:393
sms_ini_jad_3
subroutine sms_ini_jad_3(ixc, iparg, ixs, ixt, ixp, ixr, ixtg, ixs10, nodnx_sms, jadc_sms, jads_sms, jads10_sms, jadt_sms, jadp_sms, jadr_sms, jadtg_sms, tagprt_sms, kad_sms, kdi_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, npby, lpby, kinet, tagslv_rby_sms, ipari, intbuf_tab, lad_sms, jsm_sms, intstamp, ipart, igeo, tagmsr_rby_sms, nativ_sms, iad_sms, idi_sms, jad_sms, jdi_sms, t2main_sms)
Definition sms_init.F:1877
sms_init
subroutine sms_init(ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs16, ixs20, iparg, nodnx_sms, icodt, icodr, kinet, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, tagprt_sms, itab, irbe2, irbe3, lrbe2, lrbe3, nprw, lprw, ipart, igeo, ipm, nativ_sms, npby, lpby, tagmsr_rby_sms, tagslv_rby_sms, nom_opt)
Definition sms_init.F:45
deallocate_joint
subroutine deallocate_joint()
Definition deallocate_joint.F:31
kinini
subroutine kinini(ikine)
Definition kinini.F:29
elbuf_ini
subroutine elbuf_ini(elbuf_tab, mat_param, mlaw_tag, prop_tag, fail_tag, igeo, ipm, iparg, ipart, ipartsp, ixs, ixq, ixc, ixtg, flag_xfem, ipartig3d, stack, igeo_stack, ixt, ixp, ixr, kxx, geo, eos_tag, istr_24, print_flag, defaults)
Definition elbuf_ini.F:45
int18_law151_init
subroutine int18_law151_init(s_append_array, ninter, npari, numnod, numels, ngrbric, multi_fvm, igrbric, ipari, ixs, x, v, ms, kinet, x_append, v_append, mass_append, kinet_append)
Definition int18_law151_init.F:34
group_ini
subroutine group_ini(igrnod, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrpart)
Definition group_ini.F:33
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
spmd_anim_ply_init
subroutine spmd_anim_ply_init(igeo, geo, iparg, ixc, ixtg, ipartc, ipartq, iparttg, stack)
Definition spmd_anim_ply_init.F:33
tet4_10
subroutine tet4_10(igeo, itet4_10)
Definition lectur.F:11586
set_ibufssg_io
subroutine set_ibufssg_io(isphio, igrsurf, ibufssg_io)
Definition lectur.F:11474
init_permutation
subroutine init_permutation()
Definition lectur.F:11550
arret
subroutine arret(nn)
Definition arret.F:86
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135
trace_in1
subroutine trace_in1(my_char, ilen)
Definition trace_back.F:37
trace_out1
subroutine trace_out1()
Definition trace_back.F:364
chkfunct
subroutine chkfunct(nfunct, npc, nom_opt)
Definition lecfun.F:34
table_zero
subroutine table_zero(table)
Definition table_tools.F:31
strr
character *8 function strr(y)
Definition strr.F:34
drape_mod::drape_
Definition drape_mod.F:71
t3grhead
subroutine t3grhead(ixtg, pm, geo, inum, isel, itr1, eadd, index, itri, xnum, iparttg, nd, thk, igrsurf, igrsh3n, cep, xep, ixtg1, icnod, igeo, ipm, ipart, sh3tree, nod2eltg, itrioff, sh3trim, tagprt_sms, mat_param, iworksh, stack, drape, rnoise, multi_fvm, sh3ang, drapeg, ptsh3n)
Definition t3grhead.F:45
t3grtails
subroutine t3grtails(ixtg, pm, iparg, geo, eadd, nd, iparttg, dd_iad, idx, inum, index, cep, thk, xnum, itr1, igrsurf, igrsh3n, icnod, igeo, ipm, ixtg1, ipart, sh3tree, nod2eltg, itrioff, sh3trim, tagprt_sms, iworksh, stack, drape, rnoise, inivol, mat_param, sh3ang, drapeg, print_flag, ptsh3n)
Definition t3grtails.F:50
tgrhead
subroutine tgrhead(ixt, pm, geo, inum, isel, itr1, eadd, index, itri, ipartt, nd, igrsurf, igrtruss, cep, xep, itruoff, tagprt_sms, itagprld_truss)
Definition tgrhead.F:36
tgrtails
subroutine tgrtails(ixt, iparg, pm, geo, eadd, nd, dd_iad, idx, inum, index, cep, ipartt, itr1, igrsurf, igrtruss, itruoff, tagprt_sms, nod2el1d, print_flag, itagprld_truss, preload_a, npreload_a)
Definition tgrtails.F:40
th_surf_load_pressure
subroutine th_surf_load_pressure(igrsurf, th_surf, ipres, iloadp, lloadp, sizloadp, nloadp, slloadp, nibcld, npreld, nsurf, numnod)
OPTION /TH/SURF output for P and A.
Definition th_surf_load_pressure.F:39
thpinit
subroutine thpinit(ithgrp, ithbuf, iparg, dd_iad, ixri, iflag, nthgrp2)
Definition thpinit.F:33
thskewc
subroutine thskewc(rthbuf, ithgrp, ithbuf, x, ixc, ixtg, skew, nthgrp)
Definition thskewc.F:31
titre2
subroutine titre2
Definition titre2.F:30
titre3
subroutine titre3
Definition titre3.F:29
triintfric
subroutine triintfric(tabcoupleparts_fric_tmp, tabcoef_fric_tmp, intbuf_fric_tab, tabparts_fric_tmp, nsetfrictot, nsetinit, iorthfricmax, ifricorth_tmp, nsetmax)
Definition trintfric.F:35
update_weight_rbe3
subroutine update_weight_rbe3(nelemint, ifiend, s_lrbe3, nrbe3l, nrbe3, lrbe3, irbe3, inter_cand)
Definition update_weight_rbe3.F:32
updmat
subroutine updmat(bufmat, pm, ipm, table, func_id, npc, pld, sensors, nloc_dmg, mlaw_tag, mat_param)
Definition updmat.F:77
upgrade_ixint
subroutine upgrade_ixint(inter_cand, nelemint, new_size)
Definition upgrade_ixint.F:33
applysort2flux
subroutine applysort2flux(ibfflux, siz1, siz2, permutations)
Definition w_ithflux.F:101
xfem_crack_init
subroutine xfem_crack_init(iparg, ixc, ixtg, inod_crk, nodlevxf, indx_crk, ncrkpart, crkshell)
Definition xfem_crack_init.F:32
xgrhead
subroutine xgrhead(kxx, geo, inum, itr1, eadd, index, itri, ipartx, nd, igrsurf, cep, xep, ipm)
Definition xgrhead.F:37
xgrtails
subroutine xgrtails(kxx, iparg, geo, eadd, nd, dd_iad, idx, lb_max, inum, index, cep, ipartx, itr1, igrsurf, ixx, igeo)
Definition xgrtails.F:39
yctrl
subroutine yctrl(igrbric)
Definition yctrl.F:35

◆ set_ibufssg_io()

subroutine set_ibufssg_io ( integer, dimension(nisphio,*) isphio,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(sibufssg_io) ibufssg_io )

Definition at line 11473 of file lectur.F.

11474C-----------------------------------------------
11475C M o d u l e s
11476C-----------------------------------------------
11477 USE groupdef_mod
11478C-----------------------------------------------
11479C I m p l i c i t T y p e s
11480C-----------------------------------------------
11481#include "implicit_f.inc"
11482C-----------------------------------------------
11483C C o m m o n B l o c k s
11484C-----------------------------------------------
11485#include "com01_c.inc"
11486#include "com04_c.inc"
11487#include "sphcom.inc"
11488#include "units_c.inc"
11489#include "warn_c.inc"
11490#include "param_c.inc"
11491C-----------------------------------------------
11492C D u m m y A r g u m e n t s
11493C-----------------------------------------------
11494 INTEGER ISPHIO(NISPHIO,*),
11495 . IBUFSSG_IO(SIBUFSSG_IO),
11496 . N,J,NSEG,IN1,IN2,IN3,IN4,
11497 . ISU,PROC,IAD2,ITYPE
11498 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
11499C-----------------------------------------------
11500C L o c a l V a r i a b l e s
11501C-----------------------------------------------
11502 iad2 = 1
11503
11504 DO n=1,nsphio
11505 itype = isphio(1,n)
11506 IF(isphio(12,n)==0) THEN
11507 isu = isphio(3,n)
11508 nseg= igrsurf(isu)%NSEG
11509 isphio(10,n) = nseg
11510 isphio(11,n) = iad2
11511 DO j=0,nseg-1
11512 in1=igrsurf(isu)%NODES(j+1,1)
11513 in2=igrsurf(isu)%NODES(j+1,2)
11514 in3=igrsurf(isu)%NODES(j+1,3)
11515 in4=igrsurf(isu)%NODES(j+1,4)
11516 ibufssg_io(iad2+nibsph*j) = in1
11517 ibufssg_io(iad2+nibsph*j+1) = in2
11518 ibufssg_io(iad2+nibsph*j+2) = in3
11519 ibufssg_io(iad2+nibsph*j+3) = in4
11520 DO proc=1,nspmd
11521 CALL ifrontplus(in1,proc)
11522 CALL ifrontplus(in2,proc)
11523 CALL ifrontplus(in3,proc)
11524 CALL ifrontplus(in4,proc)
11525 ENDDO
11526 ENDDO
11527 iad2 = iad2 + 4*nseg
11528 ELSEIF(isphio(12,n)==2) THEN
11529 in1 = isphio(13,n)
11530 in2 = isphio(14,n)
11531 in3 = isphio(15,n)
11532 DO proc=1,nspmd
11533 CALL ifrontplus(in1,proc)
11534 CALL ifrontplus(in2,proc)
11535 CALL ifrontplus(in3,proc)
11536 ENDDO
11537 ENDIF
11538 ENDDO
11539C=======================================================================
11540 RETURN

◆ tet4_10()

subroutine tet4_10 ( integer, dimension(npropgi,*) igeo,
integer itet4_10 )

Definition at line 11585 of file lectur.F.

11586C-----------------------------------------------
11587C I m p l i c i t T y p e s
11588C-----------------------------------------------
11589#include "implicit_f.inc"
11590C-----------------------------------------------
11591C C o m m o n B l o c k s
11592C-----------------------------------------------
11593#include "com04_c.inc"
11594#include "param_c.inc"
11595C-----------------------------------------------
11596C D u m m y A r g u m e n t s
11597C-----------------------------------------------
11598 INTEGER IGEO(NPROPGI,*),ITET4_10
11599C-----------------------------------------------
11600C L o c a l V a r i a b l e s
11601C-----------------------------------------------
11602 INTEGER I,IGTYP,ITET4
11603
11604 DO i=1,numgeo
11605 igtyp =igeo(11,i)
11606 itet4 =igeo(20,i)
11607 IF((igtyp==14.OR.igtyp==6).AND.itet4==1) itet4_10 = 1
11608 ENDDO
11609
11610 RETURN