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)
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 11444 of file lectur.F.

11445C-----------------------------------------------
11446C M o d u l e s
11447C-----------------------------------------------
11448 USE reorder_mod
11449
11450C-----------------------------------------------
11451C I m p l i c i t T y p e s
11452C-----------------------------------------------
11453#include "implicit_f.inc"
11454C-----------------------------------------------
11455C C o m m o n B l o c k s
11456C-----------------------------------------------
11457#include "com04_c.inc"
11458C-----------------------------------------------
11459C L o c a l V a r i a b l e s
11460C-----------------------------------------------
11461 INTEGER I
11462
11463 DO i=1,numels
11464 permutation%SOLID(i)=i
11465 ENDDO
11466 DO i=1,numelc
11467 permutation%SHELL(i)=i
11468 ENDDO
11469 DO i=1,numeltg
11470 permutation%TRIANGLE(i)=i
11471 ENDDO
11472
11473 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 )
Parameters
[in,out]names_and_titlesNAMES_AND_TITLES host the input deck names and titles for outputs

Definition at line 529 of file lectur.F.

533C-----------------------------------------------
534C M o d u l e s
535C-----------------------------------------------
536 USE my_alloc_mod
537 USE dsgraph_mod
538 USE fvbag_mod
539 USE restmod
540 USE intbufmod
541 USE nod2el_mod
542 USE intstamp_glob_mod
543 USE submodel_mod
544 USE sms_mod
545 USE table_glob_mod
546 USE r2r_mod
547 USE elbufdef_mod
548 USE elbuftag_mod
549 USE message_mod
550 USE front_mod
551 USE sph_mod
552 USE cluster_mod
553 USE intbufdef_mod
554 USE intbufscratch_mod
555 USE ddweights_mod
556 USE xfem2def_mod
557 USE stack_mod
558 USE alefvm_mod
559 USE int8_mod
560 USE fvmbag_meshcontrol_mod
561 USE multi_fvm_mod
562 USE stack_var_mod
563 USE bpreload_mod
564 USE reorder_mod
565 USE inigrav
566 USE intbuf_fric_mod
567 USE inimap1d_mod
568 USE inimap2d_mod
569 USE func2d_mod
570 USE groupdef_mod
571 USE group_mod
572 USE optiondef_mod
573 USE option_mod
574 USE optiondef_mod
575 USE mid_pid_mod
576 USE failwave_mod
577 USE nlocal_reg_mod
578 USE skew_mod
579 USE meshsurfig3d_mod
580 USE mat_elem_mod
581 USE split_cfd_mod
582 USE pinchtype_mod
583 USE check_mod
584 USE inoutfile_mod
585 USE monvol_struct_mod
586 USE setdef_mod
587 USE set_mod
588 USE detonators_mod
589 USE ale_connectivity_mod
590 USE drape_mod
591 USE inivol_def_mod
592 USE sensor_mod
593 USE random_mod
594 USE ale_ebcs_mod
595 USE inverted_group_mod
596 USE mapping_option_mod
597 USE ebcs_mod
598 USE joint_mod
599 USE hm_option_read_mod
600 USE seatbelt_mod
601 USE loads_mod
602 USE state_mod
603 USE user_windows_mod
604 USE user_sensor_mod
605 USE ale_mod
606 USE output_mod
607 USE interfaces_mod
608 USE read_funct_python_mod
609 USE python_funct_mod
610 USE inter_cand_mod
611 USE names_and_titles_mod
612 USE damping_rby_spmdset_mod
613 USE hm_read_preload_axial_mod
614 USE bcs_mod, ONLY : bcs, bcs_struct_
615 USE defaults_mod
616 USE shell_offset_ini_mod,ONLY: shell_offset_ini
617 USE inter_offset_itag_mod, ONLY:inter_offset_itag
618 USE chk_shell_offset_mod, ONLY:chk_shell_offset
619 USE shell_offsetp_mod, ONLY:shell_offsetp
620 USE updfail_mod
621 USE random_walk_def_mod
622 use constraint_mod , only : constraint_,alloc_constraint_struct,dealloc_constraint_struct
623 use split_rwall_mod , only : split_rwall
624 use stifint_icontrol_mod, only : stifint_icontrol
625 use fractal_elem_renum_mod
626 use hm_preread_inivel_mod, only : hm_preread_inivel
627 use brokmann_random_def_mod
628 use brokmann_elem_renum_mod
629 use glob_therm_mod
630 use hm_read_inivol_mod
631 use pblast_mod
632 use iniebcs_propellant_
633 use init_monvol_mod ,only : init_monvol
634 use python_duplicate_nodes_mod
635C-----------------------------------------------
636C I m p l i c i t T y p e s
637C-----------------------------------------------
638#include "implicit_f.inc"
639C-----------------------------------------------
640C D u m m y A r g u m e n t s
641C-----------------------------------------------
642 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
643 TYPE(SUBMODEL_DATA) :: LSUBMODEL(NSUBMOD)
644 INTEGER,INTENT(IN) :: IS_DYNA
645 TYPE(DETONATORS_STRUCT_),TARGET :: DETONATORS
646 TYPE(T_EBCS_TAB), INTENT(INOUT) :: EBCS_TAB
647 INTEGER,INTENT(IN) :: NB_SEATBELT_SHELLS
648 INTEGER,INTENT(INOUT) :: SEATBELT_CONVERTED_ELEMENTS(3,NB_SEATBELT_SHELLS)
649 INTEGER,INTENT(IN) :: NB_DYNA_INCLUDE
650 TYPE(USER_WINDOWS_), INTENT(INOUT) :: USER_WINDOWS
651 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
652 TYPE(NAMES_AND_TITLES_),INTENT(INOUT) :: NAMES_AND_TITLES !< NAMES_AND_TITLES host the input deck names and titles for outputs
653 TYPE(DEFAULTS_),INTENT(INOUT) :: DEFAULTS
654 type(glob_therm_) ,intent(inout) :: glob_therm
655 TYPE(PBLAST_),INTENT(INOUT) :: PBLAST
656 TYPE(SENSOR_USER_STRUCT_) :: SENSOR_USER_STRUCT
657C-----------------------------------------------
658C G l o b a l P a r a m e t e r s
659C-----------------------------------------------
660#include "r4r8_p.inc"
661C-----------------------------------------------
662C C o m m o n B l o c k s
663C-----------------------------------------------
664#include "hash_id.inc"
665#include "com01_c.inc"
666#include "com04_c.inc"
667#include "com06_c.inc"
668#include "com09_c.inc"
669#include "com10_c.inc"
670#include "com_engcards_c.inc"
671#include "com_xfem1.inc"
672#include "eigcom.inc"
673#include "flowcom.inc"
674#include "fxbcom.inc"
675#include "intstamp_c.inc"
676#include "lagmult.inc"
677#include "sphcom.inc"
678#include "param_c.inc"
679#include "remesh_c.inc"
680#include "tabsiz_c.inc"
681#include "tablen_c.inc"
682#include "scr03_c.inc"
683#include "scr05_c.inc"
684#include "scr06_c.inc"
685#include "scr10_c.inc"
686#include "scr12_c.inc"
687#include "scr14_c.inc"
688#include "scr15_c.inc"
689#include "scr16_c.inc"
690#include "scr17_c.inc"
691#include "scr19_c.inc"
692#include "scr23_c.inc"
693#include "scry_c.inc"
694#include "sms_c.inc"
695#include "spmd_c.inc"
696#include "ddspmd_c.inc"
697#include "sysunit.inc"
698#include "titr_c.inc"
699#include "units_c.inc"
700#include "warn_c.inc"
701#include "r2r_c.inc"
702#include "intread_c.inc"
703#include "elbuf_c.inc"
704#include "userlib.inc"
705#include "drape_c.inc"
706#include "boltpr_c.inc"
707#include "inigrav_c.inc"
708#include "inter18.inc"
709#include "inter22.inc"
710#include "ige3d_c.inc"
711#include "random_c.inc"
712C-----------------------------------------------
713C F u n c t i o n
714C-----------------------------------------------
715 INTEGER NLOCAL
716 EXTERNAL nlocal
717 INTEGER SET_USRTOS
718 EXTERNAL set_usrtos
719C-----------------------------------------------
720C L o c a l V a r i a b l e s
721C-----------------------------------------------
722 TYPE intermasurfep
723 INTEGER, DIMENSION(:), POINTER :: P
724 END TYPE intermasurfep
725
726 INTEGER II,I,J,KK,N, NPTS, NMNT, NRTMT_25,MLW,
727 . NUMEL, IFIP, IS_EULER,NB_EULER_GROUPS,
728 . NAIRWA,NTHWA, LWASPIO, LEN_G,LEN_M,LEN,
729 . IADBUF, IADGEO, NUVAR, NUVARI,
730 . NS_I7,NEL,ND,AUX,NS_I21,
731 . NPT,NS_I11,
732 . SVOLMON0,FLAG_GOTO,
733 . INNOD,INSEG,NSIGI, NSIGS, NSIGSH, NSIGSPH,
734 . LB_MAX, P, NG,
735 . IINU ,NEL3D,NEL2D,NEL1D,IMAX,JMAX,
736 . OFF, NELEM, IDDLEVEL, NELEMINT,
737 . IFIXIN,IFIEND,ICO,
738 . IDS,IUN,L_MUL_LAG,NCMAX,NKMAX,
739 . MAXRTMS,MAXNSNE,
740 . MAXRTM,LWAT, L_MUL_LAG1,ISHIF,LIBAGALE,
741 . LENTHG, LBUFMAT, LBUFGEO, LBUFSF,
742 . LNOM_OPT, LENVOLU, ILEN, LCNE, LCNI2G,LENPOR,
743 . PM1SHF, NFX, AIPM, ANOD, AMOD, NBNO, NBMO,
744 . ALM, NELS, NELC, NELTG, NLGRAV, AGRVI, AGRVR,
745 . NNT, RCLEN,PM1SPH, STAT, NELDMAX, VERSDD,
746 . DSNISM, NSLEVEL,NSDEC,NSVMAX,NSPRI,DSARCH,NELT,NELP,NSEGS,
747 . NNFT, NDOFMIN, NMANIM, DSANIM,NRCVVOIS0,NSIGRS,
748 . LRBAGALE,FLAGG,ICOUNT,SWAFT, SWA4, SMATER, SEL2FA,
749 . SNFACPTX,SIXEDGE,SOFFX1,SNUMX1,SXNORM,SINVERT,SFUNC1,SIAD,
750 . SMAS,LEN_RM,LAG_NCF0,LAG_NKF0,
751 . LAG_NHF0,LAG_NCL0,LAG_NKL0,MAXNNOD, IBID,
752 . SRTRANS,LCNE_CRKXFEM,NSEGSMAX,XFEMON,
753 . IN10,IN20,SNOM_OPT_OLD,LENI,FLAG_ALLOCATE,
754 . PROC_BID,FLG_R2R_ERR,NSPCOND0,LENTHGR,FLAG_XFEM,
755 . IADTABIGE,NDOUBLONIGE,DECALIGEO,HM_NSENSOR,
756 . IPARSENS,NBT8,
757 . TAB_SOL(6),ISTR_24,IDEL_SOLID,
758 . LCNCND,I24MAXNSNE,NSIGBEAM,NSIGTRUSS,S_LOADPINTER,
759 . FLAGF,ITHFLAG,MAXRTM_T2,NS_I2,SITAGE,NCTRLMAX,INLIN,SVR_1
760 INTEGER (KIND=8) EMAX
761 INTEGER (KIND=8) K0,K1,K2,K3,K4,K5,K6,K7,K8
762! integer 8 version of the variables NUMELC etc.
763 INTEGER(KIND=8) NUMELCK8
764 INTEGER(KIND=8) NUMELTGK8
765 INTEGER(KIND=8) NUMELSK8
766 INTEGER(KIND=8) NUMELRK8
767 INTEGER(KIND=8) NUMELPK8
768 INTEGER(KIND=8) NUMELTK8
769 INTEGER(KIND=8) NUMELQK8
770 INTEGER(KIND=8) NUMELXK8
771 INTEGER(KIND=8) NUMELIG3DK8
772 INTEGER(KIND=8) NUMSPHK8
773 INTEGER(KIND=8) SVEUL8
774
775 integer
776 . isubmod(nsubmod),
777 . iuparam(100),ddstat(50,parasiz),igrnrb2(nrbe2),
778 . lcne_pxfem
779 INTEGER NSNT,NMNT_2
780
781 INTEGER, DIMENSION(:), ALLOCATABLE :: POIN_UMP_OLD
782 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAB_UMP_OLD
783 my_real, DIMENSION(:), ALLOCATABLE :: cputime_mp_old
784
785 INTEGER, DIMENSION(:,:), ALLOCATABLE :: POIN_PART_SHELL,POIN_PART_TRI
786 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: POIN_PART_SOL
787 TYPE(MID_PID_TYPE), DIMENSION(:), ALLOCATABLE :: MID_PID_SHELL,MID_PID_TRI
788 TYPE(MID_PID_TYPE), DIMENSION(:,:), ALLOCATABLE :: MID_PID_SOL
789 LOGICAL MARQUEUR3
790
791 INTEGER, DIMENSION(:),ALLOCATABLE ::
792 * IWCONT, IWCIN2 , IKINE1LAG ,DSDOF, TAGXREF,
793 * ADDCNE, ADDCNE_PXFEM, FXBTAG ,ADDCNE_CRKXFEM,
794 * TAGREFSTA,CSRECT
795
796 INTEGER, DIMENSION(:),ALLOCATABLE ::
797 * ISOLNOD,ISOLOFF,ISHEOFF,ITRUOFF,IPOUOFF,
798 * IRESOFF,ITRIOFF,IGRNRBY,IQUAOFF
799C
800 INTEGER(KIND=8) :: KVOISPH8,NUMSPH8,SIXSP8,LIMIT8
801 INTEGER :: INTEGER_LIMIT32
802
803 INTEGER, DIMENSION(:),ALLOCATABLE :: CEP,CEL,CNE,
804 . CNI2, CELI2, CEPI2,
805 . CEPSP, CELSPH, ITAGSH,
806 . CNE_PXFEM,CEL_PXFEM
807 INTEGER, DIMENSION(:), ALLOCATABLE :: FXBIPM, FXBNOD, FXBELM,
808 . FXBGRVI, EIGIPM, EIGIBUF,
809 . IMERGE,INTIDS,
810 . IMERGE2,IADMERGE2,
811 . NSLNRBM, SLNRBM,
812 . IGEO_STACK
813 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: ELDOM
814 INTEGER, DIMENSION(:), ALLOCATABLE :: CEPTMP, NELDOM
815 INTEGER, DIMENSION(:), ALLOCATABLE :: LLL
816 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ELSUB
817 INTEGER(KIND=8) ,TARGET :: DSMEMORY(7,NSPMD)
818 INTEGER, DIMENSION(:,:), ALLOCATABLE :: FXANI,IWORKSH, FXB_MATRIX_ADD
819 INTEGER, DIMENSION(:), ALLOCATABLE :: FASTAG,SEGTAG
820 INTEGER(KIND=8),TARGET :: MEMFLOW(2,NSPMD)
821 INTEGER, DIMENSION(:), ALLOCATABLE :: IFLOW
822C
823 INTEGER, DIMENSION(:), ALLOCATABLE :: KINWORK
824
825 INTEGER, DIMENSION(:), ALLOCATABLE :: CNE_CRKXFEM,CEL_CRKXFEM,ITAGN,ITAGE,CEP_CRKXFEM,IEDGE_TMP0,CRKNODIAD
826 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IEDGE_TMP
827C
828 INTEGER, DIMENSION(:), ALLOCATABLE :: NALE_R2R
829 INTEGER, DIMENSION(:,:), ALLOCATABLE :: FRONTB_R2R
830c elem sorting
831 INTEGER, DIMENSION(:), ALLOCATABLE :: IXS_S ,IXS_S_IND,
832 2 IXQ_S,IXQ_S_IND,IXC_S,IXC_S_IND,
833 3 IXT_S ,IXT_S_IND,IXP_S,IXP_S_IND,IXR_S,IXR_S_IND,
834 4 IXTG_S,IXTG_S_IND
835
836c tab IBUFSSG_IO specific inlet/outlet
837 INTEGER, DIMENSION(:), ALLOCATABLE :: IBUFSSG_IO, RESERVEP
838
839 INTEGER, DIMENSION(:), ALLOCATABLE :: IXR_KJ,R_SKEW
840C
841C initial direction for beams
842 INTEGER, DIMENSION(:), ALLOCATABLE :: IBEAM_VECTOR
843 my_real, DIMENSION(:,:), ALLOCATABLE :: rbeam_vector
844C
845C Sol2sph
846 INTEGER, DIMENSION(:), ALLOCATABLE :: SOL2SPH_TYP
847c tab /BCS/CYCLIC
848 INTEGER, DIMENSION(:), ALLOCATABLE :: IBCSCYC,LBCSCYC,ITAGCYC
849C
850 INTEGER, DIMENSION(:,:), ALLOCATABLE :: QP_IPERTURB,RBY_MSN
851 my_real
852 . , DIMENSION(:,:), ALLOCATABLE :: qp_rperturb,rby_iniaxis
853C
854 my_real
855 . eanit2(10),cost_r2r,totmas
856 TARGET :: eanit2
857C OpenMP specific
858 INTEGER ITASK, NP
859#if defined(_OPENMP)
860 INTEGER OMP_GET_THREAD_NUM, OMP_GET_NUM_THREADS
861 EXTERNAL omp_get_thread_num, omp_get_num_threads
862#endif
863
864 my_real
865 . , DIMENSION(:), ALLOCATABLE ::
866 . fxbrpm, fxbmod, fxbglm, fxbcpm, fxbcps, fxblm,
867 . fxbfls, fxbdls, fxbdep, fxbvit, fxbacc, fxbsig,
868 . fxbgrvr, eigrpm ,rmstifn, rmstifr,stiffn,
869 . ms_ply0, zi_ply0,msz20,msz2,lelx,fxb_matrix
870 my_real
871 . , DIMENSION(:,:), ALLOCATABLE :: mbufel, mdepl,rnoise
872 my_real
873 . , DIMENSION(:), ALLOCATABLE :: rflow,cmerge,dnull
874 my_real
875 . probint, flrec6(6), dscutfrq
876 my_real, DIMENSION(:), ALLOCATABLE ::
877 . xfiltr,stfac,fric_p,frigap,i2rupt,areasl,thk_part,
878 . geo_stack
879
880 my_real, DIMENSION(:,:,:), ALLOCATABLE :: xrefc,xreftg,xrefs
881 my_real, DIMENSION(:), ALLOCATABLE :: xyzref
882
883 my_real, DIMENSION(:), ALLOCATABLE :: dt_r2r
884 TYPE(INTERSURFP) , DIMENSION(:,:), ALLOCATABLE :: INTERCEP
885 my_real dtnoda
886 my_real, DIMENSION(:), ALLOCATABLE :: sh4ang,sh3ang
887 my_real, DIMENSION(:), ALLOCATABLE :: ms_b,in_b,dtelem
888C
889 TYPE (STACK_PLY) :: STACK
890C
891 INTEGER, DIMENSION(:), ALLOCATABLE :: IDRAPEID,PERTURB
892 TYPE (FVM_INIVEL_STRUCT), DIMENSION(:), ALLOCATABLE :: FVM_INIVEL
893 TYPE (FAILWAVE_STR_) :: FAILWAVE
894 TYPE (NLOCAL_STR_) :: NLOC_DMG
895 TYPE (PINCH) :: PINCH_DATA
896 TYPE (DRAPE_) ,DIMENSION(:), ALLOCATABLE :: DRAPE,DRAPE_WRK
897 TYPE (DRAPEG_) :: DRAPEG
898 TYPE(DRAPE_WORK_) ,DIMENSION(:), ALLOCATABLE :: IWORK_T
899C ! DEF_SHELL / ioffset=1 treatment for contact
900 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAGOSET !Offset
901 my_real, DIMENSION(:), ALLOCATABLE, TARGET :: xyz
902 my_real, DIMENSION(:), POINTER :: x_c ! points to X or XYZ
903C
904 INTEGER, DIMENSION(:), ALLOCATABLE :: EBCS_TAG_CELL_SPMD
905C
906 TYPE (DYNAIN_DATABASE) :: DYNAIN_DATA
907 TYPE (INTERFACES_) :: INTERFACES
908 TYPE (MAT_ELEM_) ,INTENT(INOUT) :: MAT_ELEM
909 INTEGER LWAMP_L !< Size of work array in Engine (WA)
910 INTEGER LWANMP_L !< Size of work array in Engine (WA)
911C-----------------------------------------------
912 CHARACTER(LEN=4096) :: SCR_FILE_NAME
913 CHARACTER(LEN=ncharline) :: RLINE
914 CHARACTER (LEN=4) :: CWIN
915 LOGICAL :: IS_AVAILABLE
916 INTEGER NLINES,NUSERWI,USERWI_ID
917 INTEGER SCR_FILE_NAME_LEN
918 CHARACTER(LEN=ncharkey) :: KEY
919 INTEGER NUSPHCEL
920 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IXSPS
921 LOGICAL MAT20_DISCRETE_FILL
922 INTEGER, DIMENSION(:,:), ALLOCATABLE :: FLAG_ELEM_INTER25
923 INTEGER, DIMENSION(:), ALLOCATABLE :: LIST_NIN25
924C-----------------------------------------------
925C Model Checker Memory
926 DATA iun/1/
927C======================================================================|
928C Allocations MA (Entiers)
929C======================================================================|
930 TYPE :: int_ptr_array
931 INTEGER, DIMENSION(:), POINTER :: ptr
932 END TYPE int_ptr_array
933 TYPE(int_ptr_array) :: IBUFTMP(0:1),NIGE_TMP(0:1)
934 TYPE :: real_ptr_array
935 my_real, DIMENSION(:), POINTER :: ptr2
936 END TYPE real_ptr_array
937 TYPE(real_ptr_array) :: RIGE_TMP(0:1),XIGE_TMP(0:1),
938 . VIGE_TMP(0:1)
939 INTEGER, DIMENSION(:), ALLOCATABLE ::
940 . FR_IAD,FUNCRYPT,
941 . IWORK,ITRI,KSYSUSR,PTSHEL,PTSH3N,PTSOL,PTQUAD,
942 . PTSPH,ISPTAG,DD_TMP,ITAG,ITAGND_SHXFEM,
943 . ITHPART,ITHSUB,ITHBUFTMP,DD_TMP2,
944 . IADHF,JCIHF,JLL,IWA,WEIGHT_RM,
945 . PTSPRI,PTBEAM,PTTRUSS
946 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IPARGTMP
947 TARGET :: iwork
948
949 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAB_UMP_LOC
950 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: TAB_UMP_LOC2
951 INTEGER, DIMENSION(:), POINTER ::
952 . IPARTTH,IPARTS,IPARTQ,IPARTC,IPARTT,IPARTP,IPARTR,
953 . IPARTG,IPARTX,IPARTSP,NPC1,IXS10,IXS20,IXS16,IPRES,
954 . IBMPC2,IBMPC3,IBMPC4,IWORK2,
955 . ITRI1,ITRI2,ITRI3,INDEX,
956 . INDEX1,INDEX2,IWD,IWEIG,INUM,EADD,ITR1,ITR2,XEP,
957 . IPARTTHI,IPARTIG3D,IEDGESH4,IEDGESH3,IELCRK4,IELCRK3
958 INTEGER BID13(1),SNPC1
959 INTEGER L0,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12,SIXTG0,
960 . SIXS0,SIXS10,SIXS20,SIXS16,SIWORK,SIWORK2,SIEXTAG,
961 . NUMCLD,NUMPRES,NUMLINK,NUMGRAV,NUMRBYMOU,
962 . SNRBODY,SLRBODY,LITHPART,LITHSUB,IDX,IDX1,IDX2,IDXCNT,
963 . LITHBUFI,LITHBUFMX,NTHGRPMX,SINDEX,SITRI,LDD_IAD,
964 . LSIGI,LSIGSH,LSIGSP,LSIGSPH,SINSCR,
965 . SIPART0,SIPARTTH,SIPARTS,SIPARTQ,SIPARTC,SIPARTT,SIPARTP,
966 . SIPARTR,SIPARTG,SIPARTX,SIPARTSP,ITER,
967 . LIXINT,SBUFALE,NVARTOT,
968 . NVARTOT0,NVARTOTMAX,NVARABF,
969 . PIXS10,PIXS16,PIXS20,NUMCFIELD,NUMLOADP,IXEL,
970 . SIPARTIG3D,IDXIGE1,IDXIGE2,
971 . IDXIGECNT,TAGSURFIGE,LSIGRS,LSIGBEAM,LSIGTRUSS,NSETFRICTOT,
972 . IORTHFRICMAX,COEFSLEN,NPFRICORTH,NGRPF,LENG,
973 . NIMPDISP,NIMPVEL,NIMPACC,NIMPV_LAGM,NFV0,NSETMAX,NFXVEL0
974 TYPE(CLUSTER_),DIMENSION(:),ALLOCATABLE :: CLUSTERS
975 TYPE(INTBUF_STRUCT_),DIMENSION(:),ALLOCATABLE :: INTBUF_TAB
976 TYPE(SCRATCH_STRUCT_),DIMENSION(:),ALLOCATABLE :: INSCR
977C--- Bolt preloading
978 INTEGER SIPRELOAD, SPRELOAD !NUMPRELOAD,
979
980c--- Element Buffer --------------------------------------------------
981 TYPE(ELBUF_STRUCT_),DIMENSION(:) ,ALLOCATABLE :: ELBUF_TAB
982 TYPE(ELBUF_STRUCT_),DIMENSION(:,:),ALLOCATABLE :: XFEM_TAB
983 TYPE(MLAW_TAG_) ,DIMENSION(:) ,ALLOCATABLE, TARGET :: MTAG_INI,MTAG_R2R
984 TYPE(MLAW_TAG_) ,DIMENSION(:) ,POINTER :: MLAW_TAG
985 TYPE(EOS_TAG_) ,DIMENSION(:) ,ALLOCATABLE :: EOS_TAG
986 TYPE(PROP_TAG_) ,DIMENSION(0:MAXPROP) :: PROP_TAG
987 TYPE(FAIL_TAG_) ,DIMENSION(0:MAXFAIL) :: FAIL_TAG
988c---- Xfem ------------------------------------------------------------
989 TYPE (XFEM_SHELL_) ,DIMENSION(:), ALLOCATABLE :: CRKSHELL ! NLEVMAX
990 TYPE (XFEM_LVSET_) ,DIMENSION(:), ALLOCATABLE :: CRKLVSET ! NLEVMAX
991 TYPE (XFEM_SKY_) ,DIMENSION(:), ALLOCATABLE :: CRKSKY ! NLEVMAX
992 TYPE (XFEM_AVX_) ,DIMENSION(:), ALLOCATABLE :: CRKAVX ! NLEVMAX
993 TYPE (XFEM_EDGE_) ,DIMENSION(:), ALLOCATABLE :: CRKEDGE ! NXLAYMAX
994 TYPE(XFEM_PHANTOM_),DIMENSION(:), ALLOCATABLE :: XFEM_PHANTOM ! NXLAYMAX
995C NCRKPART & IND_CRK are global values shared by all processors (only for ANIM)
996C ---- Interface t8
997 TYPE(INT8_STRUCT_) , DIMENSION(:,:), ALLOCATABLE :: INTERT8
998 INTEGER NCRKPART
999 INTEGER, DIMENSION(:), ALLOCATABLE :: INDX_CRK
1000 INTEGER, DIMENSION(:), ALLOCATABLE :: PERMIGE
1001 TYPE(TABCONPATCH_IG3D_), DIMENSION(:), ALLOCATABLE :: TABCONPATCH
1002c--- Material data --------------------------------------------------
1003 TYPE(MATPARAM_STRUCT_) , DIMENSION(:), ALLOCATABLE , TARGET :: MPARAM_INI,MPARAM_R2R
1004c--- Element group parameter table --------------------------------------------------
1005 TYPE(GROUP_PARAM_) , DIMENSION(:), ALLOCATABLE :: GROUP_PARAM_TAB ! NGROUP
1006C AMS
1007 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: T2MAIN_SMS
1008C
1009 INTEGER :: SRNOISE1,SRNOISE2
1010C T2 SPT 27/28
1011 INTEGER NSN_MULTI_CONNEC
1012 INTEGER, ALLOCATABLE, DIMENSION(:) :: T2_NB_CONNEC
1013C MERGE RBODY
1014 INTEGER, DIMENSION(:), ALLOCATABLE :: MGRBY
1015C PINCHING
1016 INTEGER SPINCH
1017C For /H3D/STRESS/TENS/OUTER
1018 INTEGER, ALLOCATABLE, DIMENSION(:) :: TAG_SKINS6
1019 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: SEATBELT_SHELL_TO_SPRING
1020C--- Bolt preload/axial
1021 INTEGER :: NPRELOAD_A
1022 INTEGER, ALLOCATABLE, DIMENSION(:) :: ITAGPRLD_SPRING
1023 INTEGER, ALLOCATABLE, DIMENSION(:) :: ITAGPRLD_BEAM
1024 INTEGER, ALLOCATABLE, DIMENSION(:) :: ITAGPRLD_TRUSS
1025 TYPE(PREL1D_), DIMENSION(:), ALLOCATABLE :: PRELOAD_A
1026C======================================================================|
1027C Allocations AM (Reels)
1028C======================================================================|
1029 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: DBRWORK
1030 my_real, DIMENSION(:), ALLOCATABLE ::
1031 . rwork,stifint,mwa,mss,mssx,mssf,msq,msr,
1032 . inp,inr,ins,vns,vnsx,stc,stt,stp,str,sttg,stur,
1033 . bns,bnsx,volnod,bvolnod,etnod,nshnod,xelemwa,
1034 . xnum,xtmp,rtrans,msig3d,stifintr,strc,strr,strp,strtg,
1035 . vnige,bnige
1036 TARGET ::
1037 . rwork
1038 my_real, DIMENSION(:), POINTER ::
1039 . thkec,eanit,pres,wma
1040 INTEGER SRWORK
1041 INTEGER LXINTD
1042 my_real totaddmas
1043 CHARACTER(LEN=NCHARLINE) ::ERR_MSG
1044 INTEGER, DIMENSION(:), ALLOCATABLE :: IBORDEDGE,INOM_OPT
1045 DOUBLE PRECISION RSIBUFSSG,RNIGE,RRIGE,RXIGE,RVIGE
1046 INTEGER INTMAX, LLINAL,ITET4_10
1047C--------- Itet=2 of S10
1048 INTEGER, DIMENSION(:), ALLOCATABLE :: ICNDS10,ITAGND,ADDCNCND,
1049 . CNCND, CELCND, CEPCND
1050
1051 !Pointer to send a valid explicit address as argument in cas of not allocated
1052 INTEGER(KIND=8) ,POINTER :: pMEMFLOW
1053
1054 DATA intmax /2147483647/
1055 my_real,
1056 . DIMENSION(:), ALLOCATABLE :: fillsol
1057C
1058C Dynamical User Library
1059 CHARACTER FILNAM*512,CLAW*4
1060 INTEGER LEN_FILNAM
1061 INTEGER IADBOXMAX
1062 INTEGER, DIMENSION(:), ALLOCATABLE :: IADBOXMAX_NODE,IADBOXMAX_SURF,
1063 . IADBOXMAX_LINE,IADBOXMAX_ELEM
1064C
1065 my_real, DIMENSION(:,:), ALLOCATABLE ::
1066 . sigi,sigsh,sigsp,sigsph,sigrs,sigbeam,sigtruss
1067 INTEGER, DIMENSION(:), ALLOCATABLE ::
1068 . STRSGLOB,STRAGLOB,ORTHOGLOB
1069 INTEGER ISIGSH,IYLDINI,KSIGSH3,FAIL_INI(5),IUSOLYLD,IUSERL
1070C
1071 INTEGER FVMAIN(NVOLU + NMONVOL),NBSUBMAT
1072C GROUPS OF GROUPS
1073 INTEGER :: MEM_MARGIN
1074 parameter(mem_margin = 250000)
1075C--- INterface Friction model
1076 TYPE(INTBUF_FRIC_STRUCT_), DIMENSION(:), ALLOCATABLE :: INTBUF_FRIC_TAB
1077 INTEGER, DIMENSION(:), ALLOCATABLE ::TABCOUPLEPARTS_FRIC_TMP,TABPARTS_FRIC_TMP,
1078 . TAGPRT_FRIC,NSETINIT,IFRICORTH_TMP,
1079 . PFRICORTH ,IREPFORTH ,LENGRPF
1080 my_real, DIMENSION(:), ALLOCATABLE ::tabcoef_fric_tmp , vforth ,phiforth
1081 TYPE(INIMAP1D_STRUCT), DIMENSION(:), ALLOCATABLE :: INIMAP1D
1082 TYPE(INIMAP2D_STRUCT), DIMENSION(:), ALLOCATABLE :: INIMAP2D
1083 TYPE(FUNC2D_STRUCT), DIMENSION(:), ALLOCATABLE :: FUNC2D
1084 TYPE(PYTHON_) :: PYTHON
1085! DDSPLIT local arrays :
1086 LOGICAL :: FLAG_24_25
1087 INTEGER :: NINDX_NM,NINDX_SCRT,I24MAXNSNE2
1088 INTEGER, DIMENSION(NSPMD) :: NUMNOD_L
1089 INTEGER, DIMENSION(:), ALLOCATABLE :: TAG_NM,INDX_NM
1090 INTEGER, DIMENSION(:), ALLOCATABLE :: TAG_SCRATCH,INDX_SCRT
1091C FLEXIBLE BODY
1092 INTEGER FXB_LAST_ADRESS(10)
1093 CHARACTER, DIMENSION(:), ALLOCATABLE :: FXBFILE_TAB*2148
1094C
1095! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1096! INDX_XXX : size = NUMNOD
1097! index of non-zero TAG_XXX value
1098! used for optimize the initialization
1099! of TAG_XXX array (XXX = NM or SCRT for SCRATCH)
1100! allocated array in lectur and threadprivate array
1101! NINDX_XXX : number of non-zero TAG_XXX value
1102! TAG_XXX : size = NUMNOD
1103! array used to tag an element for
1104! a given interface ; allocated in lectur
1105! allocated array in lectur and threadprivate array
1106! FLAG_24_25 : logical, flag for interface 24 or 25
1107! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1108 INTEGER, DIMENSION(:), ALLOCATABLE :: TAG_SKN
1109 TYPE(SKEW_) :: SKEWS
1110 TYPE (SENSOR_STR_) ,DIMENSION(:) ,ALLOCATABLE :: SENSOR_TMP
1111! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1112! TAG_SKN : integer ; dimension=NUMSKW+1
1113! tag array --> tag the i SKEW if a SPRING uses it
1114! tag array=0 --> the SKEW is not used by a SPRING
1115! tag array=1 --> the SKEW is used by one SPRING
1116! tag array>1 --> the SKEW is used by several SPRING
1117! tag array <0 --> the SKEW is used by several options (has to be duplicated to all domains that have the nodes)
1118! SKEWS : SKEW_ ; SKEW Type
1119 ! SKEWS%MULTIPLE_SKEW : dimension=NUMSKW+1
1120! %MULTIPLE_SKEW(I)%PLIST(:) is a list of processor
1121! where the SKEW is stick
1122! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1123 TYPE(SURF_), DIMENSION(:,:), ALLOCATABLE :: IGRSURF_PROC
1124! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1125! IGRSURF_PROC : SURF_ ; dimension=NSURF*NSPMD
1126! local surface property array (=IGRSURF for each proc)
1127! %ELTYP --> type of element (shell, triangle...)
1128! %ELEM --> element id
1129! %NSEG --> total element number
1130! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1131 INTEGER :: GRNOD_UID
1132 INTEGER, DIMENSION(NSPMD) :: SIZE_ALE_ELM
1133 TYPE(split_cfd_type), DIMENSION(:),ALLOCATABLE :: ALE_ELM
1134! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1135! SIZE_ALE_ELM : integer ; dimension=NSPMD ; size of ALE_ELM%SOL_ID array
1136! ALE_ELM : split_cfd_type ; dimension=NSPMD ; solid element ID used
1137! during the domain splitting (ALE part)
1138! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1139 INTEGER :: LEN_TMP_NAME
1140 CHARACTER(len=4096) :: TMP_NAME
1141! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1142! LEN_TMP_NAME : integer ; size of TMP_NAME
1143! TMP_NAME : character ; local name of file, when -outfile or
1144! -infile cdl are used, need to define the folder paths
1145! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1146 TYPE(MONVOL_STRUCT_), DIMENSION(:), ALLOCATABLE :: T_MONVOL
1147 TYPE(MONVOL_METADATA_) :: T_MONVOL_METADATA
1148 TYPE(t_ale_connectivity) :: ALE_CONNECTIVITY
1149
1150 INTEGER :: NBR_TH_MONVOL,NBR_TH_MONVOL01(9)! number of /TH/MONV
1151c For /RANDOM --------------------------------------------------
1152 INTEGER,DIMENSION(:),ALLOCATABLE :: IRAND
1153 my_real,DIMENSION(:),ALLOCATABLE :: alea,xseed
1154
1155! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1156! BOOL_ALE_TG : logical, true only if 2d model + MULTI_FVM used
1157! INDX_xxx : integer ; dimension=NUMELxxx ; index for the surface
1158! of the remote connected element
1159! FACE_ELM_xxx : integer ; dimension=(6/4/3*NUMELxxx,2) ; surface
1160! of the remote connected element
1161! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1162 LOGICAL :: BOOL_ALE_TG
1163 INTEGER, DIMENSION(:), ALLOCATABLE :: INDX_S,INDX_Q,INDX_TG
1164 INTEGER, DIMENSION(:,:), ALLOCATABLE :: FACE_ELM_S,FACE_ELM_Q,FACE_ELM_TG
1165! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1166! INV_GROUP : structure ; connectivity ELEMENT -> PART
1167! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1168 TYPE(INVERTGROUP_STRUCT_) :: INV_GROUP
1169 TYPE(MAPPING_STRUCT_) :: MAP_TABLES
1170 ! -------------
1171 ! Load structure
1172 TYPE (LOADS_) :: LOADS ! global structure for /LOAD
1173 TYPE (LOADS_), DIMENSION(NSPMD) :: LOADS_PER_PROC ! local structurfsdcod(e for each processor --> used for the restart operation
1174 ! -------------
1175 ! BCS wall structure
1176 TYPE (bcs_struct_), DIMENSION(NSPMD) :: BCS_PER_PROC
1177 ! -------------
1178 INTEGER NINIVELT
1179 INTEGER NINTEMP
1180 INTEGER ALE_EULER
1181
1182C MERGE NODES
1183 INTEGER NMERGE_NODE_CAND,NMERGE_NODE_DEST,NMERGE_TOT
1184 INTEGER, DIMENSION(:), ALLOCATABLE :: MERGE_NODE_TAB
1185 my_real,DIMENSION(:),ALLOCATABLE :: merge_node_tol
1186C
1187 my_real,DIMENSION(:),ALLOCATABLE :: dgapint, intgaploadp ,dgaploadint
1188C SEATBELTS
1189 INTEGER NB_MAT_SEATBELT,NB_MAT
1190C
1191 INTEGER :: NUMSH3,NUMSH4, NSLICE,NPT_DRAPE,JJ,ISL, IP,IE, IDSHEL
1192 INTEGER , DIMENSION(:), ALLOCATABLE :: INDXSH
1193 INTEGER :: NUMBER_LOAD_CYL
1194 INTEGER :: S_NOD2ELS,S_NOD2ELTG,S_NOD2EL1D
1195C DAMPING
1196 INTEGER :: NDAMP_VREL_RBY
1197 INTEGER :: NDAMP_FREQ_RANGE
1198 INTEGER , DIMENSION(:), ALLOCATABLE :: DAMP_RANGE_PART
1199C SPH
1200 INTEGER :: PRE_SEARCH,SZ_INTP_DIST
1201 my_real :: max_intp_dist_part
1202
1203 TYPE(INTER_CAND_) :: INTER_CAND
1204 TYPE (FAIL_FRACTAL_) :: FAIL_FRACTAL
1205 TYPE (FAIL_BROKMANN_) :: FAIL_BROKMANN
1206 INTEGER DEF_INTER(100)
1207 ! constraint structure
1208 type(constraint_) :: constraint_struct
1209c=======================================================================
1210 ireac = 0
1211 python%NB_FUNCTS = 0
1212 python%NB_SENSORS = 0
1213! domain decomposition statistic
1214 ddstat(1:50,1:parasiz)=0
1215 i22len_l = 0
1216 fvmain(1:nvolu + nmonvol) = 0
1217 m51_iflg6 = 0
1218 nvartotmax = 0
1219 err_msg='BEGINNING'
1220 err_category='INTERNAL'
1221 CALL trace_in1(err_msg,len_trim(err_msg))
1222 flag_goto = 0
1223 CALL titre2
1224 nvarabf = 1
1225 intbag=0
1226 l_mul_lag=0
1227 lag_ncf = 0
1228 lag_nkf = 0
1229 lag_nhf = 0
1230 lag_ncl = 0
1231 lag_nkl = 0
1232 lag_nhl = 0
1233 numels8a = 0
1234 nairwa = 0
1235 nmanim=0
1236 dsanim=0
1237 impl_s0 = 0
1238 flg_split = 0
1239 nvartotmax = 0
1240 nxlaymax = 0 ! max layer nb in parts xfem
1241C /DAMP/VREL + RBY
1242 ndamp_vrel_rby = 0
1243C /DAMP/FREQUENCY_RANGE
1244 ndamp_freq_range = 0
1245C ply xfem
1246 iplyxfem = 0
1247 nplyxfe = 0
1248 eplyxfe = 0
1249 intplyxfem = 0
1250C
1251 inter_ithknod=0 !defined in interface module (common_source directory)
1252 irigid_mat = 0
1253C
1254! IKINE1LAG = 0
1255 ialelag = 0
1256C added nodal mass
1257 totaddmas = zero
1258 ipart_stack = 0
1259 ipart_pcompp = 0
1260C
1261 sfrontb_r2r = 1
1262C Flag to set for Domain Decomposition and Additional nodes
1263 user_grp_domain=0
1264 nsnt=0
1265 nmnt_2=0
1266 def_inter(1:100) = defaults%interface%DEF_INTER(1:100)
1267c OpenMP specific
1268 itask=0
1269C flag need generalize BUFINTI in DDPSLIT with Interface type 11.
1270C BEFORE ININTR / I11STO KD(11)=KD(10)+4*NRTS
1271C After ININTR : KD(11)=KD(10)+2*NRTS
1272C Idem with (KD(12) = KD(11) + 4*NRTM )
1273 i11flag=0
1274 inter18_autoparam = 0
1275 inter18_is_variable_gap_defined = .false.
1276 nbpreld = 10
1277 ALLOCATE(ebcs_tag_cell_spmd(numelq+numeltg+numels))
1278C
1279 ALLOCATE(eos_tag(0:maxeos))
1280C Interface give CPU to Main surface - INITIALIZE ARRAY
1281C new initiation for XFEM CRACK
1282C
1283 ALLOCATE(intercep(3,ninter))
1284
1285 DO i=1,ninter
1286 NULLIFY(intercep(1,i)%P)
1287 NULLIFY(intercep(2,i)%P)
1288 NULLIFY(intercep(3,i)%P)
1289 ENDDO
1290C------------------------------------------------------------------
1291C Initializations of NNOISE variables (for Rad2noise Engine files
1292C------------------------------------------------------------------
1293 nnoise_sav = 0
1294 sinoise = 0
1295 sfnoise = 0
1296 ALLOCATE(inoise(0))
1297 ALLOCATE(fnoise(0))
1298C------------------------------------------------------------------
1299C Initialization size for INISHCEL
1300C------------------------------------------------------------------
1301 nusphcel = 0
1302C----------------------------------------------
1303C ALLOCATION TO REDUCE STACKSIZE
1304C----------------------------------------------
1305C INTEGER
1306 ALLOCATE(iwcont(5*numnod),stat=stat)
1307 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1308 . msgtype=msgerror,
1309 . c1='IWCONT')
1310
1311 ALLOCATE(iwcin2(2*numnod),stat=stat)
1312 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1313 . msgtype=msgerror,
1314 . c1='IWCIN2')
1315
1316C
1317 ALLOCATE(ikine1lag(3*numnod),stat=stat)
1318 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1319 . msgtype=msgerror,
1320 . c1='IKINE1LAG')
1321 ikine1lag(1:3*numnod)=0
1322
1323 ALLOCATE(dsdof(numnod),stat=stat)
1324 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1325 . msgtype=msgerror,
1326 . c1='DSDOF')
1327 dsdof(1:numnod)=0
1328
1329 ALLOCATE( addcne(0:numnod+1),stat=stat)
1330 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1331 . msgtype=msgerror,
1332 . c1='ADDCNE')
1333C ADDCNE_PXFEM needed when IPLYXFEM used
1334 ALLOCATE(addcne_pxfem(0:numnod +1),stat=stat)
1335 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1336 . msgtype=msgerror,
1337 . c1='ADDCNE_PXFEM')
1338C
1339 IF(nfxbody>0) THEN
1340 nbipm = 45
1341 ALLOCATE(fxbtag(numnod),fxbipm(nbipm*nfxbody),stat=stat)
1342 fxbipm(1:nbipm*nfxbody) = zero
1343 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1344 . msgtype=msgerror,
1345 . c1='FXBTAG')
1346 ! Table of FXBODY file name for QAPRINT
1347 ALLOCATE(fxbfile_tab(nfxbody))
1348 ELSE
1349 nbipm = 1
1350 ALLOCATE(fxbtag(1),fxbipm(1),stat=stat)
1351 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1352 . msgtype=msgerror,
1353 . c1='FXBTAG')
1354 ALLOCATE(fxbfile_tab(0))
1355 ENDIF
1356C
1357 ALLOCATE(isolnod(numels),stat=stat)
1358 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1359 . msgtype=msgerror,
1360 . c1='ISOLNOD')
1361 ALLOCATE(isoloff(numels),stat=stat)
1362 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1363 . msgtype=msgerror,
1364 . c1='ISOLOFF')
1365 ALLOCATE(isheoff(numelc),stat=stat)
1366 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1367 . msgtype=msgerror,
1368 . c1='ISHEOFF')
1369 ALLOCATE(itruoff(numelt),stat=stat)
1370 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1371 . msgtype=msgerror,
1372 . c1='ITRUOFF')
1373 ALLOCATE(ipouoff(numelp),stat=stat)
1374 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1375 . msgtype=msgerror,
1376 . c1='IPOUOFF')
1377 ALLOCATE(iresoff(numelr),stat=stat)
1378 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1379 . msgtype=msgerror,
1380 . c1='IRESOFF')
1381 ALLOCATE(itrioff(numeltg),stat=stat)
1382 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1383 . msgtype=msgerror,
1384 . c1='ITRIOFF')
1385 ALLOCATE(igrnrby(nrbody),stat=stat)
1386 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1387 . msgtype=msgerror,
1388 . c1='IGRNRBY')
1389 igrnrby(1:nrbody) = 0
1390 ALLOCATE(iquaoff(numelq),stat=stat)
1391 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1392 . msgtype=msgerror,
1393 . c1='IQUAOFF')
1394C Float
1395C----------------------------------------------
1396C ALLOC INTEGER TABLES IGEO and IPM
1397C----------------------------------------------
1398 len_g = npropgi*numgeo
1399 len_m = npropmi*nummat
1400 ALLOCATE(igeo(len_g),stat=stat)
1401 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1402 . msgtype=msgerror,
1403 . c1='IGEO')
1404 ALLOCATE(ipm(len_m),stat=stat)
1405 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1406 . msgtype=msgerror,
1407 . c1='IPM')
1408 igeo = 0
1409 ipm = 0
1410C----------------------------------------------
1411C ALLOC DDWEIGHTS ARRAY FROM MODULE
1412C----------------------------------------------
1413 CALL init_mat_weight(nummat)
1414C----------------------------------------------
1415 ALLOCATE(ipart_state(npart),stat=stat)
1416 IF(stat /= 0) THEN
1417 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,
1418 . c1='IPART_STATE')
1419 ELSE
1420 ipart_state=0
1421 END IF
1422 CALL trace_out1()
1423C----------------------------------------------
1424C ALLOC AND INIT OF TAG TABLE FOR NODES USED ON P0
1425C----------------------------------------------
1426 err_category='INTERNAL'
1427c obsolete code, replaced by new chained-list IFRONT
1428C coding of different types of boundary nodes:
1429C 0 node not on proc
1430C 1 acceleration boundary
1431C 10 kinematic boundary
1432C 100 interface boundary
1433C possible combinations
1434
1435
1436c SIFRONT minimum size NUMNOD. Value set to 2*NUMNOD
1437 sifront = 2*numnod
1438
1439c Linked-list IFRONT
1440C IFRONT%IENTRY : entry in IFRONT for node N
1441C IFRONT%P(1,N) : SPMD domain for node N
1442C IFRONT%P(2,N) : next index in IFRONT for node N
1443 ALLOCATE(ifront%P(2,sifront),stat=stat)
1444 ALLOCATE(ifront%IENTRY(numnod),stat=stat)
1445
1446c IENTRY2 use to save IENTRY
1447 ALLOCATE(ientry2(numnod),stat=stat)
1448 IF(stat/=0) THEN
1449 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,
1450 . c1='IFRONT')
1451 ENDIF
1452c FLAGKIN array to identify boundary nodes with kinematic constraints
1453c (FLAGKIN(N)=1 <=> old FRONT TAG=10)
1454 ALLOCATE(flagkin(numnod),stat=stat)
1455 IF(stat/=0) THEN
1456 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,
1457 . c1='FLAGKIN')
1458 ENDIF
1459C----------------------------------------------
1460 CALL ini_ifront()
1461 ientry2(1:numnod) = -1
1462 flagkin(1:numnod) = 0
1463
1464c IF(FLAG_GOTO == 1) GOTO 207 !!go to traitement rad2rad
1465C--------------------------------------------
1466C CALCULATE ISECUT
1467C--------------------------------------------
1468 isecut=0
1469 CALL lecsec0(lsubmodel)
1470C--------------------------------------------
1471C IMPOSED VELOCITIES : Check rotational DOFs : IMPOSE_DR
1472C--------------------------------------------
1473 impose_dr=0
1474 CALL hm_preread_impvel0(impose_dr,unitab,lsubmodel) !read /IMPDISP
1475C--------------------------------------------
1476C STOCKAGE DYNAMIQUE (GENERAL) REEL
1477C--------------------------------------------
1478 ifrwv=0
1479208 sx = 3*numnod
1480 sd = 5*numnod
1481 sv = 3*numnod
1482 svr = 3*numnod*max(iroddl,iroddl0)
1483 svr_1 = numnod*max(iroddl,iroddl0)
1484 sthke = numelc+numeltg
1485 sms = numnod
1486 spinch= npinch
1487 sin = numnod*max(iroddl,iroddl0)
1488 IF(isecut>0 .OR. iisrot>0 .OR. impose_dr>0 .OR. idrot == 1) THEN
1489 sdr = 3*numnod*max(iroddl,iroddl0)
1490 ELSE
1491 sdr = 0
1492 ENDIF
1493 IF(flag_goto == 1) GOTO 258
1494C--------------------------------------------
1495 IF(ndamp > 0) THEN
1496 sdampr = nrdamp*ndamp
1497 sdamp = 3*(1+max(iroddl,iroddl0))*numnod
1498 CALL hm_option_count('/DAMP/FREQUENCY_RANGE',ndamp_freq_range)
1499 IF (ndamp == ndamp_freq_range) sdamp = 0
1500 ALLOCATE(dampr(sdampr+sdamp) ,stat=stat)
1501 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1502 . msgtype=msgerror,
1503 . c1='DAMPR')
1504 damp => dampr(sdampr+1:sdampr+sdamp)
1505 dampr = 0
1506 ELSE
1507 sdampr = 0
1508 sdamp = 0
1509 ALLOCATE(dampr(sdampr) ,stat=stat)
1510 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1511 . msgtype=msgerror,
1512 . c1='DAMPR')
1513 ALLOCATE(damp(sdamp) ,stat=stat)
1514 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1515 . msgtype=msgerror,
1516 . c1='DAMP')
1517 ENDIF
1518 ALLOCATE(damp_range_part(npart),stat=stat)
1519 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1520 . msgtype=msgerror,
1521 . c1='DAMP_RANGE_PART')
1522 damp_range_part = 0
1523 ALLOCATE(x(sx) ,stat=stat)
1524 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1525 . msgtype=msgerror,
1526 . c1='X')
1527 ALLOCATE(d(sd) ,stat=stat)
1528 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1529 . msgtype=msgerror,
1530 . c1='D')
1531 ALLOCATE(v(sv) ,stat=stat)
1532 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1533 . msgtype=msgerror,
1534 . c1='V')
1535 ALLOCATE(vr(svr) ,stat=stat)
1536 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1537 . msgtype=msgerror,
1538 . c1='VR')
1539 ALLOCATE(dr(sdr) ,stat=stat)
1540 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1541 . msgtype=msgerror)
1542 ALLOCATE(thke(sthke) ,stat=stat)
1543 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1544 . msgtype=msgerror,
1545 . c1='THKE')
1546 ALLOCATE(ms(sms) ,stat=stat)
1547 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1548 . msgtype=msgerror,
1549 . c1='MS')
1550 ALLOCATE(in(sin) ,stat=stat)
1551 ALLOCATE(xyzref(sx) ,stat=stat)
1552 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1553 . msgtype=msgerror,
1554 . c1='XYZREF')
1555 ALLOCATE(sh4ang(numelc) ,stat=stat)
1556 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1557 . msgtype=msgerror,
1558 . c1='SH4ANG')
1559 ALLOCATE(sh3ang(numeltg) ,stat=stat)
1560 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1561 . msgtype=msgerror,
1562 . c1='SH3ANG')
1563 IF(numnod > 0) THEN
1564 x = 0
1565 d = 0
1566 v = 0
1567 ms = 0
1568 ENDIF
1569 IF(svr > 0) vr = 0
1570 IF(sdr > 0) dr = 0
1571 IF(sin > 0) in = 0
1572C--------------------------------------------
1573258 IF(numelc<sthke) THEN
1574 thkec => thke(numelc+1:sthke)
1575 ELSE
1576 thkec => thke
1577 END IF
1578 IF(sthke > 0) thke = 0
1579 IF(numelc > 0) sh4ang = 0
1580 IF(numeltg > 0) sh3ang = 0
1581c
1582 CALL nbfunct(nfunct,ntable,npts,lsubmodel)
1583C--------------------------------------------
1584C STOCKAGE DYNAMIQUE (GENERALE) ENTIER
1585C--------------------------------------------
1586C--- Longueurs
1587 sicode = numnod
1588 siskew = numnod
1589 siskwn = liskn*((numskw+1)+min(iun,nspcond)*numsph+(numfram+1)+nsubmod)
1590 siframe = liskn*(numfram+1)
1591c SNETH = 2*NSNOD+NSELS+NSELQ+NSELC+NSELT+NSELP+NSELR+NSELTG = 0
1592 sibcslag= 5*nbcslag
1593 sipart0 = lipart1*npart+lipart1*nthpart
1594 sipartth= 2*9*npart+2*9*nthpart
1595 siparts = numels
1596 sipartq = numelq
1597 sipartc = numelc
1598 sipartt = numelt
1599 sipartp = numelp
1600 sipartr = numelr
1601 sipartg = numeltg
1602 sipartx = numelx
1603 sipartsp= numsph
1604 sipartig3d = numelig3d
1605 sipart = sipart0+sipartth+siparts+sipartq+sipartc+sipartt+sipartp
1606 . + sipartr+sipartg+sipartx+sipartig3d+sipartsp
1607 numel = numels+numelq+numelc+numelt+numelp+numelr
1608 . + numeltg+numelx+numsph+numelig3d
1609c
1610 snpc = 3*nfunct+1
1611 sixtg0 = nixtg*numeltg
1612 sixtg = sixtg0
1613 sixs0 = nixs*numels
1614 sixs10 = numels10*6
1615 sixs20 = numels20*12
1616 sixs16 = numels16*8
1617 sixs = sixs0+sixs10+sixs20+sixs16
1618 sixq = nixq*numelq
1619 sixc = nixc*numelc
1620 sixt = nixt*numelt
1621 sixp = nixp*numelp
1622 sixr = nixr*numelr
1623 sitab = numnod
1624 sitabm1 = 2*numnod
1625 sgjbufi = lkjni*ngjoint
1626!---------
1627 slaccelm= 3*naccelm
1628 snom_opt1= nrbody+naccelm+nvolu+nmonvol+ninter+nintsub+
1629 + nrwall+njoint+nsect+nlink+
1630 + numskw+1+numfram+1+nfxbody+nflow+nrbe2+
1631 + nrbe3+nsubmod+nfxvel+numbcs+nummpc+
1632 + ngjoint+nunit0+nfunct+nadmesh+
1633 + nsphio+nspcond+nrbykin+nebcs+
1634 + ninicrack+nodmas+nbgauge+ncluster+ninterfric+
1635 + nrbmerge+numbcsn+nslipring+nretractor
1636 snom_opt = snom_opt1*lnopt1+1
1637 sinom_opt= 33
1638 snom_sect= ncharline*nsect
1639 IF(flag_goto==1) GOTO 209
1640C
1641C--- Allocations
1642 ALLOCATE(icode(sicode) ,stat=stat)
1643 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1644 . msgtype=msgerror,
1645 . c1='ICODE')
1646 ALLOCATE(iskew(siskew) ,stat=stat)
1647 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1648 . msgtype=msgerror,
1649 . c1='ISKEW')
1650 ALLOCATE(iskwn(siskwn) ,stat=stat)
1651 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1652 . msgtype=msgerror,
1653 . c1='ISKWN')
1654 ALLOCATE(ibcslag(sibcslag) ,stat=stat)
1655 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1656 . msgtype=msgerror,
1657 . c1='IBCSLAG')
1658 ALLOCATE(ipart(sipart) ,stat=stat)
1659 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1660 . msgtype=msgerror,
1661 . c1='IPART')
1662 ALLOCATE(npc(snpc) ,stat=stat)
1663 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1664 . msgtype=msgerror,
1665 . c1='NPC')
1666 ALLOCATE(ixtg(sixtg) ,stat=stat)
1667 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1668 . msgtype=msgerror,
1669 . c1='IXTG')
1670 ALLOCATE(ixs(sixs) ,stat=stat)
1671 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1672 . msgtype=msgerror,
1673 . c1='IXS')
1674 ALLOCATE(ixq(sixq) ,stat=stat)
1675 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1676 . msgtype=msgerror,
1677 . c1='IXQ')
1678 ALLOCATE(ixc(sixc) ,stat=stat)
1679 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1680 . msgtype=msgerror,
1681 . c1='IXC')
1682 ALLOCATE(ixt(sixt) ,stat=stat)
1683 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1684 . msgtype=msgerror,
1685 . c1='IXT')
1686 ALLOCATE(ixp(sixp) ,stat=stat)
1687 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1688 . msgtype=msgerror,
1689 . c1='IXP')
1690 ALLOCATE(ixr(sixr) ,stat=stat)
1691 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1692 . msgtype=msgerror,
1693 . c1='IXR')
1694 ALLOCATE(itab(sitab) ,stat=stat)
1695 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1696 . msgtype=msgerror,
1697 . c1='ITAB')
1698 ALLOCATE(itabm1(sitabm1) ,stat=stat)
1699 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1700 . msgtype=msgerror,
1701 . c1='ITABM1')
1702 ALLOCATE(gjbufi(sgjbufi) ,stat=stat)
1703 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1704 . msgtype=msgerror,
1705 . c1='GJBUFI')
1706 ALLOCATE(laccelm(slaccelm) ,stat=stat)
1707 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1708 . msgtype=msgerror,
1709 . c1='LACCELM')
1710
1711 ALLOCATE(nom_opt(snom_opt) ,stat=stat)
1712 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1713 . msgtype=msgerror,
1714 . c1='NOM_OPT')
1715 ALLOCATE(inom_opt(0:sinom_opt) ,stat=stat)
1716 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1717 . msgtype=msgerror,
1718 . c1='INOM_OPT')
1719 ALLOCATE(nom_sect(snom_sect) ,stat=stat)
1720 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1721 . msgtype=msgerror,
1722 . c1='NOM_SECT')
1723 ALLOCATE(ixr_kj(5*(numelr+1)) ,stat=stat)
1724 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1725 . msgtype=msgerror,
1726 . c1='IXR_KJ')
1727 ALLOCATE(iworksh(3,numelc+numeltg) ,stat=stat)
1728 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1729 . msgtype=msgerror,
1730 . c1='IXC')
1731 IF(numelig3d > 0) THEN
1732 ALLOCATE(wige(numnod) ,stat=stat)
1733 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1734 . msgtype=msgerror,
1735 . c1='WIGE')
1736 deg_max=0
1737 ELSE
1738 ALLOCATE(wige(0) ,stat=stat)
1739 ENDIF
1740 ALLOCATE(r_skew(numelr) ,stat=stat)
1741 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1742 . msgtype=msgerror,
1743 . c1='R_SKEW')
1744C
1745 ALLOCATE(ibeam_vector(numelp) ,stat=stat)
1746 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1747 . msgtype=msgerror,
1748 . c1='IBEAM_VECTOR')
1749 ALLOCATE(rbeam_vector(3,numelp) ,stat=stat)
1750 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
1751 . msgtype=msgerror,
1752 . c1='RBEAM_VECTOR')
1753C
1754 IF(abs(isigi)==3.OR.abs(isigi)== 4.OR.abs(isigi)==5)THEN
1755 ALLOCATE (ptshel(numelc) ,stat=stat)
1756 ptshel = 0
1757 ALLOCATE (ptsh3n(numeltg) ,stat=stat)
1758 ptsh3n = 0
1759 ELSE
1760 ALLOCATE (ptshel(0) ,stat=stat)
1761 ALLOCATE (ptsh3n(0) ,stat=stat)
1762 END IF
1763C --- Initialisations
1764 IF(sicode > 0) icode = 0
1765 IF(siskew > 0) iskew = 0
1766 IF(siskwn > 0) iskwn = 0
1767 IF(sibcslag > 0) ibcslag = 0
1768 IF(sipart > 0) ipart = 0
1769 IF(snpc > 0) npc = 0
1770 IF(sitab > 0) itab = 0
1771 IF(sitabm1 > 0) itabm1 = 0
1772 IF(sgjbufi > 0) gjbufi = 0
1773 IF(slaccelm > 0) laccelm = 0
1774 IF(snom_opt > 0) nom_opt = 0
1775 IF(sinom_opt > 0) inom_opt = 0
1776 IF(numelr > 0) ixr_kj = 0
1777 IF(numelc+numeltg > 0) iworksh = 0
1778 IF(numelr > 0) r_skew = 0
1779 IF(numelp > 0) ibeam_vector(1:numelp) = zero
1780 IF(numelp > 0) rbeam_vector(1:3,1:numelp) = zero
1781C
1782C--- Pointers: sub-arrays
1783 IF(siskwn-siframe<siskwn) THEN
1784 iframe => iskwn(siskwn-siframe+1:siskwn)
1785 ELSE
1786 iframe => iskwn
1787 END IF
1788
1789 ! ---------------------
1790 inter_cand%S_IXINT_2 = 0
1791 ALLOCATE( inter_cand%ADDRESS(ninter+1) )
1792 inter_cand%ADDRESS(1:ninter+1) = 0
1793 ! ---------------------
1794
1795!--- NEW DATA STRUCTE ALLOCATION FOR GROUPS OF ENTITIES
1796 ALLOCATE(subsets(nsubs))
1797 subsets(1:nsubs)%ID=0
1798 ALLOCATE(igrnod(ngrnod+nsets))
1799 ALLOCATE(igrbric(ngrbric+nsets))
1800 ALLOCATE(igrquad(ngrquad+nsets))
1801 ALLOCATE(igrsh4n(ngrshel+nsets))
1802 ALLOCATE(igrsh3n(ngrsh3n+2*nsets))
1803 ALLOCATE(igrtruss(ngrtrus+nsets))
1804 ALLOCATE(igrbeam(ngrbeam+nsets))
1805 ALLOCATE(igrspring(ngrspri+nsets))
1806 ALLOCATE(igrpart(ngrpart+nsets))
1807 ALLOCATE(igrsurf(nsurf+nsets))
1808 ALLOCATE(igrsurf_proc(nsurf+nsets,nspmd))
1809 ALLOCATE(igrslin(nslin+nsets))
1810 igrnod(1:ngrnod+nsets)%ID = 0
1811 igrnod(1:ngrnod+nsets)%NENTITY = 0
1812 igrnod(1:ngrnod+nsets)%GRTYPE = 0
1813 igrnod(1:ngrnod+nsets)%SORTED = 0
1814 igrnod(1:ngrnod+nsets)%GRPGRP = 0
1815 igrnod(1:ngrnod+nsets)%LEVEL = 0
1816 igrnod(1:ngrnod+nsets)%R2R_ALL = 0
1817 igrnod(1:ngrnod+nsets)%R2R_SHARE = 0
1818
1819
1820
1821 igrbric(1:ngrbric+nsets)%NENTITY = 0
1822 igrquad(1:ngrquad+nsets)%NENTITY = 0
1823 igrsh4n(1:ngrshel+nsets)%NENTITY = 0
1824 igrsh3n(1:ngrsh3n+2*nsets)%NENTITY = 0
1825 igrtruss(1:ngrtrus+nsets)%NENTITY = 0
1826 igrbeam(1:ngrbeam+nsets)%NENTITY = 0
1827 igrspring(1:ngrspri+nsets)%NENTITY = 0
1828 igrpart(1:ngrpart+nsets)%NENTITY = 0
1829!-- variable initialization to not printout the empty SET groups
1830 igrnod(1:ngrnod+nsets)%SET_GROUP = 0
1831 igrbric(1:ngrbric+nsets)%SET_GROUP = 0
1832 igrquad(1:ngrquad+nsets)%SET_GROUP = 0
1833 igrsh4n(1:ngrshel+nsets)%SET_GROUP = 0
1834 igrsh3n(1:ngrsh3n+2*nsets)%SET_GROUP = 0
1835 igrtruss(1:ngrtrus+nsets)%SET_GROUP = 0
1836 igrbeam(1:ngrbeam+nsets)%SET_GROUP = 0
1837 igrspring(1:ngrspri+nsets)%SET_GROUP = 0
1838 igrpart(1:ngrpart+nsets)%SET_GROUP = 0
1839 igrsurf(1:nsurf+nsets)%SET_GROUP = 0
1840 igrslin(1:nslin+nsets)%SET_GROUP = 0
1841
1842 igrsurf(1:nsurf+nsets)%NSEG = 0
1843 igrsurf(1:nsurf+nsets)%NSEG_IGE = 0
1844 igrsurf(1:nsurf+nsets)%SET_GROUP = 0
1845 igrsurf(1:nsurf+nsets)%NB_MADYMO = 0
1846 igrsurf(1:nsurf+nsets)%NSEG_R2R_ALL = 0
1847 igrsurf(1:nsurf+nsets)%NSEG_R2R_SHARE = 0
1848 igrsurf(1:nsurf+nsets)%EXT_ALL = 0
1849!--
1850! IF(NBOX > 0) CALL MY_ALLOC(IGRBOX,NBOX)
1851C ipart
1852216 l0 = sipart0
1853 l1 = l0 + sipartth
1854 l2 = l1 + siparts
1855 l3 = l2 + sipartq
1856 l4 = l3 + sipartc
1857 l5 = l4 + sipartt
1858 l6 = l5 + sipartp
1859 l7 = l6 + sipartr
1860 l8 = l7 + 0
1861 l9 = l8 + sipartg
1862 l10= l9 + sipartx
1863 l11= l10+ sipartsp
1864 l12= l11+ sipartig3d
1865 IF(l1>l0) THEN
1866 ipartth => ipart(l0+1:l1)
1867 ELSE
1868 ipartth => ipart
1869 END IF
1870 IF(l2>l1) THEN
1871 iparts => ipart(l1+1:l2)
1872 ELSE
1873 iparts => ipart
1874 END IF
1875 IF(l3>l2) THEN
1876 ipartq => ipart(l2+1:l3)
1877 ELSE
1878 ipartq => ipart
1879 END IF
1880 IF(l4>l3) THEN
1881 ipartc => ipart(l3+1:l4)
1882 ELSE
1883 ipartc => ipart
1884 END IF
1885 IF(l5>l4) THEN
1886 ipartt => ipart(l4+1:l5)
1887 ELSE
1888 ipartt => ipart
1889 END IF
1890 IF(l6>l5) THEN
1891 ipartp => ipart(l5+1:l6)
1892 ELSE
1893 ipartp => ipart
1894 END IF
1895 IF(l7>l6) THEN
1896 ipartr => ipart(l6+1:l7)
1897 ELSE
1898 ipartr => ipart
1899 END IF
1900 IF(l9>l8) THEN
1901 ipartg => ipart(l8+1:l9)
1902 ELSE
1903 ipartg => ipart
1904 END IF
1905 IF(l10>l9) THEN
1906 ipartx => ipart(l9+1:l10)
1907 ELSE
1908 ipartx => ipart
1909 END IF
1910 IF(l11>l10) THEN
1911 ipartsp=> ipart(l10+1:l11)
1912 ELSE
1913 ipartsp => ipart
1914 END IF
1915 IF(l12>l11) THEN
1916 ipartig3d=> ipart(l11+1:l12)
1917 ELSE
1918 ipartig3d => ipart
1919 END IF
1920 IF(flag_goto==1) GOTO 217
1921c
1922 IF(nfunct+2<=snpc-nfunct) THEN
1923 npc1 => npc(nfunct+2:snpc-nfunct)
1924 snpc1 = snpc-2*nfunct+1
1925 ELSE
1926 npc1 => npc
1927 snpc1 = snpc
1928 END IF
1929
1930212 IF(sixs0+sixs10>sixs0) THEN
1931 ixs10 => ixs(sixs0+1:sixs0+sixs10)
1932 ELSE
1933c IXS10 => IXS
1934c NULLIFY(IXS10)
1935 ALLOCATE(ixs10(1))
1936 END IF
1937 IF(sixs0+sixs10+sixs20>sixs0+sixs10) THEN
1938 ixs20 => ixs(sixs0+sixs10+1:sixs0+sixs10+sixs20)
1939 ELSE
1940c IXS20 => IXS
1941 ALLOCATE(ixs20(1))
1942 END IF
1943 IF(sixs>sixs0+sixs10+sixs20) THEN
1944 ixs16 => ixs(sixs0+sixs10+sixs20+1:sixs)
1945 ELSE
1946c IXS16 => IXS
1947c NULLIFY(IXS16)
1948 ALLOCATE(ixs16(1))
1949 END IF
1950 pixs10 = min(sixs,sixs0+1 )
1951 pixs20 = min(sixs,sixs0+sixs10+1 )
1952 pixs16 = min(sixs,sixs0+sixs10+sixs20+1)
1953
1954 IF(flag_goto==1) GOTO 213
1955C
1956C .. TO BE MAINTAINED (cf doc/inom_opt.txt) ..
1957210 inom_opt(1) = nrbody
1958 inom_opt(2) = inom_opt(1) + naccelm
1959 inom_opt(3) = inom_opt(2) + nvolu + nmonvol
1960 inom_opt(4) = inom_opt(3) + ninter
1961 inom_opt(5) = inom_opt(4) + nintsub
1962 inom_opt(6) = inom_opt(5) + nrwall
1963 inom_opt(7) = inom_opt(6) + 0 !obsolete option removed
1964 inom_opt(8) = inom_opt(7) + njoint
1965 inom_opt(9) = inom_opt(8) + nsect
1966 inom_opt(10)= inom_opt(9) + nlink
1967 inom_opt(11)= inom_opt(10)+ numskw+1+numfram+1+nsubmod
1968 inom_opt(12)= inom_opt(11)+ nfxbody
1969 inom_opt(13)= inom_opt(12)+ nflow
1970 inom_opt(14)= inom_opt(13)+ nrbe2
1971 inom_opt(15)= inom_opt(14)+ nrbe3
1972C
1973 inom_opt(16)= inom_opt(15)+ nfxvel
1974 inom_opt(17)= inom_opt(16)+ numbcs + numbcsn
1975 inom_opt(18)= inom_opt(17)+ nummpc
1976 inom_opt(19)= inom_opt(18)+ ngjoint
1977 inom_opt(20)= inom_opt(19)+ nunit0
1978 inom_opt(21)= inom_opt(20)+ nfunct
1979 inom_opt(22)= inom_opt(21)+ nadmesh
1980 inom_opt(23)= inom_opt(22)+ nsphio
1981 inom_opt(24)= inom_opt(23)+ nspcond
1982 inom_opt(25)= inom_opt(24)+ nebcs
1983 inom_opt(26)= inom_opt(25)+ ninicrack
1984 inom_opt(27)= inom_opt(26)+ nodmas
1985 inom_opt(28)= inom_opt(27)+ nbgauge
1986 inom_opt(29)= inom_opt(28)+ ncluster
1987 inom_opt(30)= inom_opt(29)+ ninterfric
1988 inom_opt(31)= inom_opt(30)+ nrbmerge
1989 inom_opt(32)= inom_opt(31)+ nslipring
1990 inom_opt(33)= inom_opt(32)+ nretractor
1991C
1992 IF(flag_goto==1) GOTO 211
1993
1994 CALL anodin( numnod)
1995 IF(npart==0) THEN
1996 CALL apartin(npart+1)
1997 ELSE
1998 CALL apartin(npart)
1999 END IF
2000C--------------------------------------------
2001C READING FUNCTIONS & TABLES
2002C--------------------------------------------
2003 err_msg='FUNCTIONS & TABLES'
2004 err_category='FUNCTIONS & TABLES'
2005 CALL trace_in1(err_msg,len_trim(err_msg))
2006c
2007 python%nb_functs = 0
2008 IF(nfunct > 0 .OR. ntable > 0) THEN
2009C
2010C NTABLE = NFUNCT + ...
2011 WRITE(istdo,'(A)')' .. FUNCTIONS & TABLES'
2012 ALLOCATE(table(ntable) ,stat=stat)
2013 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2014 . msgtype=msgerror,
2015 . c1='TABLE')
2016 CALL table_zero(table)
2017 IF(nfunct > 0) THEN
2018 err_msg='FUNCTIONS'
2019 CALL trace_in1(err_msg,len_trim(err_msg))
2020 ALLOCATE(tf(npts) ,stat=stat)
2021 ALLOCATE(funcrypt(nfunct) ,stat=stat)
2022 funcrypt = 0
2023 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2024 . msgtype=msgerror,
2025 . c1='TF')
2026 IF(npts > 0) tf = 0
2027 CALL hm_read_funct(npc ,tf ,nfunct ,table, npts,
2028 . nom_opt(lnopt1*inom_opt(20)+1) ,funcrypt, unitab, lsubmodel)
2029 CALL trace_out1()
2030 END IF
2031C TABLES
2032 err_msg='TABLES 1'
2033 CALL trace_in1(err_msg,len_trim(err_msg))
2034 CALL hm_read_table1 (ntable, table ,nfunct ,npc ,tf ,
2035 . nom_opt(lnopt1*inom_opt(20)+1), unitab, lsubmodel)
2036
2037 CALL hm_read_funct_python(python,npc,snpc,nfunct,lsubmodel,nsubmod,tf,npts,table, ntable)
2038 CALL chkfunct (nfunct, npc,nom_opt(lnopt1*inom_opt(20)+1))
2039 IF(nfunct > 0) THEN
2040 CALL hm_read_move_funct(npc ,tf ,nfunct ,table, ntable,funcrypt, unitab, lsubmodel)
2041 DEALLOCATE(funcrypt)
2042 END IF
2043 CALL hm_read_table2 (ntable, table ,nfunct , unitab, lsubmodel )
2044 CALL trace_out1()
2045 ELSE
2046C TABLES
2047 err_msg='TABLES 0'
2048 CALL trace_in1(err_msg,len_trim(err_msg))
2049 npts = 0
2050 ALLOCATE(tf(npts) ,stat=stat)
2051 ALLOCATE(table(0) ,stat=stat)
2052 CALL trace_out1()
2053 ENDIF
2054
2055
2056 stf = npts
2057
2058 CALL trace_out1()
2059C--------------------------------------------
2060C READING 2D FUNCTIONS
2061C--------------------------------------------
2062 ALLOCATE(func2d(nfunc2d))
2063 IF(nfunc2d > 0) THEN
2064 CALL hm_read_func2d(func2d, lsubmodel, unitab)
2065 ENDIF
2066C--------------------------------------------
2067C STOCKAGE DYNAMIQUE (GENERAL) REEL - suite
2068C-------------------------------------------
2069 err_msg='DYNAMIC STORAGE'
2070 err_msg='INTERNAL'
2071 CALL trace_in1(err_msg,len_trim(err_msg))
2072 spm = nummat*npropm
2073 sskew = lskew*(numskw+1)
2074 IF(nspcond > 0) sskew = sskew + lskew*numsph
2075 IF(nsubmod > 0) sskew = sskew + lskew*nsubmod
2076 sxframe = nxframe*(numfram+1)
2077 sskew = sskew + sxframe
2078 sgeo = numgeo*npropg
2079 seani = numels+numelq+numelc+numeltg
2080 ishif = numels+numelq+numelc
2081
2082 ALLOCATE(pm(spm) ,stat=stat)
2083 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='PM')
2084 ALLOCATE(geo(sgeo),stat=stat)
2085 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='GEO')
2086c in the skew, we put all the skews of the model
2087 ALLOCATE(skew(sskew) ,stat=stat)
2088 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='SKEW')
2089 IF(sskew-sxframe<sskew) THEN
2090 xframe => skew(sskew-sxframe+1:sskew)
2091 ELSE
2092 xframe => skew
2093 END IF
2094c ALLOCATE(XFRAME(SXFRAME) ,STAT=stat)
2095 ALLOCATE(eani(seani) ,stat=stat)
2096 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='EANI')
2097 IF(seani > 0) eani = 0
2098 IF(numeltg > 0) THEN
2099 eanit => eani(ishif+1:seani)
2100 ELSE
2101 eanit => eanit2
2102 ENDIF
2103 pm = 0
2104 skew = 0
2105 geo = 0
2106 ishif =numels+numelq+numelc
2107 CALL trace_out1()
2108C--------------------------------------------
2109 err_msg='KINEMATIC INITIALIZATION'
2110 CALL trace_in1(err_msg,len_trim(err_msg))
2111 CALL kinini(d )
2112 CALL trace_out1()
2113C--------------------------------------------
2114C READING MATERIALS
2115C--------------------------------------------
2116 err_msg='MATERIALS'
2117 err_category='MATERIALS'
2118 CALL trace_in1(err_msg,len_trim(err_msg))
2119 CALL sav_buf_point(npc,5)
2120 CALL sav_buf_point(tf,6)
2121 WRITE(istdo,'(A)')titre(11)
2122 srwork = max(nummat*10000,1000000)
2123 sbufmat = 0
2124 ALLOCATE(rwork(srwork) ,stat=stat)
2125 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='RWORK')
2126 IF(srwork > 0) rwork = zero
2127c------------------------------------
2128 ALLOCATE(mtag_ini(nummat))
2129 ALLOCATE(mparam_ini(nummat))
2130 CALL init_mlaw_tag(mtag_ini,nummat)
2131 mat_elem%MAT_PARAM(1:nummat) => mparam_ini(1:nummat)
2132 mlaw_tag(1:nummat) => mtag_ini(1:nummat)
2133 nloc_dmg%IMOD = 0
2134c---------------------------------------------------------------
2135 CALL read_material_models(
2136 . mat_elem ,mlaw_tag ,fail_tag ,eos_tag ,
2137 . rwork ,srwork ,ipm ,pm ,unitab ,
2138 . multi_fvm ,failwave ,nloc_dmg ,lsubmodel ,table ,
2139 . ltitr ,userl_avail,mat_number,
2140 . npc ,tf ,snpc ,npts ,sbufmat )
2141c---------------------------------------------------------------
2142 ALLOCATE(bufmat(sbufmat) ,stat=stat)
2143 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2144 . msgtype=msgerror,
2145 . c1='BUFMAT')
2146 bufmat = rwork(1:sbufmat)
2147 IF(ALLOCATED(rwork)) DEALLOCATE(rwork)
2148 CALL trace_out1()
2149c
2150 err_msg='STORAGE'
2151 err_msg='INTERNAL'
2152 CALL trace_in1(err_msg,len_trim(err_msg))
2153c
2154 CALL titre3
2155C--------------------------------------------
2156C INITIALIZATION OF USER POINTERS
2157C--------------------------------------------
2158 CALL sav_buf_point(pm ,1)
2159 CALL sav_buf_point(bufmat ,2)
2160 CALL sav_buf_point(geo ,3)
2161C CALL SAV_BUF_POINT(AM(M26),4)
2162cma53a1 !!!!!!! a faire
2163 CALL sav_buf_point(iskwn ,7)
2164 CALL sav_buf_point(skew ,8)
2165 CALL sav_buf_point(ipm ,11)
2166 CALL sav_buf_point(igeo,12)
2167 CALL trace_out1()
2168C--------------------------------------------
2169C READ NODES / CNODES / BUILD GHOST NODES
2170C--------------------------------------------
2171C NODES
2172 err_msg='NODES'
2173 err_category='NODES'
2174 CALL trace_in1(err_msg,len_trim(err_msg))
2175 ALLOCATE(cmerge(numcnod),stat=stat)
2176 IF(stat /= 0) THEN
2177 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,
2178 . c1='CMERGE')
2179 ENDIF
2180 cmerge = zero
2181C
2182 WRITE(istdo,'(A)')titre(12)
2183 CALL hm_read_node(x ,itab ,itabm1 ,cmerge ,unitab ,
2184 . wige ,lsubmodel,is_dyna)
2185
2186 CALL trace_out1()
2187C--------------------------------------------
2188C READING SUBMODELS & SUBMODEL TRANSFORMATION
2189C--------------------------------------------
2190 err_msg='SUBMODELS'
2191 err_category='SUBMODELS'
2192 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2193 . msgtype=msgerror)
2194 CALL trace_in1(err_msg,len_trim(err_msg))
2195 srtrans = nrtrans * ntransf
2196 ALLOCATE(rtrans(srtrans) ,stat=stat)
2197 IF(srtrans > 0) rtrans = zero
2198
2199 IF(nsubmod > 0)THEN
2200 WRITE(istdo,'(A)')' .. SUBMODELS'
2201 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2202 . msgtype=msgerror,
2203 . c1='RTRANS')
2204 CALL lectranssub(x ,igrnod ,itab ,itabm1 ,unitab,
2205 . rtrans ,lsubmodel,is_dyna)
2206 CALL lecsubmod(isubmod,x,unitab,itabm1,rtrans,itab,lsubmodel,is_dyna)
2207 ENDIF
2208
2209 CALL trace_out1()
2210C--------------------------------------------
2211C READING OBLIQUE COORDINATE SYSTEMS
2212C + READING REFERENCE FRAMES
2213C--------------------------------------------
2214C SKEWS
2215 err_msg='SKEWS'
2216 err_category='SKEWS'
2217 CALL trace_in1(err_msg,len_trim(err_msg))
2218 IF(numskw/=0)WRITE(istdo,'(A)')titre(14)
2219 CALL hm_read_skw(skew ,iskwn ,x ,
2220 . itab ,itabm1 ,bid13 ,
2221 . lsubmodel,rtrans,
2222 . nom_opt(lnopt1*inom_opt(10)+1),unitab)
2223C
2224 CALL hm_read_frm(iskwn ,x ,itab ,itabm1 ,xframe ,
2225 . lsubmodel,rtrans,
2226 . nom_opt(lnopt1*inom_opt(10)+1),unitab)
2227 CALL trace_out1()
2228C--------------------------------------------
2229C PRE-READING PLY DEFINITIONS
2230C--------------------------------------------
2231 IF(ndrape > 0) THEN
2232 ALLOCATE(idrapeid(ndrape) ,stat=stat)
2233 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2234 . msgtype=msgerror,
2235 . c1='DRAPE')
2236 idrapeid = 0
2237 CALL hm_read_prelecdrape(idrapeid,lsubmodel)
2238 ELSE
2239 ALLOCATE(idrapeid(0))
2240 ENDIF
2241C--------------------------------------------
2242C READING PROPERTIES
2243C--------------------------------------------
2244 IF(nsphsol/=0)THEN
2245 CALL hm_preread_part(ipart,igeo,lsubmodel)
2246 END IF
2247C--------------------------------------------
2248 nrbag=0
2249 sbufgeo = 0
2250C PROPERTIES
2251 err_msg='PROPERTIES'
2252 err_category='PROPERTIES'
2253 CALL trace_in1(err_msg,len_trim(err_msg))
2254c
2255 IF(numgeo > 0)THEN
2256 WRITE(istdo,'(A)')titre(31)
2257 srwork = numgeo*(bgeosize+maxfunc+maxmat+maxpid+maxtab)
2258 sbufgeo = 0
2259 ALLOCATE(dbrwork(srwork) ,stat=stat)
2260 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2261 . msgtype=msgerror,
2262 . c1='DBRWORK')
2263 dbrwork = zero
2264 ALLOCATE(knot(sknot) ,stat=stat)
2265 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2266 . msgtype=msgerror,
2267 . c1='KNOT')
2268 CALL sav_buf_point(dbrwork,4)
2269C
2270 iadgeo=1
2271 CALL hm_read_properties(geo , x , ixc , pm ,itabm1 ,
2272 . dbrwork , sbufgeo , iskwn , igeo ,ipm ,
2273 . npc , tf , unitab , rtrans ,lsubmodel ,
2274 . prop_tag , ipart , knot , idrapeid ,stack_info,
2275 . numgeostack, nprop_stack , multi_fvm, iadgeo ,defaults)
2276C
2277 ALLOCATE(bufgeo(sbufgeo) ,stat=stat)
2278 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2279 . msgtype=msgerror,
2280 . c1='BUFGEO')
2281 bufgeo(1:sbufgeo) = dbrwork(1:sbufgeo)
2282 DEALLOCATE(dbrwork)
2283 CALL sav_buf_point(bufgeo,4)
2284 ELSE
2285 ALLOCATE(bufgeo(sbufgeo) ,stat=stat)
2286 ENDIF
2287C
2288 IF(numply /= 0) THEN
2289 ALLOCATE(ply_info(3,numply),stat=stat)
2290 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2291 . msgtype=msgerror,
2292 . c1='PLY')
2293 ply_info = 0
2294 ELSE
2295 ALLOCATE(ply_info(0,0))
2296 ENDIF
2297c
2298 IF(numstack > 0) THEN
2299C pre-reading
2300 len_g = npropgi*(numstack + numply)
2301 ALLOCATE(igeo_stack(len_g),stat=stat)
2302 igeo_stack = 0
2303 len_g = npropg*(numstack + numply )
2304 ALLOCATE(geo_stack(len_g),stat=stat)
2305 geo_stack = zero
2306 CALL lecstack_ply(geo_stack ,x ,ixc ,pm ,itabm1 ,
2307 . iskwn ,igeo_stack ,ipm ,npc ,tf ,
2308 . unitab , rtrans ,lsubmodel,ipart ,idrapeid,
2309 . ply_info ,stack_info,numgeostack, nprop_stack ,
2310 . defaults )
2311 ELSE
2312 ALLOCATE(igeo_stack(0),stat=stat)
2313 ALLOCATE(geo_stack(0),stat=stat)
2314 ENDIF
2315C-----allocate DR if necessary------
2316 IF(sdr==0 .AND. idrot == 1) THEN
2317 sdr = 3*numnod*max(iroddl,iroddl0)
2318 IF(ALLOCATED(dr)) DEALLOCATE(dr)
2319 ALLOCATE(dr(sdr) ,stat=stat)
2320 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2321 . msgtype=msgerror)
2322 dr = zero
2323 ENDIF
2324C
2325
2326C print*, 'NPINCH', NPINCH, 'NUMNOD', NUMNOD
2327 spinch= npinch
2328C print*, SPINCH
2329 ALLOCATE(pinch_data%XPINCH(3,spinch) ,stat=stat)
2330 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2331 . msgtype=msgerror,
2332 . c1='XPINCH')
2333 ALLOCATE(pinch_data%DPINCH(3,spinch) ,stat=stat)
2334 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2335 . msgtype=msgerror,
2336 . c1='DPINCH')
2337 ALLOCATE(pinch_data%VPINCH(3,spinch) ,stat=stat)
2338 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2339 . msgtype=msgerror,
2340 . c1='VPINCH')
2341 ALLOCATE(pinch_data%MSPINCH(spinch) ,stat=stat)
2342 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2343 . msgtype=msgerror,
2344 . c1='MSPINCH')
2345C
2346 IF(npinch > 0) THEN
2347 pinch_data%XPINCH(1:3,1:spinch) = zero
2348 pinch_data%DPINCH(1:3,1:spinch) = zero
2349 pinch_data%VPINCH(1:3,1:spinch) = zero
2350 pinch_data%MSPINCH(1:spinch) = zero
2351 ENDIF
2352C
2353 CALL trace_out1()
2354C-----------------------------------------------------
2355C READING PARTS
2356C REPLACEMENT OF EXTERNAL MATERIAL NUMBERS
2357C REPLACEMENT OF EXTERNAL PROPERTY NUMBERS
2358C BY INTERNAL NUMBERS
2359C-----------------------------------------------------
2360 err_msg='PARTS'
2361 err_category='PARTS'
2362 CALL trace_in1(err_msg,len_trim(err_msg))
2363 siwork = max(2*numels,2*numelq,3*(npart+nthpart),3*numskw,numels,
2364 * numelc,numeltg,nummat+numgeo,numelt+numelp+numelr+
2365 * numelx+numelig3d)
2366 ALLOCATE(iwork(siwork) ,stat=stat)
2367 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2368 . msgtype=msgerror,
2369 . c1='IWORK')
2370 iwork = 0
2371 ALLOCATE(thk_part(npart) ,stat=stat)
2372C
2373 CALL hm_read_part(ipart ,pm ,geo ,ipm ,igeo ,iwork ,thk_part,
2374 . unitab,lsubmodel,multi_fvm ,mlaw_tag,mat_elem%MAT_PARAM,glob_therm)
2375
2376 CALL trace_out1()
2377
2378C--------------------------------------------
2379C STOCKAGE DYNAMIQUE (A.L.E.) ENTIER
2380C--------------------------------------------
2381 ale%GLOBAL%SNALE = max(iale,ieuler,ialelag)*numnod
2382 ale%GLOBAL%SIELVS = 6*numels+max(iale,glob_therm%ITHERM,ieuler,ialelag)* (4 * numelq + 3 * numeltg)
2383 sifill = nmult*numnod
2384 sims = nmult*numnod
2385C---
2386 ALLOCATE(ifill(sifill),stat=stat)
2387 IF(stat /= 0) CALL ancmsg(msgid = 268,
2388 . anmode = aninfo,
2389 . msgtype = msgerror,
2390 . c1 = 'IFILL')
2391
2392 ALLOCATE(ims(sims),stat=stat)
2393 IF(stat /= 0) CALL ancmsg(msgid = 268,
2394 . anmode = aninfo,
2395 . msgtype = msgerror,
2396 . c1 = 'IMS')
2397
2398
2399 IF(sifill > 0) ifill = 0
2400 IF(sims > 0) ims = 0
2401
2402 ALLOCATE(dflow(3*numnod*ialelag) ,stat=stat)
2403 ALLOCATE(vflow(3*numnod*ialelag) ,stat=stat)
2404 ALLOCATE(wflow(3*numnod*ialelag) ,stat=stat)
2405
2406 IF(ialelag > 0) THEN
2407 dflow = zero
2408 vflow = zero
2409 wflow = zero
2410 ENDIF
2411
2412 IF(alefvm_param%IEnabled > 0)THEN
2413 ALLOCATE(alefvm_buffer%FCELL(6,numels) ,stat=stat)
2414 alefvm_buffer%FCELL(:,:) = zero
2415 ENDIF
2416
2417C----------------------------------
2418C--------------------------------------------
2419C MULTIDOMAINS
2420C--------------------------------------------
2421 err_msg='MULTIDOMAINS'
2422 err_category='MULTIDOMAINS'
2423 CALL trace_in1(err_msg,len_trim(err_msg))
2424 nr2r = 5
2425 r2r_siu = 0
2426 siexlnk = nr2r*nr2rlnk
2427 IF((nr2rlnk+nsubdom)>0) THEN
2428 ALLOCATE(iexlnk(siexlnk) ,stat=stat)
2429 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2430 . msgtype=msgerror,
2431 . c1='IEXLNK')
2432 iexlnk = 0
2433 WRITE(istdo,'(A)') ' .. EXTERNAL COUPLING'
2434 CALL lecextlnk(iexlnk,ipart,lsubmodel)
2435 nl_ddr2r = nr2rlnk
2436 ELSE
2437 ALLOCATE(iexlnk(0))
2438 ENDIF
2439 IF(nsubdom > 0) THEN
2440 ALLOCATE(tag_part(npart),ipart_r2r(4,npart))
2441 tag_part(:)=0
2442 CALL r2r_void(ipart)
2443 nl_ddr2r = 4
2444 r2r_siu = 1
2445c complete mlaw_tag for new void materials
2446 IF(nummat > nummat0) THEN
2447 ALLOCATE(mtag_r2r(nummat))
2448 ALLOCATE(mparam_r2r(nummat))
2449 CALL init_mlaw_tag(mtag_r2r ,nummat)
2450 mtag_r2r(1:nummat0) = mtag_ini(1:nummat0)
2451 CALL r2r_matparam_copy(mparam_r2r, mparam_ini ,nummat0 ,nummat)
2452 mlaw_tag(1:nummat) => mtag_r2r(1:nummat)
2453 mat_elem%MAT_PARAM(1:nummat) => mparam_r2r(1:nummat)
2454 mat_elem%NUMMAT = nummat
2455 DEALLOCATE(mtag_ini)
2456 IF(ALLOCATED(mparam_ini))THEN
2457 DO i=1,nummat0 ; CALL mparam_ini(i)%DESTRUCT() ; ENDDO
2458 DEALLOCATE(mparam_ini)
2459 ENDIF
2460 ENDIF
2461 ELSE
2462 ALLOCATE(tag_part(0),ipart_r2r(4,0))
2463 ENDIF
2464 CALL trace_out1()
2465C--------------------------------------------
2466C--------------------------------------------
2467C POIN UMP
2468C--------------------------------------------
2469! TABMP_L defined in tabsiz_c
2470 tabmp_l = 10
2471C
2472 CALL trace_in1(err_msg,len_trim(err_msg))
2473 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2474 . msgtype=msgerror,
2475 . c1='PARTS')
2476
2477 ALLOCATE( poin_part_shell(2,npart) )
2478 ALLOCATE( poin_part_tri(2,npart) )
2479 ALLOCATE( poin_part_sol(2,npart,7) )
2480 ALLOCATE( mid_pid_shell(nummat),mid_pid_tri(nummat) )
2481 ALLOCATE( mid_pid_sol(nummat,7) )
2482 poin_part_shell(1:2,1:npart) = 0
2483 poin_part_tri(1:2,1:npart) = 0
2484 poin_part_sol(1:2,1:npart,1:7) = 0
2485
2486 ALLOCATE(poin_ump(nummat), stat=stat)
2487 poin_ump(1:nummat) = 0
2488 ALLOCATE(tab_ump_loc(5,npart), stat=stat)
2489 tab_ump_loc(1:5,1:npart) = 0
2490C
2491 CALL set_poin_ump(ipart,ipm,tab_ump_loc,poin_ump,taille2)
2492 CALL trace_out1()
2493C--------------------------------------------
2494C READING SOLIDS
2495C--------------------------------------------
2496 err_msg='ELEMENTS'
2497 err_category='ELEMENTS'
2498 CALL trace_in1(err_msg,len_trim(err_msg))
2499 IF(numels/=0)THEN
2500 WRITE(istdo,'(A)')titre(15)
2501
2502 CALL hm_read_solid(ixs ,pm ,itab ,itabm1 ,
2503 . ipart ,iparts ,eani ,ixs10 ,ixs20 ,ixs16 ,
2504 . igeo ,lsubmodel,is_dyna,x )
2505
2506 ENDIF
2507 CALL trace_out1()
2508C--------------------------------------------
2509C READING 2D ELEMENTS
2510C--------------------------------------------
2511 IF(numelq/=0)THEN
2512 WRITE(istdo,'(A)')titre(16)
2513 CALL hm_read_quad(ixq ,itab ,itabm1 ,ipart ,ipartq ,
2514 . ipm ,igeo ,unitab ,lsubmodel)
2515 ENDIF
2516C--------------------------------------------
2517C READING SHELLS
2518C--------------------------------------------
2519 ALLOCATE(itag(numnod),stat=stat)
2520 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2521 . msgtype=msgerror,
2522 . c1='ITAG')
2523 itag=0
2524C
2525 IF(numelc/=0)THEN
2526 WRITE(istdo,'(A)')titre(17)
2527 CALL hm_read_shell(ixc ,itab ,itabm1 ,ipart ,ipartc ,
2528 . thke ,ipm ,igeo ,unitab ,itag ,sh4ang, lsubmodel)
2529 ENDIF
2530C
2531C WARNING, SHELL ELEMENTS ARE PERMUTED
2532C TO GENERATE OPTIMIZED GROUPS
2533C AFTER READING PIDs
2534C
2535C--------------------------------------------
2536C READING TRUSSES
2537C--------------------------------------------
2538 IF(numelt/=0)THEN
2539 WRITE(istdo,'(A)')titre(18)
2540 CALL hm_read_truss(ixt ,itab ,itabm1 ,ipart ,ipartt ,
2541 . ipm ,igeo ,lsubmodel)
2542 ENDIF
2543C--------------------------------------------
2544C READING BEAMS
2545C--------------------------------------------
2546 IF(numelp/=0)THEN
2547 WRITE(istdo,'(A)')titre(19)
2548 CALL hm_read_beam(ixp ,itab ,itabm1 ,ipart ,ipartp ,
2549 . ipm ,igeo ,lsubmodel,ibeam_vector,rbeam_vector)
2550 ENDIF
2551C--------------------------------------------
2552C READING SPRINGS
2553C--------------------------------------------
2554 reint = zero
2555 IF(numelr/=0)THEN
2556 WRITE(istdo,'(A)')titre(20)
2557 CALL hm_read_spring(ixr ,itab ,itabm1 ,ipart ,ipartr ,
2558 . igeo ,ixr_kj ,lsubmodel,iskwn,r_skew,ipm)
2559 ENDIF
2560C--------------------------------------------
2561C READING TRIANGULAR SHELLS
2562C--------------------------------------------
2563 IF(numeltg/=0)THEN
2564 IF(n2d==0 .AND. numeltria==0)THEN
2565 WRITE(istdo,'(A)')titre(21)
2566 CALL hm_read_sh3n( ixtg ,itab ,itabm1 ,ipart ,ipartg ,
2567 . thkec ,pm ,geo ,eanit ,igeo ,
2568 . ipm ,unitab ,sh3ang , lsubmodel)
2569 ELSEIF(numeltria==numeltg)THEN
2570 WRITE(istdo,'(A)')titre(23)
2571 CALL hm_read_tria(ixtg ,itab ,itabm1 ,ipart ,ipartg ,
2572 . pm ,geo ,eanit ,igeo ,ipm ,
2573 . unitab , lsubmodel)
2574 ELSE
2575 !check is IXTG array is used with proper modeling : 2D-TRIA or 3D-SH3N
2576 IF(numeltg>0 .AND. n2d>0 .AND. numeltria==0)THEN
2577 CALL ancmsg(msgid=66,
2578 . msgtype=msgerror,
2579 . anmode=aninfo,
2580 . c1='SH3N',
2581 . c2='2D-ANALYSIS'
2582 . )
2583 ELSEIF(numeltg>0 .AND. n2d==0 .AND. numeltria==numeltg)THEN
2584 CALL ancmsg(msgid=66,
2585 . msgtype=msgerror,
2586 . anmode=aninfo,
2587 . c1='TRIA',
2588 . c2='3D-ANALYSIS'
2589 . )
2590 ENDIF
2591 numeltg = 0
2592 ENDIF
2593 ENDIF
2594C--------------------------------------------
2595C Check XFEM FLAG
2596 IF(numeltg + numelc == 0) icrack3d = 0
2597C--------------------------------------------
2598C READING ISO-GEOMETRIC ELEMENTS
2599C--------------------------------------------
2600 nctrlmax = 0
2601 IF(numelig3d/=0)THEN
2602
2603 skxig3d = nixig3d*numelig3d
2604 WRITE(istdo,'(A)')titre(22)
2605
2606 CALL prelecig3d(sixig3d)
2607
2608 ALLOCATE(kxig3d(skxig3d) ,stat=stat)
2609 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2610 . msgtype=msgerror,
2611 . c1='KXIG3D')
2612 ALLOCATE(ixig3d(sixig3d+addsixig3d) ,stat=stat)
2613 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2614 . msgtype=msgerror,
2615 . c1='IXIG3D')
2616 ALLOCATE(tabconpatch(nbpart_ig3d),stat=stat)
2617 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2618 . msgtype=msgerror,
2619 . c1='TABCON_PATCH_IG3D')
2620 kxig3d = 0
2621 ixig3d = 0
2622 CALL lecig3d(
2623 . itab ,ipart ,ipartig3d ,ipm ,igeo ,
2624 . kxig3d ,ixig3d ,itabm1 ,nctrlmax,tabconpatch)
2625
2626 sknotlocpc = deg_max*3*(numnod+l_tab_newfct)*numgeo ! IL FAUDRAIT AVOIR ONE NOMBRE DE POINT IGE ET DES INDICES
2627cc Sknotlocpc est un peu surdimmensionne car il prend en compte les points de travail temporaire
2628 IF(sknotlocpc > intmax .OR. sknotlocpc < zero) THEN ! L_TAB_NEWFCT pour se laisser la taille de travail
2629 sknotlocpc = intmax
2630 ELSE
2631 sknotlocpc = int(sknotlocpc)
2632 ENDIF
2633 ALLOCATE(knotlocpc(sknotlocpc) ,stat=stat)
2634 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2635 . msgtype=msgerror,
2636 . c1='KNOTLOCPC')
2637 knotlocpc(:)=0
2638
2639 sknotlocel = 2*3*numelig3d
2640 IF(sknotlocel > intmax .OR. sknotlocel < zero) THEN
2641 sknotlocel = intmax
2642 ELSE
2643 sknotlocel = int(sknotlocel)
2644 ENDIF
2645 ALLOCATE(knotlocel(sknotlocel) ,stat=stat)
2646 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2647 . msgtype=msgerror,
2648 . c1='KNOTLOCEL')
2649 knotlocel(:)=0
2650
2651 CALL prerafig3d(knot,knotlocpc,knotlocel,
2652 . kxig3d,ixig3d,igeo,
2653 . ipartig3d,
2654 . x,v,d,ms,wige,tabconpatch,1)
2655c
2656 sixig3d=sixig3d+addsixig3d
2657 ALLOCATE(msig3d(numelig3d*nctrlmax) ,stat=stat)
2658 msig3d(1:numelig3d*nctrlmax) = zero
2659 ELSE
2660 ALLOCATE(kxig3d(0) ,stat=stat)
2661 ALLOCATE(msig3d(0) ,stat=stat)
2662 ALLOCATE(ixig3d(0) ,stat=stat)
2663 ALLOCATE(knotlocel(0) ,stat=stat)
2664 ALLOCATE(knotlocpc(0) ,stat=stat)
2665 ENDIF
2666C--------------------------------------------
2667C PRE-READING GRNOD/NODENS
2668C--------------------------------------------
2669 IF(numelx > 0 .AND. ngrnod > 0 )THEN
2670 WRITE(istdo,'(A)')' .. NODENS GROUP '
2671 CALL hm_prelecgrns(itabm1 ,igrnod, lsubmodel)
2672 ENDIF
2673C---------------------------------------------
2674C PRE-READING MULTI-PURPOSE ELEMENTS.
2675C---------------------------------------------
2676 err_msg='MULTI-PURPOSE ELEMENTS'
2677 err_category='MULTI-PURPOSE ELEMENTS'
2678 CALL trace_in1(err_msg,len_trim(err_msg))
2679 IF(numelx > 0) THEN
2680 skxx = nixx*numelx
2681 CALL hm_preread_xelem(sixx, igrnod,lsubmodel)
2682 ALLOCATE(kxx(skxx) ,stat=stat)
2683 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2684 . msgtype=msgerror,
2685 . c1='KXX')
2686 ALLOCATE(ixx(sixx+150) ,stat=stat)
2687 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2688 . msgtype=msgerror,
2689 . c1='IXX')
2690 kxx = 0
2691 ixx = 0
2692 ALLOCATE(lelx(numelx) ,stat=stat)
2693 lelx(1:numelx) = zero
2694 CALL hm_read_xelem(igrnod ,itab ,itabm1 ,ipart ,ipartx,
2695 . ipm ,igeo ,kxx ,ixx ,lsubmodel)
2696 ELSE
2697 skxx = 0
2698 sixx = 0
2699 ALLOCATE(kxx(skxx) ,stat=stat)
2700 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2701 . msgtype=msgerror,
2702 . c1='KXX')
2703 ALLOCATE(ixx(sixx) ,stat=stat)
2704 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2705 . msgtype=msgerror,
2706 . c1='IXX')
2707 ALLOCATE(lelx(numelx) ,stat=stat)
2708 ENDIF
2709 CALL trace_out1()
2710C--------------------------------------------
2711C ADAPTIVE MESHING
2712C--------------------------------------------
2713 err_msg='ADAPTIVE MESHING'
2714 err_category='ADAPTIVE MESHING'
2715 CALL trace_in1(err_msg,len_trim(err_msg))
2716 levelmax=0
2717 lsh4trim=0
2718 lsh3trim=0
2719 IF(nadmesh/=0)THEN
2720
2721 ALLOCATE(sh4tree(ksh4tree,numelc),stat=stat)
2722 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2723 . msgtype=msgerror,
2724 . c1='SH4TREE')
2725 sh4tree=0
2726 ALLOCATE(sh3tree(ksh3tree,numeltg),stat=stat)
2727 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2728 . msgtype=msgerror,
2729 . c1='SH3TREE')
2730 sh3tree=0
2731 ALLOCATE(ipadmesh(kipadmesh,npart),stat=stat)
2732 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2733 . msgtype=msgerror,
2734 . c1='IPADMESH')
2735 ipadmesh=0
2736
2737 ALLOCATE(padmesh(kpadmesh,npart),stat=stat)
2738 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2739 . msgtype=msgerror,
2740 . c1='PADMESH')
2741 padmesh=zero
2742
2743 CALL set_admesh(ipart ,ipadmesh,padmesh,unitab,lsubmodel )
2744
2745 IF(iadmstat/=0)THEN
2746 lsh4trim=numelc
2747 ALLOCATE(sh4trim(lsh4trim),stat=stat)
2748 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2749 . msgtype=msgerror,
2750 . c1='SH4TRIM')
2751 sh4trim=0
2752 lsh3trim=numeltg
2753 ALLOCATE(sh3trim(lsh3trim),stat=stat)
2754 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2755 . msgtype=msgerror,
2756 . c1='SH3TRIM')
2757 sh3trim=0
2758 CALL state_admesh(
2759 . ipart ,ipartc ,ipartg ,ixc ,ixtg ,
2760 . sh4tree, sh3tree, sh4trim, sh3trim,
2761 . lsubmodel)
2762 END IF
2763 CALL build_admesh(
2764 . ipart ,ipartc ,ipartg ,ixc ,ixtg ,
2765 . x ,itab ,itabm1 ,sh4tree, sh3tree,
2766 . ipadmesh,padmesh)
2767 ELSE
2768 ALLOCATE(sh4tree(0,0))
2769 ALLOCATE(sh3tree(0,0))
2770 ALLOCATE(ipadmesh(0,0))
2771 ALLOCATE(padmesh(0,0))
2772 ALLOCATE(sh4trim(0))
2773 ALLOCATE(sh3trim(0))
2774 END IF
2775
2776 IF(istatcnd/=0)THEN
2777 ALLOCATE(mscnd(numnod),incnd(numnod),stat=stat)
2778 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2779 . msgtype=msgerror,
2780 . c1='MSCND')
2781 mscnd=zero
2782 incnd=zero
2783 ELSE
2784 ALLOCATE(mscnd(0),incnd(0))
2785 END IF
2786 CALL trace_out1()
2787
2788C--------------------------------------------
2789C REINITIALISATION MAT/PROP
2790C--------------------------------------------
2791
2792 IF(taille2>0) THEN
2793 ALLOCATE(tab_ump_loc2(7+6,taille2,2),stat=stat)
2794 tab_ump_loc2 = 0
2795 CALL reini_matprop(taille,taille2,tab_ump_loc,tab_ump_loc2,
2796 . ixs,ixq,ixc,ixt,ixp,ixr,
2797 . ixtg,eani,poin_ump)
2798
2799 ALLOCATE( tab_ump(7,taille), stat=stat)
2800 tab_ump = 0
2801 IF(taille>0) THEN
2802 CALL reini_matprop2(taille,taille2,
2803 . tab_ump_loc,tab_ump_loc2,tab_ump,tab_sol,
2804 . poin_ump)
2805 ENDIF
2806 DEALLOCATE(tab_ump_loc2)
2807 ENDIF
2808 DEALLOCATE(tab_ump_loc)
2809C--------------------------------------------
2810C TABLEAUX X-FEM (SHELL 4-N + SHELL 3-N)
2811C xfem for crack propagation (mono + multi layer shells)
2812C--------------------------------------------
2813 IF(icrack3d > 0) THEN
2814 nxel = 3 ! nb of phantom elements within one layer (change to NXEL=3)
2815 xfemon = 1
2816 IF(ipari0 /= 1) ipari0=1 ! force flag parith/on pour XFEM (pareil engine)
2817 ELSE
2818 nxel = 0
2819 xfemon = 0
2820 ENDIF
2821C-----
2822 err_msg='XFEM FOR SHELLS - ALLOCATIONS'
2823 err_category='INTERNAL'
2824 CALL trace_in1(err_msg,len_trim(err_msg))
2825C-----
2826 len = xfemon*numnod
2827 ALLOCATE(addcne_crkxfem(0:len+1),stat=stat)
2828 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2829 . msgtype=msgerror,c1='ADDCNE_CRKXFEM')
2830 addcne_crkxfem(0:len+1) = 0
2831c
2832 ALLOCATE(itagn(len),stat=stat)
2833 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2834 . msgtype=msgerror,c1='ITAGN')
2835 ALLOCATE(inod_crkxfem(len),stat=stat)
2836 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2837 . msgtype=msgerror,c1='INOD_CRKXFEM')
2838 ALLOCATE(ibordnode(len),stat=stat)
2839 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,
2840 . msgtype=msgerror,c1='IBORDNODE')
2841 len = xfemon*(numelc+numeltg)
2842 sitage=len
2843 ALLOCATE(itage(len),stat=stat)
2844 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2845 . msgtype=msgerror,c1='ITAGE')
2846 ALLOCATE(iel_crkxfem(len),stat=stat)
2847 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2848 . msgtype=msgerror,c1='IEL_CRKXFEM')
2849c
2850 itagn = 0
2851 itage = 0
2852 inod_crkxfem = 0
2853 iel_crkxfem = 0
2854 ibordnode = 0
2855c
2856 CALL trace_out1()
2857C--------------------------------------------
2858C READING GLOBAL PARAMETERS + SPH PARTICLES.
2859C---------------------------------------------
2860 err_msg='SPH'
2861 err_category='SPH'
2862 CALL trace_in1(err_msg,len_trim(err_msg))
2863 IF(nsphsol/=0)THEN
2864 ALLOCATE(sph2sol(numsph) ,stat=stat)
2865 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2866 . msgtype=msgerror,
2867 . c1='SPH2SOL')
2868 sph2sol=0
2869 ALLOCATE(sol2sph(2*numels8) ,stat=stat)
2870 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2871 . msgtype=msgerror,
2872 . c1='SOL2SPH')
2873 sol2sph=0
2874 ALLOCATE(irst(3*nsphsol) ,stat=stat)
2875 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2876 . msgtype=msgerror,
2877 . c1='IRST')
2878 irst=0
2879 ALLOCATE(sol2sph_typ(numels8) ,stat=stat)
2880 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2881 . msgtype=msgerror,
2882 . c1='SOL2SPH_TYP')
2883 sol2sph_typ=0
2884 ELSE
2885 ALLOCATE(sph2sol(0) ,stat=stat)
2886 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2887 . msgtype=msgerror,
2888 . c1='SPH2SOL')
2889 ALLOCATE(sol2sph(0) ,stat=stat)
2890 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2891 . msgtype=msgerror,
2892 . c1='SOL2SPH')
2893 ALLOCATE(irst(0) ,stat=stat)
2894 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2895 . msgtype=msgerror,
2896 . c1='IRST')
2897 ALLOCATE(sol2sph_typ(0) ,stat=stat)
2898 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2899 . msgtype=msgerror,
2900 . c1='SOL2SPH_TYP')
2901 END IF
2902 IF(numsph > 0) THEN
2903 sspbuf = nspbuf*numsph
2904 skxsp = nisp*numsph
2905 sixsp = kvoisph*numsph
2906c test with INTEGER 64 bits to avoid integer 32 bits overflow with huge cases (10 Millions SPH cells)
2907 kvoisph8 = kvoisph
2908 numsph8 = numsph
2909
2910c limit INTEGER 32 bits ((2^31)-1), we add a security marge of 5%
2911 sixsp8 = (numsph8/(nspmd))*kvoisph8
2912 limit8 = (huge(integer_limit32)-1)*0.95!((2**31)-1)*0.95
2913 IF(sixsp8>limit8)THEN
2914 CALL ancmsg(msgid=981,
2915 . msgtype=msgerror,
2916 . anmode=anstop)
2917 ENDIF
2918
2919 snod2sp = numnod
2920 ALLOCATE(kxsp(skxsp) ,stat=stat)
2921 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2922 . msgtype=msgerror,
2923 . c1='KXSP')
2924 ALLOCATE(ixsp(kvoisph,numsph) ,stat=stat)
2925 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2926 . msgtype=msgerror,
2927 . c1='IXSP')
2928 ALLOCATE(nod2sp(snod2sp) ,stat=stat)
2929 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2930 . msgtype=msgerror,
2931 . c1='NOD2SP')
2932 ALLOCATE(spbuf(sspbuf) ,stat=stat)
2933 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2934 . msgtype=msgerror,
2935 . c1='SPBUF')
2936
2937 IF(nsphio>0.AND.nbpartinlet>0)THEN
2938 ALLOCATE(reservep(nbpartinlet) ,stat=stat)
2939 IF(stat /= 0) CALL ancmsg(msgid=268,
2940 . anmode=anstop,
2941 . msgtype=msgerror,
2942 . c1='RESERVEP')
2943 reservep(1:nbpartinlet) = 0
2944 ELSE
2945 ALLOCATE(reservep(1))
2946 reservep(1) = 0
2947 ENDIF
2948 kxsp = 0
2949 ixsp = 0
2950 nod2sp = 0
2951 spbuf = zero
2952 WRITE(istdo,'(A)')' .. SPH PARTICLES DEFINITION'
2953 CALL hm_read_sphcel(itab ,itabm1 ,ipart ,
2954 2 ipartsp ,ipm ,igeo ,kxsp ,ixsp ,
2955 3 nod2sp, reservep,ixs ,iparts ,eani ,
2956 4 sph2sol,sol2sph ,irst ,x ,sol2sph_typ,
2957 5 lsubmodel,spbuf ,unitab ,ipri )
2958
2959 ELSE
2960 sspbuf = 0
2961 skxsp = 0
2962 sixsp = 0
2963 snod2sp = 0
2964 ALLOCATE(kxsp(skxsp) ,stat=stat)
2965 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2966 . msgtype=msgerror,
2967 . c1='KXSP')
2968 ALLOCATE(ixsp(0,0) ,stat=stat)
2969 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2970 . msgtype=msgerror,
2971 . c1='IXSP')
2972 ALLOCATE(nod2sp(snod2sp) ,stat=stat)
2973 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2974 . msgtype=msgerror,
2975 . c1='NOD2SP')
2976 ALLOCATE(spbuf(sspbuf) ,stat=stat)
2977 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
2978 . msgtype=msgerror,
2979 . c1='SPBUF')
2980 ENDIF
2981 CALL trace_out1()
2982C--------------------------------------------
2983C INVERSE CONNECTIVITY (Starter only)
2984C--------------------------------------------
2985C Create IXTG1 array and set to 0
2986 err_msg='CONNECTIVITY'
2987 err_category='CONNECTIVITY'
2988 CALL trace_in1(err_msg,len_trim(err_msg))
2989 ! -------------------
2990 ! initialisation of invert_group structure, used in
2991 ! HM_READ_SET and in HM_READ_SENSORS for user sensor
2992 CALL inverted_group_init(0,inv_group,numsph)
2993 ! example :
2994 CALL compute_connect_partelm(iparts ,ipartq ,ipartc ,ipartt ,ipartp,
2995 . ipartg ,ipartr ,ipartsp ,inv_group,numsph,
2996 . nisp ,kxsp )
2997 ! -------------------
2998 IF(numeltg6 ==0 )THEN
2999 sixtg1 = 0
3000 ELSE
3001 sixtg1 = 4*numeltg
3002 ENDIF
3003 ALLOCATE(ixtg1(sixtg1), stat=stat)
3004 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3005 . msgtype=msgerror,
3006 . c1='IXTG1')
3007 ixtg1 = 0
3008
3009214 ALLOCATE(knod2els(numnod+1),stat=stat)
3010 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3011 . msgtype=msgerror,
3012 . c1='KNOD2ELS')
3013 knod2els=0
3014 ALLOCATE(knod2elc(numnod+1),stat=stat)
3015 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3016 . msgtype=msgerror)
3017 knod2elc=0
3018 ALLOCATE(knod2eltg(numnod+1),stat=stat)
3019 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3020 . msgtype=msgerror,
3021 . c1='KNOD2ELTG')
3022 knod2eltg=0
3023 ALLOCATE(knod2el1d(numnod+1),stat=stat)
3024 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3025 . msgtype=msgerror,
3026 . c1='KNOD2EL1D')
3027 knod2el1d=0
3028
3029 ALLOCATE(knod2elq(numnod+1),stat=stat)
3030 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3031 . msgtype=msgerror)
3032 knod2elq=0
3033
3034
3035 s_nod2els = 8*numels+6*numels10+12*numels20+8*numels16
3036 ALLOCATE(nod2els(s_nod2els),stat=stat)
3037 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3038 . msgtype=msgerror,
3039 . c1='NOD2ELS')
3040 nod2els=0
3041 ALLOCATE(nod2elc(4*numelc),stat=stat)
3042 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3043 . msgtype=msgerror,
3044 . c1='NOD2ELC')
3045 nod2elc=0
3046 s_nod2eltg = 3*numeltg+3*numeltg6
3047 ALLOCATE(nod2eltg(s_nod2eltg),stat=stat)
3048 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3049 . msgtype=msgerror,
3050 . c1='NOD2ELTG')
3051 nod2eltg=0
3052 s_nod2el1d=2*numelt+2*numelp+3*numelr+2*sixx
3053 ALLOCATE(nod2el1d(s_nod2el1d),stat=stat)
3054 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3055 . msgtype=msgerror,
3056 . c1='NOD2EL1D')
3057 nod2el1d=0
3058 ALLOCATE(knod2elig3d(numnod+1),stat=stat)
3059 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3060 . msgtype=msgerror,
3061 . c1='KNOD2ELIG3D')
3062 knod2elig3d=0
3063 ALLOCATE(nod2elig3d(nctrlmax*numelig3d),
3064 . stat=stat)
3065 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3066 . msgtype=msgerror,
3067 . c1='NOD2ELIG3D')
3068 nod2elig3d=0
3069 ALLOCATE(nod2elq(4*numelq),stat=stat)
3070 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3071 . msgtype=msgerror,
3072 . c1='NOD2ELQ')
3073 nod2elq=0
3074
3075 IF(flag_goto==1) GOTO 215
3076
3077C--------------------------------------------
3078 CALL build_cnel(
3079 2 ixs ,ixq ,ixc ,ixt ,ixp ,
3080 3 ixr ,ixtg ,ixs10 ,ixs20 ,
3081 4 ixs16 ,ixtg1 ,igeo ,knod2els ,knod2elc ,
3082 5 knod2eltg ,nod2els ,nod2elc ,nod2eltg ,nod2el1d ,
3083 6 knod2el1d ,kxx ,ixx ,x ,lelx ,
3084 7 ixig3d ,kxig3d ,knod2elig3d,nod2elig3d,knod2elq,
3085 8 nod2elq )
3086 IF(ALLOCATED(iwork)) DEALLOCATE(iwork)
3087 CALL trace_out1()
3088C--------------------------------------------
3089C READING SUBSETS
3090C--------------------------------------------
3091 tagsurfige = 0
3092 sibufssg = 0 ! to be removed
3093!
3094 err_msg='SUBSETS'
3095 err_category='SUBSETS'
3096 CALL trace_in1(err_msg,len_trim(err_msg))
3097 IF(nsubs > 0) THEN
3098 WRITE(istdo,'(A)')' .. SUBSETS'
3099!
3100 CALL hm_read_subset(subsets,ipart,nsubs,npart,lsubmodel)
3101 CALL subset_ini(subsets)
3102!
3103 ENDIF
3104 CALL trace_out1()
3105C--------------------------------------------
3106C READING BOXES (BOX and BOX of BOX)
3107C--------------------------------------------
3108 CALL startime(19,1)
3109C--------------------------------------------
3110 err_msg='BOXES'
3111 err_category='BOXES'
3112 CALL trace_in1(err_msg,len_trim(err_msg))
3113C
3114 ALLOCATE(ibox(nbbox))
3115 IF(nbbox > 0) THEN
3116 WRITE(istdo,'(A)')' .. BOX '
3117c
3118 CALL hm_read_box(ibox ,unitab ,itabm1 ,iskwn ,skew ,
3119 . x ,rtrans ,lsubmodel)
3120C
3121 ENDIF
3122C--------------------
3123 CALL trace_out1()
3124C--------------------------
3125C ELEMENT GROUT READING
3126C--------------------------
3127 err_msg='GROUPS'
3128 CALL trace_in1(err_msg,len_trim(err_msg))
3129!
3130 idxigecnt= 1
3131!
3132 WRITE(istdo,'(A)')' .. ELEMENT GROUPS'
3133 err_category='ELEMENT GROUPS'
3134 flagg = 0
3135 iadboxmax = 1
3136C count group elements
3137 ALLOCATE(ixs_s(numels),ixs_s_ind(numels),ixq_s(numelq),
3138 2 ixq_s_ind(numelq),ixc_s(numelc),ixc_s_ind(numelc),
3139 3 ixt_s(numelt),ixt_s_ind(numelt),ixp_s(numelp),
3140 4 ixp_s_ind(numelp),ixr_s(numelr),ixr_s_ind(numelr),
3141 5 ixtg_s(numeltg),ixtg_s_ind(numeltg))
3142
3143 CALL lecgroup(
3144 1 itab ,itabm1 ,isubmod ,
3145 2 x ,ixs ,ixq ,ixc ,ixt ,ixp ,
3146 3 ixr ,ixtg , ipart ,
3147 4 iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
3148 5 ipartg ,flagg ,sh4tree ,sh3tree ,
3149 6 skew ,iskwn ,unitab ,ibox ,
3150 7 ixs10 ,ixs16 ,ixs20 ,rtrans,lsubmodel,
3151 8 ixs_s ,ixs_s_ind,ixq_s,ixq_s_ind,ixc_s,ixc_s_ind,
3152 9 ixt_s ,ixt_s_ind,ixp_s,ixp_s_ind,ixr_s,ixr_s_ind,
3153 a ixtg_s,ixtg_s_ind,iadboxmax,subsets,igrbric,igrquad,
3154 b igrsh4n,igrsh3n,igrtruss,igrbeam,igrspring)
3155C---
3156 leni=max(numels,numelq,numelc,numelt,numelp,numelr,numeltg)
3157!
3158 CALL sortgroup(
3159 1 ixs_s ,ixs_s_ind,ixq_s,ixq_s_ind,ixc_s,ixc_s_ind,
3160 2 ixt_s ,ixt_s_ind,ixp_s,ixp_s_ind,ixr_s,ixr_s_ind,
3161 3 ixtg_s,ixtg_s_ind,ixs,ixq,ixc,ixt,ixp,ixr,ixtg,leni)
3162!
3163 flagg = 1
3164 CALL lecgroup(
3165 1 itab ,itabm1 ,isubmod ,
3166 2 x ,ixs ,ixq ,ixc ,ixt ,ixp ,
3167 3 ixr ,ixtg , ipart ,
3168 4 iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
3169 5 ipartg ,flagg ,sh4tree ,sh3tree ,
3170 6 skew ,iskwn ,unitab ,ibox ,
3171 7 ixs10 ,ixs16,ixs20,rtrans,lsubmodel,
3172 8 ixs_s ,ixs_s_ind,ixq_s,ixq_s_ind,ixc_s,ixc_s_ind,
3173 9 ixt_s ,ixt_s_ind,ixp_s,ixp_s_ind,ixr_s,ixr_s_ind,
3174 a ixtg_s,ixtg_s_ind,iadboxmax,subsets,igrbric,igrquad,
3175 b igrsh4n,igrsh3n,igrtruss,igrbeam,igrspring)
3176!
3177 DEALLOCATE(ixs_s ,ixs_s_ind,ixq_s,ixq_s_ind,ixc_s,ixc_s_ind,
3178 2 ixt_s ,ixt_s_ind,ixp_s,ixp_s_ind,ixr_s,ixr_s_ind,
3179 3 ixtg_s,ixtg_s_ind)
3180C--------------------------------------------
3181C READING PART GROUPS (1st LEVEL)
3182C--------------------------------------------
3183 WRITE(istdo,'(A)')' .. PART GROUPS'
3184 err_category='PART GROUPS'
3185
3186 flagg = 0 !TAG ENTITY & ALLOCATE
3187 CALL hm_read_grpart(igrpart , ipart, isubmod, flagg ,ngrpart,lsubmodel, subsets )
3188
3189 flagg = 1 !BUILD GROUPS
3190 CALL hm_read_grpart(igrpart , ipart, isubmod, flagg ,ngrpart,lsubmodel, subsets )
3191C--------------------------------------------
3192C READING GROUPS OF GROUPS
3193C--------------------------------------------
3194 err_category='GROUP OF GROUPS'
3195 icount = 1
3196 iter = 0
3197 DO WHILE (icount > 0)
3198 iter = iter + 1
3199 flagg = 0
3200C---
3201 CALL lecggroup(
3202 . flagg ,
3203 . icount ,iter ,igrbric,igrquad ,igrsh4n,
3204 . igrsh3n ,igrtruss,igrbeam,igrspring,igrpart,
3205 . lsubmodel)
3206C---
3207 flagg = 1
3208C---
3209 CALL lecggroup(
3210 . flagg ,
3211 . icount ,iter ,igrbric,igrquad ,igrsh4n,
3212 . igrsh3n ,igrtruss,igrbeam,igrspring,igrpart,
3213 . lsubmodel)
3214 ENDDO
3215C--------------------------------------------
3216C READING SURFACES
3217C--------------------------------------------
3218
3219 ! allocation for pre-read of Rbody needed for /SET
3220 IF(nrbody > 0) THEN
3221 ALLOCATE(rby_msn(2,nrbody))
3222 CALL preread_rbody_set(lsubmodel,itabm1,rby_msn)
3223 ELSE
3224 ALLOCATE(rby_msn(0,0))
3225 ENDIF
3226
3227 ! PART UID to Internal ID conversion
3228
3229 CALL create_map_tables ( map_tables ,1 ,
3230 * lsubmodel ,subsets,
3231 * ipart,
3232 * ixs ,ixq ,ixc ,ixtg ,
3233 * ixt ,ixp ,ixr ,kxsp,ibid,
3234 * rby_msn)
3235
3236
3237 sbufsf = 0
3238 IF(nsurf+nsets > 0)THEN
3239 ALLOCATE(rwork(lisurf1*(nsurf+nsets)) ,stat=stat)
3240 rwork = zero
3241 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3242 . msgtype=msgerror,
3243 . c1='RWORK')
3244 ENDIF
3245
3246 IF(nsurf > 0)THEN
3247 WRITE(istdo,'(A)')' .. SURFACES '
3248 err_category='SURFACES DEFINITION'
3249c
3250C- Isogeometric Elements
3251 iadtabige = 0
3252 decaligeo = 0
3253 idxige1 = 0
3254 idxige2 = 1
3255 rnige=(1+nsurf*numelig3d*16*6)
3256 IF(rnige > intmax .OR. rnige < zero) THEN
3257 snige = intmax
3258 ELSE
3259 snige = int(rnige)
3260 ENDIF
3261 ALLOCATE(nige_tmp(idxige1)%ptr(snige) ,stat=stat)
3262 IF(stat /= 0) THEN
3263 CALL ancmsg(msgid=727,
3264 . msgtype=msgerror,
3265 . anmode=anstop,
3266 . c1='NIGE')
3267 ENDIF
3268 rrige=(1+nsurf*numelig3d*3*16*6)
3269 IF(rrige > intmax .OR. rrige < zero) THEN
3270 srige = intmax
3271 ELSE
3272 srige = int(rrige)
3273 ENDIF
3274 ALLOCATE(rige_tmp(idxige1)%ptr2(srige) ,stat=stat)
3275 IF(stat /= 0) THEN
3276 CALL ancmsg(msgid=727,
3277 . msgtype=msgerror,
3278 . anmode=anstop,
3279 . c1='RIGE')
3280 ENDIF
3281 rxige=(1+nsurf*numelig3d*3*16*6)
3282 IF(rxige > intmax .OR. rxige < zero) THEN
3283 sxige = intmax
3284 ELSE
3285 sxige = int(rxige)
3286 ENDIF
3287 ALLOCATE(xige_tmp(idxige1)%ptr2(sxige) ,stat=stat)
3288 IF(stat /= 0) THEN
3289 CALL ancmsg(msgid=727,
3290 . msgtype=msgerror,
3291 . anmode=anstop,
3292 . c1='XIGEO')
3293 ENDIF
3294 rvige=(1+nsurf*numelig3d*3*16*6)
3295 IF(rvige > intmax .OR. rvige < zero) THEN
3296 svige = intmax
3297 ELSE
3298 svige = int(rvige)
3299 ENDIF
3300 ALLOCATE(vige_tmp(idxige1)%ptr2(svige) ,stat=stat)
3301 IF(stat /= 0) THEN
3302 CALL ancmsg(msgid=727,
3303 . msgtype=msgerror,
3304 . anmode=anstop,
3305 . c1='VIGEO')
3306 ENDIF
3307C
3308 snige = 0
3309 srige = 0
3310 sxige = 0
3311 svige = 0
3312 idxigecnt = idxigecnt + 1
3313 idxige1 = mod(idxigecnt,2)
3314 idxige2 = mod(idxigecnt+1,2)
3315 flagg = 0
3316 inseg = 0
3317 numfakenodigeo = 0
3318 iadboxmax = 1
3319C
3320 CALL hm_read_surf(
3321 1 itab ,itabm1 ,
3322 2 igrsurf ,ixs ,ixq ,ixc ,ixt ,
3323 3 ixp ,ixr ,ixtg
3324 4 ,ipart ,iparts ,ipartq ,ipartc ,
3325 5 ipartt ,ipartp ,ipartr ,ipartg ,x ,
3326 6 sbufsf ,iskwn ,skew ,
3327 7 rwork ,knod2els ,nod2els ,sh4tree ,sh3tree ,
3328 8 isubmod ,flagg ,unitab ,ibox ,
3329 9 ixs10 ,ixs16 ,ixs20 ,rtrans,
3330 a lsubmodel ,knod2elc ,nod2elc ,knod2eltg ,nod2eltg,
3331 b kxig3d ,ixig3d ,ipartig3d ,
3332 c knot ,igeo ,wige ,knod2elig3d,nod2elig3d,
3333 d v ,nige_tmp(idxige1)%ptr,
3334 e rige_tmp(idxige1)%ptr2,xige_tmp(idxige1)%ptr2,
3335 f vige_tmp(idxige1)%ptr2,iadtabige,decaligeo,iadboxmax,knod2elq,
3336 g nod2elq ,subsets ,igrbric ,igrsh4n ,igrsh3n ,
3337 f knotlocpc ,knotlocel ,nsets ,map_tables)
3338C
3339C- Isogeometric Elements
3340 ALLOCATE(nige_tmp(idxige2)%ptr(snige+numfakenodigeo) ,stat=stat)
3341 IF(stat /= 0) THEN
3342 CALL ancmsg(msgid=727,
3343 . msgtype=msgerror,
3344 . anmode=anstop,
3345 . c1='NIGE')
3346 ENDIF
3347 snige = snige + numfakenodigeo
3348 DEALLOCATE(nige_tmp(idxige1)%ptr)
3349
3350 ALLOCATE(rige_tmp(idxige2)%ptr2(srige+3*numfakenodigeo) ,stat=stat)
3351 IF(stat /= 0) THEN
3352 CALL ancmsg(msgid=727,
3353 . msgtype=msgerror,
3354 . anmode=anstop,
3355 . c1='RIGE')
3356 ENDIF
3357 srige = srige + 3*numfakenodigeo
3358 DEALLOCATE(rige_tmp(idxige1)%ptr2)
3359
3360 ALLOCATE(xige_tmp(idxige2)%ptr2(sxige+3*numfakenodigeo) ,stat=stat)
3361 IF(stat /= 0) THEN
3362 CALL ancmsg(msgid=727,
3363 . msgtype=msgerror,
3364 . anmode=anstop,
3365 . c1='XIGE')
3366 ENDIF
3367 sxige = sxige + 3*numfakenodigeo
3368 DEALLOCATE(xige_tmp(idxige1)%ptr2)
3369
3370 ALLOCATE(vige_tmp(idxige2)%ptr2(svige+3*numfakenodigeo) ,stat=stat)
3371 IF(stat /= 0) THEN
3372 CALL ancmsg(msgid=727,
3373 . msgtype=msgerror,
3374 . anmode=anstop,
3375 . c1='VIGE')
3376 ENDIF
3377 svige = svige + 3*numfakenodigeo
3378 DEALLOCATE(vige_tmp(idxige1)%ptr2)
3379C
3380C fill, 1st level surfaces
3381 flagg = 1
3382 inseg = 0
3383 CALL hm_read_surf(
3384 1 itab ,itabm1 ,
3385 2 igrsurf ,ixs ,ixq ,ixc ,ixt ,
3386 3 ixp ,ixr ,ixtg
3387 4 ,ipart ,iparts ,ipartq ,ipartc ,
3388 5 ipartt ,ipartp ,ipartr ,ipartg ,x ,
3389 6 sbufsf ,iskwn ,skew ,
3390 7 rwork ,knod2els ,nod2els ,sh4tree ,sh3tree ,
3391 8 isubmod ,flagg ,unitab ,ibox ,
3392 9 ixs10 ,ixs16 ,ixs20 ,rtrans,
3393 a lsubmodel ,knod2elc ,nod2elc ,knod2eltg ,nod2eltg ,
3394 b kxig3d ,ixig3d ,ipartig3d ,
3395 c knot ,igeo ,wige ,knod2elig3d,nod2elig3d,
3396 d v ,nige_tmp(idxige2)%ptr,
3397 e rige_tmp(idxige2)%ptr2,xige_tmp(idxige2)%ptr2,
3398 f vige_tmp(idxige2)%ptr2,iadtabige,decaligeo,iadboxmax,knod2elq,
3399 g nod2elq ,subsets ,igrbric ,igrsh4n ,igrsh3n ,
3400 h knotlocpc ,knotlocel ,nsets ,map_tables)
3401C
3402c IF(NUMELIG3D>0) THEN
3403 IF(numfakenodigeo>0) THEN
3404 ALLOCATE(permige(numfakenodigeo) ,stat=stat)
3405c ALLOCATE(PERMIGE(IADTABIGE) ,STAT=stat)
3406c
3407 CALL presearchigeo3d(igrsurf,xige_tmp(idxige2)%ptr2,permige)
3408c CALL MYQSORT3D(IADTABIGE,XIGE_TMP(IDXIGE2)%ptr2,PERMIGE)
3409c
3410 ALLOCATE(nige_tmp(idxige1)%ptr(snige) ,stat=stat)
3411 IF(stat /= 0) THEN
3412 CALL ancmsg(msgid=727,
3413 . msgtype=msgerror,
3414 . anmode=anstop,
3415 . c1='NIGE')
3416 ENDIF
3417
3418 ALLOCATE(rige_tmp(idxige1)%ptr2(srige) ,stat=stat)
3419 IF(stat /= 0) THEN
3420 CALL ancmsg(msgid=727,
3421 . msgtype=msgerror,
3422 . anmode=anstop,
3423 . c1='RIGE')
3424 ENDIF
3425
3426 ALLOCATE(xige_tmp(idxige1)%ptr2(sxige) ,stat=stat)
3427 IF(stat /= 0) THEN
3428 CALL ancmsg(msgid=727,
3429 . msgtype=msgerror,
3430 . anmode=anstop,
3431 . c1='XIGE')
3432 ENDIF
3433
3434 ALLOCATE(vige_tmp(idxige1)%ptr2(svige) ,stat=stat)
3435 IF(stat /= 0) THEN
3436 CALL ancmsg(msgid=727,
3437 . msgtype=msgerror,
3438 . anmode=anstop,
3439 . c1='VIGE')
3440 ENDIF
3441c
3442c CALL SEARCHIGEO3D2(IGRSURF ,IADTABIGE ,PERMIGE ,
3443c . NIGE_TMP(IDXIGE2)%ptr ,NIGE_TMP(IDXIGE1)%ptr,
3444c . RIGE_TMP(IDXIGE2)%ptr2 ,RIGE_TMP(IDXIGE1)%ptr2,
3445c . XIGE_TMP(IDXIGE2)%ptr2 ,XIGE_TMP(IDXIGE1)%ptr2,
3446c . VIGE_TMP(IDXIGE2)%ptr2 ,VIGE_TMP(IDXIGE1)%ptr2,
3447c . NDOUBLONIGE)
3448
3449 CALL searchigeo3d(igrsurf ,iadtabige ,permige ,
3450 . nige_tmp(idxige2)%ptr ,nige_tmp(idxige1)%ptr,
3451 . rige_tmp(idxige2)%ptr2 ,rige_tmp(idxige1)%ptr2,
3452 . xige_tmp(idxige2)%ptr2 ,xige_tmp(idxige1)%ptr2,
3453 . vige_tmp(idxige2)%ptr2 ,vige_tmp(idxige1)%ptr2,
3454 . ndoublonige)
3455
3456c
3457 DEALLOCATE(rige_tmp(idxige2)%ptr2,xige_tmp(idxige2)%ptr2,vige_tmp(idxige2)%ptr2)
3458c
3459 snige = numfakenodigeo
3460 srige = 3*numfakenodigeo
3461 sxige = 3*numfakenodigeo
3462 svige = 3*numfakenodigeo
3463
3464c SNIGE = SNIGE - NDOUBLONIGE
3465c SRIGE = SRIGE - 3*NDOUBLONIGE
3466c SXIGE = SXIGE - 3*NDOUBLONIGE
3467c SVIGE = SVIGE - 3*NDOUBLONIGE
3468c
3469 ALLOCATE(nige_tmp(idxige2)%ptr(snige) ,stat=stat)
3470 IF(stat /= 0) THEN
3471 CALL ancmsg(msgid=727,
3472 . msgtype=msgerror,
3473 . anmode=anstop,
3474 . c1='NIGE')
3475 ENDIF
3476 DO i=1,snige
3477 nige_tmp(idxige2)%ptr(i) = nige_tmp(idxige1)%ptr(i)
3478 ENDDO
3479c
3480 ALLOCATE(rige_tmp(idxige2)%ptr2(srige) ,stat=stat)
3481 IF(stat /= 0) THEN
3482 CALL ancmsg(msgid=727,
3483 . msgtype=msgerror,
3484 . anmode=anstop,
3485 . c1='RIGE')
3486 ENDIF
3487 DO i=1,srige
3488 rige_tmp(idxige2)%ptr2(i) = rige_tmp(idxige1)%ptr2(i)
3489 ENDDO
3490c
3491 ALLOCATE(xige_tmp(idxige2)%ptr2(sxige) ,stat=stat)
3492 IF(stat /= 0) THEN
3493 CALL ancmsg(msgid=727,
3494 . msgtype=msgerror,
3495 . anmode=anstop,
3496 . c1='XIGE')
3497 ENDIF
3498 DO i=1,sxige
3499 xige_tmp(idxige2)%ptr2(i) = xige_tmp(idxige1)%ptr2(i)
3500 ENDDO
3501c
3502 ALLOCATE(vige_tmp(1)%ptr2(svige) ,stat=stat)
3503 IF(stat /= 0) THEN
3504 CALL ancmsg(msgid=727,
3505 . msgtype=msgerror,
3506 . anmode=anstop,
3507 . c1='VIGE')
3508 ENDIF
3509 DO i=1,svige
3510 vige_tmp(idxige2)%ptr2(i) = vige_tmp(idxige1)%ptr2(i)
3511 ENDDO
3512c
3513 tagsurfige=1
3514 DEALLOCATE(rige_tmp(idxige1)%ptr2,xige_tmp(idxige1)%ptr2,
3515 . vige_tmp(idxige1)%ptr2)
3516 DEALLOCATE(permige)
3517c
3518 ENDIF
3519c
3520C-------
3521C READING SURFACES OF SURFACES
3522C-------
3523 icount = 1
3524 iter = 0
3525 DO WHILE (icount == 1)
3526 flagg = 0
3527 iter = iter + 1
3528 inseg = 0
3529C--- count next level
3530 CALL hm_read_surfsurf(igrsurf, inseg, flagg, icount, iter, nsets, lsubmodel)
3531C---
3532C-------------------------------------------------
3533 flagg = 1
3534C--- fill next level
3535 CALL hm_read_surfsurf(igrsurf, inseg, flagg, icount, iter, nsets, lsubmodel)
3536C---
3537 ENDDO
3538 ENDIF
3539
3540 nsegs=npart
3541!
3542 nsegsmax=0
3543 DO i = 1,nsurf
3544 nsegs=nsegs+igrsurf(i)%NSEG
3545 ENDDO
3546 DO i = 1,ngrnod
3547 nsegsmax= max(nsegsmax,igrnod(i)%NENTITY)
3548 ENDDO
3549 DO i = 1,ngrbric
3550 nsegsmax= max(nsegsmax,igrbric(i)%NENTITY)
3551 ENDDO
3552 DO i = 1,ngrquad
3553 nsegsmax= max(nsegsmax,igrquad(i)%NENTITY)
3554 ENDDO
3555 DO i = 1,ngrshel
3556 nsegsmax= max(nsegsmax,igrsh4n(i)%NENTITY)
3557 ENDDO
3558 DO i = 1,ngrsh3n
3559 nsegsmax= max(nsegsmax,igrsh3n(i)%NENTITY)
3560 ENDDO
3561 DO i = 1,ngrtrus
3562 nsegsmax= max(nsegsmax,igrtruss(i)%NENTITY)
3563 ENDDO
3564 DO i = 1,ngrbeam
3565 nsegsmax= max(nsegsmax,igrbeam(i)%NENTITY)
3566 ENDDO
3567 DO i = 1,ngrspri
3568 nsegsmax= max(nsegsmax,igrspring(i)%NENTITY)
3569 ENDDO
3570 DO i = 1,ngrpart
3571 nsegsmax= max(nsegsmax,igrpart(i)%NENTITY)
3572 ENDDO
3573 nsegs=nsegs+nsegsmax
3574C--------------------------------------------
3575C READING LINES
3576C--------------------------------------------
3577 IF(nslin > 0) THEN
3578 WRITE(istdo,'(A)')' .. LINES '
3579 err_category='LINES'
3580 flagg = 0
3581 iadboxmax = 1
3582!
3583 CALL hm_read_lines(
3584 1 itab ,itabm1 ,
3585 2 isubmod ,igrslin ,igrsurf ,x ,ixs ,
3586 3 ixq ,ixc ,ixt ,ixp ,ixr ,
3587 4 ixtg ,ipart ,iparts ,ipartq ,ipartc ,
3588 5 ipartt ,ipartp ,ipartr ,ipartg ,
3589 6 nsegs , flagg ,skew ,iskwn ,
3590 7 unitab ,ibox ,rtrans ,lsubmodel,
3591 8 ipartx ,kxx ,ixx ,iadboxmax,subsets,
3592 9 igrtruss,igrbeam,igrspring,nsets ,map_tables)
3593C---
3594 flagg = 1
3595C---
3596 CALL hm_read_lines(
3597 1 itab ,itabm1 ,
3598 2 isubmod ,igrslin ,igrsurf ,x ,ixs ,
3599 3 ixq ,ixc ,ixt ,ixp ,ixr ,
3600 4 ixtg ,ipart ,iparts ,ipartq ,ipartc ,
3601 5 ipartt ,ipartp ,ipartr ,ipartg ,
3602 6 nsegs , flagg ,skew ,iskwn ,
3603 7 unitab ,ibox ,rtrans ,lsubmodel,
3604 8 ipartx ,kxx ,ixx ,iadboxmax,subsets,
3605 9 igrtruss,igrbeam,igrspring,nsets ,map_tables)
3606C-------
3607C LECTURE DES LIGNES DES LIGNES
3608C-------
3609 icount = 1
3610 iter = 0
3611 DO WHILE (icount == 1)
3612 iter = iter + 1
3613 inseg = 0
3614 flagg = 0
3615C--- count next level
3616 CALL hm_lines_of_lines(igrslin ,inseg ,flagg ,icount ,iter ,nsets, lsubmodel)
3617C--- fill next level
3618 flagg = 1
3619 CALL hm_lines_of_lines(igrslin ,inseg ,flagg ,icount ,iter ,nsets, lsubmodel)
3620C---
3621 ENDDO
3622 ENDIF
3623C--------------------------------------------
3624C LECTURE DES INIITAL CRACKS
3625C--------------------------------------------
3626 IF(ninicrack > 0) THEN
3627 WRITE(istdo,'(A)')' .. INITIAL CRACK '
3628 err_category='INITIAL CRACKS'
3629 silevset = ninicrack
3630 ALLOCATE(inicrack(silevset) ,stat=stat)
3631 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3632 . msgtype=msgerror,
3633 . c1='INICRACK')
3634 ! Reading /INICRACK cards
3635 CALL hm_read_inicrack(itabm1 ,inicrack ,unitab ,lsubmodel)
3636C---
3637 ELSE
3638 silevset = 0
3639 ALLOCATE(inicrack(silevset))
3640 ENDIF
3641C
3642C--------------------------------------------
3643C LECTURE DES GROUPES DE NOEUDS
3644C--------------------------------------------
3645 IF(ngrnod > 0)THEN
3646 WRITE(istdo,'(A)')' .. NODE GROUP'
3647 err_category='NODE GROUPS'
3648 innod = 0
3649 maxnnod = 1
3650 iadboxmax = 1
3651
3652 flagg = 0 !TAGNODES & ALLOCATE
3653 CALL hm_lecgrn(
3654 1 itab ,itabm1 ,igrnod ,
3655 2 isubmod ,x ,geo ,ixs ,
3656 3 ixq ,ixc ,ixt ,ixp ,ixr ,
3657 4 ixtg ,ipart ,
3658 5 iparts ,ipartq ,ipartc ,ipartt ,ipartp ,
3659 6 ipartr ,ipartg ,ipartsp ,kxsp ,
3660 7 flagg ,maxnnod ,skew ,iskwn ,
3661 8 unitab ,ibox ,ixs10 ,ixs20 ,
3662 9 ixs16 ,rtrans ,lsubmodel,ixx,
3663 a kxx ,ipartx ,iadboxmax,igrslin,subsets ,
3664 b igrbric ,igrquad ,igrsh4n ,igrsh3n ,igrtruss,
3665 c igrbeam ,igrspring,igrsurf,nsets )
3666!
3667 flagg = 1 !BUILD GROUPS
3668 CALL hm_lecgrn(
3669 1 itab ,itabm1 ,igrnod ,
3670 2 isubmod ,x ,geo ,ixs ,
3671 3 ixq ,ixc ,ixt ,ixp ,ixr ,
3672 4 ixtg ,ipart ,
3673 5 iparts ,ipartq ,ipartc ,ipartt ,ipartp ,
3674 6 ipartr ,ipartg ,ipartsp ,kxsp ,
3675 7 flagg ,maxnnod ,skew ,iskwn ,
3676 8 unitab ,ibox ,ixs10 ,ixs20 ,
3677 9 ixs16 ,rtrans ,lsubmodel,ixx,
3678 a kxx ,ipartx ,iadboxmax,igrslin,subsets ,
3679 b igrbric ,igrquad ,igrsh4n ,igrsh3n ,igrtruss,
3680 c igrbeam ,igrspring,igrsurf,nsets )
3681
3682C-------
3683C LECTURE DES GROUPES DES GROUPES
3684 icount = 1
3685 iter = 0
3686 DO WHILE (icount == 1)
3687 iter = iter + 1
3688 flagg = 0
3689 CALL hm_grogronod(igrnod ,icount ,flagg ,iter,'NODE',lsubmodel)
3690C--- fill next level
3691 flagg =1
3692 CALL hm_grogronod(igrnod ,icount ,flagg ,iter,'NODE',lsubmodel)
3693C---
3694 ENDDO
3695 ENDIF
3696
3697C--------------------------------------------
3698 CALL stoptime(19,1)
3699C--------------------------------------------
3700C /SET
3701C--------------------------------------------
3702 CALL startime(17,1)
3703
3704 ALLOCATE(set(nsets))
3705 IF(nsets > 0)THEN
3706 WRITE(istdo,'(A)')' .. SET'
3707 err_category='SET'
3708
3709 CALL hm_set(set ,lsubmodel ,inv_group ,map_tables ,ipart ,
3710 * igrsurf ,igrnod ,igrslin ,igrpart ,igrbric ,
3711 * igrquad ,igrsh4n ,igrsh3n ,igrtruss ,igrbeam ,
3712 * igrspring,ixs ,ixs10 ,ixc ,ixtg ,
3713 * knod2els ,nod2els ,knod2elc ,nod2elc ,knod2eltg ,
3714 * nod2eltg ,ipartc ,ipartg ,iparts ,sh4tree ,
3715 * sh3tree ,ixq ,knod2elq ,nod2elq ,x ,
3716 * ixt ,ixp ,ixr ,ixx ,kxx ,
3717 * kxsp ,ixs20 ,ixs16 ,geo ,itabm1 ,
3718 * ibox ,skew ,ipartq ,ipartt ,ipartp ,
3719 * ipartr ,subsets ,rby_msn ,iskwn ,rtrans ,
3720 * unitab ,rwork ,sbufsf ,siskwn ,sskew ,
3721 * rootnam ,rootlen ,infile_name ,infile_name_len )
3722
3723
3724C IF(ALLOCATED(RBY_MSN)) DEALLOCATE(RBY_MSN)
3725 ENDIF
3726
3727 IF (nsurf+nsets > 0) THEN
3728 IF(sbufsf > 0) THEN
3729 ALLOCATE(bufsf(sbufsf) ,stat=stat)
3730 bufsf = rwork(1:sbufsf)
3731 IF(stat /= 0) THEN
3732 CALL ancmsg(msgid=727,
3733 . msgtype=msgerror,
3734 . anmode=anstop,
3735 . c1='BUFSF')
3736 ENDIF
3737 ENDIF
3738 ELSE
3739 ALLOCATE(bufsf(0))
3740 ENDIF
3741 IF(ALLOCATED(rwork)) DEALLOCATE(rwork)
3742C--------------------------------------------
3743 CALL stoptime(17,1)
3744C--------------------------------------------
3745C LECTURE DES DRAPES
3746C--------------------------------------------
3747 err_msg='DRAPE'
3748 err_category='DRAPE'
3749 CALL trace_in1(err_msg,len_trim(err_msg))
3750 numelc_drape = 0
3751 numeltg_drape = 0
3752 IF(ndrape > 0) THEN
3753 WRITE(istdo,'(A)')' .. DRAPE'
3754 ALLOCATE(drape_wrk(numelc + numeltg),drapeg%INDX(numelc + numeltg))
3755 drapeg%INDX = 0
3756 ALLOCATE(indxsh(numelc + numeltg))
3757 indxsh = 0
3758C-----------------
3759C Stack part Pre orginisation
3760C-------------------------
3761 numelc_drape = 0
3762 numeltg_drape = 0
3763 stdrape = 0
3764 scdrape = 0
3765 IF(ipart_stack > 0 .OR. ipart_pcompp > 0) THEN
3766 ALLOCATE(iwork_t(numelc+numeltg))
3767 CALL pre_stackgroup(
3768 . igrsh3n ,igrsh4n ,ixc ,ixtg ,
3769 . igeo ,geo ,igeo_stack ,iworksh ,
3770 . iwork_t )
3771 ENDIF
3772 !!
3773 CALL hm_read_drape(drape_wrk ,iwork_t ,iworksh ,igrsh3n ,igrsh4n ,
3774 . ixc ,ixtg ,igeo ,igeo_stack,lsubmodel,
3775 . unitab ,indxsh )
3776 IF( numelc_drape > 0) scdrape = numelc
3777 IF( numeltg_drape > 0) stdrape = numeltg
3778 ALLOCATE(drape(numelc_drape +numeltg_drape) )
3779 IF( (numelc_drape + numeltg_drape )> 0) THEN
3780 drapeg%NUMSH4 = numelc_drape
3781 drapeg%NUMSH3 = numeltg_drape
3782 DO i=1,numelc_drape + numeltg_drape
3783 idshel = indxsh(i)
3784 npt_drape = drape_wrk(idshel)%NPLY_DRAPE
3785 drape(i)%NPLY_DRAPE = npt_drape
3786 npt = iworksh(1,idshel)
3787 drape(i)%NPLY = npt
3788 drapeg%INDX(idshel) = i
3789 ALLOCATE(drape(i)%DRAPE_PLY(npt_drape))
3790 ALLOCATE(drape(i)%INDX_PLY(npt))
3791 drape(i)%INDX_PLY = 0
3792 DO jj =1,npt_drape
3793 ip = drape_wrk(idshel)%INDX_PLY(jj)
3794 drape(i)%INDX_PLY(ip) = jj
3795 nslice = drape_wrk(idshel)%DRAPE_PLY(ip)%NSLICE
3796 drape(i)%DRAPE_PLY(jj)%NSLICE = nslice
3797 drape(i)%DRAPE_PLY(jj)%IPID = drape_wrk(idshel)%DRAPE_PLY(ip)%IPID
3798 ALLOCATE(drape(i)%DRAPE_PLY(jj)%RDRAPE(nslice,2))
3799 ALLOCATE(drape(i)%DRAPE_PLY(jj)%IDRAPE(nslice,2))
3800 DO isl = 1,nslice
3801 drape(i)%DRAPE_PLY(jj)%RDRAPE(isl,1) = drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE(isl,1)
3802 drape(i)%DRAPE_PLY(jj)%RDRAPE(isl,2) = drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE(isl,2)
3803 drape(i)%DRAPE_PLY(jj)%IDRAPE(isl,1) = drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE(isl,1)
3804 drape(i)%DRAPE_PLY(jj)%IDRAPE(isl,2) = drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE(isl,2)
3805 ENDDO ! nbre of slice
3806 ENDDO
3807 ENDDO
3808 !! Deallocation of work drape memory
3809 DO i=1,numelc_drape + numeltg_drape
3810 idshel = indxsh(i)
3811 npt = iworksh(1,idshel)
3812 IF(ALLOCATED(drape_wrk(idshel)%DRAPE_PLY)) THEN
3813 npt_drape = drape_wrk(idshel)%NPLY_DRAPE
3814 DO jj=1,npt_drape
3815 ip = drape_wrk(idshel)%INDX_PLY(jj)
3816 DEALLOCATE(drape_wrk(idshel)%DRAPE_PLY(ip)%RDRAPE,drape_wrk(idshel)%DRAPE_PLY(ip)%IDRAPE)
3817 ENDDO
3818 DEALLOCATE(drape_wrk(idshel)%DRAPE_PLY)
3819 ENDIF
3820 ENDDO
3821 DEALLOCATE(drape_wrk)
3822 DEALLOCATE(indxsh )
3823 ENDIF
3824 IF(ALLOCATED(idrapeid)) DEALLOCATE(idrapeid)
3825
3826 IF(ipart_stack > 0 .OR. ipart_pcompp > 0) THEN
3827 CALL stackgroup_drape(drape, drapeg , iwork_t , iworksh ,
3828 . igrsh3n ,igrsh4n ,ixc ,ixtg ,
3829 . igeo ,geo ,thke , stack ,
3830 . igeo_stack ,geo_stack , stack_info ,
3831 . numgeostack,nprop_stack,ply_info)
3832 ELSE
3833 ALLOCATE(stack%GEO(0,0))
3834 ALLOCATE(stack%IGEO(0,0))
3835 ALLOCATE(stack%PM(0,0))
3836 ENDIF
3837 ELSE ! with out drape
3838 ALLOCATE(drape(0))
3839 ALLOCATE(drapeg%INDX(0))
3840 IF(ipart_stack > 0 .OR. ipart_pcompp > 0) THEN
3841 CALL stackgroup(
3842 . igrsh3n ,igrsh4n ,ixc ,ixtg ,
3843 . igeo ,geo ,iworksh ,thke ,
3844 . stack ,ipm ,igeo_stack ,geo_stack ,
3845 . stack_info ,numgeostack,nprop_stack)
3846 ELSE
3847 ALLOCATE(stack%GEO(0,0))
3848 ALLOCATE(stack%IGEO(0,0))
3849 ALLOCATE(stack%PM(0,0))
3850 ENDIF
3851 ENDIF
3852C--------------------------------------------
3853 IF(nsubdom==0) GOTO 218
3854C--------------------------------------------
3855C MULTIDOMAINS - INTERFACES
3856C--------------------------------------------
3857 WRITE(istdo,'(A)')' .. MULTIDOMAINS INTERFACES DETECTION '
3858 idxcnt= 1 ! used by temporary local array "IBUFTMP"
3859 iadbuf= 1
3860 idxcnt= idxcnt + 1
3861 idx1 = mod(idxcnt,2)
3862 idx2 = mod(idxcnt+1,2)
3863 flagg = 0
3864 innod = 0
3865 flg_r2r_err = 0
3866 ale_euler = 0
3867 nspcond0 = nspcond
3868! tmp +++
3869 rsibufssg=numnod+nsubdom
3870 IF(rsibufssg > intmax .OR. rsibufssg < zero) THEN
3871 sibufssg = intmax
3872 ELSE
3873 sibufssg = int(rsibufssg)
3874 ENDIF
3875 ALLOCATE(ibuftmp(idx1)%ptr(sibufssg),stat=stat)
3876 IF(stat /= 0) THEN
3877 CALL ancmsg(msgid=727,
3878 . msgtype=msgerror,
3879 . anmode=anstop,
3880 . c1='BUFFSG')
3881 ENDIF
3882! tmp ---
3883C---
3884 ALLOCATE(tagno(2*numnod+npart),stat=stat)
3885 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3886 . msgtype=msgerror,
3887 . c1='TAGNO')
3888 tagno(:) = 0
3889 ALLOCATE(nale_r2r(ale%GLOBAL%SNALE),stat=stat)
3890 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3891 . msgtype=msgerror,
3892 . c1='NALE_R2R')
3893 nale_r2r(:) = 1
3894 ALLOCATE(dt_r2r(4*nsubdom),stat=stat)
3895 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3896 . msgtype=msgerror,
3897 . c1='DT_R2R')
3898 dt_r2r(:) = 0
3899C--- Premiere Passe -> comptage
3900 CALL r2r_group(ngrnod,
3901 1 innod,flagg,iparts,ipartq,ipartc,ipartt,ipartp,
3902 2 ipartr,ipartg,ipartsp,ixs10,ixs20,ixs16,1,
3903 3 ibuftmp(idx1)%ptr,ixr_kj,inom_opt,ipart,
3904 4 iadbuf,nale_r2r,flg_r2r_err ,
3905 5 stack%PM ,iworksh ,igrbric ,igrquad ,igrsh4n ,
3906 6 igrsh3n ,igrtruss ,igrbeam ,igrspring ,igrnod ,
3907 7 igrsurf ,igrslin, lsubmodel,ale_euler ,igeo ,
3908 8 nloc_dmg ,detonators,sensors%NSENSOR,seatbelt_shell_to_spring,
3909 9 nb_seatbelt_shells,mat_elem%MAT_PARAM)
3910C---
3911 ALLOCATE(ibuftmp(idx2)%ptr(sibufssg+innod) ,stat=stat)
3912 IF(stat /= 0) THEN
3913 CALL ancmsg(msgid=727,
3914 . msgtype=msgerror,
3915 . anmode=anstop,
3916 . c1='BUFFSG')
3917 ENDIF
3918 ibuftmp(idx2)%ptr = 0
3919 DO i=1,sibufssg
3920 ibuftmp(idx2)%ptr(i) = ibuftmp(idx1)%ptr(i)
3921 ENDDO
3922 sibufssg = sibufssg+innod
3923 DEALLOCATE(ibuftmp(idx1)%ptr)
3924
3925 flagg = 1
3926
3927C--- Deuxieme Passe -> creation des interfaces
3928 CALL r2r_group(ngrnod,
3929 1 innod,flagg,iparts,ipartq,ipartc,ipartt,ipartp,
3930 2 ipartr,ipartg,ipartsp,ixs10,ixs20,ixs16,2,
3931 3 ibuftmp(idx2)%ptr,ixr_kj,inom_opt,ipart,
3932 4 iadbuf,nale_r2r,flg_r2r_err ,
3933 5 stack%PM ,iworksh ,igrbric ,igrquad ,igrsh4n ,
3934 6 igrsh3n ,igrtruss ,igrbeam ,igrspring ,igrnod ,
3935 7 igrsurf ,igrslin, lsubmodel,ale_euler ,igeo ,
3936 8 nloc_dmg ,detonators,sensors%NSENSOR,seatbelt_shell_to_spring,
3937 9 nb_seatbelt_shells,mat_elem%MAT_PARAM)
3938C--------------------------------------------
3939C MULTIDOMAINS - SPLIT DES TABLEAUX
3940C--------------------------------------------
3941 WRITE(istdo,'(A)')' .. MULTIDOMAINS DATA SPLIT '
3942C--- Premiere Passe -> comptage
3943 CALL r2r_split(
3944 1 nslin,
3945 2 nsurf,0,eani,ibuftmp(idx2)%ptr,ixr_kj,
3946 3 inom_opt,reservep,nale_r2r,nspcond0,
3947 4 subsets,igrsurf,igrnod,igrbric,igrquad,
3948 5 igrsh4n,igrsh3n,igrtruss,igrbeam,igrspring,
3949 6 igrpart,igrslin,lsubmodel,rby_msn,iworksh,
3950 7 seatbelt_shell_to_spring,nb_seatbelt_shells)
3951C--- Deuxieme Passe -> split
3952 CALL r2r_split(
3953 1 nslin,
3954 2 nsurf,1,eani,ibuftmp(idx2)%ptr,ixr_kj,
3955 3 inom_opt,reservep,nale_r2r,nspcond0,
3956 4 subsets,igrsurf,igrnod,igrbric,igrquad,
3957 5 igrsh4n,igrsh3n,igrtruss,igrbeam,igrspring,
3958 6 igrpart,igrslin,lsubmodel,rby_msn,iworksh,
3959 7 seatbelt_shell_to_spring,nb_seatbelt_shells)
3960 DEALLOCATE(ibuftmp(idx2)%ptr)
3961C--------------------------------------------
3962C MULTIDOMAINS - MISE A JOUR DES STRUCTURES DE DONNEES
3963C--------------------------------------------
3964
3965 WRITE(istdo,'(A)')' .. MULTIDOMAINS DATA UPDATE '
3966 DEALLOCATE(knod2els,knod2elc,knod2eltg,knod2el1d,knod2elig3d,knod2elq)
3967 DEALLOCATE(nod2els,nod2elc,nod2eltg,nod2el1d,nod2elig3d,nod2elq)
3968 DEALLOCATE(xyzref)
3969 ALLOCATE(xyzref(3*numnod) ,stat=stat)
3970 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
3971 . msgtype=msgerror,
3972 . c1='XYZREF')
3973 flag_goto = 1
3974
3975C-----on realloue le tableau FRONT-------------
3976 CALL ini_ifront()
3977 ientry2(1:numnod) = -1
3978 flagkin(1:numnod) = 0
3979
3980cc r2r with new IFRONT
3981 DO i=1,numnod
3982 IF(front_r2r(i)==1)THEN
3983 CALL ifrontplus(i,1)
3984 !FLAGKIN array to identify boundary nodes with
3985 !kinematic constraints (old FRONT TAG=10)
3986 IF(flagkin_r2r(i)==1)flagkin(i)=1
3987 ENDIF
3988 ENDDO
3989
3990 DEALLOCATE(front_r2r,flagkin_r2r)
3991 sfrontb_r2r = numnod
3992 snom_opt_old = snom_opt
3993 in10 = inom_opt(10)
3994 in20 = inom_opt(20)
3995
3996C-----ARRAY size update & rebuild THKEC--
3997 GOTO 208
3998209 CONTINUE
3999
4000C----- OPTION name update ----------
4001 GOTO 210
4002211 CONTINUE
4003 CALL r2r_nom_opt(nom_opt,inom_opt,in10,in20,snom_opt_old)
4004
4005C-----on repointe les tableaux IXS10,20,16--
4006 GOTO 212
4007213 CONTINUE
4008
4009C-----on realloue les NOD2EL----------------
4010 GOTO 214
4011215 CONTINUE
4012
4013C-----on repointe les tableaux IPART--------
4014 GOTO 216
4015217 CONTINUE
4016
4017C-----on recalcule les connectivit s inverses--------
4018
4019 CALL build_cnel(
4020 2 ixs ,ixq ,ixc ,ixt ,ixp ,
4021 3 ixr ,ixtg ,ixs10 ,ixs20 ,
4022 4 ixs16 ,ixtg1 ,igeo ,knod2els ,knod2elc ,
4023 5 knod2eltg ,nod2els ,nod2elc ,nod2eltg ,nod2el1d ,
4024 6 knod2el1d ,kxx ,ixx ,x ,lelx ,
4025 7 ixig3d ,kxig3d ,knod2elig3d,nod2elig3d,knod2elq,
4026 8 nod2elq )
4027 IF(ALLOCATED(iwork)) DEALLOCATE(iwork)
4028
4029C-----on reinitialise les pointeurs utilisateurs-------
4030 CALL sav_buf_point(pm ,1)
4031 CALL sav_buf_point(bufmat ,2)
4032 CALL sav_buf_point(geo ,3)
4033 CALL sav_buf_point(iskwn ,7)
4034 CALL sav_buf_point(skew ,8)
4035 CALL sav_buf_point(ipm ,11)
4036 CALL sav_buf_point(igeo,12)
4037
4038C--------------------------------------------
4039
4040218 CONTINUE
4041 IF(.NOT. ALLOCATED(tagno)) ALLOCATE(tagno(0))
4042 IF(.NOT. ALLOCATED(nale_r2r)) ALLOCATE(nale_r2r(0))
4043 IF(.NOT. ALLOCATED(dt_r2r)) ALLOCATE(dt_r2r(0))
4044C--------------------------------------------
4045C MULTIDOMAINS - CHECK DES INTERFACES
4046C--------------------------------------------
4047
4048C--- Check multidomains datas
4049 IF(nr2rlnk/=0) THEN
4050 CALL r2r_check(iexlnk,igrnod,ipart)
4051 ENDIF
4052C--- Allocation de FRONTB_R2R
4053 ALLOCATE(frontb_r2r(sfrontb_r2r,nspmd),stat=stat)
4054 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4055 . msgtype=msgerror,
4056 . c1='FRONT_R2R')
4057 frontb_r2r = 0
4058
4059C ------------------------------------------------
4060C Tri des surfaces pour les Airbags et Modif files
4061C ------------------------------------------------
4062 CALL sort_surf(igrsurf,ixs,ixc,ixtg,ixq,ixp,ixr,ixt, kxx,nixx)
4063C--------------------------------------------
4064 CALL printgroup(
4065 1 itab ,itabm1 ,igrnod ,ninicrack,bufsf ,
4066 2 igrsurf ,igrslin ,inicrack ,ixs ,ixq ,
4067 3 ixc ,ixt ,ixp ,ixr ,ixtg ,
4068 4 ixs10 ,ixs20 ,ixs16 ,ipart ,
4069 5 kxx ,ixig3d ,kxig3d ,
4070 6 igrquad ,igrbric ,igrsh4n ,igrsh3n ,igrtruss,
4071 7 igrbeam ,igrspring,igrpart )
4072 CALL trace_out1()
4073 DEALLOCATE(kxx,ixx,lelx)
4074C--------------------------------------------
4075C TRANSFORMATIONS
4076C--------------------------------------------
4077 err_msg='TRANSFORMATIONS'
4078 err_category='TRANSFORMATIONS'
4079 CALL trace_in1(err_msg,len_trim(err_msg))
4080 CALL lectrans(x ,igrnod ,itab ,itabm1 ,unitab,
4081 . lsubmodel,rtrans)
4082 CALL trace_out1()
4083 CLOSE(unit=iusbm)
4084C--------------------------------------------
4085C READING OF /MERGE/NODE
4086C--------------------------------------------
4087 err_msg='/MERGE/NODE'
4088 err_category='/MERGE/NODE'
4089C
4090 CALL trace_in1(err_msg,len_trim(err_msg))
4091C
4092 ALLOCATE(merge_node_tab(4*nb_merge_node),stat=stat)
4093 ALLOCATE(merge_node_tol(nb_merge_node),stat=stat)
4094 merge_node_tab = 0
4095 merge_node_tol = zero
4096 nmerge_node_cand = 0
4097 nmerge_node_dest = 0
4098 IF(stat /= 0) THEN
4099 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,
4100 . c1='IMERGE')
4101 ENDIF
4102 IF(nb_merge_node > 0) THEN
4103 CALL hm_read_merge_node(x,lsubmodel,unitab,igrnod,merge_node_tab,
4104 . merge_node_tol,nmerge_node_cand,nmerge_node_dest)
4105 ENDIF
4106C
4107 CALL trace_out1()
4108C--------------------------------------------
4109C MERGE OF NODES (cnodes + /MERGE/NODE)
4110C--------------------------------------------
4111 err_msg='MERGING NODES'
4112 err_category='MERGING NODES'
4113 CALL trace_in1(err_msg,len_trim(err_msg))
4114C
4115 nmerge_tot = numcnod + nmerge_node_dest
4116 ALLOCATE(imerge(3*nmerge_tot),stat=stat)
4117 ALLOCATE(imerge2(numnod+1),stat=stat)
4118 ALLOCATE(iadmerge2(numnod+1),stat=stat)
4119 IF(stat /= 0) THEN
4120 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,
4121 . c1='IMERGE')
4122 ENDIF
4123C
4124 imerge = 0
4125 imerge2 = 0
4126 iadmerge2 =0
4127 nmerged = 0
4128C
4129C-- CNODE merging
4130 IF(numcnod > 0)
4131 . CALL merge(x ,itab ,itabm1 ,cmerge ,imerge,
4132 . imerge2,iadmerge2,nmerge_tot)
4133 DEALLOCATE(cmerge)
4134C
4135C-- /MERGE/NODE merging
4136 IF(nb_merge_node > 0)
4137 . CALL merge_node(x ,itab ,itabm1 ,imerge,imerge2,
4138 . iadmerge2,nmerge_tot,merge_node_tab,merge_node_tol,
4139 . nmerge_node_cand,nmerge_node_dest,ixs,ixs10,ixs20,
4140 . ixs16,ixq,ixc,ixt,ixp,
4141 . ixr,ixtg,eani,igrnod)
4142C
4143 CALL trace_out1()
4144C--------------------------------------------
4145C Reinitialize merged connectivities / groups
4146C--------------------------------------------
4147 err_msg='REINIT CONNECTIVITY'
4148 CALL trace_in1(err_msg,len_trim(err_msg))
4149 IF(nmerged > 0) THEN
4150 CALL reconnect(
4151 . ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
4152 . ixc ,ixt ,ixp ,ixr ,ixtg ,
4153 . igrnod ,igrsurf ,igrslin ,
4154 . iskwn ,imerge ,nmerge_tot)
4155C
4156 knod2els = 0
4157 knod2elc = 0
4158 knod2eltg = 0
4159 knod2el1d = 0
4160 knod2elig3d = 0
4161 nod2els = 0
4162 nod2elc = 0
4163 nod2eltg = 0
4164 nod2el1d = 0
4165 nod2elig3d = 0
4166 knod2elq = 0
4167 nod2elq = 0
4168 CALL build_cnel(
4169 2 ixs ,ixq ,ixc ,ixt ,ixp ,
4170 3 ixr ,ixtg ,ixs10 ,ixs20 ,
4171 4 ixs16 ,ixtg1 ,igeo ,knod2els ,knod2elc ,
4172 5 knod2eltg ,nod2els ,nod2elc ,nod2eltg ,nod2el1d ,
4173 6 knod2el1d ,kxx ,ixx ,x ,lelx ,
4174 7 ixig3d ,kxig3d ,knod2elig3d,nod2elig3d,knod2elq,
4175 8 nod2elq )
4176 ENDIF
4177 CALL trace_out1()
4178C--------------------------------------------
4179C LECTURE DE RANDOM NOISE
4180C--------------------------------------------
4181 err_msg='RANDOM NOISE'
4182 err_category='RANDOM NOISE'
4183 CALL trace_in1(err_msg,len_trim(err_msg))
4184
4185 CALL init_random( )
4186
4187 IF(rand_struct%CMD) nrand = nrand + 1
4188 ALLOCATE(irand(nrand),stat=stat)
4189 ALLOCATE(alea(nrand) ,stat=stat)
4190 ALLOCATE(xseed(nrand),stat=stat)
4191
4192 CALL hm_read_rand(x ,igrnod ,itab,irand,alea,xseed,
4193 . unitab,lsubmodel)
4194
4195 CALL trace_out1()
4196C--------------------------------------------
4197C LECTURE DES SLIPRINGS AND RETRACTORS
4198C--------------------------------------------
4199 err_msg='SEATBELTS'
4200 err_category='SEATBELTS'
4201 CALL trace_in1(err_msg,len_trim(err_msg))
4202C
4203 nb_mat_seatbelt = 0
4204 CALL hm_option_count('/MAT/LAW114',nb_mat)
4205 nb_mat_seatbelt = nb_mat_seatbelt + nb_mat
4206 CALL hm_option_count('/MAT/SPR_SEATBELT',nb_mat)
4207 nb_mat_seatbelt = nb_mat_seatbelt + nb_mat
4208 CALL hm_option_count('/MAT/LAW119',nb_mat)
4209 nb_mat_seatbelt = nb_mat_seatbelt + nb_mat
4210 CALL hm_option_count('/MAT/SH_SEATBELT',nb_mat)
4211 nb_mat_seatbelt = nb_mat_seatbelt + nb_mat
4212C
4213 IF(nslipring + nretractor > 0) WRITE(istdo,'(A)')' .. SLIPRING/RETRACTOR'
4214 IF(nslipring > 0) CALL hm_read_slipring(
4215 1 lsubmodel,itabm1,ixr,itab,unitab,
4216 2 x,npc1,nom_opt(lnopt1*inom_opt(31)+1),alea,igrnod,
4217 2 igrsh4n,ixc,ipm)
4218 IF(nretractor > 0) CALL hm_read_retractor(
4219 1 lsubmodel,itabm1,ixr,itab,unitab,
4220 2 x,npc1,nom_opt(lnopt1*inom_opt(32)+1),alea,ipm)
4221 CALL trace_out1()
4222C--------------------------------------------
4223C LECTURE DES CONDITIONS LIMITES
4224C--------------------------------------------
4225 err_msg='BCS'
4226 err_category='BCS'
4227 CALL trace_in1(err_msg,len_trim(err_msg))
4228 IF(nbcscyc>0) THEN
4229 CALL hm_preread_bcscyc(igrnod ,nom_opt(lnopt1*inom_opt(16)+1),lsubmodel,slbcscyc)
4230 END IF
4231 sibcscyc = 4*nbcscyc
4232 ALLOCATE(ibcscyc(sibcscyc),lbcscyc(slbcscyc),stat=stat)
4233 lbcscyc = 0
4234 IF(numbcs /= 0 .OR. nalebcs /= 0 .OR. numbcsn /= 0) THEN
4235 WRITE(istdo,'(A)')titre(13)
4236C READ /BCS & /BCS/LAGMUL
4237 CALL hm_read_bcs(icode ,iskew ,itab ,itabm1 ,d ,
4238 . igrnod ,ibcslag ,lag_ncf ,lag_nkf ,lag_nhf,
4239 . ikine1lag,iskwn,nom_opt(lnopt1*inom_opt(16)+1),
4240 . unitab ,lsubmodel,ibcscyc,lbcscyc)
4241C READ /ALE/BCS
4242 CALL hm_read_alebcs(icode ,iskew ,itab ,itabm1 ,d ,
4243 . igrnod ,ibcslag ,lag_ncf ,lag_nkf ,lag_nhf,
4244 . ikine1lag,iskwn,nom_opt(lnopt1*inom_opt(16)+1),
4245 . lsubmodel)
4246C READ /NBCS
4247 CALL hm_read_nbcs(icode ,iskew ,itab ,itabm1 ,d ,
4248 . igrnod ,ibcslag ,lag_ncf ,lag_nkf ,lag_nhf,
4249 . ikine1lag,iskwn,nom_opt(lnopt1*inom_opt(16)+1),lsubmodel)
4250C PRINT /BCS
4251 CALL printbcs(icode ,iskew ,itab ,itabm1 ,d ,
4252 . igrnod ,ibcslag ,lag_ncf ,lag_nkf ,lag_nhf,
4253 . ikine1lag,iskwn,nom_opt(lnopt1*inom_opt(16)+1), nbcslag)
4254 ENDIF
4255
4256C--------------------------------------
4257C
4258 ALLOCATE(icodep(0),iskewp(0))
4259 CALL trace_out1()
4260C Adaptive meshing : Sending down the bcs
4261 err_msg='ADAPTIVE MESHING BCS'
4262 err_category='ADAPTIVE MESHING BCS'
4263 CALL trace_in1(err_msg,len_trim(err_msg))
4264 IF(nadmesh/=0)THEN
4265 CALL admbcs(ixc ,ipartc,ixtg,ipartg,ipart ,
4266 . icode,iskew,itab,sh4tree,sh3tree)
4267 END IF
4268 CALL trace_out1()
4269C--------------------------------------------------------------------------
4270C TRI DES BRICK ET QUAD, CLASSEMENT PAR LOI
4271C--------------------------------------------------------------------------
4272 err_msg='SOLIDS SORT'
4273 err_category='INTERNAL'
4274 CALL trace_in1(err_msg,len_trim(err_msg))
4275 siwork = 2*max(numels,numelq)
4276 ALLOCATE(iwork(siwork) ,stat=stat)
4277 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4278 . msgtype=msgerror,
4279 . c1='IWORK')
4280 IF(numels /= 0)
4281 . CALL lce16s3(
4282 . ixs ,bid13 ,pm ,iwork ,itab ,itabm1 ,
4283 . icode ,iparts ,igrbric ,geo ,eani ,
4284 . ixs10 ,ipart ,ixs20 ,ixs16 ,knod2els,nod2els ,
4285 . igrsurf,sph2sol ,sol2sph )
4286 IF(numelq /= 0)
4287 . CALL lce16q3(
4288 . ixq ,bid13 ,pm ,iwork ,itab ,itabm1 ,
4289 . icode ,ipartq ,igrquad ,ipm ,igeo )
4290 IF(ALLOCATED(iwork)) DEALLOCATE(iwork)
4291 CALL trace_out1()
4292C--------------------------------------------
4293C MULTI-POINT CONSTRAINTS (1)
4294C--------------------------------------------
4295 err_msg='MPCS 1'
4296 err_category='MPCS 1'
4297 CALL trace_in1(err_msg,len_trim(err_msg))
4298 IF(nummpc > 0) THEN
4299 CALL hm_read_mpc0 (lmpc,lsubmodel)
4300 ELSE
4301 lmpc=0
4302 ENDIF
4303 srbmpc = lmpc
4304 ALLOCATE(rbmpc(srbmpc) ,stat=stat)
4305 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4306 . msgtype=msgerror,
4307 . c1='RBMPC')
4308 IF(srbmpc > 0) rbmpc = zero
4309 CALL trace_out1()
4310C--------------------------------------------
4311C STOCKAGE DYNAMIQUE REEL
4312C--------------------------------------------
4313 err_msg='DYNAMIC STORAGE REAL'
4314 err_category='INTERNAL'
4315 CALL trace_in1(err_msg,len_trim(err_msg))
4316 sgjbufr = lkjnr*ngjoint
4317 sw = 3*numnod*iale
4318 numelsk8 = numels
4319 numelqk8 = numelq
4320 sveul = (lveul*numels+10*numelq)*ieuler
4321 sveul8 = (int(lveul,kind(sveul8))*numelsk8+10*numelqk8)*int(ieuler,kind(sveul8))
4322 sfill = nmult*numnod
4323 sdfill = nmult*numnod
4324 salph = 2*nmult*(numelq+numels)
4325 swb = 0
4326 IF(ale%GRID%NWALE == 2) THEN
4327 swb = 3*numnod
4328 ELSEIF(ale%GRID%NWALE == 4) THEN
4329 swb = 4*numnod
4330 ENDIF
4331 ALLOCATE(wb(swb) ,stat=stat)
4332 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4333 . msgtype=msgerror,
4334 . c1='WB')
4335 IF(swb > 0) wb = zero
4336 IF(ale%GRID%NWALE == 4) THEN
4337 wma => wb(3*numnod+1:swb)
4338 ELSE
4339 wma => wb
4340 ENDIF
4341C
4342 sdsave = 0
4343 sasave = 0
4344 IF(ilag == 1 .AND. (iale+ieuler) > 0) THEN
4345 sdsave = 3*numnod
4346 sasave = 3*numnod
4347 ENDIF
4348 ALLOCATE(gjbufr(sgjbufr) ,stat=stat)
4349 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4350 . msgtype=msgerror,
4351 . c1='GJBUFR')
4352 ALLOCATE(w(sw) ,stat=stat)
4353 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4354 . msgtype=msgerror,
4355 . c1='W')
4356 ALLOCATE(veul(sveul8) ,stat=stat)
4357 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4358 . msgtype=msgerror,
4359 . c1='VEUL')
4360 ALLOCATE(fill(sfill) ,stat=stat)
4361 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4362 . msgtype=msgerror,
4363 . c1='FILL')
4364 ALLOCATE(dfill(sdfill) ,stat=stat)
4365 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4366 . msgtype=msgerror,
4367 . c1='DFILL')
4368 ALLOCATE(alph(salph) ,stat=stat)
4369 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4370 . msgtype=msgerror,
4371 . c1='ALPH')
4372 ALLOCATE(dsave(sdsave) ,stat=stat)
4373 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4374 . msgtype=msgerror,
4375 . c1='DSAVE')
4376 ALLOCATE(asave(sasave) ,stat=stat)
4377 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4378 . msgtype=msgerror,
4379 . c1='ASAVE')
4380 IF(sgjbufr > 0) gjbufr = zero
4381 IF(sw > 0) w = zero
4382 IF(sveul8 > 0) veul = zero
4383 IF(sfill > 0) fill = zero
4384 IF(sdfill > 0) dfill = zero
4385 IF(salph > 0) alph = zero
4386 IF(sdsave > 0) dsave = zero
4387 IF(sasave > 0) asave = zero
4388 CALL trace_out1()
4389C--------------------------------------------
4390C LECTURE DES JOINTS COMPLEXES (GJOINT)
4391C--------------------------------------------
4392 err_msg='GJOINTS'
4393 err_category='GJOINTS'
4394 CALL trace_in1(err_msg,len_trim(err_msg))
4395 joint_sms = .false.
4396 IF(isms/=0) joint_sms = .true.
4397 IF(ngjoint/=0) CALL hm_read_gjoint(
4398 1 gjbufi ,gjbufr ,itab ,itabm1 ,x ,
4399 2 ms ,in ,lag_ncf ,lag_nkf ,lag_nhf ,
4400 3 d ,unitab ,ikine1lag,nom_opt(lnopt1*inom_opt(18)+1),lsubmodel)
4401 CALL trace_out1()
4402C--------------------------------------------
4403C READER FOR DETONATOR OPTIONS (/DFS/DET*)
4404C--------------------------------------------
4405 err_msg='DETONATORS'
4406 err_category='DETONATORS'
4407 CALL trace_in1(err_msg,len_trim(err_msg))
4408 !new Reader
4409 CALL read_detonators(itabm1 ,itab ,igrnod ,
4410 . pm ,ipm ,x ,unitab ,
4411 . lsubmodel,detonators)
4412 CALL trace_out1()
4413C--------------------------------------------
4414C A.L.E.
4415C TABLEAUX DE VOISINS (OU FACETTES) DES ELEMENTS
4416C TABLEAUX DES NOEUDS VOISINS
4417C--------------------------------------------
4418 CALL ale_connectivity%ALE_CONNECTIVITY_INIT()
4419 err_msg='ALE LINKS'
4420 err_category='ALE'
4421 CALL trace_in1(err_msg,len_trim(err_msg))
4422 IF(nalelk/=0) THEN
4423 WRITE(istdo,'(A)')titre(29)
4424 llinal = 7 * nalelk
4425 slinale=llinal
4426 ALLOCATE(linale(slinale),stat=stat)
4427 IF(ierr/=0) THEN
4428 WRITE(iout,*) ' ** ERROR IN MEMORY ALLOCATION'
4429 WRITE(istdo,*)' ** ERROR IN MEMORY ALLOCATION'
4430 ENDIF
4431 CALL hm_read_ale_link(icode, iskew, itab, itabm1, d,
4432 . igrnod, ibcslag, lag_ncf, lag_nkf, lag_nhf,
4433 . ikine1lag, linale, lsubmodel, unitab)
4434 ELSE
4435 ALLOCATE(linale(0))
4436 ENDIF
4437 err_msg='ALE NEIGHBOURS'
4438 IF(iale+ieuler+ialelag /= 0)THEN
4439 WRITE(istdo,'(A)')titre(30)
4440 CALL alelec(
4441 1 icode ,ixs ,ixq ,ixc ,ixt ,
4442 2 ixtg ,pm ,igeo ,itab ,geo ,
4443 3 nale_r2r ,nsubdom ,multi_fvm ,ale_connectivity,glob_therm%ITHERM,detonators%IS_SHADOWING_REQUIRED)
4444C ---------------------------------------------------------------
4445C Unplug neighbor elements in case of direct lagrangian coupling
4446C ---------------------------------------------------------------
4447 IF(multi_fvm%IS_USED) THEN
4448 CALL multi_unplug_neighbors(ale_connectivity, ixs, ixq, ixtg)
4449 ENDIF
4450 CALL trace_out1()
4451C--------------------------------------------
4452C MULTIMATERIALS
4453C INITIALIZATION OF NODAL PERCENTAGES
4454C--------------------------------------------
4455 CALL trace_in1(err_msg,len_trim(err_msg))
4456 IF(nmult>0)THEN
4457 WRITE(istdo,'('' .. MULTIMATERIALS'')')
4458 IF(numels>0)
4459 . CALL inimu3(pm ,ixs ,fill ,dfill )
4460 IF(numelq>0)
4461 . CALL inimu2(pm ,ixq ,fill ,dfill )
4462 CALL inimul (pm ,fill ,dfill ,mat20_discrete_fill)
4463 ENDIF
4464 ENDIF
4465 CALL trace_out1()
4466C---------------------------------------------------
4467C DETECTION DES ELEMENTS LOIS 6 PAROI---->LOI 17
4468C---------------------------------------------------
4469 err_msg='CFD BOUNDARY ELEMENTS'
4470 err_category='CFD BOUNDARY ELEMENTS'
4471 CALL trace_in1(err_msg,len_trim(err_msg))
4472 IF(iale+ieuler/=0)
4473 + CALL paroi(pm ,ixs ,ixq ,icode ,ale_connectivity%NALE )
4474 CALL trace_out1()
4475C--------------------------------------------
4476C STOCKAGE DYNAMIQUE (CHARGEMENT) ENTIER
4477C--------------------------------------------
4478C LECTURE DES ELEMENTS MULTI-PURPOSE.
4479C---------------------------------------------
4480 err_msg='MULTI-PURPOSE ELEMENTS'
4481 err_category='MULTI-PURPOSE ELEMENTS'
4482 CALL trace_in1(err_msg,len_trim(err_msg))
4483 IF(numelx > 0) THEN
4484 skxx = nixx*numelx
4485 CALL hm_preread_xelem(sixx, igrnod,lsubmodel)
4486 ALLOCATE(kxx(skxx) ,stat=stat)
4487 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4488 . msgtype=msgerror,
4489 . c1='KXX')
4490 ALLOCATE(ixx(sixx+150) ,stat=stat)
4491 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4492 . msgtype=msgerror,
4493 . c1='IXX')
4494 kxx = 0
4495 ixx = 0
4496 ALLOCATE(lelx(numelx) ,stat=stat)
4497 lelx(1:numelx) = 0
4498 CALL hm_read_xelem(igrnod ,itab ,itabm1 ,ipart ,ipartx,
4499 . ipm ,igeo ,kxx ,ixx ,lsubmodel)
4500 ELSE
4501 skxx = 0
4502 sixx = 0
4503 ALLOCATE(kxx(skxx) ,stat=stat)
4504 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4505 . msgtype=msgerror,
4506 . c1='KXX')
4507 ALLOCATE(ixx(sixx) ,stat=stat)
4508 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4509 . msgtype=msgerror,
4510 . c1='IXX')
4511 ALLOCATE(lelx(numelx) ,stat=stat)
4512 ENDIF
4513 CALL trace_out1()
4514C--------------------------------------------
4515C LECTURE DES CONDITIONS DE SYMETRIE SPH.
4516C---------------------------------------------
4517 err_msg='SPH SYM'
4518 err_category='SPH SYM'
4519 CALL trace_in1(err_msg,len_trim(err_msg))
4520 sispsym = nspcond*numsph
4521 sispcond = nspcond*nispcond
4522 ALLOCATE(ispsym(sispsym) ,stat=stat)
4523 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4524 . msgtype=msgerror,
4525 . c1='ISPSYM')
4526 ALLOCATE(ispcond(sispcond) ,stat=stat)
4527 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4528 . msgtype=msgerror,
4529 . c1='ISPCOND')
4530 IF(nspcond > 0) THEN
4531 ispsym = 0
4532 ispcond = 0
4533 WRITE(istdo,'(A)')' .. SPH SYMMETRY CONDITIONS'
4534 CALL hm_read_spcnd(ispcond ,iskew ,itab ,itabm1 ,d ,
4535 . igrnod ,nod2sp ,iframe ,nom_opt(lnopt1*inom_opt(23)+1),
4536 . lsubmodel)
4537 ENDIF
4538 CALL trace_out1()
4539C---------------------------------------------
4540C LECTURE DES INLET/OUTLET SPH.
4541C---------------------------------------------
4542 err_msg='SPH I/O'
4543 err_category='SPH I/O'
4544 CALL trace_in1(err_msg,len_trim(err_msg))
4545 lwaspio=0
4546 sisphio = nisphio*nsphio
4547 ssphveln= nsphio*numsph*2
4548 ALLOCATE(isphio(sisphio) ,stat=stat)
4549 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4550 . msgtype=msgerror,
4551 . c1='ISPHIO')
4552 ALLOCATE(sphveln(ssphveln) ,stat=stat)
4553 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4554 . msgtype=msgerror,
4555 . c1='SPHVELN')
4556 lvsphio = 0
4557 IF(nsphio > 0)THEN
4558 WRITE(istdo,'(A)')' .. SPH INLET/OUTLET DEFINITION'
4559 isphio = 0
4560 nseg_io = 0
4561 CALL hm_preread_sphio(igrsurf ,svsphio ,
4562 . nom_opt(lnopt1*inom_opt(22)+1),
4563 . lsubmodel)
4564 ALLOCATE(vsphio(svsphio) ,stat=stat)
4565 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4566 . msgtype=msgerror,
4567 . c1='VSPHIO')
4568 vsphio(1:svsphio)=zero
4569
4570c ALLOCATE(VSPHIO2(SVSPHIO2) ,STAT=stat)
4571c VSPHIO2(1:SVSPHIO2)=ZERO
4572
4573 CALL hm_read_sphio(isphio ,vsphio ,ipart ,igrsurf ,
4574 . nod2sp ,ipartsp ,itab ,x ,
4575 . lvsphio ,lwaspio ,itabm1 ,unitab ,
4576 . lsubmodel,rtrans ,nrtrans )
4577C---- -----------------------------------------
4578C PREPARATION de la LISTE TRIEE des PARTICULES ON/OFF par PART.
4579C---------------------------------------------
4580 slprtsph = 2*(npart+1)
4581 slonfsph = numsph
4582 ALLOCATE(lprtsph(slprtsph) ,stat=stat)
4583 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4584 . msgtype=msgerror,
4585 . c1='LPRTSPH')
4586 ALLOCATE(lonfsph(slonfsph) ,stat=stat)
4587 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4588 . msgtype=msgerror,
4589 . c1='LONFSPH')
4590 lprtsph = 0
4591 lonfsph = 0
4592 CALL sphonf0(kxsp ,ixsp ,nod2sp ,ipart ,ipartsp ,
4593 . lprtsph ,lonfsph )
4594 sphveln = zero
4595 IF(nspmd > 1)THEN
4596c CALL ANSTCKC(27,'SPH INLET/OUTLET DEFINITION')
4597c CALL ANCERR(755,ANINFO)
4598 END IF
4599 ELSE
4600 slprtsph = 0
4601 slonfsph = 0
4602 svsphio = 0
4603c SVSPHIO2 = 0
4604 ALLOCATE(lprtsph(slprtsph) ,stat=stat)
4605 ALLOCATE(lonfsph(slonfsph) ,stat=stat)
4606 ALLOCATE(vsphio(svsphio) ,stat=stat)
4607c ALLOCATE(VSPHIO2(SVSPHIO2) ,STAT=stat)
4608 ENDIF
4609 IF(numsph > 0)THEN
4610C---------------------------------------------
4611C REMPLISSAGE de SPBUF(2) = H
4612C---------------------------------------------
4613 CALL spinih(kxsp ,ipart ,ipartsp ,spbuf ,pm,
4614 . ixsp ,nod2sp ,x ,lprtsph,lonfsph,
4615 . snod2sp ,slonfsph,numnod,npart,itab)
4616C---------------------------------------------
4617C TRI STARTER : Remplissage de IXSP
4618C---------------------------------------------
4619 pre_search = 0
4620 sz_intp_dist = 1 ! Array MAX_INTP_DIST_PART not used for full search siz=1
4621 CALL sptri(kxsp ,ixsp ,nod2sp ,x ,spbuf ,
4622 . lprtsph ,lonfsph ,ipartsp ,sz_intp_dist,max_intp_dist_part,
4623 . pre_search)
4624 END IF
4625 CALL trace_out1()
4626C---------------------------------------------
4627C Masses nodales fluides
4628C---------------------------------------------
4629 err_msg='FLUID NODAL MASSES'
4630 err_category='FLUID NODAL MASSES'
4631 CALL trace_in1(err_msg,len_trim(err_msg))
4632 smsnf = numnod*max(iale,ieuler,ialelag)
4633 ALLOCATE(msnf(smsnf) ,stat=stat)
4634 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4635 . msgtype=msgerror,
4636 . c1='MSNF')
4637 msnf = zero
4638 CALL trace_out1()
4639C--------------------------------------------
4640C PRE-LECTURE DES FORCES CONCENTREES & PRESSIONS
4641C--------------------------------------------
4642 err_msg='CONCENTRED LOADS'
4643 err_category='CONCENTRED LOADS'
4644 CALL trace_in1(err_msg,len_trim(err_msg))
4645 numcld = nconld
4646 numpres = npreld
4647 loads%NLOAD_CLOAD = 0
4648 loads%NLOAD_PLOAD = 0
4649 IF(nsubdom>0) ALLOCATE(nncl(nconld+npreld))
4650 CALL hm_preread_cload(numcld, igrnod ,igrsurf,lsubmodel)
4651 CALL hm_preread_pload(numpres,igrnod ,igrsurf,lsubmodel)
4652 sibcl = (numcld + numpres)*nibcld
4653 sforc = (numcld + numpres)*lfaccld
4654 ALLOCATE(ibcl(sibcl) ,stat=stat)
4655 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4656 . msgtype=msgerror,
4657 . c1='IBCL')
4658 ALLOCATE(forc(sforc) ,stat=stat)
4659 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4660 . msgtype=msgerror,
4661 . c1='FORC')
4662 ALLOCATE(dpl0cld(6*(numcld+numpres)) ,stat=stat)
4663 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4664 . msgtype=msgerror,
4665 . c1='DPL0CLD')
4666 ALLOCATE(vel0cld(6*(numcld+numpres)) ,stat=stat)
4667 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4668 . msgtype=msgerror,
4669 . c1='VEL0CLD')
4670 IF(numpres>0) THEN
4671 ipres => ibcl(numcld*nibcld+1:sibcl)
4672 ELSE
4673 ipres => ibcl
4674 END IF
4675 ibcl = 0
4676 forc = zero
4677 dpl0cld = zero
4678 vel0cld = zero
4679C--------------------------------------------
4680C LECTURE DES FORCES CONCENTREES
4681C--------------------------------------------
4682 IF(nconld/=0) THEN
4683 WRITE(istdo,'(A)')titre(33)
4684C NCONLD ET NPRELD sont modifies dans LECCLD et LECPRE
4685 CALL hm_read_cload(ibcl ,forc ,nconld,itab ,itabm1 ,
4686 . igrnod ,ibcl ,unitab,iskwn ,lsubmodel,
4687 . loads )
4688 IF(nconld*lfaccld<sforc) THEN
4689 pres => forc(nconld*lfaccld+1:sforc)
4690 ELSE
4691 pres => forc
4692 ENDIF
4693 ENDIF
4694 IF(nconld*lfaccld<sforc) THEN
4695 pres => forc(nconld*lfaccld+1:sforc)
4696 ELSE
4697 pres => forc
4698 END IF
4699 CALL trace_out1()
4700C--------------------------------------------
4701C LECTURE DES PRESSIONS
4702C--------------------------------------------
4703 err_msg='PRESSURE LOADS'
4704 err_category='PRESSURE LOADS'
4705 CALL trace_in1(err_msg,len_trim(err_msg))
4706 IF(npreld/=0)THEN
4707 WRITE(istdo,'(A)')titre(34)
4708 CALL hm_read_pload(ipres ,pres ,npreld ,itab ,itabm1,
4709 . igrsurf ,unitab ,lsubmodel ,loads )
4710 nconld=nconld+npreld
4711 ENDIF
4712C NCONLD ET NPRELD sont modifies dans LECCLD et LECPRE
4713 CALL trace_out1()
4714 IF(nsubdom>0) DEALLOCATE(nncl)
4715c
4716c pressure load in cylindrical coordinates
4717c
4718 CALL hm_read_pcyl(loads ,igrsurf ,sensors%NSENSOR,sensors%SENSOR_TAB ,table ,
4719 . iframe ,unitab ,lsubmodel,number_load_cyl )
4720C--------------------------------------------
4721C "LOAD FIELDS"
4722C--------------------------------------------
4723 err_msg = 'LOAD FIELDS'
4724 err_category = 'LOAD FIELDS'
4725 CALL trace_in1(err_msg,len_trim(err_msg))
4726C
4727C CENTRIFUGAL LOADS
4728 CALL hm_preread_load_centri(numcfield,igrnod,igrsurf,lsubmodel)
4729 scfield = lfacload*nloadc
4730 sicfield = sizfield*nloadc
4731 slcfield = numcfield
4732C
4733C PFLUID & PBLAST
4734 numloadp=0
4735 nintloadp=0
4736 CALL hm_preread_pfluid(numloadp,igrnod,igrsurf,lsubmodel)
4737 CALL hm_preread_pblast(pblast,numloadp,igrsurf,lsubmodel,nsurf)
4738 CALL hm_preread_load_pressure(numloadp,igrsurf,lsubmodel)
4739 nloadp = nloadp_f+pblast%NLOADP_B+nloadp_hyd
4740 sloadp = lfacload*nloadp
4741 siloadp = sizloadp*nloadp
4742 slloadp = numloadp
4743C
4744 CALL trace_out1()
4745c------------------------------------------------------
4746c IMPOSED DISPLACEMENTS, VELOCITIES AND ACCELERATIONS
4747c------------------------------------------------------
4748 err_msg='IMPOSED VELOCITIES'
4749 err_category='IMPOSED VELOCITIES'
4750 CALL trace_in1(err_msg,len_trim(err_msg))
4751c
4752 nfvlag = 0 ! Lagrangian multiplier flag
4753C---
4754c Input : NFXVEL = number of input cards : /IMDISP + /IMPVEL + /IMPACC
4755c Output : NFXVEL = number of imposed nodes (disp + vel + acc)
4756c
4757c--- Calculate number of nodes with imposed disp, vel, acc for allocation
4758c
4759 IF(nfxvel > 0) THEN
4760 nfv0 = nfxvel
4761c
4762 CALL hm_preread_impdisp(nimpdisp ,igrnod ,ipart ,ipartr ,
4763 . unitab ,lsubmodel)
4764c
4765 CALL hm_preread_impvel(nimpvel ,igrnod ,ipart ,ipartr , nfvlag,
4766 . unitab ,lsubmodel)
4767c
4768 CALL hm_preread_impacc(nimpacc ,igrnod ,lsubmodel)
4769c
4770 nfxvel = nimpdisp + nimpvel + nimpacc
4771 ELSE
4772 nfv0 = 0
4773 nimpdisp = 0
4774 nimpvel = 0
4775 nimpacc = 0
4776 nimpv_lagm = 0
4777 ENDIF
4778c---
4779 sibfv = nfxvel * nifv
4780 svel = nfxvel * lfxvelr
4781 nfxvel0 = nfxvel
4782 ALLOCATE(ibfv(sibfv) ,stat=stat)
4783 ALLOCATE(vel(svel ) ,stat=stat)
4784 ibfv(1:sibfv) = 0
4785 vel(1:svel) = zero
4786c------------------------------------------------------
4787c
4788 IF(nfxvel > 0) THEN
4789c
4790 WRITE(istdo,'(A)')titre(44)
4791c
4792 CALL hm_read_impvel(
4793 . vel ,ibfv ,d ,ikine1lag,
4794 . itab ,itabm1 ,igrnod ,x ,ixr ,
4795 . ipart ,ipartr ,iskwn ,nom_opt(lnopt1*inom_opt(15)+1),
4796 . nimpdisp ,nimpvel ,unitab ,lsubmodel)
4797
4798 ENDIF
4799c------------------------------------------------------
4800c IMPOSED ACCELERATIONS
4801c------------------------------------------------------
4802 IF(nimpacc > 0) THEN
4803 CALL hm_read_impacc(
4804 . vel ,ibfv ,nfxvel0 ,itab ,itabm1 ,
4805 . d ,igrnod ,iskwn ,unitab ,lsubmodel,
4806 . nfxvel ,nimpacc )
4807 ENDIF
4808c
4809C /BCS/CYCLIC ini&check
4810 IF(nbcscyc > 0) THEN
4811 ALLOCATE(itagcyc(numnod) ,stat=stat)
4812 CALL ini_bcscyc(ibcscyc,lbcscyc,skew,x,itab,icode,ibfv,itagcyc)
4813 ELSE
4814 ALLOCATE(itagcyc(0))
4815 END IF
4816C--------------------------------------------
4817 sfsav = nthvki * (ninter+nrwall+nrbody+nsect+njoint+nrbag+nvolu+nmonvol+nfxbody+nintsub)
4818 ALLOCATE(fsav(sfsav) ,stat=stat)
4819 fsav = zero
4820 CALL trace_out1()
4821C ***************************************************************** C
4822C Check if ALE or EULER materials are used with lagrangian thermics
4823C ***************************************************************** C
4824C
4825C--------------------------------------------
4826C READ INITIAL TEMPERATURE
4827C--------------------------------------------
4828 nintemp = glob_therm%NINTEMP
4829 IF (iale + ieuler /= 0) THEN
4830 IF (glob_therm%ITHERM_FE == 0 .AND. (glob_therm%NIMTEMP /= 0 .OR. nintemp /= 0)) THEN
4831 CALL ancmsg(msgid=1724, anmode=aninfo, msgtype=msgwarning)
4832 ENDIF
4833 ENDIF
4834 err_msg='INITIAL TEMPERATURES'
4835 err_category='INITIAL TEMPERATURES'
4836 CALL trace_in1(err_msg,len_trim(err_msg))
4837!
4838 IF (glob_therm%NINTEMP > 0) THEN
4839 WRITE(istdo,'(A)')titre(35)
4840 ALLOCATE(temp(numnod))
4841 temp(1:numnod) = zero
4842 ALLOCATE(intids(nintemp))
4843 CALL hm_read_initemp(temp ,nintemp ,glob_therm%ITHERM_FE,itab ,itabm1 ,
4844 . igrnod ,intids ,unitab,lsubmodel )
4845 DEALLOCATE(intids)
4846 END IF
4847!
4848 IF (glob_therm%ITHERM_FE > 0 ) THEN
4849 ALLOCATE(mcp(numnod))
4850 IF (.NOT.ALLOCATED(temp)) THEN
4851 ALLOCATE(temp(numnod))
4852 temp(1:numnod) = zero
4853 END IF
4854 mcp(1:numnod) = zero
4855C
4856 CALL hm_preread_imptemp(igrsurf, igrnod, igrbric, unitab, lsubmodel,
4857 . glob_therm%NIMTEMP,glob_therm%NFXTEMP)
4858c
4859 CALL hm_preread_convec(igrsurf, igrnod, igrbric, unitab, lsubmodel,
4860 . glob_therm%NCONVEC ,glob_therm%NUMCONV )
4861c
4862 CALL hm_preread_radiation(igrsurf, igrnod, igrbric,unitab, lsubmodel,
4863 . glob_therm%NRADIA ,glob_therm%NUMRADIA)
4864c
4865 CALL hm_preread_impflux(igrsurf, igrnod, igrbric,unitab, lsubmodel,
4866 . glob_therm%NIMPFLUX,glob_therm%NFXFLUX)
4867c
4868
4869 ALLOCATE(ibcv(glob_therm%NICONV*glob_therm%NUMCONV) ,stat=stat)
4870 ALLOCATE(fconv(glob_therm%LFACTHER*glob_therm%NUMCONV) ,stat=stat)
4871 ALLOCATE(ibftemp(glob_therm%NIFT*glob_therm%NFXTEMP) ,stat=stat)
4872 ALLOCATE(fbftemp(glob_therm%LFACTHER*glob_therm%NFXTEMP),stat=stat)
4873 ALLOCATE(ibfflux(glob_therm%NITFLUX*glob_therm%NFXFLUX) ,stat=stat)
4874 ALLOCATE(fbfflux(glob_therm%LFACTHER*glob_therm%NFXFLUX),stat=stat)
4875 ALLOCATE(ibcr(glob_therm%NIRADIA*glob_therm%NUMRADIA) ,stat=stat)
4876 ALLOCATE(fradia(glob_therm%LFACTHER*glob_therm%NUMRADIA),stat=stat)
4877 .
4878 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4879 . msgtype=msgerror,
4880 . c1='THERMAL DATA')
4881 ibcr(1:glob_therm%NIRADIA*glob_therm%NUMRADIA) = 0
4882C
4883 IF (glob_therm%NUMCONV > 0 ) THEN
4884 ibcv = 0
4885 fconv = zero
4886 CALL hm_read_convec(ibcv,fconv,itab,ixs,igrsurf,unitab,lsubmodel,
4887 . glob_therm%NCONVEC ,glob_therm%NICONV,glob_therm%NUMCONV,glob_therm%LFACTHER)
4888 ENDIF
4889C
4890 IF (glob_therm%NUMRADIA > 0 ) THEN
4891 CALL hm_read_radiation(ibcr,fradia,itab,ixs,igrsurf,unitab,lsubmodel,
4892 . glob_therm%NRADIA ,glob_therm%NUMRADIA,glob_therm%NIRADIA,glob_therm%LFACTHER)
4893 ENDIF
4894C
4895 IF (glob_therm%NFXTEMP > 0) THEN
4896 ibftemp = 0
4897 fbftemp = zero
4898 CALL hm_read_imptemp(ibftemp,fbftemp,glob_therm%NFXTEMP,itabm1,
4899 . igrnod ,ibftemp,itab ,unitab,lsubmodel,
4900 . glob_therm%NIMTEMP,glob_therm%NIFT,glob_therm%LFACTHER)
4901 ENDIF
4902C
4903 IF (glob_therm%NFXFLUX > 0 ) THEN
4904 ibfflux = 0
4905 fbfflux = zero
4906 CALL hm_read_impflux(ibfflux ,fbfflux ,itab ,ixs ,igrsurf ,
4907 . unitab ,igrnod ,igrbric, lsubmodel,
4908 . glob_therm%NIMPFLUX,glob_therm%NITFLUX,glob_therm%LFACTHER)
4909 ENDIF
4910C
4911 ELSE
4912 ALLOCATE(mcp(0))
4913 ALLOCATE(ibcv(0),fconv(0),ibftemp(0),fbftemp(0),
4914 . ibfflux(0),fbfflux(0),ibcr(0),fradia(0))
4915 IF (.NOT. ALLOCATED(temp)) ALLOCATE(temp(0))
4916 ENDIF
4917C
4918 CALL trace_out1()
4919C--------------------------------------------
4920 IF(isigi==2 .OR. isigi==4) THEN
4921 sfzero = 3*numnod
4922 ELSEIF(iabs(isigi)==5) THEN
4923 sfzero = 3*4*(numelc+numeltg)
4924 ELSE
4925 sfzero = 0
4926 ENDIF
4927 ALLOCATE(fzero(sfzero) ,stat=stat)
4928 IF(sfzero > 0) fzero = zero
4929C--------------------------------------------
4930C LECTURE DES IMPACT LASER
4931C--------------------------------------------
4932 err_msg='LASER IMPACTS'
4933 err_category='LASER IMPACTS'
4934 CALL trace_in1(err_msg,len_trim(err_msg))
4935 CALL leclas(lsubmodel)
4936 CALL trace_out1()
4937C-------------------------------------------------
4938C GENERATION FACETTES EXTERNES (FICHIERS ANIM)
4939C ALE-EULER SEULEMENT
4940C-------------------------------------------------
4941 nfacx=0
4942 err_msg='ELEMENTARY BOUNDARY CONDITIONS'
4943 err_category='ELEMENTARY BOUNDARY CONDITIONS'
4944 CALL trace_in1(err_msg,len_trim(err_msg))
4945 ebcs_tag_cell_spmd(1:numelq+numeltg+numels)=0
4946 CALL read_ebcs(igrsurf,multi_fvm,npc1,lsubmodel,ebcs_tab)
4947 IF(nebcs > 0)THEN
4948 !allocate & count
4949 IF(.NOT. ALLOCATED(sensor_tmp)) ALLOCATE( sensor_tmp(0) )
4950 CALL iniebcs(ale_connectivity, 0, igrsurf, ixs, ixq, ixtg,
4951 . pm, igeo, x, sensor_tmp, monvol, multi_fvm%IS_USED,
4952 . ebcs_tab, ebcs_tag_cell_spmd)
4953 DEALLOCATE(sensor_tmp)
4954 ENDIF
4955 CALL trace_out1()
4956C--------------------------------------------
4957C LECTURE DES ACCELEROMETRES
4958C--------------------------------------------
4959 err_msg='ACCELEROMETERS'
4960 err_category='ACCELEROMETERS'
4961 CALL trace_in1(err_msg,len_trim(err_msg))
4962 saccelm = naccelm * llaccelm
4963 ALLOCATE(accelm(saccelm) ,stat=stat)
4964 IF(saccelm > 0) accelm = zero
4965 IF(naccelm > 0) CALL lecacc(
4966 1 laccelm,accelm ,itabm1 ,unitab,ixc,
4967 2 iskwn,nom_opt(lnopt1*inom_opt(1)+1), lsubmodel)
4968 CALL trace_out1()
4969C--------------------------------------------
4970C LECTURE DES GAUGES
4971C--------------------------------------------
4972 err_msg='GAUGES'
4973 err_category='GAUGES'
4974 CALL trace_in1(err_msg,len_trim(err_msg))
4975 ALLOCATE(lgauge(3*nbgauge) ,stat=stat)
4976 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4977 . msgtype=msgerror,
4978 . c1='LGAUGE')
4979 IF(nbgauge > 0) lgauge=0
4980 ALLOCATE(gauge(llgauge*nbgauge) ,stat=stat)
4981 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
4982 . msgtype=msgerror,
4983 . c1='GAUGE')
4984 IF(nbgauge > 0) gauge=zero
4985 IF(nbgauge > 0) CALL hm_read_gauge(lgauge,gauge,itabm1,unitab,ixc,nom_opt(lnopt1*inom_opt(27)+1),lsubmodel)
4986 CALL trace_out1()
4987C--------------------------------------------
4988C LECTURE DES SENSORS
4989C--------------------------------------------
4990 err_msg='SENSORS'
4991 err_category='SENSORS'
4992 CALL trace_in1(err_msg,len_trim(err_msg))
4993c
4994 ! -------------
4995 ! size initialization for user sensor
4996 CALL sensor_user_init(sensor_user_struct)
4997 ! -------------
4998c
4999 python%NB_SENSORS = 0
5000 CALL hm_read_sensors(python,
5001 . sensors ,laccelm ,itabm1 ,ipart ,lgauge ,
5002 . subsets ,nsets ,igrsurf ,igrnod ,bufsf ,
5003 . skew ,iskwn ,unitab ,lsubmodel ,hm_nsensor,
5004 . sensor_user_struct)
5005 ! -----------------
5006 ! check if a user sensor is used with a list of node
5007 ! convert the list of User node ID into Local node ID
5008
5009 IF(sensor_user_struct%IS_USED) THEN
5010 IF(sensor_user_struct%POINTER_NODE > 0) THEN
5011 CALL sensor_user_convert_local_id(
5012 . itabm1,sensor_user_struct%POINTER_NODE,sensor_user_struct%NUMBER_NODE,
5013 . sensor_user_struct%NODE_LIST,1,ipart)
5014 ENDIF
5015 ENDIF
5016 ! -----------------
5017 CALL trace_out1()
5018
5019C--------------------------------------------
5020C LECTURE DES VITESSES INITIALES
5021C--------------------------------------------
5022 err_msg='INITIAL VELOCITIES'
5023 err_category='INITIAL VELOCITIES'
5024 CALL trace_in1(err_msg,len_trim(err_msg))
5025C
5026 IF(nrbody > 0) THEN
5027 ALLOCATE(rby_iniaxis(7,nrbody))
5028 rby_iniaxis = zero
5029 ELSE
5030 ALLOCATE(rby_iniaxis(0,0))
5031 ENDIF
5032C
5033 ninivelt = 0 ! /INIVEL w/ T_start
5034 IF(ninvel > 0 ) CALL hm_preread_inivel(lsubmodel,unitab,hm_ninvel,ninivelt)
5035 loads%NINIVELT = ninivelt
5036 IF(ninvel/=0.OR.isigi>=3)THEN
5037 siwork = ninvel
5038 ALLOCATE(iwork(siwork) ,stat=stat)
5039 iwork = 0
5040 WRITE(istdo,'(A)')titre(35)
5041 ALLOCATE(fvm_inivel(ninvel))
5042 DO i = 1, ninvel
5043 fvm_inivel(i)%FLAG = .false.
5044 ENDDO
5045 ALLOCATE(loads%INIVELT(ninivelt) ,stat=stat)
5046C
5047 CALL hm_read_inivel(v , w , itab , itabm1 , vr ,
5048 . igrnod , igrbric, iskwn , skew , iwork ,
5049 . x , unitab , lsubmodel, rtrans , xframe ,
5050 . iframe , vflow , wflow , kxsp , multi_fvm ,
5051 . fvm_inivel, igrquad, igrsh3n , rby_msn, rby_iniaxis,
5052 . sensors ,ninivelt,loads%INIVELT)
5053 CALL inivel(v, vr, svr_1, itabm1)
5054C
5055 IF(ALLOCATED(iwork)) DEALLOCATE(iwork)
5056 ninvel = siwork
5057C
5058 ELSE
5059 ALLOCATE(fvm_inivel(0:0))
5060 ENDIF
5061C
5062 IF(ALLOCATED(rby_msn)) DEALLOCATE(rby_msn)
5063C
5064 CALL trace_out1()
5065
5066C--------------------------------------------
5067C /BCS/WALL - SLIDING BOUNDARY CONDITION
5068C (COLLOCATED SCHEME / LAW 151)
5069C--------------------------------------------
5070 IF(bcs%NUM_WALL /= 0) THEN
5071C READ /BCS/WALL
5072 CALL hm_read_bcs_wall(unitab, lsubmodel, igrnod, ngrnod, sensors, itabm1, numnod, multi_fvm)
5073 ENDIF
5074
5075C--------------------------------------------
5076C LECTURE DES PRELOADS
5077C--------------------------------------------
5078 err_msg='BOLT PRELOADING'
5079 err_category='BOLT PRELOADING'
5080 CALL trace_in1(err_msg,len_trim(err_msg))
5081c
5082 npreload_a = npreload
5083 CALL hm_pre_read_preload_axial(ngrspri,igrspring,npreload_a,lsubmodel)
5084 numpreload = npreload
5085 IF(npreload > npreload_a) THEN
5086 IF(nsect /= 0)THEN
5087 CALL prelecsec4bolt(snstrf,ssecbuf,igrnod,itabm1,0,
5088 . nom_opt(lnopt1*inom_opt(8)+1),igrbric,lsubmodel)
5089 ALLOCATE(nstrf(snstrf) ,stat=stat)
5090 ALLOCATE(secbuf(ssecbuf) ,stat=stat)
5091 nstrf = 0
5092 secbuf = zero
5093 CALL lecsec4bolt(ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
5094 2 ixtg ,x ,nstrf ,itab ,itabm1 ,
5095 3 igrnod ,secbuf ,
5096 4 ipari ,ixs10 ,ixs20 ,ixs16 ,unitab ,
5097 5 iskwn ,xframe ,eani,nom_sect,rtrans,
5098 6 lsubmodel,nom_opt(lnopt1*inom_opt(8)+1),igrbric)
5099 ENDIF
5100 CALL hm_pre_read_preload(nstrf,lsubmodel) !to calculate NUMPRELOAD = NUMPRELOAD + NN (NN = NSTRF(K0+7) = NSEGS)
5101 sipreload = 3*numpreload !! sb - A ajuster
5102 spreload = 6*numpreload !! sb - A ajuster
5103 ALLOCATE(ipreload(sipreload) ,stat=stat)
5104 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5105 . msgtype=msgerror,
5106 . c1='IPRELOAD')
5107 ALLOCATE(preload(spreload) ,stat=stat)
5108 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5109 . msgtype=msgerror,
5110 . c1='PRELOAD')
5111 ALLOCATE(iflag_bpreload(numels) ,stat=stat)
5112 IF(stat /= 0) CALL ancmsg(msgid= 268,anmode=aninfo,
5113 . msgtype= msgerror,
5114 . c1= 'IFLAG_BPRELOAD')
5115 ipreload = 0
5116 iflag_bpreload = 0
5117 preload = zero
5118
5119 WRITE(istdo,'(A)')titre(34)
5120 CALL hm_read_preload(ixs ,ixs10 ,ipreload ,preload,iflag_bpreload,
5121 . nstrf ,sensors ,unitab ,x ,
5122 . eani ,itab ,lsubmodel)
5123c
5124 IF(ALLOCATED(nstrf)) DEALLOCATE(nstrf)
5125 IF(ALLOCATED(secbuf)) DEALLOCATE(secbuf)
5126 snstrf = 0
5127 ssecbuf = 0
5128 ELSE
5129 ALLOCATE(ipreload(0) ,stat=stat)
5130 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5131 . msgtype=msgerror,
5132 . c1='IPRELOAD')
5133 ALLOCATE(preload(0) ,stat=stat)
5134 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5135 . msgtype=msgerror,
5136 . c1='PRELOAD')
5137 ALLOCATE(iflag_bpreload(0) ,stat=stat)
5138 IF(stat /= 0) CALL ancmsg(msgid= 268,anmode=aninfo,
5139 . msgtype= msgerror,
5140 . c1= 'IFLAG_BPRELOAD')
5141 ENDIF
5142! /PRELOAD/AXIAL 2 int 2 real per preload, itag_spring...
5143 ALLOCATE(preload_a(npreload_a) ,stat=stat)
5144 ALLOCATE(itagprld_spring(numelr) ,stat=stat)
5145 ALLOCATE(itagprld_beam(numelp) ,stat=stat)
5146 ALLOCATE(itagprld_truss(numelt) ,stat=stat)
5147 IF(stat /= 0) CALL ancmsg(msgid= 268,anmode=aninfo,
5148 . msgtype= msgerror,
5149 . c1= 'PRELOAD_AXIAL')
5150! itagprld_spring(nsprint), itagpre_beam(nbeam) : id of preload/axial; used for element grouping
5151 itagprld_spring = 0
5152 itagprld_beam = 0
5153 itagprld_truss = 0
5154 IF (npreload_a > 0) THEN
5155 CALL hm_read_preload_axial(
5156 . npreload_a, ngrspri, igrspring, itagprld_spring,
5157 . unitab , lsubmodel, preload_a, numelr ,
5158 . snpc , npc , nfunct , sensors ,
5159 . ngrbeam , igrbeam , numelp , itagprld_beam ,
5160 . ngrtrus , igrtruss , numelt , itagprld_truss ,
5161 . iout )
5162 npreload = npreload - npreload_a
5163 END IF
5164 CALL trace_out1()
5165C-------------------------------------------------
5166C LECTURE DES LIENS RIGIDES
5167C--------------------------------------------
5168 err_msg='RIGID LINKS'
5169 err_category='RIGID LINKS'
5170 CALL trace_in1(err_msg,len_trim(err_msg))
5171 CALL hm_pre_read_link(numlink, igrnod,lsubmodel)
5172 snnlink = 10*nlink
5173 slnlink = numlink
5174 ALLOCATE(nnlink(snnlink) ,stat=stat)
5175 ALLOCATE(lnlink(slnlink) ,stat=stat)
5176 IF(snnlink > 0) nnlink = 0
5177 IF(slnlink > 0) lnlink = 0
5178 IF(nlink > 0) THEN
5179 CALL hm_read_link(
5180 1 nnlink ,lnlink ,itab ,itabm1 ,d ,
5181 2 igrnod ,iskwn ,iframe ,nom_opt(lnopt1*inom_opt(9)+1),lsubmodel)
5182 ENDIF
5183C
5184 sfbvel = 3*nibvel
5185 sgrav = lfacgrv*ngrav
5186 sfr_wave = numnod*ifrwv
5187 sparts0 = npart
5188 ALLOCATE(fbvel(sfbvel) ,stat=stat)
5189 ALLOCATE(grav(sgrav ) ,stat=stat)
5190 ALLOCATE(fr_wave(sfr_wave) ,stat=stat)
5191 ALLOCATE(parts0(sparts0) ,stat=stat)
5192 IF(sfbvel > 0) fbvel = zero
5193 IF(sgrav > 0) grav = zero
5194 IF(sfr_wave > 0) fr_wave = zero
5195 IF(sparts0 > 0) parts0 = zero
5196c--------------------------------------------
5197 CALL trace_out1()
5198C--------------------------------------------
5199C LECTURE DES ANCIENS POIDS
5200C--------------------------------------------
5201 CALL prelec_ddw(filnam,len_filnam,marqueur3)
5202 IF(marqueur3) THEN
5203 WRITE(iout,'(A)')' '
5204 WRITE(iout,'(A)')
5205 . ' --------------------------------------'
5206 WRITE(iout,'(A)')
5207 . ' DDW OPTION FOR THE DOMAIN DECOMPOSITION'
5208 WRITE(iout,'(A)')
5209 . ' --------------------------------------'
5210 WRITE(istdo,*)
5211 . '.. DDW OPTION FOR THE DOMAIN DECOMPOSITION'
5212
5213 ALLOCATE(tab_ump_old(7,taille_old),stat=stat)
5214 ALLOCATE(cputime_mp_old(taille_old),stat=stat)
5215 tab_ump_old = 0
5216 cputime_mp_old = zero
5217
5218 CALL lec_ddw(filnam,len_filnam,tab_ump_old,cputime_mp_old)
5219
5220 CALL prelec_ddw_poin(filnam,len_filnam)
5221 ALLOCATE(poin_ump_old(nummat_old), stat=stat)
5222 poin_ump_old = 0
5223
5224 CALL lec_ddw_poin(filnam,len_filnam,poin_ump_old)
5225 ELSE
5226 ALLOCATE(tab_ump_old(0,0),stat=stat)
5227 ALLOCATE(cputime_mp_old(0),stat=stat)
5228 ALLOCATE(poin_ump_old(0), stat=stat)
5229 ENDIF
5230C--------------------------------------------
5231C USER S WINDOW
5232C--------------------------------------------
5233 err_msg='USER WINDOWS'
5234 err_category='USER WINDOWS'
5235 CALL trace_in1(err_msg,len_trim(err_msg))
5236C
5237 IF(user_windows%HAS_USER_WINDOW /= 0 ) THEN
5238!
5239!==============
5240 CALL hm_read_window_user(user_windows,lsubmodel,itab,
5241 * x, v, vr, ms, in)
5242!==============
5243!
5244 ENDIF
5245 CALL trace_out1()
5246C---------------------------
5247C Calcul ELEM RBY ON/OFF pour domdec
5248C---------------------------
5249 err_msg='RIGID BODIES ON'
5250 err_category='RIGID BODIES'
5251 CALL trace_in1(err_msg,len_trim(err_msg))
5252 IF(numels /=0) isoloff = 0
5253 IF(numelc /=0) isheoff = 0
5254 IF(numelt /=0) itruoff = 0
5255 IF(numelp /=0) ipouoff = 0
5256 IF(numelr /=0) iresoff = 0
5257 IF(numeltg /=0) itrioff = 0
5258 IF(numelq /=0) iquaoff = 0
5259 CALL setrbyon(
5260 1 ixs ,ixc ,ixtg ,igrnod ,igrnrby ,
5261 2 isoloff ,isheoff ,itrioff,knod2els,knod2elc,
5262 5 knod2eltg,nod2els ,nod2elc,nod2eltg,ixq ,
5263 6 iquaoff ,knod2elq,nod2elq,lsubmodel)
5264 CALL trace_out1()
5265C---------------------------
5266C Calcul ELEM OFF (RBE2) pour domdec
5267C---------------------------
5268 err_msg='RBE2 ON'
5269 err_category='RBE2'
5270 CALL trace_in1(err_msg,len_trim(err_msg))
5271 CALL setrb2on(
5272 1 ixs ,ixc ,ixtg ,igrnod ,
5273 2 igrnrb2,isoloff,isheoff,itrioff,itabm1,
5274 3 lsubmodel)
5275 CALL trace_out1()
5276C---------------------------------------------
5277C Calcul FLEXIBLE BODY - ELEM OFF pour domdec
5278C---------------------------------------------
5279 err_msg='FLEXIBLE BODIES ON'
5280 err_category='FLEXIBLE BODIES'
5281 CALL trace_in1(err_msg,len_trim(err_msg))
5282 IF(nfxbody > 0)THEN
5283 lenmod=0
5284 CALL hm_setfxrbyon(itabm1,ixs,isoloff,ixc,isheoff,
5285 1 ixt,itruoff,ixp,ipouoff,ixr,iresoff,
5286 2 ixtg,itrioff,fxbipm,lsubmodel)
5287 ENDIF
5288 CALL trace_out1()
5289C--------------------------------------------
5290C LECTURE DES CLUSTERS DES ELEMENTS
5291C--------------------------------------------
5292 err_msg='CLUSTERS'
5293 err_category='CLUSTERS'
5294 ALLOCATE(clusters(ncluster), stat=stat)
5295 CALL hm_read_cluster(
5296 . clusters ,unitab ,iskwn ,igrbric ,igrspring,
5297 . ixs ,ixr ,nom_opt(lnopt1*inom_opt(28)+1),
5298 . lsubmodel)
5299C--------------------------------------------
5300C LECTURE DES INITIAL VOLUME FRACTIONS
5301C--------------------------------------------
5302 CALL hm_read_inivol(inivol, kvol, igrsurf ,ipart, multi_fvm, bufmat,
5303 * ipm, nbsubmat, lsubmodel, unitab,
5304 * n2d ,numeltg,numels,numelq,nummat,
5305 * npart,nsurf,lipart1,npropmi,sipart,sinivol,
5306 * nsubdom,sbufmat,igrnod,ngrnod)
5307C--------------------------------------------
5308C Surfaces fictives IGE
5309C--------------------------------------------
5310 IF(tagsurfige>0) THEN
5311 snige = iadtabige
5312 nige => nige_tmp(idxige2)%ptr
5313C--------------------------------------------
5314 srige = iadtabige
5315 rige => rige_tmp(idxige2)%ptr2
5316C--------------------------------------------
5317 sxige = iadtabige
5318 xige => xige_tmp(idxige2)%ptr2
5319C--------------------------------------------
5320 svige = iadtabige
5321 vige => vige_tmp(idxige2)%ptr2
5322 ENDIF
5323 CALL trace_out1()
5324
5325
5326C -------------------------------------------------
5327C Check surfaces for airbags
5328C -------------------------------------------------
5329 CALL check_surf(igrsurf)
5330C----------------------------------
5331C READER FOR MONITORED VOLUMES
5332C----------------------------------
5333 err_msg='MONITORED VOLUMES'
5334 err_category='MONITORED VOLUMES'
5335 CALL trace_in1(err_msg,len_trim(err_msg))
5336 ibagsurf = 0
5337 libagale = 0
5338 lrbagale = 0
5339 nventtot = 0
5340 ALLOCATE(t_monvol(nvolu + nmonvol))
5341 CALL monvol_allocate(nvolu + nmonvol, t_monvol, t_monvol_metadata)
5342 IF(nvolu + nmonvol> 0) THEN
5343 WRITE(istdo,'(A)') ' .. MONITORED VOLUMES '
5344
5345 CALL read_monvol(t_monvol, t_monvol_metadata, itab, itabm1, ipm, igeo,
5346 . x, pm, geo, ixc, ixtg, sensors,
5347 . unitab, npc1, npc, tf, igrsurf, igrbric, nom_opt(lnopt1*inom_opt(2)+1),iframe, xframe,
5348 . lsubmodel)
5349
5350 CALL init_monvol(t_monvol, t_monvol_metadata,
5351 3 ixc , ixtg ,x ,npc1 ,
5352 4 itab , igrsurf ,
5353 5 sensors , igrbric ,sbufale ,
5354 6 ixs , v ,libagale,
5355 7 lrbagale )
5356
5357 libagjet=0
5358 lrbagjet=0
5359 libaghol=0
5360 lrbaghol=0
5361 lrcbag = 0
5362 licbag = nicbag * nvolu * nvolu
5363 DO ii = 1, nvolu
5364 libagjet = libagjet + nibjet * t_monvol(ii)%NJET
5365 lrbagjet = lrbagjet + nrbjet * t_monvol(ii)%NJET
5366 libaghol = libaghol + nibhol * t_monvol(ii)%NVENT
5367 lrbaghol = lrbaghol + nrbhol * t_monvol(ii)%NVENT
5368 IF(t_monvol(ii)%TYPE == 5 .OR. t_monvol(ii)%TYPE == 9) THEN
5369 lrcbag = lrcbag + t_monvol(ii)%NCA * nrcbag
5370 ENDIF
5371 ENDDO
5372
5373 svolmon0 = nrvolu * nvolu + lrcbag + lrbagjet + lrbaghol
5374 svolmon = svolmon0 + sbufale + 1
5375 ALLOCATE(volmon(svolmon), stat = stat)
5376 volmon(1:svolmon) = zero
5377
5378 smonvol = nimv * nvolu + licbag + libagjet + libaghol + libagale
5379 ALLOCATE(monvol(smonvol), stat = stat)
5380 monvol(1:smonvol) = 0
5381 ELSE
5382 ALLOCATE(monvol(0))
5383 ALLOCATE(volmon(0))
5384 ENDIF
5385 CALL trace_out1()
5386C---------------------------
5387C Calcul de DOF pour domdec implicite
5388C---------------------------
5389 err_msg='IMPLICIT DOMAIN DECOMPOSITION'
5390 err_category='IMPLICIT DOMAIN DECOMPOSITION'
5391 CALL trace_in1(err_msg,len_trim(err_msg))
5392 CALL dsdim0(
5393 1 dsdof,ixs , ixq, ixc , ixt,
5394 2 ixp ,ixr , ixtg, kxx,
5395 3 ixx ,geo )
5396C---------------------------
5397C DOMAIN DECOMPOSITION SUR MODELE COMPLET
5398C CEP tableau donnant pour chaque element le proc associe.
5399C allocation de taille NELEM
5400C---------------------------
5401C IDDLEVEL indique le niveau de la domdec :
5402C 0 == niveau 1) non prise en compte des interfaces (input v31)
5403C 1 == niveau 2) prise en compte des interfaces dans la dd (input v41)
5404C---------------------------
5405 iddlevel = 0
5406 nelemint = 0
5407 ifixin = 1
5408 ifiend = 1
5409 DO i = 1, numnod
5410 iwcont(i) = 0
5411 iwcont(numnod+i) = 0
5412 iwcin2(i)= 0
5413 iwcin2(numnod+i)= 0
5414c save IENTRY
5415c replace save of old FRONT
5416c FRONT(I,NSPMD+1) = FRONT(I,1)
5417 ientry2(i) = ifront%IENTRY(i)
5418 ENDDO
5419 DO i=0,maxlaw
5420 sol1tnl(i,1)=zero
5421 sol1tnl(i,2)=zero
5422 sol1tnl(i,3)=zero
5423
5424 sol8tnl(i,1)=zero
5425 sol8tnl(i,2)=zero
5426 sol8tnl(i,3)=zero
5427
5428 DO j=0,3
5429 shtnl(i,j,1)=zero
5430 shtnl(i,j,2)=zero
5431 shtnl(i,j,3)=zero
5432
5433 tritnl(i,j,1)=zero
5434 tritnl(i,j,2)=zero
5435 tritnl(i,j,3)=zero
5436 ENDDO
5437 ENDDO
5438 DO i=1,10
5439 soltelt(i)=zero
5440 shtelt(i)=zero
5441 tritelt(i)=zero
5442 ENDDO
5443 tpsref = zero
5444C Sauvegarde longueurs tableaux lagmult
5445 lag_ncf0 = lag_ncf
5446 lag_nkf0 = lag_nkf
5447 lag_nhf0 = lag_nhf
5448 lag_ncl0 = lag_ncl
5449 lag_nkl0 = lag_nkl
5450 CALL trace_out1()
5451C-----------------
5452C Update stack Due to DRAPE
5453C-------------------------
5454 IF(ndrape > 0 .AND. (ipart_stack > 0 .OR. ipart_pcompp > 0)) THEN
5455 CALL shellthk_upd(drape ,stack ,thke ,ixc ,ixtg ,
5456 . igeo ,iworksh ,drapeg%INDX)
5457 ENDIF
5458C-----------------------------------------------------
5459C LECTURE DES /PERTURB( random noise sur les epaisseurs des shells/part )
5460C-----------------------------------------------------
5461 err_msg='PERTURB'
5462 err_category='PERTURB'
5463 CALL trace_in1(err_msg,len_trim(err_msg))
5464
5465 IF(iperturb /= 0) THEN
5466 srnoise1=nperturb
5467 srnoise2=numelc+numeltg+numels+numsph
5468 ALLOCATE(rnoise(nperturb,numelc+numeltg+numels+numsph))
5469 rnoise(1:nperturb,1:numelc+numeltg+numels+numsph) = zero
5470 ALLOCATE(perturb(nperturb))
5471 perturb(1:nperturb) = 0
5472 ALLOCATE(qp_iperturb(nperturb,6))
5473 qp_iperturb(1:nperturb,1:6) = 0
5474 ALLOCATE(qp_rperturb(nperturb,4))
5475 qp_rperturb(1:nperturb,1:4) = zero
5476 CALL hm_read_perturb(mat_elem%MAT_PARAM,
5477 . ipart ,rnoise ,ipartc ,ipartg ,ipartsp ,
5478 . igrpart ,ipm ,iparts ,perturb ,qp_iperturb,
5479 . qp_rperturb ,lsubmodel,unitab )
5480 ELSE
5481 srnoise1=1
5482 srnoise2=1
5483 ALLOCATE(rnoise(1,1))
5484 rnoise(1,1) = zero
5485 ALLOCATE(perturb(1))
5486 perturb(1) = 0
5487 ALLOCATE(qp_iperturb(0,0))
5488 ALLOCATE(qp_rperturb(0,0))
5489 ENDIF
5490
5491 CALL trace_out1()
5492C-----------------
5493C Global Mat for PID 11 and PID51 (for shell)
5494C-------------------------
5495!! IF(IGLOBMAT > 0) THEN ! global flag can be added
5496 CALL globmat(igeo , geo ,pm ,stack%PM, stack%GEO,stack%IGEO)
5497!! ENDIF
5498C-------------------------
5499C Fill index to renumber Solid elements after Domain Decomposition
5500C Array has 2 parts :
5501C PERMUTATION%SOLID(1:NUMELS) : INDEX(NEW ID)=OLD_ID
5502C PERMUTATION%SOLID(NUMELS+1:2*NUMELS) : INDEX(OLD)=NEW_ID
5503 ALLOCATE(permutation%SOLID(max(2*numels,1)))
5504 ALLOCATE(permutation%SHELL(max(2*numelc,1)))
5505 ALLOCATE(permutation%TRIANGLE(max(2*numeltg,1)))
5506 permutation%TRIANGLE = 0
5507 permutation%SHELL = 0
5508 permutation%SOLID = 0
5509
5510C------------------------------------------------------------------------
5511C REMPLACEMENT DES NOS EXTERNES DES FCTS ET SKEW PAR LES NOS SYSTEMES
5512C------------------------------------------------------------------------
5513 err_msg='USER TO SYSTEM RENUMBERING'
5514 err_category='INTERNAL'
5515 CALL trace_in1(err_msg,len_trim(err_msg))
5516 CALL fsdcod(python, bufmat ,pm ,geo ,ibcl ,ipres ,
5517 . ibfv ,iskew ,iskwn ,sensors ,mat_elem%MAT_PARAM ,
5518 . itabm1 ,skew ,laccelm ,bid13 ,bufgeo ,
5519 . ibcslag ,igeo ,ipm ,
5520 . ibftemp ,ibcv ,ibfv ,
5521 . ibcr ,table ,npc1 ,npc ,tf ,
5522 . nom_opt(lnopt1*inom_opt(3)+1),ibfflux ,glob_therm,nimpvel,nimpdisp,
5523 . nimpacc)
5524C
5525c------------------------------------------------------------------------
5526c Update & check parameters of material laws
5527c------------------------------------------------------------------------
5528 CALL updmat(bufmat ,pm ,ipm ,table ,npc1 ,
5529 . npc ,tf ,sensors ,nloc_dmg ,mlaw_tag ,
5530 . mat_elem%MAT_PARAM)
5531c
5532 CALL updfail(mat_elem%MAT_PARAM ,nummat ,nfunct ,ntable ,npc1 ,table ,
5533 . fail_fractal,ngrshel ,ngrsh3n,igrsh4n ,igrsh3n ,
5534 . nixc ,ixc ,nixtg ,ixtg ,numelc ,numeltg ,
5535 . iworksh ,stack ,igeo ,npropgi ,numgeo ,fail_brokmann)
5536C
5537 CALL trace_out1()
5538C------------------------------------------------------------------------
5539C OPTIONS SPH:
5540C REMPLACEMENT DES NOS EXTERNES DES FCTS
5541C------------------------------------------------------------------------
5542 CALL trace_in1(err_msg,len_trim(err_msg))
5543 IF(nsphio/=0)
5544 . CALL sphdcod(npc1,isphio,nom_opt(lnopt1*inom_opt(22)+1))
5545 CALL trace_out1()
5546C
5547C------------------------------------------------------------------------
5548C
5549CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
5550C
5551C 100 return adress for domain decomposition after reading of contact interfaces or AMS element selection
5552C
5553CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
5554
5555 100 CONTINUE
5556
5557 CALL init_permutation()
5558C
5559 IF(iddlevel==1) THEN
5560 totaddmas = zero
5561 ms = zero
5562 in = zero
5563 mcp = zero
5564 msnf = zero
5565C
5566 IF((nsubdom>0)) THEN
5567C For multidomains - Mass and inertia must be nonzero for coupled nodes
5568 DO i=1,numnod
5569 IF(tagno(i+n_part) > 1) THEN
5570 ms(i)=1e-20
5571 IF(iroddl==1) in(i)=1e-20
5572 ENDIF
5573 END DO
5574 ENDIF
5575C
5576 ENDIF
5577C
5578c-----------------------------------------------------------------------
5579c Create seatbelt entities + domdec
5580c-----------------------------------------------------------------------
5581C
5582 n_seatbelt = 0
5583 IF(nb_mat_seatbelt > 0) THEN
5584 err_msg='SEATBELTS'
5585 err_category='SEATBELTS'
5586 CALL trace_in1(err_msg,len_trim(err_msg))
5587 WRITE(istdo,'(A)')' .. SEATBELT INITIALIZATION'
5588 CALL create_seatbelt(ixr,itab,knod2el1d,nod2el1d,ipm,
5589 . x,sensors,bufmat,pm,geo,
5590 . iddlevel,knod2elc,nod2elc,ixc,igeo,
5591 . iskwn ,tf ,npc)
5592 CALL trace_out1()
5593 ENDIF
5594C
5595C------------------------------------------------------------------
5596C RAYLEIGH DAMPING
5597C--------------------------------------------
5598 IF (ndamp > 0) THEN
5599 IF(iddlevel==0)THEN
5600 err_msg='DAMPING'
5601 err_category='DAMPING'
5602 CALL trace_in1(err_msg,len_trim(err_msg))
5603 IF(ndamp > 0) CALL hm_read_damp(dampr,igrnod,iskwn,lsubmodel,unitab,
5604 . snpc1,npc1,ndamp_vrel_rby,igrpart,damp_range_part)
5605 CALL trace_out1()
5606 ENDIF
5607 ENDIF
5608C
5609c-----------------------------------------------------------------------
5610C
5611 IF(isms == 0) THEN
5612 IF(.NOT. ALLOCATED(tagprt_sms)) THEN
5613 ALLOCATE(tagprt_sms(0))
5614 ALLOCATE(nativ_sms(0))
5615 ALLOCATE(t2main_sms(4,0))
5616 ENDIF
5617 ELSEIF(isms/=0)THEN
5618 err_msg='AMS'
5619 err_category='AMS'
5620 WRITE(istdo,'(A)')' .. AMS INITIALIZATION'
5621 IF(iddlevel==0) THEN
5622C
5623 err_msg='AMS INITIALIZATION PHASE I'
5624 CALL trace_in1(err_msg,len_trim(err_msg))
5625C
5626 ALLOCATE(tagprt_sms(npart),nativ_sms(numnod),t2main_sms(4,numnod),stat=stat)
5627C
5628 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5629 . msgtype=msgerror,
5630 . c1='TAGPRT_SMS / NATIV_SMS / T2MAIN_SMS')
5631 tagprt_sms=0
5632 nativ_sms(1:numnod)=0
5633 t2main_sms=0
5634C
5635 CALL inisms(igrpart ,iparts ,ipartq ,ipartc ,
5636 . ipartt ,ipartp ,ipartr ,ipartg ,
5637 . ipartx ,tagprt_sms )
5638C
5639 CALL trace_out1()
5640C
5641 ELSE
5642C
5643C AMS Prepare DOMETIS
5644C
5645 err_msg='AMS INITIALIZATION PHASE II'
5646 CALL trace_in1(err_msg,len_trim(err_msg))
5647C
5648 ALLOCATE(kinwork(numnod),stat=stat)
5649 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5650 . msgtype=msgerror,
5651 . c1='KINWORK')
5652 CALL kinrem(d ,kinwork ,rwbuf ,itab ,nprw ,
5653 . lprw ,npby ,lpby )
5654C
5655 ALLOCATE(tagrel_sms(ngroup),tagslv_rby_sms(numnod),tagmsr_rby_sms(numnod),
5656 . kad_sms(numnod+1), jad_sms(numnod+1), iad_sms(numnod+1), lad_sms(numnod+1),
5657 . jadc_sms(4*numelc),
5658 . jads_sms(8*numels), jads10_sms(6*numels10),
5659 . jadt_sms(2*numelt),
5660 . jadp_sms(2*numelp),
5661 . jadr_sms(3*numelr),
5662 . jadtg_sms(3*numeltg), jadrb_sms(nrbody),
5663 . stat=stat)
5664 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5665 . msgtype=msgerror,
5666 . c1='TAGREL_SMS')
5667C
5668C
5669 CALL sms_init(
5670 1 ixs ,ixq ,ixc ,ixt ,ixp ,
5671 2 ixr ,ixtg ,ixtg1 ,ixs10 ,ixs16 ,
5672 3 ixs20 ,iparg ,dsdof ,
5673 4 icodt ,icodr ,kinwork ,
5674 5 iparts ,ipartq ,ipartc ,
5675 6 ipartt ,ipartp ,ipartr ,ipartg ,
5676 7 ipartx ,tagprt_sms ,itab ,irbe2 ,
5677 8 irbe3 ,lrbe2 ,lrbe3 ,nprw ,lprw ,
5678 9 ipart ,igeo ,ipm ,nativ_sms,npby ,
5679 a lpby ,tagmsr_rby_sms,tagslv_rby_sms,nom_opt)
5680C
5681 CALL sms_ini_kad(
5682 1 ixs ,ixq ,ixc ,ixt ,ixp ,
5683 2 ixr ,ixtg ,ixtg1 ,ixs10 ,ixs16 ,
5684 3 ixs20 ,iparg ,ms ,ms0 ,dsdof ,
5685 4 icodt ,icodr ,kinet ,
5686 5 kad_sms ,iparts ,ipartq ,
5687 6 ipartc ,ipartt ,ipartp ,ipartr ,
5688 7 ipartg ,ipartx ,tagprt_sms,tagrel_sms,itab ,
5689 8 irbe2 ,irbe3 ,lrbe2 ,lrbe3 ,
5690 9 nprw ,lprw ,ipart ,igeo ,nativ_sms)
5691
5692C
5693 ALLOCATE(kdi_sms(knz_sms),pk_sms(knz_sms),
5694 . stat=stat)
5695 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5696 . msgtype=msgerror,
5697 . c1='KDI_SMS')
5698C
5699 CALL sms_ini_kdi(
5700 2 ixc ,iparg ,ixs ,ixt ,ixp ,
5701 3 ixr ,ixtg ,ixs10 ,dsdof ,kad_sms ,
5702 4 kdi_sms ,jadc_sms,jads_sms ,jads10_sms ,
5703 5 jadt_sms ,jadp_sms,
5704 6 jadr_sms,jadtg_sms,tagprt_sms,iad_sms ,
5705 7 tagrel_sms,iparts ,ipartq ,ipartc ,ipartt ,
5706 8 ipartp ,ipartr ,ipartg ,ipartx ,
5707 9 npby ,lpby ,kinet ,tagslv_rby_sms,ipari ,
5708 a intbuf_tab,lad_sms ,ipart ,igeo ,nativ_sms)
5709C
5710 ALLOCATE(idi_sms(nnz_sms),jdi_sms(nnz_sms),stat=stat)
5711 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5712 . msgtype=msgerror,
5713 . c1='JDI_SMS')
5714C
5715 CALL sms_ini_jad_1(
5716 2 ixc ,iparg ,ixs ,ixt ,ixp ,
5717 3 ixr ,ixtg ,ixs10 ,dsdof ,jadc_sms ,
5718 4 jads_sms ,jads10_sms,jadt_sms ,jadp_sms,jadr_sms ,
5719 5 jadtg_sms,tagprt_sms,kad_sms,kdi_sms ,pk_sms ,
5720 6 tagrel_sms,iparts ,ipartq ,ipartc ,ipartt ,
5721 7 ipartp ,ipartr ,ipartg ,ipartx ,
5722 8 npby ,lpby ,kinet ,tagslv_rby_sms,ipari ,
5723 9 intbuf_tab,lad_sms ,ipart ,igeo ,nativ_sms ,
5724 a iad_sms ,idi_sms,jad_sms ,jdi_sms ,t2main_sms)
5725
5726 DEALLOCATE(jdi_sms)
5727
5728 ALLOCATE(jdi_sms(nnz_sms),stat=stat)
5729 IF(stat/=0) THEN
5730 CALL ancmsg(msgid=268,anmode=aninfo,
5731 . msgtype=msgerror,
5732 . c1='JDI_SMS')
5733 CALL arret(2)
5734 ENDIF
5735
5736 CALL sms_ini_jad_2(
5737 2 ixc ,iparg ,ixs ,ixt ,ixp ,
5738 3 ixr ,ixtg ,ixs10 ,dsdof ,jadc_sms ,
5739 4 jads_sms ,jads10_sms,jadt_sms,jadp_sms,jadr_sms ,
5740 5 jadtg_sms,tagprt_sms,kad_sms,kdi_sms ,
5741 7 tagrel_sms,iparts ,ipartq ,ipartc ,ipartt ,
5742 8 ipartp ,ipartr ,ipartg ,ipartx ,
5743 9 npby ,lpby ,kinet ,tagslv_rby_sms,ipari ,
5744 a intbuf_tab,lad_sms ,nprw ,lprw ,tagmsr_rby_sms,
5745 c intstamp ,ipart ,igeo ,nativ_sms,irbe2 ,
5746 d lrbe2 ,iad_sms ,idi_sms,jad_sms ,jdi_sms ,
5747 e t2main_sms)
5748
5749 DEALLOCATE(jdi_sms)
5750
5751 ALLOCATE(jdi_sms(nnz_sms),stat=stat)
5752 IF(stat/=0) THEN
5753 CALL ancmsg(msgid=268,anmode=aninfo,
5754 . msgtype=msgerror,
5755 . c1='JDI_SMS')
5756 CALL arret(2)
5757 ENDIF
5758 ALLOCATE(jsm_sms(nnz_sms),stat=stat)
5759 IF(stat/=0) THEN
5760 CALL ancmsg(msgid=268,anmode=aninfo,
5761 . msgtype=msgerror,
5762 . c1='JSM_SMS')
5763 CALL arret(2)
5764 ENDIF
5765C
5766 CALL sms_ini_jad_3(
5767 2 ixc ,iparg ,ixs ,ixt ,ixp ,
5768 3 ixr ,ixtg ,ixs10 ,dsdof ,jadc_sms,
5769 4 jads_sms ,jads10_sms,jadt_sms ,jadp_sms,jadr_sms ,
5770 5 jadtg_sms,tagprt_sms,kad_sms ,kdi_sms ,
5771 6 tagrel_sms,iparts ,ipartq ,ipartc ,ipartt ,
5772 7 ipartp ,ipartr ,ipartg ,ipartx ,
5773 8 npby ,lpby ,kinet ,
5774 9 tagslv_rby_sms,ipari ,intbuf_tab,
5775 a lad_sms ,jsm_sms ,intstamp ,ipart ,
5776 b igeo ,tagmsr_rby_sms,nativ_sms,
5777 c iad_sms ,idi_sms,jad_sms ,jdi_sms ,t2main_sms)
5778C
5779 DEALLOCATE(kinwork)
5780 DEALLOCATE(t2main_sms)
5781 CALL trace_out1()
5782C
5783C If no element selected AMS is deactivated
5784 IF((isms_selec >= 2).AND.(nnz_sms == 0)) isms_selec = 0
5785C
5786 END IF
5787C
5788 END IF
5789C-----
5790 nelem = numelc+numeltg+numels+numelr
5791 + + numelp+numelt+numelq+numelx+numelig3d
5792C
5793
5794 ALLOCATE(ielem21(nelem),stat=stat)
5795 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5796 . msgtype=msgerror,
5797 . c1='IELEM21')
5798 ielem21=0
5799C
5800 err_msg='DOMAIN DECOMPOSITION'
5801 err_category='DOMAIN DECOMPOSITION'
5802 CALL trace_in1(err_msg,len_trim(err_msg))
5803 IF(iddlevel==1) THEN
5804 ngroup = 0
5805 lbufel = 0
5806 segindx=0
5807c treatment for new IFRONT
5808c reinit
5809 CALL ini_ifront()
5810c reset with savec IENTRY2
5811 DO i=1,numnod
5812 IF(ientry2(i)/=-1)THEN
5813 CALL ifrontplus(i,1)
5814 ENDIF
5815 ENDDO
5816C Remise a jour de FRONT pour les procs differents de 0
5817C IL faut prendre en compte les options ou front(i,p) = 1, p<>1
5818C les sensors de type 2 modifient front sur p<>1
5819 ELSEIF(iddlevel==0) THEN
5820 IF(nelem+nconld+glob_therm%NUMCONV+glob_therm%NUMRADIA+glob_therm%NFXFLUX+slcfield>0) THEN
5821 scep = nelem+nconld+glob_therm%NUMCONV+glob_therm%NUMRADIA+glob_therm%NFXFLUX+slloadp+number_load_cyl
5822 scel = nelem+nconld+glob_therm%NUMCONV+glob_therm%NUMRADIA+glob_therm%NFXFLUX+slloadp+number_load_cyl
5823 ALLOCATE(cep(scep))
5824 ALLOCATE(cel(scel))
5825 ELSE
5826 scep = 1
5827 scel = 1
5828 ALLOCATE(cep(scep))
5829 ALLOCATE(cel(scel))
5830 ENDIF
5831 ENDIF
5832 emax = max(numelc,numeltg,numels,numelr,
5833 . numelp,numelt,numelq,numelx,numelig3d)
5834 k1 = 1
5835 k2 = k1+emax
5836 k3 = k2+emax
5837 k4 = k3+2*emax
5838 k5 = k4+2*emax
5839 k6 = k5 + nelem
5840 k7 = k6 + nelem
5841 k8 = k7 + nelem
5842C allocation moyenne normalement suffisante si taille de groupe moyenne > NVSIZ/2
5843 ldd_iad = ((nelem+numsph)/nvsiz/2)*(nspmd+1)
5844 ALLOCATE(dd_tmp(ldd_iad) ,stat=stat)
5845 dd_tmp = 0
5846 idx = 1
5847
5848 ALLOCATE(iwork(k8) ,stat=stat)
5849 IF(emax>0) THEN
5850 itri1 => iwork(1:k2)
5851 itri2 => iwork(k2+1:k3)
5852 index1 => iwork(k3+1:k4)
5853 index2 => iwork(k4+1:k5)
5854 ELSE
5855 itri1 => iwork
5856 itri2 => iwork
5857 index1 => iwork
5858 index2 => iwork
5859 END IF
5860 IF(nelem>0) THEN
5861 inum => iwork(k5+1:k6)
5862 iwd => iwork(k6+1:k7)
5863 iweig => iwork(k7+1:k8)
5864 ELSE
5865 inum => iwork
5866 iwd => iwork
5867 iweig => iwork
5868 END IF
5869
5870 IF(.NOT.ALLOCATED(inter_cand%IXINT)) ALLOCATE(inter_cand%IXINT(inter_cand%S_IXINT_1,inter_cand%S_IXINT_2))
5871 IF(.NOT. ALLOCATED(npby)) ALLOCATE(npby(0))
5872 IF(.NOT. ALLOCATED(lpby)) ALLOCATE(lpby(0))
5873 IF(.NOT. ALLOCATED( rby)) ALLOCATE( rby(0))
5874
5875 CALL dometis(
5876 1 ixs ,ixq ,ixc ,ixt ,ixp ,
5877 2 ixr ,ixtg ,cep ,geo ,
5878 3 itri1 ,itri2 ,index1 ,index2 ,inum ,
5879 4 iwd ,iwcont ,nelem ,iddlevel,nelemint ,
5880 5 inter_cand,pm ,x ,kxx ,ixx ,
5881 6 addcne ,igeo ,eani ,iwcin2 ,dsdof ,
5882 7 isoloff ,isheoff ,itrioff ,itruoff ,ipouoff ,
5883 8 iresoff ,ielem21 ,ipm ,ixs10 ,d ,
5884 9 clusters ,kxig3d ,ixig3d ,cost_r2r,bufmat,
5885 1 taille ,poin_ump,tab_ump ,
5886 2 poin_ump_old,tab_ump_old,cputime_mp_old,
5887 3 nsnt, nmnt_2,tabmp_l,iquaoff,
5888 4 igrsurf , fvmain,
5889 5 itab ,ipart ,ipartc ,ipartg ,iparts,
5890 6 poin_part_shell,poin_part_tri,poin_part_sol,
5891 7 mid_pid_shell,mid_pid_tri,mid_pid_sol,t_monvol,
5892 8 ebcs_tag_cell_spmd,npby,lpby,mat_elem%MAT_PARAM)
5893
5894 DEALLOCATE(iwork)
5895C---------------------------
5896C Domdec SPH
5897C---------------------------
5898 IF(numsph > 0)THEN
5899 IF(iddlevel==0) THEN
5900 ALLOCATE(cepsp(numsph),stat=stat)
5901 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5902 . msgtype=msgerror,
5903 . c1='CEPSP')
5904
5905 ALLOCATE(celsph(numsph),stat=stat)
5906 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
5907 . msgtype=msgerror,
5908 . c1='CELSPH')
5909 END IF
5910
5911 CALL spdometis(kxsp, ixsp, nod2sp, cepsp, reservep,
5912 . sph2sol, cep)
5913 ELSE
5914 IF(iddlevel==0) ALLOCATE(celsph(1))
5915 IF(.NOT.(ALLOCATED(cepsp))) ALLOCATE(cepsp(0),stat=stat)
5916 END IF
5917C---------------------------
5918C IMPACTS LASER TRAITEMENT SPMD 1ere Phase
5919C---------------------------
5920 IF(nlaser>0) THEN
5921 CALL laserp1(ilas ,cep,ixq )
5922 ENDIF
5923 off = 1
5924 CALL trace_out1()
5925C---------------------------
5926C DEFINE ELEMENT GROUPS
5927C---------------------------
5928 err_msg='ELEMENTS GROUPS'
5929 err_category='ELEM/PROP/MAT COMPATIBILITY'
5930 CALL trace_in1(err_msg,len_trim(err_msg))
5931
5932 numelck8 = numelc
5933 numeltgk8 = numeltg
5934 numelsk8 = numels
5935 numelrk8 = numelr
5936 numelpk8 = numelp
5937 numeltk8 = numelt
5938 numelqk8 = numelq
5939 numelxk8 = numelx
5940 numelig3dk8 = numelig3d
5941 numsphk8 = numsph
5942! working int8 to avoid integer overflow for large models
5943 emax = max(24*numelck8,25*numeltgk8+1,30*numelsk8+1,19*numelrk8,
5944 . 19*numelpk8+1,17*numeltk8,19*numelqk8,
5945 . 15*numelxk8+1,24*numelig3dk8+1,numsphk8) + 1
5946
5947 ALLOCATE(ipargtmp(nparg,numel) ,stat=stat)
5948 ipargtmp = 0
5949 ALLOCATE(iwork(emax) ,stat=stat)
5950 IF(stat /= 0) THEN
5951 CALL ancmsg(msgid=727,
5952 . msgtype=msgerror,
5953 . anmode=anstop,
5954 . c1='IPARG')
5955 ENDIF
5956C REMPLACEMENT DES NOS EXTERNES DES SS-MATERIAUX PAR LES NOS SYSTEMES
5957 IF(iddlevel == 0) CALL m20dcod(mlaw_tag,ipm, pm, mat_elem%MAT_PARAM)
5958C
5959C adresse temporaire de DD_IAD
5960C nombre de super groupes
5961 nspgroup = 0
5962C buffer max (super groupe)
5963 lb_max = 0
5964C
5965 WRITE(istdo,'(A)')titre(37)
5966C---------------------------------
5967C- PRE TRI + SUPER GROUPES
5968C---------------------------------
5969 ngr_sol = 0
5970 IF(numels/=0) THEN
5971 k0 = 1
5972 k1 = k0 + numels*16
5973 k2 = k1 + numels
5974 k3 = k2 + numels+1
5975 k4 = k3 + numels*2
5976 k5 = k4 + numels*8
5977 !K5B= K4 + NUMELS
5978 k6 = k5 + numels
5979 !warning: please also update any index change
5980 ! for MODIF option (MODIF_SPMD.F)
5981 iwork = 0
5982 inum => iwork(1:k1)
5983 itri1 => iwork(k1+1:k2)
5984 eadd => iwork(k2+1:k3)
5985 index1 => iwork(k3+1:k4)
5986 itri2 => iwork(k4+1:k5)
5987 itri3 => iwork(k5+1:k6)
5988C
5989C
5990 CALL sgrhead(
5991 1 ixs ,pm ,geo ,inum ,bid13 ,
5992 2 itri1 ,eadd ,index1 ,itri2 ,iparts ,
5993 3 nd ,igrsurf,igrbric,eani ,
5994 4 cep(off),itri3 ,ixs10 ,ixs20 ,ixs16 ,
5995 5 igeo ,ipm ,nod2els,isoloff ,
5996 6 tagprt_sms,sph2sol,sol2sph,mat_elem%MAT_PARAM,
5997 7 sol2sph_typ ,iflag_bpreload, clusters ,
5998 8 rnoise(1,min(srnoise2,numelc+numeltg+1)),
5999 9 damp_range_part)
6000C---------------------------------
6001C- GROUPAGE SPMD
6002C---------------------------------
6003C test non depassement de LDD_IAD
6004 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6005 ALLOCATE(dd_tmp2(idx-1))
6006 DO i = 1, idx-1
6007 dd_tmp2(i)=dd_tmp(i)
6008 END DO
6009 DEALLOCATE(dd_tmp)
6010 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6011 DO i = 1, idx-1
6012 dd_tmp(i)=dd_tmp2(i)
6013 END DO
6014 DEALLOCATE(dd_tmp2)
6015 END IF
6016C
6017 grsol_id1 = ngroup
6018 CALL sgrtails(
6019 1 ixs ,pm ,ipargtmp ,geo ,
6020 2 eadd ,nd ,iparts ,dd_tmp(idx),
6021 3 idx ,eani ,inum ,index1 ,
6022 4 cep(off) ,itri1 ,ixs10 ,igrsurf ,igrbric ,
6023 5 ixs20 ,ixs16 ,igeo ,iddlevel,
6024 6 ipm ,nod2els ,isoloff ,isolnod ,
6025 7 tagprt_sms,inivol ,sph2sol ,sol2sph ,sol2sph_typ,
6026 8 iflag_bpreload, clusters ,mat_elem%MAT_PARAM ,rnoise(1,min(srnoise2,numelc+numeltg+1)),
6027 9 ipri ,damp_range_part)
6028 grsol_id2 = ngroup
6029 ngr_sol = grsol_id2 - grsol_id1
6030C
6031 off = off + numels
6032C After IDDLEVEL Finish Indexes - Fill PERMUTATION%SOLID(NUMELS+1,PERMUTATION%SOLID(2*NUMELS)
6033 DO i=1,numels
6034 n=permutation%SOLID(i)
6035 permutation%SOLID(numels+n)=i
6036 ENDDO
6037! already done in SGRHEAD / SGRTAILS
6038! CALL APPLYSORT2CLUSTER(CLUSTERS,PERMUTATION%SOLID(NUMELS+1:2*NUMELS))
6039 CALL applysort2flux(ibfflux,glob_therm%NITFLUX,glob_therm%NFXFLUX,permutation%SOLID(numels+1:2*numels))
6040 CALL applysort2flux(ibcr,glob_therm%NIRADIA,glob_therm%NUMRADIA,permutation%SOLID(numels+1:2*numels))
6041 CALL applysort2flux(ibcv,glob_therm%NICONV,glob_therm%NUMCONV,permutation%SOLID(numels+1:2*numels))
6042 ENDIF
6043
6044C
6045C---- QUADS
6046C
6047 IF(numelq/=0) THEN
6048 k1 = 9*numelq
6049 k2 = 10*numelq
6050 k3 = 11*numelq+1
6051 k4 = 13*numelq+1
6052 k5 = 18*numelq+1
6053 k6 = 19*numelq+1
6054 !warning: please also update any index change
6055 ! for MODIF option (MODIF_SPMD.F)
6056 iwork = 0
6057 inum => iwork(1:k1)
6058 itr1 => iwork(k1+1:k2)
6059 eadd => iwork(k2+1:k3)
6060 index1 => iwork(k3+1:k4)
6061 itri1 => iwork(k4+1:k5)
6062 xep => iwork(k5+1:k6)
6063C
6064 CALL qgrhead(
6065 1 ixq ,pm ,geo ,inum ,bid13 ,
6066 2 itr1 ,eadd ,index1 ,itri1 ,ipartq ,
6067 4 nd ,igrsurf ,igrquad ,cep(off) ,mat_elem%MAT_PARAM,
6068 5 xep ,igeo ,ipm ,iquaoff )
6069C---------------------------------
6070C- GROUPAGE SPMD
6071C---------------------------------
6072C test non depassement de LDD_IAD
6073 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6074 ALLOCATE(dd_tmp2(idx-1))
6075 DO i = 1, idx-1
6076 dd_tmp2(i)=dd_tmp(i)
6077 END DO
6078 DEALLOCATE(dd_tmp)
6079 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6080 DO i = 1, idx-1
6081 dd_tmp(i)=dd_tmp2(i)
6082 END DO
6083 DEALLOCATE(dd_tmp2)
6084 END IF
6085C
6086 CALL qgrtails(
6087 1 ixq ,pm ,ipargtmp ,geo ,
6088 2 eadd ,nd ,dd_tmp(idx),idx ,
6089 3 inum ,index1 ,cep(off) ,ipartq ,
6090 4 itr1 ,igrsurf ,igrquad ,mat_elem%MAT_PARAM,
6091 5 igeo ,ipm ,iquaoff ,inivol, ipri)
6092 off = off + numelq
6093 ENDIF
6094C
6095C---- COQUES
6096C
6097 IF(numelc/=0) THEN
6098C---------------------------------
6099C- PRE TRI + SUPER GROUPES
6100C---------------------------------
6101 k0 = 1
6102 k1 = 9*numelc
6103 k2 = 11*numelc
6104 k3 = 12*numelc+1
6105 k4 = 14*numelc+1
6106 k5 = 22*numelc+1
6107 k6 = 23*numelc+1
6108 k7 = 24*numelc+1
6109 !warning: please also update any index change
6110 ! for MODIF option (MODIF_SPMD.F)
6111 iwork = 0
6112 inum => iwork(1:k1)
6113 itr1 => iwork(k1+1:k1+numelc)
6114 itr2 => iwork(k1+numelc+1:k2)
6115 eadd => iwork(k2+1:k3)
6116 index1 => iwork(k3+1:k4)
6117 itri1 => iwork(k4+1:k5)
6118 xep => iwork(k5+1:k6)
6119 ALLOCATE(xnum(numelc) ,stat=stat)
6120 xnum = zero
6121C
6122 CALL cgrhead(
6123 1 ixc ,pm ,geo ,inum ,bid13 ,
6124 2 itr1 ,eadd ,index1 ,itri1 ,xnum ,
6125 3 ipartc ,nd ,thke ,igrsurf ,igrsh4n ,
6126 4 cep(off),xep ,igeo ,ipm ,
6127 5 ipart ,sh4tree ,nod2elc ,isheoff ,sh4trim ,
6128 6 tagprt_sms,lgauge,iworksh ,mat_elem%MAT_PARAM,
6129 7 stack ,drape ,rnoise ,sh4ang,drapeg, ptshel,
6130 8 damp_range_part)
6131C---------------------------------
6132C- GROUPAGE SPMD
6133C---------------------------------
6134c
6135C test non depassement de LDD_IAD
6136 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6137 ALLOCATE(dd_tmp2(idx-1))
6138 DO i = 1, idx-1
6139 dd_tmp2(i)=dd_tmp(i)
6140 END DO
6141 DEALLOCATE(dd_tmp)
6142 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6143 DO i = 1, idx-1
6144 dd_tmp(i)=dd_tmp2(i)
6145 END DO
6146 DEALLOCATE(dd_tmp2)
6147 END IF
6148
6149C
6150 CALL cgrtails(
6151 1 ixc ,pm ,ipargtmp ,geo ,
6152 2 eadd ,nd ,ipartc ,dd_tmp ,
6153 3 idx ,inum ,itr1 ,
6154 4 index1 ,cep(off) ,thke ,xnum ,
6155 5 igrsurf ,igrsh4n ,igeo ,ipm ,
6156 6 ipart ,sh4tree ,nod2elc ,isheoff ,
6157 7 sh4trim ,tagprt_sms, lgauge,iworksh ,
6158 8 stack ,drape ,rnoise ,mat_elem%MAT_PARAM,
6159 9 sh4ang, iddlevel , drapeg,ipri, ptshel,damp_range_part)
6160
6161 off = off + numelc
6162
6163 DO i=1,numelc
6164 n=permutation%SHELL(i)
6165 permutation%SHELL(numelc+n)=i
6166 ENDDO
6167
6168 DEALLOCATE(xnum)
6169 ENDIF
6170C------
6171 IF(numelt/=0) THEN
6172 k1 = 7*numelt
6173 k2 = 8*numelt
6174 k3 = 9*numelt+1
6175 k4 = 11*numelt+1
6176 k5 = 16*numelt+1
6177 k6 = 17*numelt+1
6178 !warning: please also update any index change
6179 ! for MODIF option (MODIF_SPMD.F)
6180 iwork = 0
6181 inum => iwork(1:k1)
6182 itr1 => iwork(k1+1:k2)
6183 eadd => iwork(k2+1:k3)
6184 index1 => iwork(k3+1:k4)
6185 itri1 => iwork(k4+1:k5)
6186 xep => iwork(k5+1:k6)
6187C
6188 CALL tgrhead(
6189 1 ixt ,pm ,geo ,inum ,bid13 ,
6190 2 itr1 ,eadd ,index1 ,itri1 ,
6191 3 ipartt ,nd ,igrsurf,igrtruss,
6192 4 cep(off),xep ,itruoff,
6193 5 tagprt_sms,itagprld_truss)
6194C---------------------------------
6195C- GROUPAGE SPMD
6196C---------------------------------
6197C test non depassement de LDD_IAD
6198 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6199 ALLOCATE(dd_tmp2(idx-1))
6200 DO i = 1, idx-1
6201 dd_tmp2(i)=dd_tmp(i)
6202 END DO
6203 DEALLOCATE(dd_tmp)
6204 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6205 DO i = 1, idx-1
6206 dd_tmp(i)=dd_tmp2(i)
6207 END DO
6208 DEALLOCATE(dd_tmp2)
6209 END IF
6210C
6211 CALL tgrtails(
6212 1 ixt ,ipargtmp,pm ,geo ,
6213 2 eadd ,nd ,dd_tmp ,idx ,
6214 3 inum ,index1 ,cep(off) ,ipartt ,
6215 4 itr1 ,igrsurf ,igrtruss ,itruoff ,
6216 5 tagprt_sms,nod2el1d,ipri,itagprld_truss,
6217 6 preload_a,npreload_a)
6218 off = off + numelt
6219 ENDIF
6220C
6221C-----
6222 IF(numelp > 0) THEN
6223 k1 = 9*numelp
6224 k2 = 10*numelp
6225 k3 = 11*numelp+1
6226 k4 = 13*numelp+1
6227 k5 = 18*numelp+1
6228 k6 = 19*numelp+1
6229 !warning: please also update any index change
6230 ! for MODIF option (MODIF_SPMD.F)
6231 iwork = 0
6232 inum => iwork(1:k1)
6233 itr1 => iwork(k1+1:k2)
6234 eadd => iwork(k2+1:k3)
6235 index1 => iwork(k3+1:k4)
6236 itri1 => iwork(k4+1:k5)
6237 xep => iwork(k5+1:k6)
6238C
6239 ALLOCATE(xnum(3*numelp) ,stat=stat)
6240 xnum(1:3*numelp) = zero
6241C
6242 CALL pgrhead(
6243 1 ixp ,pm ,geo ,inum ,
6244 2 itr1 ,eadd ,index1 ,itri1 ,ipartp ,
6245 3 nd ,igrsurf ,igrbeam ,cep(off) ,
6246 4 xep ,igeo ,ipouoff ,tagprt_sms , ipm ,
6247 5 itagprld_beam,ibeam_vector,rbeam_vector,xnum)
6248C---------------------------------
6249C- GROUPAGE SPMD
6250C---------------------------------
6251C test non depassement de LDD_IAD
6252 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6253 ALLOCATE(dd_tmp2(idx-1))
6254 DO i = 1, idx-1
6255 dd_tmp2(i)=dd_tmp(i)
6256 END DO
6257 DEALLOCATE(dd_tmp)
6258 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6259 DO i = 1, idx-1
6260 dd_tmp(i)=dd_tmp2(i)
6261 END DO
6262 DEALLOCATE(dd_tmp2)
6263 END IF
6264C
6265 CALL pgrtails(mat_elem%MAT_PARAM,
6266 1 ixp ,ipargtmp,pm ,geo ,
6267 2 eadd ,nd ,dd_tmp ,idx ,
6268 3 inum ,index1 ,cep(off) ,ipartp ,
6269 4 itr1 ,igrsurf ,igrbeam ,igeo ,
6270 5 ipm ,ipouoff ,tagprt_sms,
6271 6 nod2el1d, ipri ,itagprld_beam,preload_a,
6272 7 npreload_a,ibeam_vector,rbeam_vector,xnum)
6273C
6274 off = off + numelp
6275C
6276 DEALLOCATE(xnum)
6277 ENDIF
6278C
6279C-----
6280C
6281 IF(numelr/=0) THEN
6282 k1 = 9*numelr
6283 k2 = 10*numelr
6284 k3 = 11*numelr+1
6285 k4 = 13*numelr+1
6286 k5 = 18*numelr+1
6287 k6 = 19*numelr+1
6288 !warning: please also update any index change
6289 ! for MODIF option (MODIF_SPMD.F)
6290 iwork = 0
6291 inum => iwork(1:k1)
6292 itr1 => iwork(k1+1:k2)
6293 eadd => iwork(k2+1:k3)
6294 index1 => iwork(k3+1:k4)
6295 itri1 => iwork(k4+1:k5)
6296 xep => iwork(k5+1:k6)
6297C
6298 CALL rgrhead(
6299 1 ixr ,geo ,inum ,bid13 ,igeo ,
6300 2 itr1 ,eadd ,index1 ,itri1 ,
6301 4 ipartr ,nd ,igrsurf,igrspring,
6302 5 cep(off),xep ,iresoff,
6303 6 tagprt_sms, clusters,ipm,r_skew,itagprld_spring)
6304C---------------------------------
6305C- GROUPAGE SPMD
6306C---------------------------------
6307C test non depassement de LDD_IAD
6308 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6309 ALLOCATE(dd_tmp2(idx-1))
6310 DO i = 1, idx-1
6311 dd_tmp2(i)=dd_tmp(i)
6312 END DO
6313 DEALLOCATE(dd_tmp)
6314 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6315 DO i = 1, idx-1
6316 dd_tmp(i)=dd_tmp2(i)
6317 END DO
6318 DEALLOCATE(dd_tmp2)
6319 END IF
6320C
6321 CALL rgrtails(
6322 1 ixr ,ipargtmp ,geo ,eadd ,igeo ,
6323 2 nd ,dd_tmp ,idx ,inum ,
6324 3 index1 ,cep(off) ,ipartr ,itr1 ,
6325 4 igrsurf ,igrspring ,iresoff ,tagprt_sms ,nod2el1d,
6326 5 ipm , clusters,r_skew,ipri ,itagprld_spring,
6327 6 preload_a,npreload_a)
6328 off = off + numelr
6329 ENDIF
6330C
6331 IF(numeltg/=0) THEN
6332C---------------------------------
6333C- PRE TRI + SUPER GROUPES
6334C---------------------------------
6335 k1 = 10*numeltg
6336 k2 = 12*numeltg
6337 k3 = 13*numeltg+1
6338 k4 = 15*numeltg+1
6339 k5 = 23*numeltg+1
6340 k6 = 24*numeltg+1
6341 k7 = 25*numeltg+1
6342 k8 = 26*numeltg+1
6343 !warning: please also update any index change
6344 ! for MODIF option (MODIF_SPMD.F)
6345 iwork = 0
6346 inum => iwork(1:k1)
6347 itr1 => iwork(k1+1:k2)
6348 eadd => iwork(k2+1:k3)
6349 index1 => iwork(k3+1:k4)
6350 itri1 => iwork(k4+1:k5)
6351 xep => iwork(k5+1:k6)
6352
6353 ALLOCATE(xnum(numeltg) ,stat=stat)
6354 xnum = zero
6355
6356 IF(numeltg6>0) THEN
6357 CALL cdk6inx(ixtg ,ixtg1 ,eanit )
6358 ENDIF
6359 IF(n2d==0)THEN
6360 CALL c3grhead(
6361 1 ixtg ,pm ,geo ,inum ,bid13 ,
6362 2 itr1 ,eadd ,index1 ,itri1 ,xnum ,
6363 3 ipartg ,nd ,thkec ,igrsurf ,igrsh3n ,
6364 4 cep(off),xep ,ixtg1 ,eanit ,
6365 5 igeo ,ipm ,ipart ,sh3tree ,nod2eltg,
6366 6 itrioff ,sh3trim ,tagprt_sms,
6367 7 iworksh , stack ,drape ,rnoise(1,min(srnoise2,numelc+1)),
6368 8 multi_fvm , sh3ang,drapeg,ptsh3n,mat_elem%MAT_PARAM,
6369 9 damp_range_part)
6370 ELSE
6371 CALL t3grhead(
6372 1 ixtg ,pm ,geo ,inum ,bid13 ,
6373 2 itr1 ,eadd ,index1 ,itri1 ,xnum ,
6374 3 ipartg ,nd ,thkec ,igrsurf ,igrsh3n ,
6375 4 cep(off),xep ,ixtg1 ,eanit ,
6376 5 igeo ,ipm ,ipart ,sh3tree ,nod2eltg,
6377 6 itrioff ,sh3trim ,tagprt_sms,mat_elem%MAT_PARAM,
6378 7 iworksh , stack ,drape ,rnoise(1,min(srnoise2,numelc+1)),
6379 8 multi_fvm ,sh3ang,drapeg,ptsh3n)
6380 ENDIF
6381C---------------------------------
6382C- GROUPAGE SPMD
6383C---------------------------------
6384C test non depassement de LDD_IAD
6385 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6386 ALLOCATE(dd_tmp2(idx-1))
6387 DO i = 1, idx-1
6388 dd_tmp2(i)=dd_tmp(i)
6389 END DO
6390 DEALLOCATE(dd_tmp)
6391 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6392 DO i = 1, idx-1
6393 dd_tmp(i)=dd_tmp2(i)
6394 END DO
6395 DEALLOCATE(dd_tmp2)
6396 END IF
6397C
6398 IF(n2d==0)THEN
6399 CALL c3grtails(
6400 1 ixtg ,pm ,ipargtmp ,geo ,
6401 2 eadd ,nd ,ipartg ,dd_tmp ,
6402 3 idx ,inum ,index1 ,cep(off) ,
6403 4 thkec ,xnum ,itr1 ,igrsurf ,igrsh3n ,
6404 5 eanit ,igeo ,ipm ,ixtg1 ,
6405 6 ipart ,sh3tree ,nod2eltg ,itrioff ,
6406 7 sh3trim ,tagprt_sms,iworksh ,stack ,
6407 8 drape ,rnoise(1,min(srnoise2,numelc+1)) ,
6408 9 mat_elem%MAT_PARAM,sh3ang,drapeg,ipri ,ptsh3n,damp_range_part)
6409 ELSE
6410 CALL t3grtails(
6411 1 ixtg ,pm ,ipargtmp ,geo ,
6412 2 eadd ,nd ,ipartg ,dd_tmp ,
6413 3 idx ,inum ,index1 ,cep(off) ,
6414 4 thkec ,xnum ,itr1 ,igrsurf ,igrsh3n ,
6415 5 eanit ,igeo ,ipm ,ixtg1 ,
6416 6 ipart ,sh3tree ,nod2eltg ,itrioff ,
6417 7 sh3trim ,tagprt_sms,iworksh ,stack ,
6418 8 drape ,rnoise(1,min(srnoise2,numelc+1)) ,inivol,
6419 9 mat_elem%MAT_PARAM,sh3ang ,drapeg,ipri,ptsh3n)
6420 ENDIF
6421 off = off + numeltg
6422 DO i=1,numeltg
6423 n=permutation%TRIANGLE(i)
6424 permutation%TRIANGLE(numeltg+n)=i
6425 ENDDO
6426
6427 DEALLOCATE(xnum)
6428 ENDIF
6429
6430 CALL applysort2fvm(t_monvol)
6431
6432C---------------------------------
6433 IF(numsph/=0) THEN
6434 if ( .NOT. ALLOCATED(ixsps) ) ALLOCATE(ixsps(kvoisph,numsph),stat=stat)
6435 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6436 . msgtype=msgerror,
6437 . c1='IXSPS')
6438
6439 iwork = 0
6440 eadd => iwork(1:numsph+1)
6441 CALL spgrhead(kxsp ,ixsp ,ipargtmp,pm ,ipart ,
6442 2 ipartsp ,eadd ,cepsp ,nd ,ipm ,
6443 3 igeo ,spbuf ,sph2sol,
6444 4 sol2sph ,irst ,mat_elem%MAT_PARAM,ixsps)
6445C---------------------------------
6446C- GROUPAGE SPMD
6447C---------------------------------
6448C test non depassement de LDD_IAD
6449 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6450 ALLOCATE(dd_tmp2(idx-1))
6451 DO i = 1, idx-1
6452 dd_tmp2(i)=dd_tmp(i)
6453 END DO
6454 DEALLOCATE(dd_tmp)
6455 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6456 DO i = 1, idx-1
6457 dd_tmp(i)=dd_tmp2(i)
6458 END DO
6459 DEALLOCATE(dd_tmp2)
6460 END IF
6461C
6462 CALL spgrtails(kxsp ,ipargtmp,pm ,ipart ,
6463 2 ipartsp ,eadd ,nd ,cepsp,dd_tmp ,
6464 3 idx ,ixsp ,ipm , igeo ,
6465 4 spbuf ,sph2sol,sol2sph ,
6466 5 irst ,nod2sp ,ipri ,mat_elem%MAT_PARAM,
6467 6 ixsps)
6468 IF (ALLOCATED(ixsps)) DEALLOCATE(ixsps)
6469 ENDIF
6470C---------------------------------
6471 IF(numelx>0) THEN
6472!
6473 k1=6*numelx
6474 k2=k1+numelx
6475 k3=k2+numelx+1
6476 k4=k3+numelx*2
6477 k5=k4+numelx*4
6478 k6=k5+numelx
6479 !warning: please also update any index change
6480 ! for MODIF option (MODIF_SPMD.F)
6481 iwork = 0
6482 inum => iwork(1:k1)
6483 itr1 => iwork(k1+1:k2)
6484 eadd => iwork(k2+1:k3)
6485 index1 => iwork(k3+1:k4)
6486 itri1 => iwork(k4+1:k5)
6487 xep => iwork(k5+1:k6)
6488!
6489 CALL xgrhead(
6490 1 kxx, geo, inum, itr1,
6491 2 eadd, index1, itri1, ipartx,
6492 3 nd, igrsurf,
6493 4 cep(off), xep,ipm)
6494C---------------------------------
6495C- GROUPAGE SPMD
6496C---------------------------------
6497C test non depassement de LDD_IAD
6498 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6499 ALLOCATE(dd_tmp2(idx-1))
6500 DO i = 1, idx-1
6501 dd_tmp2(i)=dd_tmp(i)
6502 END DO
6503 DEALLOCATE(dd_tmp)
6504 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6505 DO i = 1, idx-1
6506 dd_tmp(i)=dd_tmp2(i)
6507 END DO
6508 DEALLOCATE(dd_tmp2)
6509 END IF
6510C
6511 CALL xgrtails(
6512 1 kxx ,ipargtmp ,geo ,eadd ,
6513 2 nd ,dd_tmp ,idx ,lb_max ,inum ,
6514 3 index1 ,cep(off) ,ipartx ,itr1 ,igrsurf ,
6515 4 ixx ,igeo)
6516 off = off + numelx
6517 ENDIF
6518 CALL trace_out1()
6519C
6520C build Inverse connectivity - update after all element/sph grouping
6521C
6522 knod2els = 0
6523 knod2elc = 0
6524 knod2eltg = 0
6525 knod2el1d = 0
6526 knod2elig3d = 0
6527 nod2els = 0
6528 nod2elc = 0
6529 nod2eltg = 0
6530 nod2el1d = 0
6531 nod2elig3d = 0
6532 knod2elq = 0
6533 nod2elq = 0
6534 CALL build_cnel(
6535 2 ixs ,ixq ,ixc ,ixt ,ixp ,
6536 3 ixr ,ixtg ,ixs10 ,ixs20 ,
6537 4 ixs16 ,ixtg1 ,igeo ,knod2els ,knod2elc ,
6538 5 knod2eltg ,nod2els ,nod2elc ,nod2eltg ,nod2el1d ,
6539 6 knod2el1d ,kxx ,ixx ,x ,lelx ,
6540 7 ixig3d ,kxig3d ,knod2elig3d,nod2elig3d,knod2elq,
6541 8 nod2elq )
6542
6543C---------------------------------
6544 CALL trace_in1(err_msg,len_trim(err_msg))
6545 IF(numelig3d>0) THEN
6546
6547 k1=(nixig3d+1)*numelig3d
6548 k2=k1+numelig3d
6549 k3=k2+numelig3d+1
6550 k4=k3+numelig3d*2
6551 k5=k4+numelig3d*4
6552 k6=k5+numelig3d
6553
6554 iwork = 0
6555 inum => iwork(1:k1)
6556 itr1 => iwork(k1+1:k2)
6557 eadd => iwork(k2+1:k3)
6558 index1 => iwork(k3+1:k4)
6559 itri1 => iwork(k4+1:k5)
6560 xep => iwork(k5+1:k6)
6561C
6562 CALL ig3dgrhead(
6563 1 kxig3d ,geo ,inum ,itr1 ,eadd ,
6564 2 index1 ,itri1 ,ipartig3d ,nd ,igrsurf ,
6565 3 cep(off) ,xep ,igeo ,
6566 4 ipm ,pm ,nige ,knotlocel)
6567C--------------------------------
6568C- GROUPAGE SPMD
6569C---------------------------------
6570C test non depassement de LDD_IAD
6571 IF(idx+nd*(nspmd+1)>ldd_iad)THEN
6572 ALLOCATE(dd_tmp2(idx-1))
6573 DO i = 1, idx-1
6574 dd_tmp2(i)=dd_tmp(i)
6575 END DO
6576 DEALLOCATE(dd_tmp)
6577 ALLOCATE(dd_tmp(idx+nd*(nspmd+1)))
6578 DO i = 1, idx-1
6579 dd_tmp(i)=dd_tmp2(i)
6580 END DO
6581 DEALLOCATE(dd_tmp2)
6582 END IF
6583C
6584 CALL ig3dgrtails(
6585 1 kxig3d ,ipargtmp ,geo ,eadd ,nd ,
6586 2 dd_tmp ,idx ,lb_max ,inum ,index1 ,
6587 3 cep(off) ,ipartig3d ,itr1 ,igrsurf ,
6588 4 ixig3d ,igeo ,
6589 5 pm ,nige ,knotlocel, mat_elem%MAT_PARAM)
6590 off = off + numelig3d
6591 ENDIF
6592 DEALLOCATE(iwork)
6593 CALL trace_out1()
6594
6595C--------------------------------------------
6596C REFERENCE METRIQUE
6597C--------------------------------------------
6598 err_msg='REFERENCE METRICS'
6599 err_category='REFERENCE METRICS'
6600 CALL trace_in1(err_msg,len_trim(err_msg))
6601C
6602 xyzref = x
6603C
6604 IF(iddlevel==0)THEN
6605
6606 IF(nxref > 0 .OR. neref > 0 .OR. irefsta > 0) THEN
6607 ALLOCATE(xrefc(4,3,numelc))
6608 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6609 . msgtype=msgerror,c1='XREFC')
6610 ALLOCATE(xreftg(3,3,numeltg))
6611 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6612 . msgtype=msgerror,c1='XREFTG')
6613 ALLOCATE(xrefs(8,3,numels8))
6614 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6615 . msgtype=msgerror,c1='XREFS')
6616 ALLOCATE(tagxref(numnod))
6617 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6618 . msgtype=msgerror,c1='TAGXREF')
6619 ALLOCATE(tagrefsta(numnod))
6620 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6621 . msgtype=msgerror,c1='TAGREFSTA')
6622 ELSE
6623 ALLOCATE(xrefc(1,1,1))
6624 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6625 . msgtype=msgerror,c1='XREFC')
6626 ALLOCATE(xreftg(1,1,1))
6627 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6628 . msgtype=msgerror,c1='XREFTG')
6629 ALLOCATE(xrefs(1,1,1))
6630 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6631 . msgtype=msgerror,c1='XREFS')
6632 ALLOCATE(tagxref(1))
6633 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6634 . msgtype=msgerror,c1='TAGXREF')
6635 ALLOCATE(tagrefsta(1))
6636 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6637 . msgtype=msgerror,c1='TAGREFSTA')
6638 ENDIF
6639 ENDIF
6640C
6641 tagxref = 0
6642 tagrefsta = 0
6643C
6644 IF(nxref > 0) THEN
6645 WRITE(istdo,'(A)')' .. REFERENCE STATE (XREF)'
6646 CALL hm_read_xref(itabm1 ,ipart ,ipartc ,ipartg ,iparts ,
6647 . unitab ,ixc ,ixtg ,ixs ,x ,
6648 . xrefc ,xreftg ,xrefs ,rtrans ,lsubmodel ,
6649 . tagxref ,iddlevel ,eani ,ipm ,igeo )
6650 ENDIF
6651 IF(irefsta > 0) THEN
6652 WRITE(istdo,'(A)')' .. REFERENCE STATE (REFSTA)'
6653 CALL lecrefsta(itabm1 ,unitab ,ixc ,ixtg ,ixs ,
6654 . xyzref ,xrefc ,xreftg ,xrefs ,tagxref ,
6655 . iddlevel,tagrefsta )
6656C
6657 IF(iddlevel==0 .AND. ((ninter > 0).OR.(isms == 1))) THEN
6658 rewind(iin6)
6659 ELSE
6660 IF(ipid /= 0) CLOSE(iin6)
6661 irefsta = 0
6662C NXREF = NXREF + 1
6663 nxref = 1
6664 ENDIF
6665 ENDIF
6666 IF(neref > 0 ) THEN
6667 WRITE(istdo,'(A)')' .. REFERENCE STATE (EREF)'
6668 CALL hm_read_eref(itabm1 ,ipart ,ipartc ,ipartg ,iparts ,
6669 . ixc ,ixtg ,ixs ,x ,xrefc ,
6670 . xreftg ,xrefs ,lsubmodel,iddlevel,itab ,
6671 . tagxref ,tagrefsta )
6672C
6673 IF(iddlevel ==1 .OR. ((ninter == 0).AND.(isms == 0))) nxref = 1
6674 ENDIF
6675C-------------------------------------------------
6676 !check if a law 151 is associated to any PART
6677 multi_fvm%IS_ASSOCIATED_TO_A_PART = .false.
6678 DO ng=1,ngroup
6679 mlw = ipargtmp(1,ng)
6680 IF(mlw == 151)THEN
6681 multi_fvm%IS_ASSOCIATED_TO_A_PART = .true.
6682 EXIT
6683 ENDIF
6684 ENDDO
6685C-------------------------------------------------
6686 !check if all part are using law 151
6687 multi_fvm%ARE_ALL_PARTS_151 = .true.
6688 nb_euler_groups = 0
6689 DO ng=1,ngroup
6690 mlw = ipargtmp(1,ng)
6691 is_euler = ipargtmp(11,ng)
6692 IF(is_euler == 1 ) nb_euler_groups=nb_euler_groups+1
6693 IF(mlw /= 151 .AND. is_euler == 1)THEN
6694 multi_fvm%ARE_ALL_PARTS_151 = .false.
6695 EXIT
6696 ENDIF
6697 ENDDO
6698 IF(nb_euler_groups == 0)multi_fvm%ARE_ALL_PARTS_151 = .false.
6699C-------------------------------------------------
6700 !copy IPARG <- IPARGTMP, and Deallocate IPARGTMP
6701 siparg = nparg*ngroup
6702 IF(ALLOCATED(iparg))DEALLOCATE(iparg)
6703 ALLOCATE(iparg(siparg) ,stat=stat)
6704 DO j=1,nparg
6705 DO i=1,ngroup
6706 iparg((i-1)*nparg + j) = ipargtmp(j,i)
6707 ENDDO
6708 ENDDO
6709 DEALLOCATE(ipargtmp)
6710C-------------------------------------------------
6711C provisoire
6712 IF(isms/=0)THEN
6713 DO n=1,ngroup
6714 iparg(nparg*(n-1)+52)=1
6715 END DO
6716 END IF
6717 nbr_gpmp = ngroup
6718c-----------------------------------------------------------------------
6719!
6720 !---------------------------------------------------
6721 ! element renumbering after domdec for /fail/fractal
6722 !---------------------------------------------------
6723 call fractal_elem_renum(fail_fractal,numelc,numeltg)
6724!
6725 !---------------------------------------------------
6726 ! element renumbering after domdec for /fail/alter + brokmann
6727 !---------------------------------------------------
6728 if (iddlevel==1) call brokmann_elem_renum(fail_brokmann,numelc,numeltg)
6729c-----------------------------------------------------------------------
6730c set default material/property parameters by element group
6731c-----------------------------------------------------------------------
6732 IF(ALLOCATED(group_param_tab)) DEALLOCATE(group_param_tab)
6733 ALLOCATE(group_param_tab(ngroup) ,stat=stat)
6734c
6735 CALL set_elgroup_param(group_param_tab ,iparg ,ngroup ,n2d ,
6736 . ipm ,igeo ,pm ,geo ,bufmat )
6737C-------------------------------------------------
6738 CALL trace_out1()
6739C--------------------------------------------
6740C Itet=2 of S10 : dynamic condensation
6741C--------------------------------------------
6742 IF(numels10>0) THEN
6743 IF(ALLOCATED(itagnd)) DEALLOCATE(itagnd)
6744 ALLOCATE(itagnd(numnod),stat=stat)
6745 itagnd(1:numnod)=0
6746 CALL dim_s10edg(ns10e, ixs10 ,iparg,itagnd)
6747 IF(ns10e>0) THEN
6748 IF(ALLOCATED(icnds10)) DEALLOCATE(icnds10)
6749 ALLOCATE(icnds10(3*ns10e),stat=stat)
6750 icnds10(1:3*ns10e)=0
6751 itagnd(1:numnod)=0
6752 CALL ind_s10edg(icnds10, ixs, ixs10 ,iparg,itagnd)
6753 IF(ipari0/=0) CALL reord_icnd(icnds10, itagnd)
6754 CALL s10edg_rlink(nlink, numlink,nnlink,lnlink,
6755 . itagnd,icnds10,itab,ipri,numnod,ns10e)
6756 END IF
6757 ELSE
6758 IF(ALLOCATED(itagnd)) DEALLOCATE(itagnd)
6759 ALLOCATE(itagnd(0),stat=stat)
6760 END IF
6761
6762C--------------------------------------------
6763C DOMAIN DECOMPOSITION 1 (reconstruction des tableaux)
6764C--------------------------------------------
6765C si NSPMD = 1 il faut qd meme construire dd_iad et fr_iad
6766 err_msg='DOMAIN DECOMPOSITION ARRAYS'
6767 err_category='DOMAIN DECOMPOSITION'
6768 CALL trace_in1(err_msg,len_trim(err_msg))
6769 sdd_iad = (nspmd+1)*nspgroup
6770 ALLOCATE(dd_iad(sdd_iad) ,stat=stat)
6771 dd_iad = 0
6772 CALL domdec1(
6773 1 iparg ,ixs ,ixq ,ixc ,ixt ,
6774 2 ixp ,ixr ,ixtg ,dd_iad ,
6775 3 x ,dd_tmp ,ixs10 ,ixs20 ,
6776 4 ixs16 ,kxx ,ixx ,kxsp ,ixsp ,
6777 5 cepsp ,ixtg1)
6778C
6779 DEALLOCATE(dd_tmp)
6780 CALL trace_out1()
6781C--------------------------------------------
6782C Multidomains -> modif domdec
6783C--------------------------------------------
6784 err_msg='MULTIDOMAINS'
6785 err_category='MULTIDOMAINS'
6786 IF((nsubdom>0).AND.(iddom==0).AND.(flg_r2r_err==0)) THEN
6787 WRITE(istdo,'(A)')' .. MULTIDOMAINS DOMDEC SYNCHRONIZATION '
6788 CALL r2r_domdec(iexlnk,igrnod,frontb_r2r,dt_r2r,0)
6789 ENDIF
6790C--------------------------------------------
6791C STOCKAGE DYNAMIQUE (RESOLUTION) REEL
6792C--------------------------------------------
6793 err_msg='ELEMENT BUFFER ALLOCATION'
6794 err_category='INTERNAL'
6795 CALL trace_in1(err_msg,len_trim(err_msg))
6796 selbuf = lbufel
6797 ALLOCATE(elbuf(selbuf) ,stat=stat)
6798 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6799 . msgtype=msgerror,
6800 . c1='ELBUF')
6801 elbuf = zero
6802 CALL trace_out1()
6803C--------------------------------------------
6804C GRAVITY
6805C--------------------------------------------
6806 err_msg='GRAVITY'
6807 err_category='GRAVITY'
6808 CALL trace_in1(err_msg,len_trim(err_msg))
6809c CALL PRELECGRAV(NUMGRAV ,IGRNOD)
6810 CALL hm_preread_grav(numgrav ,igrnod , lsubmodel)
6811 sigrv = nigrv*ngrav
6812 slgrav = numgrav
6813 IF(iddlevel==0)THEN
6814 ALLOCATE(igrv(sigrv) ,stat=stat)
6815 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6816 . msgtype=msgerror,
6817 . c1='IGRV')
6818 ALLOCATE(lgrav(slgrav) ,stat=stat)
6819 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6820 . msgtype=msgerror,
6821 . c1='LGRAV')
6822 END IF
6823 igrv = 0
6824 CALL hm_read_grav(igrv ,lgrav ,grav ,itab ,itabm1 ,
6825 . igrnod ,npc ,sensors ,unitab ,iskwn ,
6826 . itagnd ,lsubmodel)
6827 CALL trace_out1()
6828C----------------------------------
6829C LECTURE DES CARTES INIGRAV
6830C----------------------------------
6831 err_msg='INIGRAV'
6832 err_category='GRAVITY'
6833 CALL trace_in1(err_msg,len_trim(err_msg))
6834 IF(ninigrav > 0) sinigrav = ninigrav
6835 IF(iddlevel == 0) THEN
6836 ALLOCATE(inigrv(04,sinigrav) ,stat=stat)
6837 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6838 . msgtype=msgerror,
6839 . c1='INIGRV')
6840 ALLOCATE(linigrav(11,sinigrav) ,stat=stat)
6841 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
6842 . msgtype=msgerror,
6843 . c1='LINIGRAV')
6844 END IF
6845 IF(ninigrav > 0) THEN
6846 IF(iddlevel == 0) THEN
6847 inigrv = 0
6848 WRITE(istdo,'(A)') ' .. INITIAL GRAVITY LOADING'
6849 CALL hm_read_inigrav(igrv ,lgrav ,grav ,itab ,itabm1 ,
6850 . igrpart ,npc ,unitab ,iskwn ,
6851 . itagnd ,igrsurf ,tf ,bufsf ,lsubmodel)
6852 ENDIF
6853 ENDIF
6854 CALL trace_out1()
6855C----------------------------------
6856C LECTURE DES CARTES INIMAP1D
6857C----------------------------------
6858 err_msg = 'INIMAP1D'
6859 err_category= 'INITIALIZATION'
6860 CALL trace_in1(err_msg,len_trim(err_msg))
6861
6862 IF(iddlevel==0 .AND. ninimap1d+ninimap2d>0)WRITE(istdo,'(A)')titre(54)
6863
6864 IF(iddlevel==0)THEN
6865 ALLOCATE(inimap1d(ninimap1d))
6866 IF(ninimap1d > 0) THEN
6867 CALL hm_read_inimap1d(inimap1d ,npc , itabm1, x, igrbric,
6868 . igrquad ,igrsh3n, multi_fvm, unitab, lsubmodel)
6869 IF(.NOT. multi_fvm%IS_USED) THEN
6870 DO kk = 1, ninimap1d
6871 ALLOCATE(inimap1d(kk)%TAGNODE(numnod))
6872 inimap1d(kk)%TAGNODE(1:numnod) = 0
6873 ENDDO
6874 ENDIF
6875 ENDIF
6876 ENDIF
6877 CALL trace_out1()
6878C----------------------------------
6879C LECTURE DES CARTES INIMAP2D
6880C----------------------------------
6881 err_msg = 'INIMAP2D'
6882 err_category= 'INITIALIZATION'
6883 CALL trace_in1(err_msg,len_trim(err_msg))
6884 IF(iddlevel==0)THEN
6885 ALLOCATE(inimap2d(ninimap2d))
6886 IF(ninimap2d > 0) THEN
6887 CALL hm_read_inimap2d(inimap2d, func2d, itabm1, x, igrbric,
6888 . igrquad , igrsh3n, unitab, lsubmodel)
6889 IF(.NOT. multi_fvm%IS_USED) THEN
6890 DO kk = 1, ninimap2d
6891 ALLOCATE(inimap2d(kk)%TAGNODE(numnod))
6892 inimap2d(kk)%TAGNODE(1:numnod) = 0
6893 ENDDO
6894 ENDIF
6895 ENDIF
6896 ENDIF
6897 CALL trace_out1()
6898C--------------------------------------------
6899C "LOAD FIELDS" : CENTRIFUGAL,FLUID,BLAST
6900C--------------------------------------------
6901 !ALLOCATIONS
6902 err_msg='LOAD FIELDS'
6903 err_category='LOAD FIELDS'
6904 CALL trace_in1(err_msg,len_trim(err_msg))
6905 IF(iddlevel == 0)THEN
6906C
6907C Centrifugal Loads
6908 ALLOCATE(icfield(sicfield) ,stat=stat)
6909 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='ICFIELD')
6910 ALLOCATE(lcfield(slcfield) ,stat=stat)
6911 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='LCFIELD')
6912 ALLOCATE(cfield(scfield) ,stat=stat)
6913 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='CFIELD')
6914!INITIALIZATIONS
6915 IF(ALLOCATED(icfield)) icfield(:) = 0
6916 IF(ALLOCATED(lcfield)) lcfield(:) = 0
6917 IF(ALLOCATED(cfield )) cfield(:) = zero
6918!READING CARDS & STORING DATA
6919 IF(nloadc/=0)THEN
6920 CALL hm_read_load_centri(icfield ,lcfield ,cfield ,itab ,itabm1 ,
6921 . igrnod ,npc ,sensors ,unitab ,iframe ,
6922 . lsubmodel)
6923 END IF
6924C
6925C PFLUID & PBLAST & LOAD PRESSURE
6926 ALLOCATE(iloadp(siloadp) ,stat=stat)
6927 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='ILOADP')
6928 ALLOCATE(lloadp(slloadp) ,stat=stat)
6929 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='LLOADP')
6930 ALLOCATE(loadp(sloadp) ,stat=stat)
6931 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='LOADP')
6932 ALLOCATE(interloadp(nintloadp) ,stat=stat)
6933 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='INTERLOADP')
6934 ALLOCATE(intgaploadp(nintloadp) ,stat=stat)
6935 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='INTGAPLOADP')
6936
6937 s_loadpinter = 0
6938 IF(nintloadp > 0) THEN
6939 s_loadpinter = ninter*nloadp_hyd
6940 ALLOCATE(kloadpinter(ninter + 1) ,stat=stat)
6941 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='KLOADPINTER')
6942 ALLOCATE(loadpinter(s_loadpinter) ,stat=stat)
6943 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='LOADPINTER')
6944 ALLOCATE(dgapint(ninter) ,stat=stat)
6945 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='DGAPINT')
6946 ALLOCATE(dgaploadint(s_loadpinter) ,stat=stat)
6947 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='DGAPLOADINT')
6948 ELSE
6949 ALLOCATE(kloadpinter(0))
6950 ALLOCATE(loadpinter(0))
6951 ALLOCATE(dgapint(0))
6952 ALLOCATE(dgaploadint(0))
6953 ENDIF
6954
6955!INITIALIZATIONS
6956 IF(ALLOCATED(iloadp )) iloadp(:) = 0
6957 IF(ALLOCATED(lloadp )) lloadp(:) = 0
6958 IF(ALLOCATED(loadp )) loadp(:) = zero
6959 IF(ALLOCATED(interloadp )) interloadp(:) = 0
6960 IF(ALLOCATED(kloadpinter )) kloadpinter(:) = 0
6961 IF(ALLOCATED(loadpinter )) loadpinter(:) = 0
6962 IF(ALLOCATED( intgaploadp )) intgaploadp(:)=zero
6963 IF(ALLOCATED( dgapint )) dgapint(:)=zero
6964 IF(ALLOCATED( dgaploadint )) dgaploadint(:)=zero
6965!READING CARDS & STORING DATA
6966 numloadp=0
6967 nintloadp = 0
6968 nintloadp21 = 0
6969 IF(nloadp_f/=0)THEN
6970 CALL hm_read_pfluid(numloadp ,iloadp ,lloadp ,loadp ,npc ,
6971 . sensors ,igrsurf ,unitab ,iframe ,lsubmodel)
6972 END IF
6973 IF(pblast%NLOADP_B/=0)THEN
6974 CALL hm_read_pblast( pblast,
6975 . itab ,itabm1 ,unitab ,igrsurf, numloadp,
6976 . iloadp ,lloadp ,loadp ,x , bufsf ,
6977 . lsubmodel,rtrans)
6978 ENDIF
6979 IF(nloadp_hyd/=0)THEN
6980 CALL hm_read_load_pressure(
6981 . numloadp ,iloadp ,lloadp ,interloadp ,loadp ,
6982 . kloadpinter,loadpinter ,npc ,sensors ,igrsurf ,
6983 . unitab ,iskwn ,lsubmodel ,dgapint ,intgaploadp,
6984 . dgaploadint,s_loadpinter,pblast)
6985
6986 END IF
6987
6988 DEALLOCATE( interloadp,intgaploadp )
6989 ENDIF
6990 CALL trace_out1()
6991C--------------------------------------------
6992C LECTURE DES RBE2 Constraints
6993C--------------------------------------------
6994 err_msg='RBE2'
6995 err_category='RBE2'
6996 CALL trace_in1(err_msg,len_trim(err_msg))
6997 CALL hm_preread_rbe2(sirbe2,slrbe2,igrnod,lsubmodel)
6998 IF(iddlevel==0)THEN
6999 ALLOCATE(irbe2(sirbe2) ,stat=stat)
7000 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7001 . msgtype=msgerror,
7002 . c1='IRBE2')
7003 END IF
7004 IF(iddlevel==0)THEN
7005 ALLOCATE(lrbe2(slrbe2) ,stat=stat)
7006 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7007 . msgtype=msgerror,
7008 . c1='LRBE2')
7009 END IF
7010 IF(sirbe2 > 0) THEN
7011 irbe2 = 0
7012 lrbe2 = 0
7013 CALL hm_read_rbe2(
7014 . irbe2 ,lrbe2 ,itab ,itabm1 ,igrnod,
7015 . iskwn ,d ,iddlevel ,nom_opt(lnopt1*inom_opt(13)+1),itagnd,
7016 . icnds10 ,lsubmodel)
7017 ENDIF
7018
7019
7020 CALL c_new_hash(grnod_uid,ngrnod)
7021 DO i=1,ngrnod
7022 CALL c_hash_insert(grnod_uid,igrnod(i)%ID,i)
7023 ENDDO
7024
7025C--------------------------------------------
7026C LECTURE DES RBE3 Interpolation Constraints
7027C--------------------------------------------
7028 CALL trace_out1()
7029 err_msg='RBE3'
7030 err_category='RBE3'
7031 CALL trace_in1(err_msg,len_trim(err_msg))
7032 CALL hm_preread_rbe3(sirbe3,slrbe3,igrnod,grnod_uid,lsubmodel)
7033 lxintd = 0
7034 slrbe3 = 2*slrbe3
7035 sfrbe3 = (3+1)*slrbe3
7036 IF(iddlevel==0)THEN
7037 ALLOCATE(irbe3(sirbe3) ,stat=stat)
7038 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7039 . msgtype=msgerror,
7040 . c1='IRBE3')
7041 ALLOCATE(lrbe3(slrbe3), frbe3(sfrbe3) ,stat=stat)
7042 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7043 . msgtype=msgerror,
7044 . c1='LRBE3')
7045 END IF
7046 IF(sirbe3 > 0) THEN
7047 irbe3 = 0
7048 lrbe3 = 0
7049 frbe3 = zero
7050 CALL hm_read_rbe3(irbe3 ,lrbe3 ,frbe3 ,itab ,itabm1 ,
7051 . igrnod ,iskwn ,lxintd ,d ,iddlevel,
7052 . nom_opt(lnopt1*inom_opt(14)+1),itagnd ,
7053 . grnod_uid,unitab,lsubmodel)
7054 ENDIF
7055
7056 CALL c_delete_hash(grnod_uid)
7057
7058 CALL trace_out1()
7059
7060C---------------------------------------------
7061C CHECK ENGINE FILE : DYNAIN FILE
7062C-------------------------------------------
7063 dynain_data%DYNAIN_CHECK = 0
7064 CALL check_dynain(ipart,ipartc,ipartg,ixc,ixtg,dynain_data%DYNAIN_CHECK)
7065
7066C---------------------------------------------
7067C CHECK ENGINE FILE /H3D/?/TMAX initialization
7068C-------------------------------------------
7069 CALL ini_h3dtmax_engine(iparg,ipart,iparts,ipartc,ipartg,iddlevel)
7070C---------------------------------------------
7071C CHECK ENGINE FILE DYNAIN or STATE if to use F.I. total strain for QEPH
7072C-------------------------------------------
7073 istr_24 = 0
7074 IF(numelc/=0) CALL check_qeph_stra(istr_24)
7075C--------------------------------------------
7076C LECTURE DES ELEMENTS DESACTIVABLES
7077C--------------------------------------------
7078 err_msg='ELEMENTS DEACTIVATION'
7079 err_category='ELEMENTS DEACTIVATION'
7080 CALL trace_in1(err_msg,len_trim(err_msg))
7081 siactiv = lactiv*nactiv
7082 IF(iddlevel==0)THEN
7083 ALLOCATE(iactiv(siactiv), factiv(lractiv*nactiv) ,stat=stat)
7084 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7085 . msgtype=msgerror, c1='IACTIV')
7086 END IF
7087 iactiv = 0
7088 IF(nactiv > 0) CALL hm_read_activ(iactiv ,factiv ,sensors,igrbric,
7089 . igrquad ,igrsh4n ,igrsh3n ,igrtruss,igrbeam,
7090 . igrspring,lsubmodel,unitab)
7091C--------------------------------------------
7092 sibmpc = nummpc + lmpc*3
7093 IF(iddlevel==0)THEN
7094 ALLOCATE(ibmpc(sibmpc) ,stat=stat)
7095 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7096 . msgtype=msgerror,
7097 . c1='IBMPC')
7098 END IF
7099 ibmpc = 0
7100 IF(lmpc>0) THEN
7101 ibmpc2 => ibmpc(nummpc+1:nummpc+lmpc)
7102 ibmpc3 => ibmpc(nummpc+lmpc+1:nummpc+lmpc*2)
7103 ibmpc4 => ibmpc(nummpc+lmpc*2+1:sibmpc)
7104 ELSE
7105 ibmpc2 => ibmpc
7106 ibmpc3 => ibmpc
7107 ibmpc4 => ibmpc
7108 END IF
7109
7110 skinet = numnod
7111 IF(iddlevel==0)THEN
7112 ALLOCATE(kinet(skinet) ,stat=stat)
7113 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7114 . msgtype=msgerror,
7115 . c1='KINET')
7116 END IF
7117 kinet = 0
7118
7119 sipari = npari*ninter
7120 IF(iddlevel==0)THEN
7121 ALLOCATE(ipari(sipari) ,stat=stat)
7122 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7123 . msgtype=msgerror,
7124 . c1='IPARI')
7125 END IF
7126 ipari = 0
7127 CALL trace_out1()
7128C--------------------------------------------
7129C External faces of solid elements
7130C--------------------------------------------
7131 err_msg='SOLID ELEMENTS FACES'
7132 err_category='SOLID ELEMENTS FACES'
7133 CALL trace_in1(err_msg,len_trim(err_msg))
7134 ALLOCATE(fastag(numels) ,stat=stat)
7135 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7136 . msgtype=msgerror,
7137 . c1='FASTAG')
7138 CALL ani_fasolfr1(ixs,ixc,ixtg,fastag,isolnod)
7139 sfasolfr = 2*nfasolfr
7140 IF(iddlevel==0)THEN
7141 ALLOCATE(fasolfr(sfasolfr),stat=stat)
7142 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7143 . msgtype=msgerror,
7144 . c1='FASOLFR')
7145 END IF
7146 CALL ani_fasolfr2(fastag,fasolfr,isolnod)
7147 DEALLOCATE(fastag)
7148 CALL trace_out1()
7149C--------------------------------------------
7150C External Segs of quad elements
7151C--------------------------------------------
7152 err_msg='QUAD ELEMENTS SEGS'
7153 err_category='QUAD ELEMENTS SEGS'
7154 CALL trace_in1(err_msg,len_trim(err_msg))
7155 ALLOCATE(segtag(4*numelq) ,stat=stat)
7156 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7157 . msgtype=msgerror,
7158 . c1='SEGTAG')
7159 segtag(1:4*numelq) = 0
7160 CALL ani_segquadfr1(ixq ,segtag ,knod2elq ,nod2elq ,x ,nsegquadfr)
7161 ssegquadfr = 2*nsegquadfr
7162 IF(iddlevel==0)THEN
7163 ALLOCATE(segquadfr(ssegquadfr),stat=stat)
7164 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7165 . msgtype=msgerror,
7166 . c1='SEGTAG')
7167 END IF
7168 CALL ani_segquadfr2(segtag,segquadfr)
7169 DEALLOCATE(segtag)
7170 CALL trace_out1()
7171C--------------------------------------------
7172C MULTI-POINT CONSTRAINTS (2)
7173C--------------------------------------------
7174 err_msg='MPCS 2'
7175 err_category='MPCS'
7176 CALL trace_in1(err_msg,len_trim(err_msg))
7177 IF(nummpc > 0) CALL hm_read_mpc (
7178 1 rbmpc ,ibmpc ,ibmpc2 ,ibmpc3 ,ibmpc4 ,
7179 2 iskwn ,itab ,itabm1 ,lag_ncf ,lag_nkf ,
7180 3 lag_nhf ,d ,ikine1lag,
7181 4 nom_opt(lnopt1*inom_opt(17)+1),itagnd,
7182 5 lsubmodel,unitab)
7183 CALL trace_out1()
7184C--------------------------------------------
7185C OPTIMIZATION (Part 3 & 4)
7186C--------------------------------------------
7187 IF(ALLOCATED(tagprt_fric)) DEALLOCATE(tagprt_fric)
7188 ALLOCATE(tagprt_fric(npart),stat=stat)
7189 tagprt_fric(1:npart) = 0
7190
7191C--------------------------------------------!
7192C FRICTION MODEL : BUFFER STRUCTURE ALLOCATION, Lectur of option
7193C--------------------------------------------!
7194 iorthfricmax = 0
7195 npfricorth = 0
7196 IF(ninterfric > 0) THEN
7197
7198 IF(iddlevel == 0) ALLOCATE(intbuf_fric_tab(ninterfric), stat=stat)
7199
7200C 1st step : counting number of set of parts in friction models
7201 ALLOCATE(tabcoupleparts_fric_tmp(1),stat=stat)
7202 ALLOCATE(tabcoef_fric_tmp(1),stat=stat)
7203 ALLOCATE(ifricorth_tmp(1),stat=stat)
7204 ALLOCATE(lengrpf(npart),stat=stat)
7205 lengrpf(1:npart) = 0
7206
7207 leng = 0
7208 DO n=1,ngrpart
7209 leng = max(leng,igrpart(n)%NENTITY)
7210 ENDDO
7211
7212 flagf = 0
7213 nsetfrictot = 0
7214 coefslen = 0
7215 ngrpf = 0
7216 nsetmax = 0
7217
7218 CALL hm_read_friction_models(
7219 1 nom_opt(lnopt1*inom_opt(29)+1),unitab,igrpart ,ipart ,tagprt_fric,
7220 2 tabcoupleparts_fric_tmp ,tabcoef_fric_tmp ,intbuf_fric_tab,nsetfrictot ,
7221 3 flagf ,coefslen , iorthfricmax ,ifricorth_tmp ,ngrpf ,
7222 4 lengrpf ,leng , nsetmax ,lsubmodel )
7223
7224 DEALLOCATE(tabcoupleparts_fric_tmp)
7225 DEALLOCATE(tabcoef_fric_tmp)
7226 DEALLOCATE(ifricorth_tmp)
7227
7228C 2nd step : storing parts ids and coefficients in temperarly tabs :
7229 ALLOCATE(tabcoupleparts_fric_tmp(2*ninterfric*nsetmax),stat=stat)
7230 coefslen = ninterfric*(2*nsetmax+1)
7231 ALLOCATE(tabcoef_fric_tmp(8*coefslen),stat=stat)
7232 tabcoupleparts_fric_tmp(1:2*ninterfric*nsetmax) = 0
7233 tabcoef_fric_tmp(1:8*coefslen) = zero
7234
7235 ALLOCATE(ifricorth_tmp(ninterfric*nsetmax),stat=stat)
7236 ifricorth_tmp(1:ninterfric*nsetmax) = 0
7237
7238 flagf = 1
7239 nsetfrictot = 0
7240 coefslen = 0
7241 nsetmax = 0
7242
7243 CALL hm_read_friction_models(
7244 1 nom_opt(lnopt1*inom_opt(29)+1),unitab,igrpart ,ipart ,tagprt_fric,
7245 2 tabcoupleparts_fric_tmp ,tabcoef_fric_tmp ,intbuf_fric_tab,nsetfrictot ,
7246 3 flagf ,coefslen , iorthfricmax ,ifricorth_tmp ,ngrpf ,
7247 4 lengrpf ,leng , nsetmax , lsubmodel )
7248
7249C 3rd step : Tri of tabs
7250
7251 coefslen = ninterfric*(2*nsetmax+1)
7252 ALLOCATE(nsetinit(ninterfric),stat=stat)
7253 ALLOCATE(tabparts_fric_tmp(2*ninterfric*nsetmax),stat=stat)
7254 nsetinit(1:ninterfric) = 0
7255 tabparts_fric_tmp(1:2*ninterfric*nsetmax) = 0
7256
7257 CALL triintfric(
7258 . tabcoupleparts_fric_tmp ,tabcoef_fric_tmp ,intbuf_fric_tab ,
7259 . tabparts_fric_tmp,nsetfrictot,nsetinit,iorthfricmax,ifricorth_tmp,
7260 . nsetmax )
7261
7262C 4th step : ALLOCATION OF NEW BUFFER FOR INTERFACE FRICTION
7263
7264 IF(iddlevel == 0) CALL intbuf_fric_ini_starter(intbuf_fric_tab )
7265
7266C 4th step : Final storing of structures in buffer
7267 CALL intbuf_fric_copy(
7268 . tabcoupleparts_fric_tmp ,tabcoef_fric_tmp,tabparts_fric_tmp ,
7269 . nsetinit ,ifricorth_tmp , intbuf_fric_tab )
7270
7271 DEALLOCATE(tabcoupleparts_fric_tmp)
7272 DEALLOCATE(tabcoef_fric_tmp)
7273 DEALLOCATE(tabparts_fric_tmp )
7274
7275 DEALLOCATE( nsetinit )
7276 DEALLOCATE(ifricorth_tmp)
7277 DEALLOCATE(lengrpf )
7278
7279C------/FRICTION/ORIENTATION READING FOR ORTHOTROPIC FRICTION
7280
7281 IF(iorthfricmax > 0) THEN
7282
7283 flagf = 0
7284 npfricorth = 0
7285c KFRICORIENT = 0
7286 IF(.NOT.ALLOCATED(pfricorth))ALLOCATE(pfricorth(npart),stat=stat)
7287 IF(.NOT.ALLOCATED(irepforth))ALLOCATE(irepforth(1),stat=stat)
7288 IF(.NOT.ALLOCATED(vforth))ALLOCATE(vforth(1),stat=stat)
7289 IF(.NOT.ALLOCATED(phiforth))ALLOCATE(phiforth(1),stat=stat)
7290
7291 pfricorth(1:npart) = 0
7292
7293 CALL hm_read_friction_orientations (intbuf_fric_tab ,
7294 1 npfricorth ,igrpart ,ipart ,pfricorth ,
7295 2 irepforth ,iskwn ,phiforth ,vforth ,skew ,
7296 3 flagf ,tagprt_fric ,rtrans ,lsubmodel ,unitab )
7297
7298 DEALLOCATE(irepforth,vforth,phiforth)
7299
7300 ALLOCATE(irepforth(npfricorth),stat=stat)
7301 ALLOCATE(vforth(3*npfricorth),stat=stat)
7302 ALLOCATE(phiforth(npfricorth),stat=stat)
7303
7304 irepforth(1:npfricorth) = 0
7305 vforth(1:3*npfricorth) = zero
7306 phiforth(1:npfricorth) = zero
7307
7308 flagf = 1
7309 CALL hm_read_friction_orientations (intbuf_fric_tab ,
7310 1 npfricorth ,igrpart ,ipart ,pfricorth ,
7311 2 irepforth ,iskwn ,phiforth ,vforth ,skew ,
7312 3 flagf ,tagprt_fric ,rtrans ,lsubmodel ,unitab )
7313 ENDIF
7314
7315 ELSEIF(iddlevel == 0) THEN !NINTERFRIC = 0
7316 ALLOCATE(intbuf_fric_tab(0))
7317 ENDIF
7318 IF(.NOT.ALLOCATED(pfricorth))ALLOCATE(pfricorth(0))
7319 IF(.NOT.ALLOCATED(irepforth))ALLOCATE(irepforth(1))
7320 IF(.NOT.ALLOCATED(vforth)) ALLOCATE(vforth(1))
7321 IF(.NOT.ALLOCATED(phiforth)) ALLOCATE(phiforth(1))
7322
7323
7324C--------------------------------------------
7325C ALE CONNECTIVITY
7326C--------------------------------------------
7327 CALL ale_connectivity%ALE_CONNECTIVITY_INIT()
7328 IF(ale_connectivity%has_ne_connect) THEN
7329 CALL ale_connectivity%ALE_COMPUTE_CONNECTIVITY(numnod, numelq, numeltg, numels,
7330 . nixq, nixtg, nixs,
7331 . ixq, ixtg, ixs)
7332 ENDIF
7333 CALL ale_connectivity%ALE_COMPUTE_EE_CONNECTIVITY(pm,igeo,
7334 . npropgi,numgeo, npropm, nummat , numnod, numelq, numeltg, numels, n2d,
7335 . iale , ieuler, glob_therm%ITHERM, ialelag,detonators%IS_SHADOWING_REQUIRED,
7336 . nixq , nixtg , nixs ,
7337 . ixq , ixtg , ixs )
7338C--------------------------------------------
7339 IF(nsubdom > 0) THEN
7340C---------------Deactivation of ALE flags if no more ALE elements in domain -------------C
7341 IF(ale_euler == 0) THEN
7342 iale = 0
7343 ieuler = 0
7344 ENDIF
7345 ENDIF
7346C
7347C--------------------------------------------
7348C shell offset projection thke could be overwritten by /INI
7349C--------------------------------------------
7350C--------------------------------------------
7351C check if need offset treatment
7352C--------------------------------------------
7353 CALL chk_shell_offset(
7354 . ngroup, nparg, iparg, npropg,
7355 . numgeo, geo, defaults%SHELL%IOFFSET)
7356 IF (defaults%SHELL%IOFFSET>0) THEN
7357 IF (iddlevel == 0) THEN
7358 NULLIFY(x_c)
7359 IF (defaults%SHELL%IOFFSET==1) THEN
7360 ALLOCATE(itagoset(numelc+numeltg), stat=stat)
7361 itagoset = 0
7362 ALLOCATE(xyz(3*numnod), stat=stat)
7363 xyz(1:3*numnod) = x(1:3*numnod)
7364 x_c=>xyz
7365 ELSE
7366 ALLOCATE(itagoset(0), stat=stat)
7367 x_c=>x
7368 END IF
7369 CALL shell_offsetp(
7370 . ngroup, nparg, iparg, npropg,
7371 . numgeo, geo, numelc, nixc,
7372 . ixc, numeltg, nixtg, ixtg,
7373 . numnod, x_c, thke, itagoset,
7374 . defaults%SHELL)
7375 END IF
7376 ELSEIF (iddlevel == 0) THEN
7377 NULLIFY(x_c)
7378 x_c=>x
7379 END IF
7380C
7381C--------------------------------------------
7382C LECTURE DES INTERFACES
7383C--------------------------------------------
7384 err_msg='INTERFACES'
7385 err_category='INTERFACES'
7386 CALL trace_in1(err_msg,len_trim(err_msg))
7387 nintstamp=0
7388 nmnt = 0
7389 interfaces%PARAMETERS%ISTIF_DT = 0
7390C PROBINT egalement initialisee dans ENGINE (rdresa)
7391 probint=half
7392 interfaces%PARAMETERS%INT25_EROSION_SOLID = 0
7393
7394 IF(ninter == 0.AND.ninterfric > 0 )THEN
7395 CALL ancmsg(msgid=1593,
7396 . msgtype=msgwarning,
7397 . anmode=aninfo_blind_1)
7398 ENDIF
7399
7400 IF(ninter > 0)THEN
7401 IF(iddlevel == 0) THEN
7402 ALLOCATE(xfiltr(ninter) ,stat=stat)
7403 ALLOCATE(stfac(ninter) ,stat=stat)
7404 ALLOCATE(fric_p(10*ninter) ,stat=stat)
7405 ALLOCATE(i2rupt(6*ninter) ,stat=stat)
7406 ALLOCATE(areasl(ninter) ,stat=stat)
7407 ALLOCATE(frigap(nparir*ninter),stat=stat)
7408 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7409 . msgtype=msgerror,
7410 . c1='XFILTR')
7411 END IF
7412 xfiltr = zero
7413 stfac = zero
7414 fric_p = zero
7415 frigap = zero
7416 i2rupt = zero
7417 areasl = zero
7418C
7419 IF(iddlevel == 0) CALL startime(10,1)
7420 IF(iddlevel == 1) CALL startime(11,1)
7421
7422 WRITE(istdo,'(A)')titre(38)
7423 IF(nintsub/=0)THEN
7424 CALL hm_read_intsub(igrnod ,igrsurf,nom_opt(lnopt1*inom_opt(3)+1),igrslin,lsubmodel)
7425 END IF
7426 ids = 117
7427 i = 0
7428c CALL ANCNTS(IDS, I)
7429C
7430 nsn_multi_connec = 0
7431 ALLOCATE(t2_nb_connec(numnod))
7432 t2_nb_connec(1:numnod) = 0
7433C------------------------------------------------------------
7434C INTERFACE READING
7435C--------------------------------------------------------------
7436 ninter25 = 0
7437 CALL hm_read_interfaces(
7438 1 ipari ,frigap ,itab ,itabm1 ,
7439 2 igrnod ,igrsurf ,igrslin ,igrbric ,igrsh3n ,
7440 3 igrtruss ,npc ,iskwn ,xfiltr ,stfac ,
7441 4 fric_p ,i2rupt ,areasl ,unitab ,nom_opt(lnopt1*inom_opt(3)+1) ,
7442 5 def_inter ,npc1 ,sensors ,multi_fvm ,nom_opt(lnopt1*inom_opt(29)+1),
7443 6 intbuf_fric_tab ,lsubmodel,tf ,npts ,npari ,
7444 7 kloadpinter ,dgapint ,interfaces ,sitab ,nparir ,
7445 8 sitabm1 ,siskwn ,liskn ,snpc ,snpc1 ,
7446 9 glob_therm%ITHERM_FE,glob_therm%INTHEAT)
7447C
7448 IF(.NOT. ALLOCATED(ale_connectivity%NALE)) ALLOCATE(ale_connectivity%NALE(0))
7449
7450 IF(ninter > 0) THEN
7451 ALLOCATE(list_nin25(ninter))
7452 list_nin25(1:ninter) = 0
7453 ENDIF
7454 IF(ninter25 >0.AND.numels > 0) THEN
7455 ALLOCATE(flag_elem_inter25(ninter25,numels))
7456 flag_elem_inter25(1:ninter25,1:numels) = 0
7457 ELSE
7458 ALLOCATE(flag_elem_inter25(0,0))
7459 ENDIF
7460
7461 CALL lecint (ipari ,ninter ,ipm ,bufmat ,
7462 . nmnt ,itab ,itabm1 ,geo ,
7463 . pm ,x ,igrnod ,igrsurf ,igrslin ,
7464 . npc ,probint ,lag_ncf ,
7465 . lag_nkf ,lag_ncl ,lag_nkl ,lag_nhf ,maxrtm ,
7466 . iskwn ,maxrtms ,igeo ,
7467 . xfiltr ,stfac ,fric_p ,frigap ,
7468 . i2rupt ,areasl ,unitab ,ixs ,nom_opt(lnopt1*inom_opt(3)+1),
7469 . itag ,ixc ,ixtg ,knod2elc ,knod2eltg,
7470 . nod2elc ,nod2eltg ,knod2els ,nod2els ,ixs10 ,
7471 . ixs16 ,ixs20 ,def_inter ,maxnsne ,
7472 . npc1 ,multi_fvm ,nom_opt(lnopt1*inom_opt(29)+1),intbuf_fric_tab,
7473 . igrbric ,igrsh3n ,igrtruss ,maxrtm_t2 ,nsn_multi_connec,
7474 . t2_nb_connec,iddlevel ,ale_connectivity%NALE ,interfaces ,snpc1 ,
7475 . flag_elem_inter25 ,list_nin25)
7476
7477 !need to allocate only once at first passage in lectur
7478 flag_allocate = 1
7479 !PROC argument is used only for call in ddsplit
7480 proc_bid = 0
7481
7482 IF(iddlevel == 0) THEN
7483 !--------------------------------------------!
7484 ! NEW INTERFACE BUFFER STRUCTURE ALLOCATION
7485 !--------------------------------------------!
7486 ALLOCATE(intbuf_tab(ninter), stat=stat)
7487 !--------------------------------------------!
7488
7489 !--------------------------------------------!
7490 !NEW INTERFACE BUFFER STRUCTURE INITIALIZATION
7491 !--------------------------------------------!
7492 CALL intbuf_ini_starter(intbuf_tab, ipari, numnod,
7493 . i11flag, flag_allocate, proc_bid ,intbuf_fric_tab)
7494 !--------------------------------------------!
7495
7496 CALL int8_ini(intbuf_tab,ipari,nbt8)
7497 ALLOCATE(intert8(nspmd,nbt8))
7498 DO p = 1,nspmd
7499 DO i = 1,nbt8
7500 ALLOCATE(intert8(p,i)%BUFFER(nspmd))
7501 DO j=1,nspmd
7502 intert8(p,i)%BUFFER(j)%NBMAIN = -1
7503 intert8(p,i)%BUFFER(j)%NBSECND_TOT = 0
7504 ENDDO
7505 ENDDO
7506 ENDDO
7507 ! -------------------
7508 ! allocation of arrays for the interface 18 with law 151
7509 CALL int18_law151_alloc(npari,ninter,numnod,numels,multi_fvm,ipari)
7510 ! -------------------
7511 END IF
7512C
7513C-----Allocation structures INTSTAMP
7514C
7515 IF(nintstamp/=0)THEN
7516 IF(iddlevel == 0) THEN
7517 ALLOCATE(intstamp(nintstamp) ,stat=stat)
7518 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7519 . msgtype=msgerror,
7520 . c1='INTSTAMP')
7521 CALL intstamp_zero(intstamp)
7522 END IF
7523 ELSE
7524 IF(iddlevel == 0) THEN
7525 ALLOCATE(intstamp(0))
7526 ENDIF
7527 END IF
7528C
7529 CALL lecins(ipari ,itab ,pm ,ipm ,bufmat ,
7530 . igrnod ,igrsurf ,igrslin ,xfiltr ,stfac ,
7531 . fric_p ,frigap ,i2rupt ,areasl ,lixint ,
7532 . x ,ninter ,ixs ,nom_opt(lnopt1*inom_opt(3)+1),
7533 . ixc ,ixtg ,knod2elc ,knod2eltg ,nod2elc,
7534 . nod2eltg ,intbuf_tab,knod2els ,nod2els ,ixs10 ,
7535 . ixs16 ,ixs20 ,nige ,rige ,xige ,
7536 . vige ,igrbric ,multi_fvm,ale_connectivity%NALE ,igeo ,
7537 . interfaces,s_nod2els,s_nod2eltg,flag_elem_inter25 ,list_nin25)
7538C
7539cc DEALLOCATE(XFILTR)
7540cc DEALLOCATE(STFAC)
7541cc DEALLOCATE(FRIC_P)
7542C DEALLOCATE(FRIGAP)
7543cc DEALLOCATE(I2RUPT)
7544cc DEALLOCATE(AREASL)
7545C----
7546c CALL ANCNTG(IDS, I, J)
7547 ids = 60
7548c CALL ANCHECK(IDS)
7549 IF(nintsub/=0)THEN
7550 CALL inintsub(
7551 . itab ,igrnod ,igrsurf ,
7552 . ipari ,maxrtm,nom_opt(lnopt1*inom_opt(3)+1),
7553 . intbuf_tab,maxrtms ,igrslin ,maxnsne)
7554 ENDIF
7555C----
7556 IF(iddlevel == 0) THEN
7557 ALLOCATE(inscr(ninter) ,stat=stat)
7558 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7559 . msgtype=msgerror,
7560 . c1='INSCR')
7561
7562 ENDIF
7563
7564 CALL prescrint(ipari,intbuf_tab,inscr)
7565
7566 IF(iddlevel == 0) THEN
7567
7568 DO i=1,ninter
7569 ALLOCATE(inscr(i)%WA(inscr(i)%SINSCR) ,stat=stat)
7570 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7571 . msgtype=msgerror,
7572 . c1='INSCR')
7573 inscr(i)%WA = 0
7574 ENDDO
7575 ELSE
7576 DO i=1,ninter
7577 inscr(i)%WA = 0
7578 ENDDO
7579 END IF
7580 CALL scrint(ipari ,inscr, intbuf_tab)
7581
7582 IF(iddlevel == 0) CALL stoptime(10,1)
7583 IF(iddlevel == 1) CALL stoptime(11,1)
7584
7585 WRITE(istdo,'(A)')titre(68)
7586C-----
7587 aux = max( numnod , numelt+numelp+numelr+numeltg+numelc+100 ,
7588 . maxrtm+100 )
7589 ns_i7 = 2*numnod + 2002 + 4*aux
7590C
7591 ns_i11 = 2002 + nmnt
7592 aux = 2002 + 8*maxrtms
7593 ns_i11 = max(ns_i11,aux)
7594C
7595C Max size for interface type2 - i2buc1
7596 aux = max( numnod , maxrtm_t2+100 )
7597 ns_i2 = 2*numnod + 2002 + 4*aux
7598C
7599 ifip=max(ns_i7,ns_i11,
7600 . numnod+2+4*numelc+4*numeltg+8*numels
7601 . +2*numelt+2*numelp+2*numelr)
7602C-----
7603 siwork = max(ns_i7,ns_i11,numnod+2+4*numelc+4*numeltg+8*numels
7604 . + 2*numelt+2*numelp+2*numelr+16*numels10+ 2*(sixx-1)
7605 . + maxnsne,ns_i2)
7606C
7607 srwork = max(6000,numnod)
7608 ALLOCATE(iwork(siwork) ,stat=stat)
7609 ALLOCATE(rwork(srwork) ,stat=stat)
7610 iwork = 0
7611 rwork = zero
7612C-----
7613 IF(lxintd>0.AND.nspmd>1) lixint = lixint + lxintd
7614
7615 inter_cand%S_IXINT_2 = lixint
7616 IF(iddlevel==0)THEN
7617 IF( ALLOCATED(inter_cand%IXINT) ) DEALLOCATE( inter_cand%IXINT )
7618 ALLOCATE(inter_cand%IXINT(inter_cand%S_IXINT_1,inter_cand%S_IXINT_2))
7619 ALLOCATE(xtmp(3*numnod) ,stat=stat)
7620 xtmp = d(1:3*numnod)
7621 ENDIF
7622 ifixin = ifip
7623 ifiend = ifixin
7624 nelemint = 0
7625 lixint = 0
7626C
7627C read /INIBRI/FILL before interfaces stiffness
7628 IF(.NOT.ALLOCATED(fillsol)) ALLOCATE(fillsol(numels),stat=stat)
7629 IF(stat/=0) CALL ancmsg(msgid=268,anmode=aninfo,
7630 . msgtype=msgerror,
7631 . c1='FILLSOL')
7632 IF(numels/=0) CALL lecfill(ixs,fillsol,unitab,lsubmodel)
7633
7634 IF(iddlevel == 0) CALL startime(12,1)
7635 IF(iddlevel == 1) CALL startime(13,1)
7636
7637 CALL int18_law151_init(multi_fvm%S_APPEND_ARRAY,ninter,npari,
7638 1 numnod,numels,ngrbric,
7639 2 multi_fvm,igrbric,ipari,ixs,
7640 4 x ,v ,ms ,kinet ,
7641 5 multi_fvm%X_APPEND,multi_fvm%V_APPEND,multi_fvm%MASS_APPEND,multi_fvm%KINET_APPEND)
7642
7643C
7644C fill interface structure to be used by sorting
7645c set INTERCEP for INT7 only to avoid bug with INT20 dur to renumerotation
7646c in I20NLG (other interface types still done in SET_INTERCEP)
7647 CALL fill_intercep(ipari,intbuf_tab,intercep)
7648C
7649 CALL inintr(ipari ,inscr ,x_c ,v ,ixs ,ixq ,
7650 2 ixc ,pm ,geo ,itab ,ms ,
7651 3 iwork ,rwork ,ixtg ,d ,ixt ,
7652 4 ixp ,ixr ,ale_connectivity ,nelemint ,iddlevel ,
7653 5 lixint ,igrbric ,iwcont ,iwcin2 ,knod2els ,
7654 7 knod2elc ,knod2eltg ,nod2els ,nod2elc ,nod2eltg ,
7655 8 igrsurf ,ielem21 ,sh4tree ,sh3tree ,ipart ,
7656 9 ipartc ,ipartg ,thke ,thk_part ,nod2el1d ,
7657 a knod2el1d ,ixs10 ,inter_cand ,frigap ,ixs16 ,
7658 b ixs20 ,ipm ,nom_opt(lnopt1*inom_opt(3)+1),iparts ,siskwn ,
7659 c kxx ,ixx ,igeo ,intercep ,lelx ,
7660 d intbuf_tab,fillsol ,stack%PM ,iworksh ,nsnt ,
7661 e nmnt_2 ,kxig3d ,ixig3d ,knod2elq ,nod2elq ,
7662 f segquadfr ,tagprt_fric,intbuf_fric_tab ,ipartt ,
7663 g ipartp ,ipartx ,ipartr ,nsn_multi_connec ,t2_nb_connec,
7664 h sicode ,icode ,iskew ,multi_fvm ,s_nod2els ,
7665 i sitab ,sitabm1 ,flag_elem_inter25 ,list_nin25 )
7666 IF(iddlevel == 0) CALL stoptime(12,1)
7667 IF(iddlevel == 1) CALL stoptime(13,1)
7668
7669 idel_solid = 0
7670 DO i=1,ninter
7671 IF(ipari(npari*(i-1)+7)==25.AND.ipari(npari*(i-1)+100)>0) THEN
7672 idel_solid = idel_solid + 1
7673 ENDIF
7674 ENDDO
7675 IF(idel_solid == 0) interfaces%PARAMETERS%INT25_EROSION_SOLID = 0
7676
7677 DEALLOCATE (flag_elem_inter25)
7678 DEALLOCATE (list_nin25)
7679
7680 DEALLOCATE (t2_nb_connec)
7681 DEALLOCATE (rwork)
7682 DEALLOCATE (iwork)
7683
7684 IF(iddlevel==1) THEN
7685 DEALLOCATE(xfiltr)
7686 DEALLOCATE(fric_p)
7687 DEALLOCATE(frigap)
7688 END IF
7689C-------------RBE3 use IXINT--pour opt.
7690 IF(lxintd>0.AND.nspmd>1)THEN
7691 IF(lixint+lxintd > inter_cand%S_IXINT_2)THEN
7692 CALL upgrade_ixint(inter_cand,nelemint,lxintd)
7693 ENDIF
7694
7695 CALL update_weight_rbe3(nelemint,lixint,slrbe3,nrbe3l,nrbe3,
7696 . lrbe3,irbe3,inter_cand)
7697 ENDIF
7698 CALL trace_out1()
7699C-----
7700 IF(iddlevel==0)THEN
7701 d(1:3*numnod) = xtmp(1:3*numnod)
7702 DEALLOCATE(xtmp)
7703 END IF
7704C
7705 ELSEIF(iddlevel == 0) THEN !NINTER = 0
7706
7707 sinscr = 0
7708 ALLOCATE(intstamp(0))
7709
7710 !--------------------------------------------!
7711 ! NEW INTERFACE BUFFER STRUCTURE ALLOCATION
7712 !--------------------------------------------!
7713 ALLOCATE(intbuf_tab(0), stat=stat)
7714 !--------------------------------------------!
7715C
7716 ENDIF
7717
7718
7719C--------------------------------------------
7720C LECTURE DES MURS RIGIDES
7721C--------------------------------------------
7722 err_msg='RIGID WALLS'
7723 err_category='RIGID WALLS'
7724 CALL trace_in1(err_msg,len_trim(err_msg))
7725 snprw = nrwall*nnprw
7726 siwork = nrwall*numnod
7727 slprw = 0
7728 IF(iddlevel==0) THEN
7729 ALLOCATE(nprw(snprw) ,stat=stat)
7730 END IF
7731 ALLOCATE(iwork(siwork) ,stat=stat)
7732 nprw = 0
7733 iwork = 0
7734C
7735 srwbuf = nrwlp*nrwall
7736 srwsav = 0
7737 srwork = 3*numnod*nrwall+srwbuf
7738 ALLOCATE(rwork(srwork) ,stat=stat)
7739 rwork = zero
7740 nrwlag = 0
7741c
7742 IF(nrwall > 0) THEN
7743 WRITE(istdo,'(A)')titre(39)
7744 CALL read_rwall(
7745 1 rwork ,nprw ,iwork ,slprw ,ms ,
7746 2 v ,itab ,itabm1 ,x ,ixs ,
7747 3 ixq ,npc1 ,d ,igrnod ,
7748 4 srwbuf ,imerge ,unitab ,
7749 5 ikine1lag,iddlevel ,lsubmodel ,rtrans ,
7750 6 nom_opt(lnopt1*inom_opt(5)+1),itagnd)
7751 ENDIF
7752C
7753
7754 IF(iddlevel==0) THEN
7755 ALLOCATE(lprw(slprw) ,stat=stat)
7756 END IF
7757 lprw = iwork(1:slprw)
7758 DEALLOCATE(iwork)
7759 IF(iddlevel==0) THEN
7760 ALLOCATE(rwbuf(srwbuf) ,stat=stat)
7761 IF(stat /= 0) THEN
7762 CALL ancmsg(msgid=727,
7763 . msgtype=msgerror,
7764 . anmode=anstop,
7765 . c1='RWBUF')
7766 ENDIF
7767 END IF
7768 rwbuf = rwork(1:srwbuf)
7769 DEALLOCATE(rwork)
7770 IF(ALLOCATED(rwsav)) DEALLOCATE(rwsav)
7771 ALLOCATE(rwsav(srwsav) ,stat=stat)
7772 CALL trace_out1()
7773C
7774C--------------------------------------------
7775C LECTURE DES MASSES AJOUTEES
7776C--------------------------------------------
7777 err_msg='ADDED MASSES'
7778 err_category='ADDED MASSES'
7779 CALL trace_in1(err_msg,len_trim(err_msg))
7780 IF(nodmas > 0)THEN
7781 WRITE(istdo,'(A)')titre(43)
7782 IF(iddlevel==0) THEN
7783 ALLOCATE(ipmas(nodmas),stat=stat)
7784 ipmas(1:nodmas)%NPART = 0
7785 ipmas(1:nodmas)%WEIGHT_FLAG = 0
7786 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
7787 . msgtype=msgerror,
7788 . c1='IPMAS')
7789 ENDIF
7790!---
7791 flagg = 0
7792!---
7793 CALL hm_read_admas(
7794 . ms ,itabm1 ,igrnod ,unitab ,igrsurf,
7795 . ipart ,ipmas ,totaddmas,flagg ,igrpart,
7796 . x ,lsubmodel)
7797!---
7798 flagg = 1
7799!---
7800 CALL hm_read_admas(
7801 . ms ,itabm1 ,igrnod ,unitab ,igrsurf,
7802 . ipart ,ipmas ,totaddmas,flagg ,igrpart,
7803 . x ,lsubmodel)
7804!---
7805 IF(ns10e>0) CALL addmast10(icnds10, ms )
7806C---
7807 ELSE
7808 IF(iddlevel==0) THEN
7809 ALLOCATE(ipmas(0))
7810 ENDIF
7811 ENDIF
7812 CALL trace_out1()
7813C--------------------------------------------
7814C LECTURE DES STRUCTURES RIGIDES
7815C--------------------------------------------
7816 err_msg='RIGID ENTITIES'
7817 err_category='RIGID BODY'
7818 CALL trace_in1(err_msg,len_trim(err_msg))
7819 CALL hm_preread_rbody (slpby ,igrnod ,lsubmodel)
7820 CALL preread_rbody_lagmul(slpbyl ,igrnod ,lsubmodel)
7821 CALL hm_preread_merge(smgrby, slpby, igrnod, lsubmodel)
7822 snpby = nnpby*nrbykin
7823 snpbyl = nnpby*nrbylag
7824 snrbody = snpby + snpbyl
7825 slrbody = slpby + slpbyl
7826 srby = nrby*nrbody
7827 IF(iddlevel==0) THEN
7828 IF(ALLOCATED(npby)) DEALLOCATE(npby)
7829 IF(ALLOCATED(lpby)) DEALLOCATE(lpby)
7830 IF(ALLOCATED(rby)) DEALLOCATE(rby)
7831 ALLOCATE(npby(snrbody),stat=stat)
7832 ALLOCATE(lpby(slrbody),stat=stat)
7833 ALLOCATE(rby(srby) ,stat=stat)
7834 END IF
7835 IF(nrbmerge > 0) THEN
7836 ALLOCATE(mgrby(nmgrby*smgrby),stat=stat)
7837 ELSE
7838 ALLOCATE(mgrby(0),stat=stat)
7839 ENDIF
7840 npby = 0
7841 lpby = 0
7842 mgrby = 0
7843 rby = zero
7844 IF(snpby<snrbody) THEN
7845 npbyl => npby(snpby+1:snrbody)
7846 ELSE
7847 npbyl => npby
7848 END IF
7849 IF(slpby<slrbody) THEN
7850 lpbyl => lpby(slpby+1:slrbody)
7851 ELSE
7852 lpbyl => lpby
7853 END IF
7854 IF(nrby *nrbykin<srby) THEN
7855 rbyl => rby(nrby *nrbykin+1:srby)
7856 ELSE
7857 rbyl => rby
7858 END IF
7859C
7860 IF(nrbody > 0) WRITE(istdo,'(A)')titre(41)
7861 IF(nrbykin > 0) THEN
7862 CALL hm_read_rbody(
7863 1 rby ,npby ,lpby ,itab ,itabm1 ,
7864 2 igrnod ,igrsurf ,ibfv ,igrv ,lgrav ,
7865 3 sensors ,imerge ,unitab ,iskwn ,nom_opt ,
7866 4 slrbody ,knod2els,knod2elc,knod2eltg,knod2el1d,
7867 5 knod2elq ,itagnd ,icnds10 ,lsubmodel,icfield ,
7868 6 lcfield )
7869 ENDIF
7870C--------------------------------------------
7871C LECTURE DES FUSIONS DE RIGID BODY
7872C--------------------------------------------
7873 IF(nrbmerge > 0) THEN
7874 CALL hm_read_merge(
7875 . mgrby,smgrby ,npby,lpby ,slrbody,
7876 . rby ,nom_opt,inom_opt(30),igrnod ,
7877 . itab ,itabm1 ,lgrav ,igrv ,
7878 . lsubmodel)
7879 ENDIF
7880C--------------------------------------------
7881C CHECK DES STRUCTURES RIGIDES
7882C--------------------------------------------
7883 IF(nrbykin > 0) THEN
7884 CALL checkrby(
7885 1 rby ,npby ,lpby ,itab ,
7886 2 d ,iddlevel,nom_opt,slrbody)
7887 ENDIF
7888C--------------------------------------------
7889C LECTURE RB LAGRANGE
7890C--------------------------------------------
7891 IF(nrbylag > 0) THEN
7892 CALL hm_read_rbody_lagmul(rbyl ,npbyl ,lpbyl ,igrnod ,lsubmodel ,
7893 . itab ,itabm1 ,d ,ikine1lag,nom_opt)
7894 ENDIF
7895 CALL trace_out1()
7896C--------------------------------------------
7897 IF(ninter > 0) THEN
7898C--------------------------------------------
7899C
7900 IF(nintstamp/=0)THEN
7901 err_msg='INTERFACES TYPE21'
7902 err_category='INTERFACES'
7903 CALL trace_in1(err_msg,len_trim(err_msg))
7904c IF(IDDLEVEL==0)THEN
7905 CALL lecstamp(ipari ,intstamp ,unitab, npby,
7906 . icode ,nom_opt(lnopt1*inom_opt(3)+1),lsubmodel)
7907c ENDIF
7908 CALL trace_out1()
7909 END IF
7910C--------------------------------------------
7911C OPTIMISATION INTERFACE SPMD
7912C--------------------------------------------
7913 err_category='INTERNAL'
7914 IF(iddlevel==0)THEN
7915 IF(iale+ieuler/=0)
7916 + CALL paroi(pm ,ixs ,ixq ,icode ,ale_connectivity%NALE )
7917 IF(numels/=0)
7918 + CALL lce16s4(ixs ,pm ,icode )
7919C
7920 lag_ncf = lag_ncf0
7921 lag_nkf = lag_nkf0
7922 lag_nhf = lag_nhf0
7923 lag_ncl = lag_ncl0
7924 lag_nkl = lag_nkl0
7925 ENDIF
7926 ENDIF
7927
7928C--------------------------------------------
7929C
7930C After IDDLEVEL - we do not enter inintr anymore
7931C set I11FLAG to 1
7932 i11flag = 1
7933
7934 DEALLOCATE(ielem21)
7935C
7936C---------------------------------
7937 IF((seani > 0).AND.(iddlevel==1)) eani = 0
7938C---------------------------------
7939#ifdef DNC
7940C--------------------------------------------
7941C LECTURE et PREPARATION DES ELEMENTS FINIS A ENVOYER A MADYMO :
7942C "EXTENDED COUPLING".
7943C--------------------------------------------
7944 err_msg='MADYMO INTERFACED FEM'
7945 err_category='MADYMO INTERFACED FEM'
7946 CALL trace_in1(err_msg,len_trim(err_msg))
7947 IF(nexmad/=0) THEN
7948 siwork2 = max(npart,numnod,2*numnod+numelc+numeltg+numels)
7949 siwork = npart+numnod+2*(numelc+numeltg+numels)
7950
7951 ALLOCATE(iwork(siwork+siwork2),stat=stat)
7952 iwork = 0
7953 IF(siwork<siwork+siwork2) THEN
7954 iwork2 => iwork(siwork+1:siwork+siwork2)
7955 ELSE
7956 iwork2 => iwork
7957 ENDIF
7958 ENDIF
7959 IF(ALLOCATED(iconx)) DEALLOCATE(iconx)
7960 IF(nexmad/=0) THEN
7961 WRITE(istdo,'(A)')' .. FEM INTERFACED TO MADYMO'
7962 CALL hm_read_madymo_exfem(iwork(7*nconx+1),itab ,itabm1 ,ipart ,ipartc,
7963 . ipartg ,iparts ,ixc ,ixtg ,ixs ,
7964 . iwork2 ,geo ,pm ,iwork ,igeo ,
7965 . ipm ,lsubmodel)
7966
7967 smadprt = nmadprt
7968 smadsh4 = nmadsh4
7969 smadsh3 = nmadsh3
7970 smadsol = nmadsol
7971 smadnod = nmadnod
7972
7973 smadfail= numelc+numeltg+numels
7974
7975 siextag = 2*nmadnod+nmadsh4+nmadsh3+nmadsol
7976
7977 siexmad = nmadprt+nmadsh4+nmadsh3+nmadsol+nmadnod
7978 . + numelc+numeltg+numels
7979
7980 siconx = 7*nconx+siexmad+siextag
7981 ALLOCATE(iconx(siconx),stat=stat)
7982 iconx(1:siconx) = 0
7983 DO i=1,7*nconx+siexmad
7984 iconx(i) = iwork(i)
7985 ENDDO
7986 ELSE
7987 siconx = 7*nconx
7988 ALLOCATE(iconx(siconx),stat=stat)
7989 IF(siconx > 0)THEN
7990 iconx(1:7*nconx)=iwork(1:7*nconx)
7991 ENDIF
7992 ENDIF
7993 IF(ALLOCATED(iwork)) DEALLOCATE(iwork)
7994 CALL trace_out1()
7995#else
7996 IF(.NOT. ALLOCATED(iconx)) ALLOCATE(iconx(0))
7997#endif
7998C---------------------------------------------
7999C LECTURE DES CORPS FLEXIBLES
8000C---------------------------------------------
8001 err_msg='FLEXIBLE BODIES'
8002 err_category='FLEXIBLE BODIES'
8003 CALL trace_in1(err_msg,len_trim(err_msg))
8004C
8005
8006 IF(nfxbody == 0) THEN
8007 IF(iddlevel==0) THEN
8008 ALLOCATE(fxbnod(0),fxb_matrix(0),fxb_matrix_add(4,0))
8009 ALLOCATE(fxbglm(0), fxbcpm(0) , fxbrpm(0),
8010 . fxbcps(0) , fxblm(0) , fxbfls(0),
8011 . fxbdls(0), fxbdep(0), fxbvit(0),
8012 . fxbacc(0), fxbmod(0), fxbelm(0),
8013 . fxbsig(0), fxbgrvi(0), fxbgrvr(0))
8014 ENDIF
8015 ELSE IF(nfxbody>0) THEN
8016C
8017 IF(iddlevel==1) THEN
8018C-- length must be reset for second pass
8019 lenglm=0
8020 lencp=0
8021 lenlm=0
8022 lenfls=0
8023 lendls=0
8024 lenvar=0
8025 lenrpm=0
8026 lenmcd=0
8027 lenelm=0
8028 lensig=0
8029 lengrvi=0
8030 lengrvr=0
8031 ENDIF
8032C
8033 IF(iddlevel==0) THEN
8034 INQUIRE(iolength=rclen) flrec6
8035 OPEN(unit=ifxm,status='SCRATCH',
8036 . access='DIRECT',recl=rclen)
8037 OPEN(unit=ifxs,status='SCRATCH',
8038 . access='DIRECT',recl=rclen)
8039 WRITE(istdo,'(A)')titre(51)
8040 ALLOCATE(fxbnod(lennod),fxb_matrix(lenmat),fxb_matrix_add(4,lenmat))
8041 ENDIF
8042C
8043 CALL hm_read_fxb1(nom_opt(lnopt1*inom_opt(11)+1),fxbnod,fxbipm,fxb_matrix,fxb_matrix_add,
8044 . nmanim,itab,itabm1,fxbfile_tab,lsubmodel)
8045C
8046 DO nfx=1,nfxbody
8047 aipm=(nfx-1)*nbipm
8048 anod=fxbipm(aipm+6)
8049 nbno=fxbipm(aipm+3)
8050 nbmo=fxbipm(aipm+4)+fxbipm(aipm+17)
8051 fxbipm(aipm+19)=lenelm+1
8052 fxbipm(aipm+20)=lensig+1
8053 fxbipm(aipm+26)=lengrvi+1
8054 fxbipm(aipm+27)=lengrvr+1
8055C
8056 CALL fxbtagn(
8057 . fxbnod(anod), nbno, fxbipm(aipm+18), ibcl , ipres ,
8058 . ixs , ixc , ixt , ixp , ixr ,
8059 . ixtg , iparg , fxbtag, nbmo, fxbipm(aipm+4),
8060 . nels , nelc, neltg, igrv ,lgrav ,
8061 . nlgrav , ipari , intbuf_tab , fxbipm(aipm+29), nelt,
8062 . nelp)
8063 fxbipm(aipm+21)=nels
8064 fxbipm(aipm+22)=nelc
8065 fxbipm(aipm+23)=neltg
8066 fxbipm(aipm+34)=nelt
8067 fxbipm(aipm+35)=nelp
8068 fxbipm(aipm+24)=0
8069 fxbipm(aipm+25)=nlgrav
8070 ENDDO
8071C
8072 IF(iddlevel==0) THEN
8073 ALLOCATE(fxbglm(lenglm), fxbcpm(lencp) , fxbrpm(lenrpm),
8074 . fxbcps(lencp) , fxblm(lenlm) , fxbfls(lenfls),
8075 . fxbdls(lendls), fxbdep(lenvar), fxbvit(lenvar),
8076 . fxbacc(lenvar), fxbmod(lenmod*6), fxbelm(lenelm),
8077 . fxbsig(lensig), fxbgrvi(lengrvi), fxbgrvr(lengrvr))
8078 ENDIF
8079C
8080 fxbelm(1:lenelm)= 0
8081 DO nfx=1,nfxbody
8082 aipm=(nfx-1)*nbipm
8083 anod=fxbipm(aipm+6)
8084 nbno=fxbipm(aipm+3)
8085 alm=fxbipm(aipm+19)
8086 IF(fxbipm(aipm+4)>0) CALL fxbelnum(
8087 . fxbnod(anod), nbno, iparg , fxbtag, fxbelm(alm),
8088 . ixs , ixc , ixtg , iparts ,ipartc ,
8089 . ipartg , ixt , ixp , ipartt ,ipartp )
8090 ENDDO
8091C
8092 CALL hm_read_fxb2(fxbipm, fxbrpm, fxbnod, fxbglm,
8093 . fxbcpm, fxbcps, fxblm, fxbfls, fxbdls,
8094 . fxbmod, itab , itabm1 , nom_opt(lnopt1*inom_opt(11)+1),fxb_last_adress,
8095 . lsubmodel)
8096C
8097C
8098 ELSEIF(iddlevel==0) THEN
8099 ALLOCATE(fxbnod(0) , fxbmod(0), fxbglm(0), fxbgrvi(0),
8100 . fxbcpm(0) , fxbcps(0), fxblm(0) , fxbfls(0) ,
8101 . fxbdls(0) , fxbdep(0), fxbvit(0), fxbacc(0) ,
8102 . fxbrpm(0) , fxbelm(0), fxbsig(0),
8103 . fxbgrvr(0))
8104 ENDIF
8105C
8106 CALL trace_out1()
8107 err_msg='EIGEN MODES'
8108 err_category='EIGEN MODES'
8109 CALL trace_in1(err_msg,len_trim(err_msg))
8110 IF(neig>0) THEN
8111C
8112 INQUIRE(iolength=rclen) flrec6
8113 OPEN(unit=ieigm,status='SCRATCH',
8114 . access='DIRECT',recl=rclen)
8115C
8116 WRITE(istdo,'(A)')titre(52)
8117 CALL hm_preread_eig(igrnod ,nnt ,lsubmodel)
8118 neipm=17
8119 nerpm=4
8120 leibuf = nnt
8121 IF(iddlevel==0) THEN
8122 ALLOCATE(eigipm(neipm*neig), eigibuf(nnt))
8123 ALLOCATE(eigrpm(nerpm*neig))
8124 eigipm = 0
8125 eigibuf = 0
8126 eigrpm = zero
8127 ENDIF
8128C
8129 CALL hm_read_eig(eigipm, eigibuf, eigrpm, igrnod ,itabm1 ,
8130 . unitab, lsubmodel)
8131 ELSEIF(iddlevel==0) THEN
8132 ALLOCATE(eigipm(0), eigibuf(0))
8133 ALLOCATE(eigrpm(0))
8134 ENDIF
8135 CALL trace_out1()
8136 CALL trace_in1(err_msg,len_trim(err_msg))
8137 IF(ndsolv==1) THEN
8138 WRITE(6,*) "ERROR Deprecated Linear solver"
8139 CALL arret(5)
8140 ELSEIF(iddlevel==0) THEN
8141 nslevel=0
8142 ALLOCATE(ceptmp(0), neldom(0), eldom(0,0,0),
8143 . elsub(0,0))
8144 ENDIF
8145 CALL trace_out1()
8146C
8147C shell composite xfem
8148C
8149 err_msg='COMPOSITE SHELLS'
8150 err_category='COMPOSITE SHELLS'
8151 CALL trace_in1(err_msg,len_trim(err_msg))
8152C
8153 IF(iddlevel==0) THEN
8154 IF(iplyxfem > 0) THEN
8155 ALLOCATE(ms_ply0(numnod*nplymax),stat=stat)
8156 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8157 . msgtype=msgerror,
8158 . c1='MS_PLY0')
8159 ms_ply0=zero
8160 ALLOCATE(zi_ply0(numnod*nplymax),stat=stat)
8161 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8162 . msgtype=msgerror,
8163 . c1='ZI_PLY0')
8164 zi_ply0=zero
8165 ALLOCATE(msz20(numnod),stat=stat)
8166 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8167 . msgtype=msgerror,
8168 . c1='MSZ20')
8169 msz20=zero
8170 ALLOCATE(itagnd_shxfem(numnod),stat=stat)
8171 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8172 . msgtype=msgerror,
8173 . c1='ITAGND_SHXFEM')
8174 itagnd_shxfem=0
8175 ALLOCATE(itagsh(numelc),stat=stat)
8176 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8177 . msgtype=msgerror,
8178 . c1='ITAGSH')
8179 itagsh=0
8180 ALLOCATE(inod_pxfem(numnod),stat=stat)
8181 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8182 . msgtype=msgerror,
8183 . c1='INOD_PXFEM')
8184 inod_pxfem=0
8185 ALLOCATE(iel_pxfem(numelc),stat=stat)
8186 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8187 . msgtype=msgerror,
8188 . c1='IEL_PXFEM')
8189 iel_pxfem=0
8190 ELSE
8191 ALLOCATE(ms_ply0(0),zi_ply0(0),itagnd_shxfem(0),
8192 . itagsh(0),inod_pxfem(0),iel_pxfem(0))
8193 ALLOCATE(ms_ply(0),zi_ply(0),msz20(0))
8194 ENDIF
8195 ENDIF
8196C
8197 CALL trace_out1()
8198C
8199C-----------------------------------------------------------
8200C
8201 err_msg='ARRAYS ALLOCATION FOR INTIA'
8202 err_category='INTERNAL'
8203 CALL trace_in1(err_msg,len_trim(err_msg))
8204C
8205C tab masse
8206 IF(iddlevel == 0) THEN
8207 ALLOCATE(msc(numelc) ,stat=stat)
8208 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8209 . msgtype=msgerror,
8210 . c1='MSC')
8211 ALLOCATE(mstg(numeltg) ,stat=stat)
8212 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8213 . msgtype=msgerror,
8214 . c1='MSTG')
8215 ALLOCATE(inc(numelc) ,stat=stat)
8216 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8217 . msgtype=msgerror,
8218 . c1='INC')
8219 ALLOCATE(intg(numeltg) ,stat=stat)
8220 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8221 . msgtype=msgerror,
8222 . c1='INTG')
8223 ALLOCATE(ptg(3,numeltg) ,stat=stat)
8224 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8225 . msgtype=msgerror,
8226 . c1='PTG')
8227 IF(glob_therm%ITHERM_FE > 0)THEN
8228 ALLOCATE(mcpc(numelc) ,stat=stat)
8229 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8230 . msgtype=msgerror,
8231 . c1='MCPC')
8232 ALLOCATE(mcptg(numeltg) ,stat=stat)
8233 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8234 . msgtype=msgerror,
8235 . c1='MCPTG')
8236 ELSE
8237 ALLOCATE(mcpc(0),mcptg(0))
8238 END IF
8239 ENDIF
8240C
8241 msc = zero
8242 mstg = zero
8243 inc = zero
8244 intg = zero
8245 ptg = zero
8246 mcpc = zero
8247 mcptg = zero
8248C
8249C-------------------------------------------------------
8250C
8251 IF(iddlevel == 0) THEN
8252 IF(irest_mselt/=0)THEN
8253 ALLOCATE(mssa(numels) ,stat=stat)
8254 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8255 . msgtype=msgerror,
8256 . c1='MSSA')
8257 ALLOCATE(msrt(numelr) ,stat=stat)
8258 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8259 . msgtype=msgerror,
8260 . c1='MSRT')
8261 ELSE
8262 ALLOCATE(mssa(0) ,stat=stat)
8263 ALLOCATE(msrt(0) ,stat=stat)
8264 ENDIF
8265C-------------------------------------------------------
8266 IF(i7stifs/=0)THEN
8267 ALLOCATE(stifint(numnod+numfakenodigeo) ,stat=stat)
8268 ALLOCATE(stifintr(numnod) ,stat=stat)
8269 ELSE
8270 ALLOCATE(stifint(0) ,stat=stat)
8271 ALLOCATE(stifintr(0) ,stat=stat)
8272 ENDIF
8273C-------------------------------------------------------
8274 IF(irigid_mat > 0) THEN
8275 ALLOCATE(slnrbm(numnod) ,nslnrbm(numnod))
8276 ALLOCATE( rmstifn(numnod), rmstifr(numnod))
8277 ELSE
8278 ALLOCATE( slnrbm(0),nslnrbm(0),rmstifn(0), rmstifr(0))
8279 ALLOCATE( front_rm(0))
8280 ENDIF
8281C-------------------------------------------------------
8282 ALLOCATE(fxani(2,nmanim), mbufel(lbufel,nmanim),
8283 . mdepl(3*numnod,nmanim))
8284 ALLOCATE(stiffn(numnod*2) ,stat=stat)
8285 ENDIF
8286C
8287 stifint = zero
8288 stifintr = zero
8289 slnrbm= 0
8290 nslnrbm=0
8291 IF(numnod > 0) stiffn = em20
8292C
8293 CALL trace_out1()
8294C--------------------------------------------
8295 ! still need for *Y00, *sty files - not yet covered by CFG files (hm_reader)
8296 IF(iddlevel == 0) CALL yctrl(igrbric)
8297!
8298 IF (iddlevel == 0) CALL hm_yctrl(unitab,lsubmodel,igrbric,ixc,ixtg, ptshel,ptsh3n,nusphcel)
8299C
8300C----------------------------------------------------------
8301C
8302C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8303C The following is executed with iddlevel=0 only for AMS with automatic element selection
8304C or if no contact interfaces and no ams
8305 IF((iddlevel == 1).OR.(isms_selec >= 3).OR.((ninter == 0).AND.(isms == 0))) THEN
8306C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8307C
8308C--------------------------------------------
8309C ELEMENT BUFFER INTIALIZATION
8310C--------------------------------------------
8311 err_msg='ELEMENT BUFFER INITIALIZATION'
8312 err_category='INTERNAL'
8313 CALL trace_in1(err_msg,len_trim(err_msg))
8314 WRITE(istdo,'(A)')titre(45)
8315 numel=2*(numelc+numelq+numelt+numels+numelp+numelr+
8316 & numeltg+numelx+numsph+numelig3d)
8317C
8318C--------------------------------------------
8319C NEW ELEMENT BUFFER STRUCTURE ALLOCATION
8320C--------------------------------------------
8321c
8322 flag_xfem = 0
8323 ALLOCATE(elbuf_tab(ngroup), stat=stat)
8324C
8325 CALL elbuf_ini(elbuf_tab,mat_elem%MAT_PARAM,
8326 . mlaw_tag ,prop_tag ,fail_tag ,
8327 . igeo ,ipm ,pm ,iparg ,ipart ,
8328 . ipartsp ,ixs ,ixq ,ixc ,ixtg ,
8329 . flag_xfem,ipartig3d,stack ,igeo_stack ,
8330 . ixt ,ixp ,ixr ,kxx ,geo ,
8331 . eos_tag ,istr_24 ,ipri ,defaults)
8332C---
8333C if xfem
8334c---
8335 IF(icrack3d > 0) THEN
8336 flag_xfem = 1
8337
8338 ALLOCATE(xfem_tab(ngroup,nxel), stat=stat)
8339c
8340 DO ixel=1,nxel
8341 CALL elbuf_ini(xfem_tab(1:ngroup,ixel),mat_elem%MAT_PARAM,
8342 . mlaw_tag ,prop_tag ,fail_tag ,
8343 . igeo ,ipm ,pm ,iparg ,ipart ,
8344 . ipartsp ,ixs ,ixq ,ixc ,ixtg ,
8345 . flag_xfem ,ipartig3d,stack ,igeo_stack,
8346 . ixt ,ixp ,ixr ,kxx ,geo ,
8347 . eos_tag ,istr_24 ,ipri ,defaults)
8348 ENDDO
8349 ELSE
8350 ALLOCATE(xfem_tab(0,0), stat=stat)
8351 ENDIF
8352C--------------------------------------------
8353C WARNING FOR PTHICKFAIL
8354C--------------------------------------------
8355 CALL check_pthickfail(elbuf_tab,mat_elem%MAT_PARAM ,iparg ,geo ,
8356 . ipm ,stack ,igeo ,nummat ,numgeo ,
8357 . ngroup ,nparg ,npropmi ,npropgi ,npropg )
8358C--------------------------------------------
8359C CHECK MATERIAL / PROPERTY COMPATIBILITY
8360C--------------------------------------------
8361 CALL check_mat_elem_prop_compatibility(
8362 . elbuf_tab,iparg ,ipm ,igeo ,nummat ,numgeo ,
8363 . ngroup ,nparg ,npropmi ,npropgi ,mat_elem%MAT_PARAM ,
8364 . n2d ,ixt ,numelt ,ixp ,numelp ,ixr ,
8365 . numelr ,kxx ,numelx )
8366C
8367C--------------------------------------------
8368C CHECK COMPATIBILITY /DTTSH
8369C--------------------------------------------
8370 IF(numels>0) THEN
8371 CALL chk_dttsh(elbuf_tab,ixs ,iparg ,d )
8372 END IF
8373!-------ini of shell offset treatment
8374 IF (defaults%SHELL%IOFFSET>0) THEN
8375 IF (defaults%SHELL%IOFFSET==1) CALL inter_offset_itag(
8376 . ninter, ipari, npari, igrsurf,
8377 . nsurf, numelc, numeltg, itagoset)
8378 CALL shell_offset_ini(
8379 . ngroup, nparg, iparg, npropg,
8380 . numgeo, geo, numelc, numeltg,
8381 . npropgi, igeo, itagoset, elbuf_tab,
8382 . defaults%SHELL )
8383 END IF
8384C-----------------------------------------------------------
8385C ALLOCATION OF ARRAYS FOR INITIA - DEALLOCATED AFTER INTIA
8386C-----------------------------------------------------------
8387C
8388 nsigs =11
8389 lsigsh = 0
8390 lsigsp = 0
8391 lsigsph = 0
8392 lsigi = max(numels+numelq,numsol+numquad)
8393 lsigrs = 0
8394 lsigbeam = 0
8395 lsigtruss = 0
8396 nsigi = 0
8397 nsigsph= 12
8398 nsigsh = 0
8399 nsigrs = 0
8400 nsigbeam = 0
8401 nsigtruss = 0
8402 IF(isigi/=0)THEN
8403 nsigsh = nvshell
8404 nsigrs = nvspri
8405 nsigbeam = nvbeam
8406 nsigtruss = nvtruss
8407 IF(nubeam > 0) nsigbeam = nsigbeam + nubeam
8408 IF(iushell/=0) nsigsh = nsigsh + nushell
8409 IF(iortshel/=0) nsigsh = nsigsh + nortshel
8410 IF(nvshell1/=0)nsigsh = nsigsh + nvshell1
8411 IF(nvshell2 /= 0)nsigsh = nsigsh + nvshell2 + 3
8412 IF(nusphcel /= 0)nsigsph = nsigsph + nusphcel
8413 nsigi= nvsolid1 + nvsolid2 + nvsolid3 + nusolid + 4 + nvsolid4 +
8414 . nvsolid5 + nvsolid6 + 7
8415
8416
8417 IF(iabs(isigi) == 3 .OR. iabs(isigi) == 4 .OR.
8418 . iabs(isigi) == 5) THEN
8419 lsigsh = numshel+numsh3n
8420 lsigsp = max(numsol+numquad,numels+numelq)
8421 lsigsph = numsphy
8422 lsigrs = numspri
8423 lsigbeam = numbeam
8424 lsigtruss = numtrus
8425 ELSE
8426 lsigsh = numelc+numeltg
8427 lsigsp = numels+numelq
8428 lsigsph = numsph
8429 lsigrs = numelr
8430 lsigbeam = numelp
8431 lsigtruss = numelt
8432 END IF
8433 END IF
8434C
8435 IF(abs(isigi)==3.OR.abs(isigi)==4.OR.abs(isigi)==5)THEN
8436 imax = max(numels,numelq,numelc,numelt,numelp,numelr,
8437 . numeltg,numsol,numquad,numshel,numsh3n,
8438 . numsphy,numspri,numbeam,numtrus)
8439 ELSE
8440 imax = max(numels,numelq,numelc,numelt,numelp,numelr,
8441 . numeltg,numelig3d)
8442 END IF
8443 sindex = 2*imax
8444 sitri = imax
8445 IF(abs(isigi)==3.OR.abs(isigi)==4.OR.abs(isigi)==5)THEN
8446 jmax=max(numelc,numsol,numquad,numshel,numsh3n,numsphy,
8447 . numelr,numspri,numelp,numbeam,numtrus)
8448 ELSE
8449 jmax=0
8450 END IF
8451C
8452C------- refsta
8453 IF(abs(isigi)==3.OR.abs(isigi)==4.OR.abs(isigi)==5)THEN
8454 ALLOCATE (ptsol(numels) ,stat=stat)
8455 ALLOCATE (ptquad(numelq) ,stat=stat)
8456 ALLOCATE (ptsph(numsph) ,stat=stat)
8457 ALLOCATE (ptspri(numelr) ,stat=stat)
8458 ALLOCATE (ptbeam(numelp) ,stat=stat)
8459 ALLOCATE (pttruss(numelt) ,stat=stat)
8460 ptsol = 0
8461 ptquad = 0
8462 ptsph = 0
8463 ptspri = 0
8464 ptbeam = 0
8465 pttruss= 0
8466 ELSE
8467 ALLOCATE (ptsol(0) ,stat=stat)
8468 ALLOCATE (ptquad(0) ,stat=stat)
8469 ALLOCATE (ptsph(0) ,stat=stat)
8470 ALLOCATE (ptspri(0) ,stat=stat)
8471 ALLOCATE (ptbeam(0) ,stat=stat)
8472 ALLOCATE (pttruss(0) ,stat=stat)
8473 END IF
8474C
8475 ico = 0
8476 itet4_10=0
8477 CALL tet4_10(igeo,itet4_10)
8478 IF(numels10/=0.OR.numels16/=0.OR.numels20/=0.OR.itet4_10/=0) THEN
8479 ico=12
8480 ENDIF
8481C
8482C non optimise (12 max(8,10,12)
8483 ALLOCATE(mss(8*numels) ,stat=stat)
8484 ALLOCATE(mssx(ico*numels) ,stat=stat)
8485 ALLOCATE(mssf(8*numels*max(iale,ieuler,ialelag)) ,stat=stat)
8486 ALLOCATE(msq(numelq) ,stat=stat)
8487 IF(.NOT.ALLOCATED(mstr)) ALLOCATE(mstr(numelt) ,stat=stat)
8488 IF(.NOT.ALLOCATED(msp)) ALLOCATE(msp(numelp) ,stat=stat)
8489 ALLOCATE(msr(numelr*3) ,stat=stat)
8490 ALLOCATE(inp(numelp) ,stat=stat)
8491 ALLOCATE(inr(numelr*3) ,stat=stat)
8492 ALLOCATE(ins(numels*8) ,stat=stat)
8493 mss = zero
8494 mssx = zero
8495 mssf = zero
8496 msq = zero
8497 mstr = zero
8498 msp = zero
8499 msr = zero
8500 inp = zero
8501 inr = zero
8502 ins = zero
8503C------
8504C ELSE
8505C ALLOCATE(MSS(0) ,STAT=stat)
8506C ALLOCATE(MSSX(0) ,STAT=stat)
8507C ALLOCATE(MSSF(0) ,STAT=stat)
8508C ALLOCATE(MSQ(0) ,STAT=stat)
8509C ALLOCATE(MSTR(0) ,STAT=stat)
8510C ALLOCATE(MSP(0) ,STAT=stat)
8511C ALLOCATE(MSR(0) ,STAT=stat)
8512C ALLOCATE(INP(0) ,STAT=stat)
8513C ALLOCATE(INR(0) ,STAT=stat)
8514C ALLOCATE(INS(0) ,STAT=stat)
8515C ENDIF
8516C----
8517 ALLOCATE(xelemwa(maxnx*16) ,stat=stat)
8518 xelemwa = zero
8519 IF(i7stifs/=0) THEN
8520 ico = 0
8521 IF(numels10/=0.OR.numels16/=0.OR.numels20/=0.OR.itet4_10/=0) THEN
8522 ico=12
8523 ENDIF
8524 ALLOCATE(vns(numels*8+numelig3d*nctrlmax) ,stat=stat)
8525 ALLOCATE(vnsx(numels*ico) ,stat=stat)
8526 ALLOCATE(stc(numelc) ,stat=stat)
8527 ALLOCATE(stt(numelt) ,stat=stat)
8528 ALLOCATE(stp(numelp) ,stat=stat)
8529 ALLOCATE(str(numelr) ,stat=stat)
8530 ALLOCATE(sttg(numeltg) ,stat=stat)
8531 ALLOCATE(stur(0) ,stat=stat)
8532 ALLOCATE(bns(numels*8+numelig3d*nctrlmax) ,stat=stat)
8533 ALLOCATE(bnsx(numels*ico) ,stat=stat)
8534 ALLOCATE(vnige(numelig3d*nctrlmax) ,stat=stat)
8535 ALLOCATE(bnige(numelig3d*nctrlmax) ,stat=stat)
8536 vns = zero
8537 vnsx = zero
8538 stc = zero
8539 stt = zero
8540 stp = zero
8541 str = zero
8542 sttg = zero
8543 stur = zero
8544 bns = zero
8545 bnsx = zero
8546 vnige = zero
8547 bnige = zero
8548 ELSE
8549 ALLOCATE(vns(0))
8550 ALLOCATE(vnsx(0))
8551 ALLOCATE(stc(0))
8552 ALLOCATE(stt(0))
8553 ALLOCATE(stp(0))
8554 ALLOCATE(str(0))
8555 ALLOCATE(sttg(0))
8556 ALLOCATE(stur(0))
8557 ALLOCATE(bns(0))
8558 ALLOCATE(bnsx(0))
8559 ALLOCATE(vnige(0))
8560 ALLOCATE(bnige(0))
8561 ENDIF
8562 IF(i7stifs/=0)THEN
8563 ALLOCATE(volnod(numnod+numfakenodigeo) ,stat=stat)
8564 ALLOCATE(bvolnod(numnod+numfakenodigeo) ,stat=stat)
8565 ALLOCATE(etnod(numnod) ,stat=stat)
8566 ALLOCATE(nshnod(numnod) ,stat=stat)
8567 volnod = zero
8568 bvolnod = zero
8569 etnod = zero
8570 nshnod = zero
8571 stifint = zero
8572 stifintr = zero
8573 ELSE
8574 ALLOCATE(volnod(0) ,stat=stat)
8575 ALLOCATE(bvolnod(0) ,stat=stat)
8576 ALLOCATE(etnod(0) ,stat=stat)
8577 ALLOCATE(nshnod(0) ,stat=stat)
8578 ENDIF
8579
8580C-- Rot. Stiffness parithon computation -> allocated even if no interfaces, to avoid "if" in element routines
8581 ALLOCATE(strc(numelc) ,stat=stat)
8582 ALLOCATE(strp(numelp) ,stat=stat)
8583 ALLOCATE(strr(numelr) ,stat=stat)
8584 ALLOCATE(strtg(numeltg) ,stat=stat)
8585 strc = zero
8586 strp = zero
8587 strr = zero
8588 strtg = zero
8589C---
8590 ALLOCATE(index(sindex) ,stat=stat)
8591 ALLOCATE(itri(sitri) ,stat=stat)
8592 ALLOCATE(ksysusr(2*jmax) ,stat=stat)
8593 ALLOCATE(isptag(numsph) ,stat=stat)
8594 IF(sindex > 0) index = 0
8595 IF(sitri > 0) itri = 0
8596 IF(jmax > 0) ksysusr = 0
8597 IF(numsph > 0) isptag = 0
8598C
8599 IF(nrbykin>0) THEN
8600 ALLOCATE(iwa(numnod),stat=stat)
8601 ELSE
8602 ALLOCATE(iwa(0),stat=stat)
8603 ENDIF
8604C
8605 CALL trace_out1()
8606
8607 err_msg='INITIALIZATION'
8608 err_category='ELEMENT INITIALIZATION'
8609 CALL trace_in1(err_msg,len_trim(err_msg))
8610C
8611C----------------------------------
8612C -- LECTURE OF INITIAL STATE DATA
8613C----------------------------------
8614C
8615 ALLOCATE(sigi(nsigs,lsigi) ,stat=stat)
8616 ALLOCATE(sigsh(max(1,nsigsh),max(1,lsigsh)) ,stat=stat)
8617 ALLOCATE(sigsp(nsigi,lsigsp) ,stat=stat)
8618 ALLOCATE(sigsph(nsigsph,lsigsph) ,stat=stat)
8619 ALLOCATE(sigrs(nsigrs,lsigrs) ,stat=stat)
8620 ALLOCATE(sigbeam(nsigbeam,lsigbeam) ,stat=stat)
8621 ALLOCATE(sigtruss(nsigtruss,lsigtruss) ,stat=stat)
8622 ALLOCATE(strsglob(numels) ,stat=stat)
8623 ALLOCATE(straglob(numels) ,stat=stat)
8624 ALLOCATE(orthoglob(numels) ,stat=stat)
8625C
8626 IF(lsigi > 0) sigi = zero
8627 IF(lsigsh > 0) sigsh = zero
8628 IF(lsigsp > 0) sigsp = zero
8629 IF(lsigsph > 0) sigsph = zero
8630 IF(lsigrs > 0) sigrs = zero
8631 IF(lsigbeam > 0)sigbeam= zero
8632 IF(lsigtruss > 0)sigtruss= zero
8633 IF(numels > 0) strsglob = -1
8634 IF(numels > 0) straglob = -1
8635 IF(numels > 0) orthoglob = 0
8636C
8637
8638 IF(.NOT. ALLOCATED(idrape)) ALLOCATE(idrape(0))
8639
8640 CALL lec_inistate( ixs ,ixq ,ixc ,ixt ,
8641 1 ixp ,ixr ,geo ,pm ,kxsp ,
8642 2 ixtg ,index ,itri ,
8643 3 nsigsh ,igeo ,ipm ,nsigs ,nsigsph ,
8644 4 ksysusr ,ptshel ,ptsh3n ,ptsol ,ptquad ,
8645 5 ptsph ,numel ,nsigrs ,unitab ,isolnod ,
8646 6 lsubmodel,rtrans ,idrape ,nsigi ,
8647 7 ptspri ,nsigbeam,ptbeam ,nsigtruss,pttruss ,
8648 8 sigi ,sigsh ,sigsp ,sigsph ,sigrs ,
8649 9 sigbeam ,sigtruss,strsglob,straglob,orthoglob,
8650 a isigsh ,iyldini ,ksigsh3 ,fail_ini,iusolyld,
8651 b iuserl ,igrbric ,map_tables,iparg ,stack ,iworksh,
8652 c mat_elem%MAT_PARAM,numsph,nisp)
8653C
8654C----------------------------------
8655C -- ELEMENT INITIALIZATION
8656C----------------------------------
8657C
8658 ALLOCATE(dtelem(2*numel) ,stat=stat)
8659 IF(stat/=0) THEN
8660 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,
8661 . c1='DTELEM')
8662 ENDIF
8663 IF(numel > 0) dtelem = zero
8664C
8665 CALL startime(14,1)
8666
8667 CALL initia(iparg , elbuf , ms , in , v ,
8668 & x , ixs , ixq , ixc , ixt ,
8669 & ixp , ixr , detonators , geo , pm ,
8670 & rby , npby , lpby , npc , npts ,
8671 & tf , veul , ale_connectivity , skew , fill ,
8672 & ipart , itab , sensors , skvol ,
8673 & ixtg , thke , nloc_dmg , group_param_tab ,glob_therm,
8674 & igrnod , igrsurf , bufsf , vr ,
8675 & bufmat , xlas , ilas , dtelem , mss ,
8676 & msq , msc , mstr , msp , msr ,
8677 & mstg , ptg , inc , nod2eltg , knod2eltg,
8678 & inp , inr , intg , index ,
8679 & itri , kxx , ixx , xelemwa ,
8680 & iwa , nod2elq , knod2elq , nod2els , knod2els ,
8681 & kxsp , ixsp , nod2sp , ispcond , icode ,
8682 & iskew , iskwn , ispsym , xframe , isptag ,
8683 & spbuf , mssx , nsigi ,
8684 & npbyl , lpbyl , rbyl , msnf , mssf ,
8685 & nsigsh , igeo , ipm , nsigs ,
8686 & nsigsph , vns , vnsx , stc , stt ,
8687 & stp , str , sttg , stur , bns ,
8688 & bnsx , volnod , bvolnod , etnod , nshnod ,
8689 & stifint , fxbdep , fxbvit , fxbacc , fxbipm ,
8690 & fxbrpm , fxbelm , fxbsig , fxbmod , ins ,
8691 & ptshel , ptsh3n , ptsol , ptquad ,
8692 & wma , ptsph , fxbnod , mbufel , mdepl ,
8693 & fxani , numel , nsigrs ,
8694 & sh4tree , sh3tree , mcp , temp ,
8695 & imerge2 , iadmerge2 ,
8696 & slnrbm , nslnrbm , rmstifn , rmstifr ,
8697 & ms_ply0 , zi_ply0 , itagnd_shxfem , itagsh , mcpc ,
8698 & mcptg , xrefc , xreftg , xrefs , mssa ,
8699 & msrt , irbe2 , lrbe2 , inivol , kvol , nbsubmat,
8700 & ixs10 , ixs16 , ixs20 , totaddmas ,
8701 & ipmas , stiffn , msz20 , itagn , sitage ,
8702 & itage , ixr_kj , elbuf_tab ,
8703 & nom_opt , inom_opt(13) , inom_opt(21) , inom_opt(20),
8704 & sol2sph , irst , sh3trim , xfem_tab ,
8705 & kxig3d , ixig3d , msig3d , knot , nctrlmax,
8706 & wige , stack ,
8707 & rnoise , drape , sh4ang , sh3ang ,
8708 & geo_stack , igeo_stack , stifintr , strc , strp ,
8709 & strr , strtg , perturb , itagnd , nativ_sms,
8710 & iloadp , loadp , ptspri , nsigbeam ,
8711 & ptbeam , nsigtruss , pttruss ,
8712 & multi_fvm , sigi , sigsh , sigsp ,
8713 & sigsph , sigrs , sigbeam , sigtruss , strsglob ,
8714 & straglob , orthoglob , isigsh , iyldini , ksigsh3 ,
8715 & fail_ini , iusolyld , iuserl , iddlevel , inimap1d ,
8716 & inimap2d , func2d , fvm_inivel , tagprt_sms , igrbric ,
8717 & igrquad , igrsh4n , igrsh3n , igrpart , totmas ,
8718 & knotlocpc , knotlocel , vnige , bnige , fxbglm ,
8719 & fxbcpm , fxbcps , fxblm , fxbfls , fxbdls ,
8720 & fxb_matrix , fxb_matrix_add , fxb_last_adress , inom_opt(11) , r_skew ,
8721 & knod2el1d , nod2el1d , ebcs_tab , rby_iniaxis , alea ,
8722 & knod2elc , nod2elc , dr , slrbody , drapeg ,
8723 & ipari , intbuf_tab , interfaces , mat_elem%MAT_PARAM ,
8724 & npreload_a , preload_a , fail_fractal ,fail_brokmann ,defaults ,
8725 & ndamp_freq_range,dampr , ibeam_vector , rbeam_vector ,d)
8726
8727
8728 IF(ninter>0.AND.numelig3d>0) THEN
8729 CALL fictivmassigeo(intbuf_tab,nctrlmax,msig3d ,kxig3d)
8730 IF(i7stifs/=0)THEN
8731 CALL bulkfakeigeo3(elbuf_tab,iparg,pm,kxig3d,igrsurf,stifint)
8732 ENDIF
8733 ENDIF
8734C
8735C----------------------------------
8736C
8737 CALL stoptime(14,1)
8738
8739
8740 CALL trace_out1()
8741!---
8742C--------------------------------------------
8743C INITIALIZATION OF BUFFERS --- IGRNOD, IGRBRIC, ..., IGRSURF, ... ---
8744C--------------------------------------------
8745 err_msg='GROUP ENTITIES BUFFER INITIALIZATION'
8746 err_category='INTERNAL'
8747 CALL trace_in1(err_msg,len_trim(err_msg))
8748!! WRITE(ISTDO,'(A)')TITRE(45)
8749!
8750 CALL group_ini(igrnod ,igrbric ,igrquad ,igrsh4n ,igrsh3n,
8751 . igrtruss ,igrbeam ,igrspring ,igrpart )
8752 CALL isurf_ini(igrsurf)
8753 CALL islin_ini(igrslin)
8754!
8755 CALL trace_out1()
8756C---
8757C
8758!! DEALLOCATE(SIGI)
8759!! DEALLOCATE(SIGSH)
8760!! DEALLOCATE(SIGSP)
8761 DEALLOCATE(sigsph)
8762!! DEALLOCATE(SIGRS)
8763!! DEALLOCATE(SIGBEAM)
8764!! DEALLOCATE(SIGTRUSS)
8765 DEALLOCATE(xelemwa)
8766 DEALLOCATE(strsglob)
8767 DEALLOCATE(straglob)
8768 DEALLOCATE(orthoglob)
8769C
8770 IF(ALLOCATED(ptshel))DEALLOCATE(ptshel)
8771 IF(ALLOCATED(ptsh3n))DEALLOCATE(ptsh3n)
8772 DEALLOCATE(ptsol)
8773 DEALLOCATE(ptquad)
8774 DEALLOCATE(ptsph)
8775 DEALLOCATE(ptspri)
8776 DEALLOCATE(ptbeam)
8777 DEALLOCATE(pttruss)
8778 DEALLOCATE(mss)
8779 DEALLOCATE(mssx)
8780 DEALLOCATE(mssf)
8781 DEALLOCATE(msq)
8782 DEALLOCATE(msr)
8783 IF(ALLOCATED(msig3d)) DEALLOCATE(msig3d)
8784 IF(ALLOCATED(tabconpatch)) DEALLOCATE(tabconpatch)
8785 DEALLOCATE(inp)
8786 DEALLOCATE(inr)
8787 DEALLOCATE(ins)
8788 DEALLOCATE(vns)
8789 DEALLOCATE(vnsx)
8790 DEALLOCATE(stc)
8791 DEALLOCATE(stt)
8792 DEALLOCATE(stp)
8793 DEALLOCATE(str)
8794 DEALLOCATE(sttg)
8795 DEALLOCATE(stur)
8796 DEALLOCATE(bns)
8797 DEALLOCATE(bnsx)
8798 DEALLOCATE(volnod)
8799 DEALLOCATE(bvolnod)
8800 DEALLOCATE(etnod)
8801 DEALLOCATE(nshnod)
8802 DEALLOCATE(vnige)
8803 DEALLOCATE(bnige)
8804 DEALLOCATE(strc)
8805 DEALLOCATE(strp)
8806 DEALLOCATE(strr)
8807 DEALLOCATE(strtg)
8808 DEALLOCATE(isptag)
8809 DEALLOCATE(index)
8810 DEALLOCATE(itri)
8811 DEALLOCATE(ksysusr)
8812 DEALLOCATE(iwa)
8813 IF (defaults%SHELL%IOFFSET==1) THEN
8814 DEALLOCATE(itagoset)
8815 DEALLOCATE(xyz)
8816 END IF
8817
8818C
8819C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8820C
8821 ENDIF !IF((IDDLEVEL == 1).OR.(ISMS_SELEC >= 3))
8822C
8823C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8824C
8825 IF((iddlevel == 0).AND.((ninter > 0).OR.(isms == 1))) THEN
8826 iddlevel = 1
8827 WRITE(istdo,*)
8828 . '.. RETURNS TO DOMAIN DECOMPOSITION FOR OPTIMIZATION'
8829C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8830C return to domain decomposition
8831C ---> for interface and AMS - small loop, without INITIA.F
8832C- ---> for AMS with automatic element selection - big loop with INITIA.F
8833C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8834C
8835 IF(iale+ieuler/=0) CALL paroi(pm ,ixs ,ixq ,icode ,ale_connectivity%NALE )
8836 IF(numels/=0) CALL lce16s4(ixs ,pm ,icode )
8837C
8838 lag_ncf = lag_ncf0
8839 lag_nkf = lag_nkf0
8840 lag_nhf = lag_nhf0
8841 lag_ncl = lag_ncl0
8842 lag_nkl = lag_nkl0
8843C
8844 DEALLOCATE(elbuf)
8845 DEALLOCATE(dd_iad)
8846C
8847 IF(isms_selec >= 3) THEN
8848C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8849C Additional treatments for big loop - element buffer deallocation
8850C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8851 DEALLOCATE(dtelem)
8852 flag_xfem = 0
8853 CALL deallocate_elbuf(
8854 . elbuf_tab, igeo ,iparg ,ixs ,ixc ,ixtg ,
8855 . flag_xfem, ixt ,ixp ,ixr ,kxx )
8856 DEALLOCATE(elbuf_tab)
8857C XFEM buffer deallocation
8858 IF(icrack3d > 0) THEN
8859 flag_xfem = 1
8860 DO ixel=1,nxel
8861 CALL deallocate_elbuf(
8862 . xfem_tab(1:ngroup,ixel),igeo ,iparg ,ixs ,ixc ,ixtg ,
8863 . flag_xfem ,ixt ,ixp ,ixr ,kxx )
8864 ENDDO
8865 ENDIF
8866C
8867 rewind(iin4)
8868 rewind(iin5)
8869C XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
8870 ENDIF
8871C
8872 GOTO 100
8873C
8874 ENDIF
8875C
8876C------------------------------------------------------------------------
8877C
8878C Check tied contacts -> hierarchy + warnings AMS
8879 err_category='INTERFACES'
8880 CALL chktyp2 (ipari, itab ,
8881 . nom_opt(lnopt1*inom_opt(3)+1),intbuf_tab,nativ_sms)
8882c-----------------------------------------------------------------------------------
8883c Initialization of frontwave structure for failure propagation
8884c
8885 CALL failwave_init(failwave,iparg,ixc,ixtg,numnod)
8886c
8887c-----------------------------------------------------------------------------------
8888c
8889C rigid material
8890C
8891
8892 err_msg='RIGID MATERIALS'
8893 err_category='RIGID MATERIALS'
8894 CALL trace_in1(err_msg,len_trim(err_msg))
8895 IF(irigid_mat > 0) THEN
8896C
8897C NFRBYM = 28 (
8898C NIRBYM = 2
8899 ALLOCATE(rbym(nfrbym*nrbym),irbym(nrbym*nirbym),lnrbym(ngslnrbym))
8900 rbym = 0
8901 irbym = 0
8902 lnrbym = 0
8903C
8904 CALL rigid_mat(nrbym ,ngslnrbym ,slnrbm, nslnrbm ,rmstifn,
8905 . rmstifr ,x ,v ,ms , in ,
8906 . rbym ,irbym ,lnrbym ,nom_opt)
8907C
8908 len_rm = nrbym*nspmd
8909 ALLOCATE(front_rm(len_rm))
8910 front_rm = 0
8911 ALLOCATE(weight_rm(nrbym))
8912 weight_rm = 1
8913 ELSE
8914 ALLOCATE( rbym(0),irbym(0),lnrbym(0), weight_rm(0))
8915 ENDIF
8916 CALL trace_out1()
8917 err_msg='DEALLOCATION'
8918 err_category='INTERNAL'
8919 CALL trace_in1(err_msg,len_trim(err_msg))
8920 DEALLOCATE(slnrbm,nslnrbm,rmstifn,rmstifr )
8921C----
8922 IF(ALLOCATED(msig3d)) DEALLOCATE(msig3d)
8923 IF(ALLOCATED(itag)) DEALLOCATE(itag)
8924C
8925C xfem for compostie
8926C
8927 CALL trace_out1()
8928 err_msg='XFEM FOR COMPOSIT'
8929 err_category='XFEM FOR COMPOSIT'
8930 CALL trace_in1(err_msg,len_trim(err_msg))
8931 IF(iplyxfem > 0) THEN
8932 nplyxfe = 0
8933 eplyxfe = 0
8934 DO i=1,numnod
8935 IF(itagnd_shxfem(i) > 0 )THEN
8936 nplyxfe = nplyxfe + 1
8937 inod_pxfem(i) = nplyxfe
8938 ENDIF
8939 ENDDO
8940C
8941 DO i=1,numelc
8942 IF(itagsh(i) > 0) THEN
8943 eplyxfe = eplyxfe + 1
8944 iel_pxfem(i) = eplyxfe
8945 ENDIF
8946 ENDDO
8947 ALLOCATE(ms_ply(nplyxfe*nplymax),stat=stat)
8948 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8949 . msgtype=msgerror,
8950 . c1='MS_PLY')
8951 ms_ply=zero
8952 ALLOCATE(zi_ply(nplyxfe*nplymax),stat=stat)
8953 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8954 . msgtype=msgerror,
8955 . c1='ZI_PLY')
8956 zi_ply=zero
8957C
8958 ALLOCATE(msz2(nplyxfe),stat=stat)
8959 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
8960 . msgtype=msgerror,
8961 . c1='MSZ2')
8962 msz2=zero
8963C
8964 CALL preplyxfem(ms_ply0,zi_ply0,iel_pxfem,inod_pxfem,ixc,
8965 . ms_ply,zi_ply,addcne_pxfem,msz20,msz2)
8966 lcne_pxfem = addcne_pxfem(nplyxfe+1) - 1
8967 ALLOCATE(cne_pxfem(lcne_pxfem),cel_pxfem(eplyxfe))
8968 cne_pxfem = 0
8969 cel_pxfem = 0
8970C
8971 CALL fillcne_pxfem(iel_pxfem,inod_pxfem,ixc,cep,addcne_pxfem,
8972 . cne_pxfem, cel_pxfem)
8973C
8974 ENDIF
8975C
8976 DEALLOCATE(ms_ply0,zi_ply0,msz20,itagsh)
8977 DEALLOCATE(itagnd_shxfem)
8978 CALL trace_out1()
8979C-------------------------------------
8980C /DAMP/VREL with RBY
8981C-------------------------------------
8982 IF (ndamp_vrel_rby > 0) THEN
8983 CALL damping_rby_spmdset(igrnod,ngrnod,ndamp,nrdamp,dampr,nnpby,
8984 . nrbody,npby,nrbmerge)
8985 ENDIF
8986c-------------------------------------------------------------------
8987c-------------------------------------------------------------------
8988C XFEM for crack propagation within shell (mono + multi layers)
8989c-------------------------------------------------------------------
8990 err_msg='XFEM FOR SHELLS'
8991 err_category='XFEM FOR SHELLS'
8992 CALL trace_in1(err_msg,len_trim(err_msg))
8993c
8994c------------------------------
8995 ALLOCATE(crklvset(nlevmax) ,stat=stat)
8996 ALLOCATE(crkshell(nlevmax) ,stat=stat)
8997 ALLOCATE(crksky(nlevmax) ,stat=stat)
8998 ALLOCATE(crkavx(nlevmax) ,stat=stat)
8999 ALLOCATE(indx_crk(nlevmax) ,stat=stat)
9000c
9001 indx_crk = 0 ! For Anim
9002 ncrkpart = 0 ! Nombre des parts xfem (local proc)
9003 ncrkxfe = 0 ! Nombre des noeuds xfem
9004 ecrkxfe = 0 ! Nombre des elements xfem
9005 ecrkxfec = 0 ! Nombre des shells 4N xfem
9006 ecrkxfetg= 0 ! Nombre des shells 3N xfem
9007c------------------------------
9008 IF(icrack3d > 0) THEN
9009c-----
9010 IF(icrack3d == 1) THEN
9011 WRITE(istdo,'(A)')' .. XFEM MULTI-LAYER SHELL'
9012 ELSEIF(icrack3d == 2)THEN
9013 WRITE(istdo,'(A)')' .. XFEM MONO-LAYER SHELL'
9014 ELSEIF(icrack3d == 3)THEN
9015 WRITE(istdo,'(A)')' .. XFEM MIXED MONO/MULTI-LAYER SHELL'
9016 ENDIF
9017c-----
9018c numerotation locale des noeuds et elems fantomes des parts xfem
9019c IEL_CRKXFEM : local system numerotation of Xfem shells
9020c INOD_CRKXFEM : local system numerotation of Xfem nodes
9021c--------------------------------------------------
9022c build local Xfem node and element tables
9023 CALL pretag_xfem(iparg ,itage ,iel_crkxfem,itagn ,inod_crkxfem)
9024c
9025c build xfem sky adress table
9026 CALL precrkxfem(iparg ,ixc ,ixtg ,ncrkxfe ,
9027 . iel_crkxfem ,inod_crkxfem ,addcne_crkxfem)
9028c--------------------------------------------------
9029c ADDCNE_CRKXFEM = tableau adresses sky Xfem
9030 lcne_crkxfem = addcne_crkxfem(ncrkxfe+1) - 1 ! longueur tableau sky CNE_CRKXFEM
9031 ALLOCATE(crknodiad(lcne_crkxfem) ,stat=stat)
9032 ALLOCATE(cne_crkxfem(lcne_crkxfem) ,stat=stat)
9033 ALLOCATE(cel_crkxfem(ecrkxfe) ,stat=stat)
9034 ALLOCATE(cep_crkxfem(ecrkxfe) ,stat=stat)
9035 ALLOCATE(nodlevxf(ncrkxfe) ,stat=stat)
9036 ALLOCATE(crkedge(nxlaymax) ,stat=stat)
9037 ALLOCATE(xfem_phantom(nxlaymax) ,stat=stat)
9038 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,msgtype=msgerror,c1='NODLEVXF')
9039 crknodiad = 0
9040 cne_crkxfem = 0
9041 cel_crkxfem = 0
9042 cep_crkxfem = 0 ! Proc num of each xfem element
9043 numelcrk = 0
9044 nodlevxf = 0
9045c--------------------------------------------------
9046 CALL fillcne_xfem(lcne_crkxfem,iparg,
9047 . iel_crkxfem ,inod_crkxfem ,ixc ,ixtg ,cep ,
9048 . addcne_crkxfem,cne_crkxfem ,cel_crkxfem,cep_crkxfem,crknodiad)
9049c
9050 CALL xfem_crack_init(iparg ,ixc ,ixtg ,inod_crkxfem,nodlevxf,
9051 . indx_crk,ncrkpart,crkshell)
9052c--------------------------------------------------
9053 DEALLOCATE(itagn,itage)
9054C NODGLOBXFE
9055 snodglobxfe = 4*ecrkxfe*nlevmax ! nb max de noeuds phant, tous les plis. faux si mixte
9056C
9057 numedges = 0 ! nb des edges glob (pareil tous les plis)
9058 siedgesh = 4*ecrkxfec + 3*ecrkxfetg
9059c
9060 ALLOCATE(iedgesh(siedgesh),stat=stat)
9061 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,msgtype=msgerror,c1='IEDGESH')
9062 ALLOCATE(ibordedge(siedgesh) ,stat=stat)
9063 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,msgtype=msgerror,c1='IBORDEDGE')
9064 ALLOCATE(nodedge(2*siedgesh),stat=stat)
9065 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,msgtype=msgerror,c1='NODEDGE')
9066 ALLOCATE(iedge(siedgesh),stat=stat)
9067 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,msgtype=msgerror,c1='IEDGE')
9068 ALLOCATE(iedge_tmp0(siedgesh),stat=stat)
9069 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,msgtype=msgerror,c1='IEDGE_TMP0')
9070 iedgesh = 0
9071 ibordedge = 0
9072 nodedge = 0
9073 iedge = 0
9074 iedge_tmp0= 0
9075!
9076 IF(ecrkxfec > 0) THEN
9077 iedgesh4 => iedgesh(1:4*ecrkxfec)
9078 ielcrk4 => iel_crkxfem(1:numelc)
9079 ELSE
9080 iedgesh4 => iedgesh
9081 ielcrk4 => iel_crkxfem
9082 ENDIF
9083!
9084 IF(ecrkxfetg > 0) THEN
9085 iedgesh3 => iedgesh(1+4*ecrkxfec:siedgesh)
9086 ielcrk3 => iel_crkxfem(1+numelc:numelc+numeltg)
9087 ELSE
9088 iedgesh3 => iedgesh
9089 ielcrk3 => iel_crkxfem
9090 ENDIF
9091c--------------------------------------------------
9092 CALL iedge_xfem(
9093 . ibordnode ,ixc ,ixtg ,iedgesh4 ,iedgesh3 ,
9094 . ibordedge ,nodedge ,ielcrk4 ,ielcrk3 ,iedge ,
9095 . cep_crkxfem,iedge_tmp0)
9096c
9097 CALL allocxfem(ixc ,ixtg ,iparg ,lcne_crkxfem,crklvset,
9098 . crksky ,crkavx,crkedge,xfem_phantom)
9099c--------------------------------------------------
9100 IF(ninicrack > 0) ! initial cracks
9101 . CALL inicrkfill (elbuf_tab,xfem_tab,
9102 . ixc ,ixtg ,iparg ,inicrack,
9103 . x ,iel_crkxfem,inod_crkxfem,xrefc ,xreftg ,
9104 . iedgesh4 ,iedgesh3,nodedge ,crklvset,
9105 . crkshell,crkedge ,xfem_phantom ,itab )
9106c--------------------------------------------------
9107 ALLOCATE(iedge_tmp(3,numedges),stat=stat)
9108 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,
9109 . msgtype=msgerror,c1='IEDGE_TMP')
9110 IF(numedges > 0) THEN
9111 DO i=1,numedges
9112 iedge_tmp(1,i) = 0
9113 iedge_tmp(2,i) = 0
9114 iedge_tmp(3,i) = iedge_tmp0(i)
9115 ENDDO
9116 ENDIF
9117 DEALLOCATE(iedge_tmp0)
9118C---
9119 ALLOCATE(elcutc(2*(numelc+numeltg)) ,stat=stat)
9120 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,
9121 . msgtype=msgerror,c1='ELCUTC')
9122 elcutc = 0
9123C---
9124 ALLOCATE(nodenr(ncrkxfe) ,stat=stat)
9125 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,
9126 . msgtype=msgerror,c1='NODENR')
9127 nodenr = 0
9128C---
9129 ALLOCATE(kxfenod2elc(ncrkxfe) ,stat=stat)
9130 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,
9131 . msgtype=msgerror,c1='KXFENOD2ELC')
9132 kxfenod2elc = 0
9133C---
9134 ALLOCATE(enrtag(numnod*ienrnod) ,stat=stat)
9135 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=anstop,
9136 . msgtype=msgerror,c1='ENRTAG')
9137 enrtag = 0
9138C---
9139 ELSE
9140 numedges = 0
9141 siedgesh = 0
9142 numelcrk= 0
9143 ALLOCATE(cne_crkxfem(0),cel_crkxfem(0),cep_crkxfem(0))
9144 ALLOCATE(iedgesh(0))
9145 ALLOCATE(ibordedge(0))
9146 ALLOCATE(nodedge(0))
9147 ALLOCATE(iedge(0))
9148 ALLOCATE(iedge_tmp(0,0))
9149 ALLOCATE(crknodiad(0))
9150 ALLOCATE(nodlevxf(0))
9151 ALLOCATE(crkedge(0))
9152C
9153 ALLOCATE(elcutc(0))
9154 ALLOCATE(nodenr(0))
9155 ALLOCATE(kxfenod2elc(0))
9156 ALLOCATE(enrtag(0))
9157 ENDIF ! ICRACK3D > 0 (Xfem)
9158C----------------------------------
9159 CALL trace_out1()
9160C----------------------------------
9161C RBE2 Desactivation des elements initialization for ITRUOFF ...
9162C----------------------------------
9163 err_msg='RIGID BODY ELEMENT DEACTIVATION'
9164 err_category='RIGID BODY'
9165 CALL trace_in1(err_msg,len_trim(err_msg))
9166 CALL seteloff2(ixs ,ixc ,ixt ,ixp ,ixr ,
9167 2 ixtg ,iparg ,isoloff,isheoff,
9168 3 itruoff,ipouoff,iresoff,itrioff,igrnrb2,
9169 4 igrnod ,irbe2 )
9170C----------------------------------
9171C RBODY Desactivation des elements des rigid body (on par defaut)
9172C----------------------------------
9173 CALL seteloff(ixs ,ixc ,ixt ,ixp ,ixr ,
9174 2 ixtg ,iparg , isoloff,isheoff,
9175 3 itruoff,ipouoff,iresoff,itrioff,igrnrby,
9176 4 igrnod ,elbuf_tab,iquaoff,ixq )
9177 CALL trace_out1()
9178C----------------------------------
9179C Interf Stamp. Tri et initialisations
9180C----------------------------------
9181 err_msg='STAMPING INITIALIZATION'
9182 err_category='INTERFACES'
9183 CALL trace_in1(err_msg,len_trim(err_msg))
9184 IF(ninter/=0)THEN
9185C-----
9186 aux = max( numnod , numelt+numelp+numelr+numeltg+numelc+100 ,
9187 . maxrtm+100 )
9188 ns_i21 = 2*numnod + 2002 + 4*aux
9189 siwork = ns_i21
9190 srwork = max(6000,numnod)
9191 ALLOCATE(iwork(siwork) ,stat=stat)
9192 ALLOCATE(rwork(srwork) ,stat=stat)
9193 iwork = 0
9194 rwork = zero
9195C-----
9196 CALL inintr_thkvar(elbuf_tab,
9197 1 ipari ,intbuf_tab ,inscr ,x ,
9198 2 ixs ,ixc ,pm ,geo ,itab ,
9199 3 iwork ,rwork ,ixtg ,d ,
9200 4 iparg ,knod2els ,
9201 5 knod2elc,knod2eltg,nod2els,nod2elc ,nod2eltg,
9202 6 intstamp,skew ,ms ,in ,v ,
9203 7 vr ,rby ,npby ,lpby ,iparts ,
9204 8 ipartc ,ipartg,thk_part,nom_opt,inom_opt(3))
9205 DEALLOCATE(rwork)
9206 DEALLOCATE(iwork)
9207C-----
9208 END IF
9209C-----
9210
9211 DEALLOCATE(thk_part)
9212 CALL trace_out1()
9213C-------------------------------------------------------------
9214C Set INTERCEP only for INTERFACE24 (flag=0)
9215C-------------------------------------------------------------
9216 CALL set_intercep(ipari,intercep,0,intbuf_tab,itab,cep) ! this call is maintained here to avoid a bug
9217C-------------------------------------------------------------
9218C Interface type 24 - set FRONTPLUS to neighboug surfaces
9219C-------------------------------------------------------------
9220 i24maxnsne = 0
9221 CALL i24setnodes(ipari,intbuf_tab,intercep,itab,i24maxnsne)
9222
9223C-------------------------------------------------------------
9224C----------------------------------
9225C Interf. type 7 et 21 : affectation des rigidites cote second
9226C----------------------------------
9227 err_msg='INTERFACES STIFFNESS'
9228 err_category='INTERFACES'
9229 CALL trace_in1(err_msg,len_trim(err_msg))
9230 IF(ninter>0)THEN
9231 IF (i7stifs/=0) THEN
9232 CALL stifint_icontrol(
9233 1 numnod, stifint, npari, ninter,
9234 2 ipari, npropgi, numgeo, igeo,
9235 3 numels, nixs, ixs, numels8,
9236 4 numels10, ixs10, numels16, ixs16,
9237 5 numels20, ixs20, npropm, nummat,
9238 6 pm, intbuf_tab)
9239 CALL inintr1 (ipari ,stifint, intbuf_tab ,stfac)
9240 END IF
9241 DEALLOCATE(stfac)
9242 ENDIF
9243 CALL trace_out1()
9244
9245C--------FRICTION OROTHTROPIC DIRECTIONS COMPUTATION -----
9246 IF(ninter > 0 .AND.ninterfric >0.AND. iorthfricmax > 0) THEN
9247
9248 CALL inintr_orthdirfric(
9249 a ipari ,intbuf_tab,intbuf_fric_tab,igeo ,geo ,
9250 b x , ixtg ,ixc ,ipartg , ipartc ,
9251 c pfricorth,irepforth,phiforth , vforth ,knod2elc ,
9252 d knod2eltg,nod2eltg ,nod2elc ,iworksh ,pm ,
9253 e stack%PM ,thke ,skew ,itab ,ipart )
9254
9255c DEALLOCATE(PFRICORTH ,IREPFORTH , VFORTH ,PHIFORTH )
9256
9257 ENDIF
9258
9259 DEALLOCATE(tagprt_fric)
9260C---------------------------
9261C IMPACTS LASER TRAITEMENT SPMD 2eme Phase
9262C---------------------------
9263 err_msg='LASER IMPACT PHASE 2'
9264 err_msg='LASER'
9265 CALL trace_in1(err_msg,len_trim(err_msg))
9266 IF(nlaser>0) THEN
9267 CALL laserp3(ilas ,iparg )
9268 ENDIF
9269 CALL trace_out1()
9270C----------------------------------
9271C LECTURE DES RIVETS
9272C----------------------------------
9273 err_msg='RIVETS'
9274 err_category='RIVETS'
9275 CALL trace_in1(err_msg,len_trim(err_msg))
9276 slrivet = nrivet*4
9277 srivet = nrivet*nrivf
9278 ALLOCATE(lrivet(slrivet) ,stat=stat)
9279 ALLOCATE(rivet(srivet) ,stat=stat)
9280 lrivet = 0
9281 rivet = zero
9282C
9283 IF(nrivet/=0)THEN
9284 WRITE(istdo,'(A)') ' .. RIVETS '
9285 CALL hm_read_rivet(lrivet ,v ,vr ,ms ,in ,
9286 2 rivet ,geo ,itab ,itabm1 ,d ,
9287 3 ipart ,igeo ,lsubmodel)
9288 ENDIF
9289c CALL ANCHECK(81)
9290 CALL trace_out1()
9291C----------------------------------
9292C SEATBELT 2D->1D for SECTIONS
9293C----------------------------------
9294 IF(nb_seatbelt_shells /= 0)THEN
9295 CALL my_alloc(seatbelt_shell_to_spring,numelc,2)
9296 IF(numelc > 0)THEN
9297 seatbelt_shell_to_spring(1:numelc,1) = 0
9298 seatbelt_shell_to_spring(1:numelc,2) = 0
9299 ENDIF
9300c
9301 DO i=1,nb_seatbelt_shells
9302
9303 l0 = 0
9304 IF(seatbelt_converted_elements(2,i) /= 0) THEN
9305 l0 = set_usrtos(seatbelt_converted_elements(1,i),map_tables%ISH4NM,numelc)
9306 ENDIF
9307
9308 l1 = 0
9309 IF(seatbelt_converted_elements(2,i) /= 0) THEN
9310 l1 = set_usrtos(seatbelt_converted_elements(2,i),map_tables%ISPRINGM,numelr)
9311 ENDIF
9312
9313 l2 = 0
9314 IF(seatbelt_converted_elements(3,i) /= 0) THEN
9315 l2 = set_usrtos(seatbelt_converted_elements(3,i),map_tables%ISPRINGM,numelr)
9316 ENDIF
9317
9318 IF(l0 /= 0) THEN
9319 seatbelt_shell_to_spring(l0,1) = l1
9320 seatbelt_shell_to_spring(l0,2) = l2
9321 ENDIF
9322
9323 ENDDO
9324 ELSE
9325 CALL my_alloc(seatbelt_shell_to_spring,1,2)
9326 seatbelt_shell_to_spring(1,1) = 0
9327 seatbelt_shell_to_spring(1,2) = 0
9328 ENDIF
9329C----------------------------------
9330C LECTURE DES SECTIONS
9331C----------------------------------
9332 err_msg='SECTIONS'
9333 err_category='SECTIONS'
9334 CALL trace_in1(err_msg,len_trim(err_msg))
9335 IF(nsect/=0)THEN
9336 WRITE(istdo,'(A)') ' .. SECTIONS'
9337 CALL prelecsec(
9338 1 snstrf ,ssecbuf ,itabm1 ,0 ,nom_opt(lnopt1*inom_opt(8)+1),
9339 2 igrbric ,igrquad ,igrsh4n ,igrsh3n ,igrtruss ,
9340 3 igrbeam ,igrspring ,igrnod ,lsubmodel, seatbelt_shell_to_spring,
9341 4 nb_seatbelt_shells)
9342 ALLOCATE(nstrf(snstrf) ,stat=stat)
9343 ALLOCATE(secbuf(ssecbuf) ,stat=stat)
9344 nstrf = 0
9345 secbuf = zero
9346 CALL lecsec42(ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
9347 2 ixtg ,x ,itab ,itabm1 ,
9348 3 igrnod ,secbuf ,
9349 4 ipari ,ixs10 ,ixs20 ,ixs16 ,unitab ,
9350 5 iskwn ,xframe ,isolnod,nom_sect,rtrans,
9351 6 lsubmodel,nom_opt(lnopt1*inom_opt(8)+1),igrbric,igrquad,igrsh4n,
9352 7 igrtruss ,igrbeam,igrspring,igrsh3n,seatbelt_shell_to_spring,
9353 8 nb_seatbelt_shells)
9354 snstrf = SIZE(nstrf)
9355 ELSE
9356 snstrf = 0
9357 ssecbuf = 0
9358 ALLOCATE(nstrf(snstrf) ,stat=stat)
9359 ALLOCATE(secbuf(ssecbuf) ,stat=stat)
9360 ENDIF
9361 IF(ALLOCATED(seatbelt_shell_to_spring)) DEALLOCATE(seatbelt_shell_to_spring)
9362 CALL trace_out1()
9363C--------------------------------------------
9364C SENSORS INITIALIZATION
9365C--------------------------------------------
9366c
9367 CALL inisen(sensors ,ipari,nom_opt,inom_opt(5),
9368 . inom_opt(8),inom_opt(4),ixr ,r_skew ,numelr,
9369 . nsect ,ninter ,nintsub ,nrwall ,nrbody )
9370c
9371C----------------------------------
9372C LECTURE DES JOINTS
9373C----------------------------------
9374 err_msg='JOINTS'
9375 err_category='JOINTS'
9376 CALL trace_in1(err_msg,len_trim(err_msg))
9377 CALL hm_prelecjoi(sljoint ,igrnod,lsubmodel)
9378 ALLOCATE(ljoint(sljoint) ,stat=stat)
9379 ljoint = 0
9380
9381 ALLOCATE( cyl_join(njoint) )
9382
9383 IF(njoint/=0)THEN
9384 WRITE(istdo,'(A)') ' .. CYLINDRICAL JOINTS'
9385 CALL init_joint(njoint)
9386 CALL hm_read_cyljoint(ljoint ,itabm1 ,d ,itab ,igrnod ,
9387 . nom_opt(lnopt1*inom_opt(7)+1),lsubmodel)
9388 ENDIF
9389c CALL ANCHECK(83)
9390 CALL trace_out1()
9391C-------------------------------------------------
9392C BLOCAGE DES NOEUDS MAT 11 HORS DOMAINE CALCULE
9393C-------------------------------------------------
9394 err_msg='BLOCK BOUNDARY MATERIAL NODES'
9395 err_category='BLOCK BOUNDARY MATERIAL NODES'
9396 CALL trace_in1(err_msg,len_trim(err_msg))
9397 IF(iale+ieuler /= 0 .AND. numelq+numels > 0) THEN
9398 CALL nodm11(pm,ixs,ixq,icode)
9399 ENDIF
9400 CALL trace_out1()
9401C-------------------------------------------------
9402C LISTE DES NOEUDS CORRESPONDANT A ONE MILIEU POREUX
9403C-------------------------------------------------
9404 err_msg='POROUS NODES'
9405 err_category='POROUS NODES'
9406 CALL trace_in1(err_msg,len_trim(err_msg))
9407 IF(iale+ieuler /=0 .AND. numelq+numels >0)THEN
9408 siwork = numnod+4*nfacx
9409 ALLOCATE(iwork(siwork) ,stat=stat)
9410 siwork = 0
9411 CALL pornod(geo ,ixs ,ixq ,iwork ,icode ,
9412 + itab ,npby ,lpby ,igeo)
9413 snodpor = numpor
9414 ALLOCATE(nodpor(snodpor) ,stat=stat)
9415 nodpor = iwork(1:snodpor)
9416 DEALLOCATE(iwork)
9417 ELSE
9418 snodpor = 0
9419 ALLOCATE(nodpor(snodpor) ,stat=stat)
9420 ENDIF
9421 CALL trace_out1()
9422C---
9423 IF(kcontact/=0)THEN
9424 kcontact=1
9425 sicontact=numnod
9426 ALLOCATE(icontact(sicontact))
9427 icontact = 0
9428 ELSE
9429 ALLOCATE(icontact(0))
9430 END IF
9431 IF(nadmesh/=0)THEN
9432 srcontact=numnod
9433 ALLOCATE(rcontact(srcontact))
9434 rcontact = ep30
9435 ALLOCATE(acontact(srcontact))
9436 acontact = ep30
9437 ALLOCATE(pcontact(srcontact))
9438 pcontact = zero
9439 ELSE
9440 ALLOCATE(rcontact(0))
9441 ALLOCATE(acontact(0))
9442 ALLOCATE(pcontact(0))
9443 END IF
9444C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
9445 CALL fvdim(t_monvol)
9446 ALLOCATE(fvdata(nfvbag))
9447
9448C
9449 err_msg='FVMBAG MESHING'
9450 err_category='FVMBAG MESHING'
9451 CALL trace_in1(err_msg,len_trim(err_msg))
9452 IF(tetramesher_used) THEN
9453 CALL fvmesh0(t_monvol, node_coord, ixs_temp, ixc, ixtg, pm,ipm, igrsurf, xyzref ,nb_total_node)
9454 ELSE
9455 CALL fvmesh0(t_monvol, x, ixs, ixc, ixtg, pm,ipm, igrsurf, xyzref ,numnod)
9456 ENDIF
9457
9458 CALL copy_to_volmon(t_monvol, lrcbag, t_monvol_metadata%RCBAG, svolmon, volmon)
9459
9460 CALL copy_to_monvol(t_monvol, licbag, t_monvol_metadata%ICBAG, smonvol, monvol)
9461
9462 CALL trace_out1()
9463 err_msg='BEM FLOW'
9464 err_category='BEM FLOW'
9465 CALL trace_in1(err_msg,len_trim(err_msg))
9466C----------------------------------
9467C LECTURE DES ECOULEMENTS (FLUIDE INCOMPRESSIBLE OU THERMIQUE)
9468C----------------------------------
9469 IF(nflow>0) THEN
9470 CALL hm_preread_bem(igrsurf, igrnod , nnft ,
9471 . unitab , nom_opt(lnopt1*inom_opt(12)+1), lsubmodel)
9472C
9473 ALLOCATE(iflow(liflow), rflow(lrflow))
9474 iflow(1:liflow) = 0
9475 rflow(1:lrflow) = zero
9476C
9477 DO i=1,nspmd
9478 memflow(1,i)=0
9479 memflow(2,i)=0
9480 ENDDO
9481C
9482 CALL hm_read_bem(igrsurf, iflow, rflow,
9483 . npc1 , igrnod , memflow(1,1),unitab,
9484 . x, nom_opt(lnopt1*inom_opt(12)+1),lgauge, igrv, lsubmodel,iresp)
9485C
9486 ELSE
9487 ALLOCATE(iflow(0), rflow(0))
9488 ENDIF
9489 CALL trace_out1()
9490 err_msg='EULERIAN BOUNDARY CONDITIONS'
9491 err_category='EULERIAN BOUNDARY CONDITIONS'
9492 CALL trace_in1(err_msg,len_trim(err_msg))
9493c
9494 IF(nebcs > 0)THEN
9495 segindx = 0
9496 !update due to domain decomposition
9497 CALL iniebcs(ale_connectivity, 1,igrsurf, ixs, ixq, ixtg,
9498 . pm, igeo, x, sensors, monvol, multi_fvm%IS_USED, ebcs_tab, ebcs_tag_cell_spmd)
9499 !initialization
9500 CALL iniebcsp0(x, iparg, elbuf_tab, ebcs_tab, ixs, ixq, ixtg, iparts, ipartq, ipartg, pm, ipm, mat_elem%MAT_PARAM)
9501 CALL iniebcs_propellant(ixs,ixq,ixtg,multi_fvm%IS_USED,ebcs_tab,mat_elem%MAT_PARAM,sixs,sixq,sixtg,nummat)
9502 ENDIF
9503 CALL trace_out1()
9504C--------------------------------------------
9505C MULTIPLICATEURS DE LAGRANGE
9506C--------------------------------------------
9507 err_msg='LAGRANGE MULTIPLIERS'
9508 err_category='LAGRANGE MULTIPLIERS'
9509 CALL trace_in1(err_msg,len_trim(err_msg))
9510 ncmax = lag_ncf + lag_ncl
9511 nkmax = lag_nkf + lag_nkl
9512 lag_nhl = lag_ncl * 10
9513
9514 IF( ALLOCATED(iadhf) ) DEALLOCATE(iadhf)
9515 IF( ALLOCATED(iadll) ) DEALLOCATE(iadll)
9516 IF( ALLOCATED(lll) ) DEALLOCATE(lll)
9517 IF( ALLOCATED(jll) ) DEALLOCATE(jll)
9518 ALLOCATE(iadhf(lag_ncf + 1))
9519 ALLOCATE(iadll(lag_ncf + 1))
9520 ALLOCATE(lll(lag_nkf))
9521 ALLOCATE(jll(lag_nkf))
9522 IF(lag_ncf > 0) THEN
9523C---
9524 CALL lagm_ini(lag_nhf ,iadhf ,iadll ,jll ,lll ,
9525 2 ipari ,intbuf_tab,igrnod, ibcslag ,
9526 3 ms ,in ,gjbufi ,ibmpc ,ibmpc2 ,
9527 4 ibmpc3 ,ibmpc4 ,ibfv ,vel ,itab ,
9528 5 nom_opt,inom_opt(3),inom_opt(15),inom_opt(16),
9529 6 inom_opt(17),inom_opt(18))
9530 ALLOCATE(jcihf(lag_nhf), stat=stat)
9531 CALL lagm_nhf(lag_ncf, iadll ,jll ,lll ,jcihf )
9532C---
9533 slagbuf = lag_nhf + 3*lag_ncf+2
9534 ALLOCATE(lagbuf(slagbuf), stat=stat)
9535 l1 = lag_ncf + 1
9536 l2 = l1 + lag_nhf
9537 l3 = l2 + lag_ncf + 1
9538 l4 = l3 + lag_nkf
9539 l5 = l4 + lag_nkf
9540 lagbuf = 0
9541 lagbuf(1:l1) = iadhf(1:lag_ncf + 1)
9542 lagbuf(l1+1:l2) = jcihf(1:lag_nhf)
9543 DEALLOCATE(jll)
9544 DEALLOCATE(iadhf)
9545 DEALLOCATE(jcihf)
9546 ELSE
9547 slagbuf = 0
9548 ALLOCATE(lagbuf(slagbuf))
9549 ENDIF
9550C---
9551 IF(nrwlag>0)
9552 . CALL lgmini_rwl(nprw , lprw , ms , itab,
9553 . nom_opt(lnopt1*inom_opt(5)+1))
9554 IF(ninter>0)
9555 . CALL lgmini_i7(ipari ,intbuf_tab , ms , itab , igrnod,
9556 . nom_opt(lnopt1*inom_opt(3)+1))
9557 nhmax = lag_nhf + lag_nhl
9558 lwat = 0
9559 IF(lag_ncl/=0) lwat = max(6*(numels16+numels20),6*numnod)
9560 l_mul_lag1 = 2*ncmax + 4*nkmax + lwat + numnod + 2
9561 IF(ncmax>0) THEN
9562 l_mul_lag = max(l_mul_lag1,
9563 . 11*ncmax + 4*nkmax + 3*nhmax + 6*numnod + 2)
9564 ENDIF
9565 slambda = ncmax
9566 ALLOCATE(lambda(slambda), stat=stat)
9567 IF(slambda > 0) lambda = zero
9568 CALL trace_out1()
9569C----------------------------------
9570C CALCUL FORCES GRAVITE MODALES
9571C----------------------------------
9572 err_msg='GRAVITY NODAL FORCES'
9573 err_category='GRAVITY NODAL FORCES'
9574 CALL trace_in1(err_msg,len_trim(err_msg))
9575 IF(nfxbody>0) THEN
9576 DO nfx=1,nfxbody
9577 aipm=(nfx-1)*nbipm
9578 anod=fxbipm(aipm+6)
9579 nlgrav=fxbipm(aipm+25)
9580 agrvi=fxbipm(aipm+26)
9581 agrvr=fxbipm(aipm+27)
9582 amod=fxbipm(aipm+7)
9583 IF(nlgrav>0)
9584 . CALL fxbgrav(
9585 . igrv , lgrav , fxbipm(aipm+18), fxbnod(anod),
9586 . fxbgrvi(agrvi), fxbgrvr(agrvr), fxbipm(aipm+3), fxbmod(amod),
9587 . fxbipm(aipm+4), fxbipm(aipm+17), ms , grav ,
9588 . skew , fxbipm(aipm+29), nfx , fxbipm(aipm+30))
9589 ENDDO
9590 ENDIF
9591 CALL trace_out1()
9592
9593C--------------------------------------------
9594C THPARTS TREADING
9595C--------------------------------------------
9596 err_msg='TIME HISTORY PARTS'
9597 err_category='TIME HISTORY'
9598 CALL trace_in1(err_msg,len_trim(err_msg))
9599 IF(nthpart >0) THEN
9600 CALL hm_read_thpart(ipart ,igrbric ,igrquad ,igrsh4n ,igrsh3n,
9601 . igrtruss ,igrbeam ,igrspring, lsubmodel)
9602 ENDIF
9603 CALL trace_out1()
9604
9605 CALL create_map_tables ( map_tables ,2 ,
9606 * lsubmodel ,subsets,
9607 * ipart,
9608 * ixs ,ixq ,ixc ,ixtg ,
9609 * ixt ,ixp ,ixr ,kxsp,lrivet,
9610 * ibid )
9611C----------------------------------
9612C TH GROUP READING
9613C----------------------------------
9614 err_msg='TIME HISTORY GROUPS'
9615 err_category='TIME HISTORY'
9616 CALL trace_in1(err_msg,len_trim(err_msg))
9617c
9618 ! Number of /TH read by hm reader
9619 CALL hm_option_count('/TH' ,nthgrp0)
9620 CALL hm_option_count('/ATH',nthgrp01(1))
9621 CALL hm_option_count('/BTH',nthgrp01(2))
9622 CALL hm_option_count('/CTH',nthgrp01(3))
9623 CALL hm_option_count('/DTH',nthgrp01(4))
9624 CALL hm_option_count('/ETH',nthgrp01(5))
9625 CALL hm_option_count('/FTH',nthgrp01(6))
9626 CALL hm_option_count('/GTH',nthgrp01(7))
9627 CALL hm_option_count('/HTH',nthgrp01(8))
9628 CALL hm_option_count('/ITH',nthgrp01(9))
9629 DO i=1,9
9630 nthgrpmx = max(nthgrp0,nthgrp01(i))
9631 ENDDO
9632c
9633 ! Number of /TH/MONV
9634 nbr_th_monvol = 0
9635 nbr_th_monvol01(1:9) = 0
9636 CALL hm_option_count('/TH/MONV' ,nbr_th_monvol)
9637 CALL hm_option_count('/ATH/MONV',nbr_th_monvol01(1))
9638 CALL hm_option_count('/BTH/MONV',nbr_th_monvol01(2))
9639 CALL hm_option_count('/CTH/MONV',nbr_th_monvol01(3))
9640 CALL hm_option_count('/DTH/MONV',nbr_th_monvol01(4))
9641 CALL hm_option_count('/ETH/MONV',nbr_th_monvol01(5))
9642 CALL hm_option_count('/FTH/MONV',nbr_th_monvol01(6))
9643 CALL hm_option_count('/GTH/MONV',nbr_th_monvol01(7))
9644 CALL hm_option_count('/HTH/MONV',nbr_th_monvol01(8))
9645 CALL hm_option_count('/ITH/MONV',nbr_th_monvol01(9))
9646 DO i=1,9
9647 nbr_th_monvol = max(nbr_th_monvol,nbr_th_monvol01(i))
9648 ENDDO
9649c
9650 output%TH%SITHGRP = (nthgrp0+nbr_th_monvol)*nithgr
9651 lithpart = nthgrpmx*(npart+nthpart)
9652 lithsub = nthgrpmx*nsubs
9653 lithbufmx = 0
9654 lithbufi = 0
9655 nvartot = 0
9656 nvartot0 = 0
9657c
9658 ! New routine to pre-read /TH with hm_reader and old reader
9659 ! (needed to estimate sizes of buffers)
9660 CALL hm_read_prethgrou(lithbufmx,nvartot0,lsubmodel,0,output)
9661 DO i=1,9
9662 CALL hm_read_prethgrou(lithbufi,nvartot,lsubmodel,i,output)
9663 lithbufmx = max(lithbufmx,lithbufi,nvartot,nvartot0)
9664 nvartotmax = max(nvartotmax,nvartot,nvartot0)
9665 ENDDO
9666c
9667 sithvar = nvartot0*10+nvartot*10+nvolu*10
9668 ALLOCATE(ithpart(lithpart) , stat=stat)
9669 ALLOCATE(ithsub(lithsub) , stat=stat)
9670 ALLOCATE(ithbuftmp(lithbufmx), stat=stat)
9671 ALLOCATE(ithvar(sithvar) , stat=stat)
9672 IF(sithvar > 0) ithvar(1:sithvar) = 0
9673 CALL my_alloc(output%TH%ITHGRP,output%TH%SITHGRP)
9674c
9675 output%TH%ITHGRP(1:output%TH%SITHGRP) = 0
9676 ithpart = 0
9677 ithsub = 0
9678 ithbuftmp = 0
9679 output%TH%SITHBUF = 0
9680 ithflag = 10
9681c-----
9682 interfaces%PARAMETERS%INTCAREA =0
9683 ! New routine to read /TH with hm_reader and old reader
9684 CALL hm_read_thgrou(
9685 1 output%TH%ITHGRP ,ithbuftmp,itab ,itabm1 ,ixtg ,
9686 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
9687 3 kxx ,ixx ,ipart ,output%TH%SITHBUF,
9688 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
9689 5 nthgrp ,ithpart ,ithsub ,fxbipm ,ipart ,lipart1 ,
9690 6 8 ,12 ,imerge ,ithvar ,
9691 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
9692 8 inom_opt(5),inom_opt(8),inom_opt(7),
9693 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
9694 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
9695 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
9696 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
9697 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
9698 e map_tables, 0,inom_opt(31),inom_opt(32),sensors ,
9699 f interfaces,ipari ,output%TH%DUMP_THNMS1_FILE,glob_therm%ITHERM_FE,output%CHECKSUM,
9700 g nsubdom,ipri)
9701C
9702 CALL my_alloc(output%TH%ITHBUF,output%TH%SITHBUF)
9703 output%TH%ITHBUF(1:output%TH%SITHBUF) = ithbuftmp(1:output%TH%SITHBUF)
9704
9705 If (lithbufmx < output%TH%SITHBUF) then
9706 print*,'Allocation error :LITHBUFMX, SITHBUF=',lithbufmx,output%TH%SITHBUF
9707 endif
9708 ALLOCATE(rthbuf(srthbuf), stat=stat)
9709 IF(srthbuf > 0) CALL thskewc(
9710 1 rthbuf ,output%TH%ITHGRP ,output%TH%ITHBUF,x ,ixc ,ixtg ,skew,nthgrp)
9711
9712C--------
9713C ithgrpa
9714C--------
9715 IF(nthgrp01(1) > 0) THEN
9716 output%TH%SITHGRPA = (nthgrp01(1)+nbr_th_monvol)*nithgr
9717 CALL my_alloc(output%TH%ITHGRPA,output%TH%SITHGRPA)
9718 output%TH%ITHGRPA = 0
9719 ithpart = 0
9720 ithsub = 0
9721 ithbuftmp = 0
9722 output%TH%SITHBUFA = 0
9723 ithflag = 1
9724c-----
9725 IF(npart+nthpart>0) THEN
9726 ipartthi=>ipartth(1:2*(npart+nthpart))
9727 ELSE
9728 ipartthi=>ipartth
9729 END IF
9730 CALL hm_read_thgrou(
9731 1 output%TH%ITHGRPA ,ithbuftmp,itab ,itabm1 ,ixtg ,
9732 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
9733 3 kxx ,ixx ,ipart ,output%TH%SITHBUFA ,
9734 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
9735 5 nthgrp1(1),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
9736 6 1 ,1 ,imerge ,ithvar ,
9737 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
9738 8 inom_opt(5),inom_opt(8),inom_opt(7),
9739 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
9740 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
9741 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
9742 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
9743 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
9744 e map_tables, 1,inom_opt(31),inom_opt(32),sensors,
9745 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
9746 g nsubdom,ipri)
9747C
9748 CALL my_alloc(output%TH%ITHBUFA,output%TH%SITHBUFA)
9749 output%TH%ITHBUFA = ithbuftmp(1:output%TH%SITHBUFA)
9750 ELSE
9751 output%TH%SITHGRPA = 0
9752 output%TH%SITHBUFA = 0
9753 CALL my_alloc(output%TH%ITHGRPA,output%TH%SITHGRPA)
9754 CALL my_alloc(output%TH%ITHBUFA,output%TH%SITHBUFA)
9755 ENDIF
9756C--------
9757C ithgrpb
9758C--------
9759 IF(nthgrp01(2) > 0) THEN
9760 output%TH%SITHGRPB = (nthgrp01(2)+nbr_th_monvol)*nithgr
9761 CALL my_alloc(output%TH%ITHGRPB,output%TH%SITHGRPB)
9762 output%TH%ITHGRPB = 0
9763 ithpart = 0
9764 ithsub = 0
9765 ithbuftmp = 0
9766 output%TH%SITHBUFB = 0
9767 ithflag = 2
9768c-----
9769 IF(npart+nthpart>0) THEN
9770 ipartthi=>ipartth(1+2*(npart+nthpart):4*(npart+nthpart))
9771 ELSE
9772 ipartthi=>ipartth
9773 END IF
9774 CALL hm_read_thgrou(
9775 1 output%TH%ITHGRPB ,ithbuftmp,itab ,itabm1 ,ixtg ,
9776 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
9777 3 kxx ,ixx ,ipart ,output%TH%SITHBUFB ,
9778 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
9779 5 nthgrp1(2),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
9780 6 1 ,1 ,imerge ,ithvar ,
9781 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
9782 8 inom_opt(5),inom_opt(8),inom_opt(7),
9783 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
9784 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
9785 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
9786 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
9787 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
9788 e map_tables, 2,inom_opt(31),inom_opt(32),sensors,
9789 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
9790 g nsubdom,ipri)
9791C
9792 CALL my_alloc(output%TH%ITHBUFB,output%TH%SITHBUFB)
9793 output%TH%ITHBUFB = ithbuftmp(1:output%TH%SITHBUFB)
9794 ELSE
9795 output%TH%SITHGRPB = 0
9796 output%TH%SITHBUFB = 0
9797 CALL my_alloc(output%TH%ITHGRPB,output%TH%SITHGRPB)
9798 CALL my_alloc(output%TH%ITHBUFB,output%TH%SITHBUFB)
9799 ENDIF
9800C--------
9801C ithgrpc
9802C--------
9803 IF(nthgrp01(3) > 0) THEN
9804 output%TH%SITHGRPC = (nthgrp01(3)+nbr_th_monvol)*nithgr
9805 CALL my_alloc(output%TH%ITHGRPC,output%TH%SITHGRPC)
9806 output%TH%ITHGRPC = 0
9807 ithpart = 0
9808 ithsub = 0
9809 ithbuftmp = 0
9810 output%TH%SITHBUFC = 0
9811 ithflag = 3
9812c-----
9813 IF(npart+nthpart>0) THEN
9814 ipartthi=>ipartth(1+4*(npart+nthpart):6*(npart+nthpart))
9815 ELSE
9816 ipartthi=>ipartth
9817 END IF
9818 CALL hm_read_thgrou(
9819 1 output%TH%ITHGRPC ,ithbuftmp,itab ,itabm1 ,ixtg ,
9820 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
9821 3 kxx ,ixx ,ipart ,output%TH%SITHBUFC ,
9822 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
9823 5 nthgrp1(3),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
9824 6 1 ,1 ,imerge ,ithvar ,
9825 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
9826 8 inom_opt(5),inom_opt(8),inom_opt(7),
9827 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
9828 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
9829 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
9830 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
9831 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
9832 e map_tables, 3,inom_opt(31),inom_opt(32),sensors,
9833 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
9834 g nsubdom,ipri)
9835C
9836 CALL my_alloc(output%TH%ITHBUFC, output%TH%SITHBUFC)
9837 output%TH%ITHBUFC(1:output%TH%SITHBUFC) = ithbuftmp(1:output%TH%SITHBUFC)
9838 ELSE
9839 output%TH%SITHGRPC = 0
9840 output%TH%SITHBUFC = 0
9841 CALL my_alloc(output%TH%ITHBUFC, output%TH%SITHBUFC)
9842 CALL my_alloc(output%TH%ITHGRPC, output%TH%SITHGRPC)
9843 ENDIF
9844C--------
9845C ithgrpd
9846C--------
9847 IF(nthgrp01(4) > 0) THEN
9848 output%TH%SITHGRPD = (nthgrp01(4)+nbr_th_monvol)*nithgr
9849 CALL my_alloc(output%TH%ITHGRPD,output%TH%SITHGRPD)
9850 output%TH%ITHGRPD = 0
9851 ithpart = 0
9852 ithsub = 0
9853 ithbuftmp = 0
9854 output%TH%SITHBUFD = 0
9855 ithflag = 4
9856c-----
9857 IF(npart+nthpart>0) THEN
9858 ipartthi=>ipartth(1+6*(npart+nthpart):8*(npart+nthpart))
9859 ELSE
9860 ipartthi=>ipartth
9861 END IF
9862 CALL hm_read_thgrou(
9863 1 output%TH%ITHGRPD ,ithbuftmp,itab ,itabm1 ,ixtg ,
9864 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
9865 3 kxx ,ixx ,ipart ,output%TH%SITHBUFD ,
9866 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
9867 5 nthgrp1(4),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
9868 6 1 ,1 ,imerge ,ithvar ,
9869 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
9870 8 inom_opt(5),inom_opt(8),inom_opt(7),
9871 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
9872 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
9873 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
9874 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
9875 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
9876 e map_tables, 4,inom_opt(31),inom_opt(32),sensors,
9877 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
9878 g nsubdom,ipri)
9879C
9880 CALL my_alloc(output%TH%ITHBUFD,output%TH%SITHBUFD)
9881 output%TH%ITHBUFD(1:output%TH%SITHBUFD) = ithbuftmp(1:output%TH%SITHBUFD)
9882 ELSE
9883 output%TH%SITHGRPD = 0
9884 output%TH%SITHBUFD = 0
9885 ALLOCATE(output%TH%ITHBUFD(output%TH%SITHBUFD), stat=stat)
9886 ALLOCATE(output%TH%ITHGRPD(output%TH%SITHGRPD), stat=stat)
9887 ENDIF
9888C--------
9889C ithgrpe
9890C--------
9891 IF(nthgrp01(5) > 0) THEN
9892 output%TH%SITHGRPE = (nthgrp01(5)+nbr_th_monvol)*nithgr
9893 CALL my_alloc(output%TH%ITHGRPE,output%TH%SITHGRPE)
9894 output%TH%ITHGRPE = 0
9895 ithpart = 0
9896 ithsub = 0
9897 ithbuftmp = 0
9898 output%TH%SITHBUFE = 0
9899 ithflag = 5
9900c-----
9901 IF(npart+nthpart>0) THEN
9902 ipartthi=>ipartth(1+8*(npart+nthpart):10*(npart+nthpart))
9903 ELSE
9904 ipartthi=>ipartth
9905 END IF
9906c-----
9907 CALL hm_read_thgrou(
9908 1 output%TH%ITHGRPE ,ithbuftmp,itab ,itabm1 ,ixtg ,
9909 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
9910 3 kxx ,ixx ,ipart ,output%TH%SITHBUFE ,
9911 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
9912 5 nthgrp1(5),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
9913 6 1 ,1 ,imerge ,ithvar ,
9914 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
9915 8 inom_opt(5),inom_opt(8),inom_opt(7),
9916 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
9917 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
9918 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
9919 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
9920 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
9921 e map_tables, 5,inom_opt(31),inom_opt(32),sensors,
9922 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
9923 g nsubdom,ipri)
9924C
9925 CALL my_alloc(output%TH%ITHBUFE,output%TH%SITHBUFE)
9926 output%TH%ITHBUFE = ithbuftmp(1:output%TH%SITHBUFE)
9927 ELSE
9928 output%TH%SITHGRPE = 0
9929 output%TH%SITHBUFE = 0
9930 CALL my_alloc(output%TH%ITHBUFE,output%TH%SITHBUFE)
9931 CALL my_alloc(output%TH%ITHGRPE,output%TH%SITHGRPE)
9932 ENDIF
9933C--------
9934C ithgrpf
9935C--------
9936 IF(nthgrp01(6) > 0) THEN
9937 output%TH%SITHGRPF = (nthgrp01(6)+nbr_th_monvol)*nithgr
9938 CALL my_alloc(output%TH%ITHGRPF,output%TH%SITHGRPF)
9939 output%TH%ITHGRPF = 0
9940 ithpart = 0
9941 ithsub = 0
9942 ithbuftmp = 0
9943 output%TH%SITHBUFF = 0
9944 ithflag = 6
9945c-----
9946 IF(npart+nthpart>0) THEN
9947 ipartthi=>ipartth(1+10*(npart+nthpart):12*(npart+nthpart))
9948 ELSE
9949 ipartthi=>ipartth
9950 END IF
9951 CALL hm_read_thgrou(
9952 1 output%TH%ITHGRPF ,ithbuftmp,itab ,itabm1 ,ixtg ,
9953 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
9954 3 kxx ,ixx ,ipart ,output%TH%SITHBUFF ,
9955 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
9956 5 nthgrp1(6),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
9957 6 1 ,1 ,imerge ,ithvar ,
9958 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
9959 8 inom_opt(5),inom_opt(8),inom_opt(7),
9960 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
9961 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
9962 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
9963 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
9964 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
9965 e map_tables, 6,inom_opt(31),inom_opt(32),sensors,
9966 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
9967 g nsubdom,ipri)
9968C
9969 CALL my_alloc(output%TH%ITHBUFF,output%TH%SITHBUFF)
9970 output%TH%ITHBUFF(1:output%TH%SITHBUFF) = ithbuftmp(1:output%TH%SITHBUFF)
9971 ELSE
9972 output%TH%SITHGRPF = 0
9973 output%TH%SITHBUFF = 0
9974 CALL my_alloc(output%TH%ITHBUFF,output%TH%SITHBUFF)
9975 CALL my_alloc(output%TH%ITHGRPF,output%TH%SITHGRPF)
9976 ENDIF
9977C--------
9978C ithgrpg
9979C--------
9980 IF(nthgrp01(7) > 0) THEN
9981 output%TH%SITHGRPG = (nthgrp01(7)+nbr_th_monvol)*nithgr
9982 CALL my_alloc(output%TH%ITHGRPG,output%TH%SITHGRPG)
9983 output%TH%ITHGRPG = 0
9984 output%TH%SITHBUFG = 0
9985 ithpart = 0
9986 ithsub = 0
9987 ithbuftmp = 0
9988 ithflag = 7
9989c-----
9990 IF(npart+nthpart>0) THEN
9991 ipartthi=>ipartth(1+12*(npart+nthpart):14*(npart+nthpart))
9992 ELSE
9993 ipartthi=>ipartth
9994 END IF
9995 CALL hm_read_thgrou(
9996 1 output%TH%ITHGRPG ,ithbuftmp,itab ,itabm1 ,ixtg ,
9997 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
9998 3 kxx ,ixx ,ipart ,output%TH%SITHBUFG ,
9999 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
10000 5 nthgrp1(7),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
10001 6 1 ,1 ,imerge ,ithvar ,
10002 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
10003 8 inom_opt(5),inom_opt(8),inom_opt(7),
10004 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
10005 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
10006 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
10007 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
10008 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
10009 e map_tables, 7,inom_opt(31),inom_opt(32),sensors,
10010 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
10011 g nsubdom,ipri)
10012C
10013 CALL my_alloc(output%TH%ITHBUFG,output%TH%SITHBUFG)
10014 output%TH%ITHBUFG(1:output%TH%SITHBUFG) = ithbuftmp(1:output%TH%SITHBUFG)
10015 ELSE
10016 output%TH%SITHGRPG = 0
10017 output%TH%SITHBUFG = 0
10018 CALL my_alloc(output%TH%ITHBUFG,output%TH%SITHBUFG)
10019 CALL my_alloc(output%TH%ITHGRPG,output%TH%SITHGRPG)
10020 ENDIF
10021C--------
10022C ithgrph
10023C--------
10024 IF(nthgrp01(8) > 0) THEN
10025 output%TH%SITHGRPH = (nthgrp01(8)+nbr_th_monvol)*nithgr
10026 CALL my_alloc(output%TH%ITHGRPH,output%TH%SITHGRPH)
10027 output%TH%ITHGRPH = 0
10028 ithpart = 0
10029 ithsub = 0
10030 ithbuftmp = 0
10031 output%TH%SITHBUFH = 0
10032 ithflag = 8
10033c-----
10034 IF(npart+nthpart>0) THEN
10035 ipartthi=>ipartth(1+14*(npart+nthpart):16*(npart+nthpart))
10036 ELSE
10037 ipartthi=>ipartth
10038 END IF
10039 CALL hm_read_thgrou(
10040 1 output%TH%ITHGRPH ,ithbuftmp,itab ,itabm1 ,ixtg ,
10041 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
10042 3 kxx ,ixx ,ipart ,output%TH%SITHBUFH ,
10043 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
10044 5 nthgrp1(8),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
10045 6 1 ,1 ,imerge ,ithvar ,
10046 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
10047 8 inom_opt(5),inom_opt(8),inom_opt(7),
10048 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
10049 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
10050 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
10051 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
10052 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
10053 e map_tables, 8,inom_opt(31),inom_opt(32),sensors,
10054 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
10055 g nsubdom,ipri)
10056C
10057 CALL my_alloc(output%TH%ITHBUFH,output%TH%SITHBUFH)
10058 output%TH%ITHBUFH(1:output%TH%SITHBUFH) = ithbuftmp(1:output%TH%SITHBUFH)
10059 ELSE
10060 output%TH%SITHGRPH = 0
10061 output%TH%SITHBUFH = 0
10062 CALL my_alloc(output%TH%ITHBUFH,output%TH%SITHBUFH)
10063 CALL my_alloc(output%TH%ITHGRPH,output%TH%SITHGRPH)
10064 ENDIF
10065C--------
10066C ithgrpi
10067C--------
10068 IF(nthgrp01(9) > 0) THEN
10069 output%TH%SITHGRPI = (nthgrp01(9)+nbr_th_monvol)*nithgr
10070 CALL my_alloc(output%TH%ITHGRPI,output%TH%SITHGRPI)
10071 output%TH%ITHGRPI = 0
10072 ithpart = 0
10073 ithsub = 0
10074 ithbuftmp = 0
10075 output%TH%SITHBUFI = 0
10076 ithflag = 9
10077c-----
10078 IF(npart+nthpart>0) THEN
10079 ipartthi=>ipartth(1+16*(npart+nthpart):18*(npart+nthpart))
10080 ELSE
10081 ipartthi=>ipartth
10082 END IF
10083 CALL hm_read_thgrou(
10084 1 output%TH%ITHGRPI ,ithbuftmp,itab ,itabm1 ,ixtg ,
10085 2 ixs ,ixq ,ixc ,ixt ,ixp ,ixr ,
10086 3 kxx ,ixx ,ipart ,output%TH%SITHBUFI ,
10087 4 nthwa ,kxsp ,lrivet ,iskwn ,iframe ,
10088 5 nthgrp1(9),ithpart ,ithsub ,fxbipm ,ipartthi,2 ,
10089 6 1 ,1 ,imerge ,ithvar ,
10090 7 1 ,nvarabf ,nom_opt ,inom_opt(11),inom_opt(3),
10091 8 inom_opt(5),inom_opt(8),inom_opt(7),
10092 9 inom_opt(2),inom_opt(1),inom_opt(10),inom_opt(27),
10093 a inom_opt(28),inom_opt(22),isphio,srthbuf,t_monvol ,
10094 b igrsurf ,subsets ,ithflag,npby ,lsubmodel, iparg ,
10095 c iparts ,ipartq ,ipartc ,ipartt ,ipartp ,ipartr ,
10096 d ipartg ,ipartx ,ipartsp ,ipartig3d,lithbufmx,
10097 e map_tables, 9,inom_opt(31),inom_opt(32),sensors,
10098 f interfaces,ipari ,0,glob_therm%ITHERM_FE,output%CHECKSUM,
10099 g nsubdom,ipri)
10100C
10101 CALL my_alloc(output%TH%ITHBUFI,output%TH%SITHBUFI)
10102 output%TH%ITHBUFI = ithbuftmp(1:output%TH%SITHBUFI)
10103 ELSE
10104 output%TH%SITHGRPI = 0
10105 output%TH%SITHBUFI = 0
10106 CALL my_alloc(output%TH%ITHBUFI,output%TH%SITHBUFI)
10107 CALL my_alloc(output%TH%ITHGRPI,output%TH%SITHGRPI)
10108 ENDIF
10109C
10110
10111 IF(ALLOCATED(ithpart)) DEALLOCATE(ithpart)
10112 IF(ALLOCATED(ithsub)) DEALLOCATE(ithsub)
10113 IF(ALLOCATED(ithbuftmp)) DEALLOCATE(ithbuftmp)
10114C
10115C -------------------------------------------------
10116C /TH/SURF : outputting Pressure and Area :
10117C -------------------------------------------------
10118 CALL th_surf_load_pressure(igrsurf , output%TH%TH_SURF , ipres ,iloadp ,lloadp ,
10119 . sizloadp ,nloadp ,slloadp ,nibcld ,npreld ,
10120 . nsurf ,numnod )
10121C
10122C------------------------- CHECK -------------------
10123C-- La variable NSMAT (nb de Material ds TH),
10124C est disponible uniquement apres THGROU en version block
10125c CALL ANCHECK(4)
10126C
10127c CALL ANCHECK(8)
10128C
10129c CALL ANCHECK(11)
10130C
10131c CALL ANCHECK(12)
10132C
10133c CALL ANCHECK(16)
10134C
10135c CALL ANCHECK(18)
10136C
10137c CALL ANCHECK(20)
10138C
10139c CALL ANCHECK(24)
10140C
10141c CALL ANCHECK(27)
10142C
10143c CALL ANCHECK(31)
10144C
10145c CALL ANCHECK(34)
10146C
10147c CALL ANCHECK(38)
10148C
10149c CALL ANCHECK(48)
10150C
10151c CALL ANCHECK(45)
10152C
10153c CALL ANCHECK(50)
10154C
10155c CALL ANCHECK(55)
10156C
10157c CALL ANCHECK(57)
10158C
10159c CALL ANCHECK(58)
10160C
10161c CALL ANCHECK(59)
10162C
10163c CALL ANCHECK(61)
10164C
10165c CALL ANCHECK(80)
10166C
10167C
10168C affectation du numero de processeur (spmd)
10169C
10170 CALL thpinit(output%TH%ITHGRP,output%TH%ITHBUF,iparg ,dd_iad ,lrivet ,
10171 . 0 ,nthgrp )
10172 IF(nthgrp01(1) > 0)
10173 . CALL thpinit(output%TH%ITHGRPA,output%TH%ITHBUFA,iparg ,dd_iad ,lrivet ,
10174 . i ,nthgrp1(1) )
10175 IF(nthgrp01(2) > 0)
10176 . CALL thpinit(output%TH%ITHGRPB,output%TH%ITHBUFB,iparg ,dd_iad ,lrivet ,
10177 . i ,nthgrp1(2) )
10178 IF(nthgrp01(3) > 0)
10179 . CALL thpinit(output%TH%ITHGRPC,output%TH%ITHBUFC,iparg ,dd_iad ,lrivet ,
10180 . i ,nthgrp1(3) )
10181 IF(nthgrp01(4) > 0)
10182 . CALL thpinit(output%TH%ITHGRPD,output%TH%ITHBUFD,iparg ,dd_iad ,lrivet ,
10183 . i ,nthgrp1(4) )
10184 IF(nthgrp01(5) > 0)
10185 . CALL thpinit(output%TH%ITHGRPE,output%TH%ITHBUFE,iparg ,dd_iad ,lrivet ,
10186 . i ,nthgrp1(5) )
10187 IF(nthgrp01(6) > 0)
10188 . CALL thpinit(output%TH%ITHGRPF,output%TH%ITHBUFF,iparg ,dd_iad ,lrivet ,
10189 . i ,nthgrp1(6) )
10190 IF(nthgrp01(7) > 0)
10191 . CALL thpinit(output%TH%ITHGRPG,output%TH%ITHBUFG,iparg ,dd_iad ,lrivet ,
10192 . i ,nthgrp1(7) )
10193 IF(nthgrp01(8) > 0)
10194 . CALL thpinit(output%TH%ITHGRPH,output%TH%ITHBUFH,iparg ,dd_iad ,lrivet ,
10195 . i ,nthgrp1(8) )
10196 IF(nthgrp01(9) > 0)
10197 . CALL thpinit(output%TH%ITHGRPI,output%TH%ITHBUFI,iparg ,dd_iad ,lrivet ,
10198 . i ,nthgrp1(9) )
10199 CALL trace_out1()
10200C--------------------------------------------
10201C Multidomains -> deallocation des tableaux.
10202C--------------------------------------------
10203 IF(nsubdom>0) THEN
10204 DEALLOCATE(tag_part,tagmon,tagrby,tagint,tagcyl,taglnk)
10205 DEALLOCATE(tagrb3,tagrb2,tagjoin,tagmpc,tag_mat)
10206 ENDIF
10207C--------------------------------------------
10208C STOCKAGE DYNAMIQUE (CONNEXIONS RIGIDES a MADYMO).
10209C--------------------------------------------
10210 err_msg='DYNAMIC STORAGE MADYMO LINK'
10211 err_category='DYNAMIC STORAGE MADYMO LINK'
10212 CALL trace_in1(err_msg,len_trim(err_msg))
10213 srconx = nconx*nrcnx
10214 ALLOCATE(rconx(srconx) ,stat=stat)
10215 rconx = zero
10216C--------------------------------------------
10217C RECALCUL DE NRBODY (NRBYKIN MIS A JOUR EN AMONT)
10218C---------------------------------------------------------------------
10219 IF(nrbmerge > 0) THEN
10220 nrbody = nrbykin + nrbylag
10221 ENDIF
10222C--------------------------------------------
10223C TABLEAU DE TRAVAIL WA(LENWA)
10224C PARTIE NON SAUVEGARDEE SUR LE FICHIER DE RESTART
10225C--------------------------------------------
10226 nrcvvois0 = 0
10227C appel a routine generique ici et dans ddsplit
10228 CALL setlenwa(
10229 1 lenwa ,nthwa ,nairwa ,numels ,numelq,
10230 2 numelc,numeltg,numelt ,numelp ,numelr,
10231 3 numnod,nmnt ,l_mul_lag1,l_mul_lag,maxnx ,
10232 4 lwasph,numsph ,lwaspio, nrcvvois0,
10233 5 lwamp_l,lwanmp_l ,glob_therm%ITHERM)
10234 lwamp = lwamp_l !< Copy values in common
10235 lwanmp = lwanmp_l !< Copy values in common
10236C init MULTIMAX
10237 ALLOCATE(mwa(lenwa) , stat=stat)
10238 mwa = zero
10239 CALL setmulti(ipari )
10240 CALL trace_out1()
10241C---------------------------------------------------------------------
10242C INITIALIZATION OF INTERFACES SECOND PART
10243C INIT INTERFACE TYPE 6 + BUCKET SORT TYPE 4 STATISTICS
10244C PUT INTERFACE NODES INTO FRONTIERE(1)
10245C---------------------------------------------------------------------
10246 err_msg='INTERFACE INITIALIZATION PHASE 2'
10247 err_category='INTERFACES'
10248 CALL trace_in1(err_msg,len_trim(err_msg))
10249 i2nsnt = 0
10250C Mass and inertia are not modified - a specific array is used
10251 ALLOCATE(ms_b(numnod),stat=stat)
10252 ms_b(1:numnod)=ms(1:numnod)
10253 IF(iroddl==1) THEN
10254 ALLOCATE(in_b(numnod),stat=stat)
10255 in_b(1:numnod)=in(1:numnod)
10256 ELSE
10257 ALLOCATE(in_b(1))
10258 ENDIF
10259C
10260 IF(ns10e>0.AND.n2d==0) CALL stifn0_nd(icnds10,stiffn)
10261 IF(ninter > 0) THEN
10262 CALL inintr2(ipari ,inscr ,x ,
10263 . ixs ,ixq ,ixc ,pm ,geo ,
10264 . inscr ,itab ,ms ,npby ,lpby ,
10265 . mwa ,d ,i2nsnt ,in ,
10266 . stiffn,stifint ,nom_opt(lnopt1*inom_opt(3)+1),inod_pxfem ,ms_ply,
10267 . intbuf_tab,stifintr,itagnd,icnds10,ms_b,in_b,nstrf,itagcyc,
10268 . irbe2 ,irbe3 ,lrbe3 ,
10269 . knod2els ,nod2els , ixs10 ,ixs16 ,ixs20,
10270 . s_nod2els )
10271 ENDIF
10272 CALL trace_out1()
10273C---------------------------------------------
10274C Update of STIFFN for TETRA10 for time step estimation
10275C--------------------------------------------
10276 IF(ns10e>0.AND.n2d==0) CALL stifn1_nd(icnds10,stiffn)
10277 IF(ndamp>0) CALL dampdtnoda(ms_b,in_b,stiffn,stiffn(numnod+1),
10278 1 igrnod,dampr )
10279C--------------------------------------------
10280C TRI ET IMPRESSION DES DT ELEM
10281C--------------------------------------------
10282 CALL outri(dtelem,ixs,ixq,ixc,ixt,ixp,ixr,ixtg,
10283 . kxx,kxsp,kxig3d,igeo,numel)
10284C--------------------------------------------
10285C TRI ET IMPRESSION DES DT NODAUX
10286C--------------------------------------------
10287 CALL outrin(ms_b,in_b,stiffn,stiffn(numnod+1),itab,dtnoda)
10288C---------------------------------------------
10289C Target time step estimation - (type2 effect on nodal time step is taken into account in ININTR2)
10290C--------------------------------------------
10291 err_msg='ADDED MASS ESTIMATION'
10292 err_category='ADDED MASS ESTIMATION'
10293 CALL trace_in1(err_msg,len_trim(err_msg))
10294 IF(n2d==0) CALL add_mass_stat(ms_b,in_b,stiffn,stiffn(numnod+1),itab,totmas)
10295C---------------------------------
10296C MULTIDOMAINS SPEEDUP ESTIMATION
10297C---------------------------------
10298 IF(nsubdom>0) THEN
10299 CALL r2r_speedup(dtelem,dtnoda,dt_r2r,cost_r2r,isoloff,
10300 . isheoff,itruoff ,ipouoff ,iresoff ,itrioff,
10301 . iquaoff)
10302 ENDIF
10303C--------------------------------------------
10304 DEALLOCATE(stiffn)
10305 DEALLOCATE(stifint)
10306 DEALLOCATE(stifintr)
10307 DEALLOCATE(ms_b)
10308 DEALLOCATE(in_b)
10309 DEALLOCATE(dtelem)
10310 CALL trace_out1()
10311C--------------------------------------------
10312C INI & CHECK RBE3
10313C--------------------------------------------
10314 err_msg='RBE3 INITIALIZATION'
10315 err_category='RBE3'
10316 CALL trace_in1(err_msg,len_trim(err_msg))
10317 IF(sirbe3 > 0) THEN
10318 CALL inirbe3(irbe3 ,lrbe3 ,frbe3 ,skew ,x ,
10319 . ms ,in ,
10320 . nom_opt(lnopt1*inom_opt(14)+1))
10321 ENDIF
10322 CALL trace_out1()
10323C--------------------------------------------
10324 err_msg='KINEMATIC CONDITIONS CHECK'
10325 err_category='KINEMATIC CONDITIONS'
10326 CALL trace_in1(err_msg,len_trim(err_msg))
10327C--------------------------------------------
10328C traitement for 2nd pass /RBODY/RBE2 /BCS /IMPVEL w/ Itet2 of S10
10329C--------------------------------------------
10330 IF(ns10e>0) THEN
10331 CALL rigmodif1_nd(npby,lpby,itagnd)
10332 CALL rbe2modif1_nd(irbe2,lrbe2,itagnd)
10333 CALL bcsmodif_nd(icode, itagnd,icnds10,itab)
10334 CALL fixmodif_nd(ibfv , itagnd,icnds10,itab)
10335 CALL bcscycmodif_nd(ibcscyc,lbcscyc,itagnd,itab)
10336 END IF
10337C--------------------------------------------
10338C CHECK DE CONDITIONS CINEMATIQUES
10339C--------------------------------------------
10340C D(3,NUMNOD) UTILISE DANS LE STARTER COMME FLAG
10341C DE CONDITION CINEMATIQUE IKINE(NUMNOD)
10342C--------------------------------------------
10343 CALL kinchk(d ,rwbuf ,itab ,nprw ,lprw ,kinet ,
10344 . npby , lpby ,irbe2 ,lrbe2 ,irbe3 ,lrbe3 ,
10345 . nom_opt ,inom_opt(5),inom_opt(13),inom_opt(14) ,
10346 . itagcyc )
10347 IF(ninvel/=0)
10348 . CALL inivchk(d ,rwbuf,itab,nprw,lprw,kinet,
10349 1 npby, lpby,irbe2,lrbe2,irbe3,lrbe3,
10350 2 frbe3,x ,skew ,v ,vr )
10351#ifdef DNC
10352 IF(nexmad/=0)
10353 . CALL madchk(d ,itab ,iconx(7*nconx+1))
10354#endif
10355 CALL trace_out1()
10356C--------------------------------------------
10357C Initial mass
10358C--------------------------------------------
10359 err_msg='MASS ARRAY ALLOCATION'
10360 err_category='INIIAL MASS'
10361 CALL trace_in1(err_msg,len_trim(err_msg))
10362 ALLOCATE(ms0(numnod) ,stat=stat)
10363 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
10364 . msgtype=msgerror,
10365 . c1='MS0')
10366 ms0(1:numnod)=ms(1:numnod)
10367 CALL trace_out1()
10368C--------------------------------------------
10369C Inlet / Outlet
10370C--------------------------------------------
10371c build structure surfaces specific Inlet Outlet
10372 IF(nsphio > 0)THEN
10373 sibufssg_io = 4*nseg_io
10374 ALLOCATE(ibufssg_io(sibufssg_io) ,stat=stat)
10375 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
10376 . msgtype=msgerror,
10377 . c1='IBUFSSG_IO')
10378 ibufssg_io(1:sibufssg_io) = 0
10379 CALL set_ibufssg_io(isphio, igrsurf, ibufssg_io)
10380 ELSE
10381 ALLOCATE(ibufssg_io(1))
10382 sibufssg_io = 0
10383 ENDIF
10384
10385!--------------------------------------------
10386! Split the surface & add the MONVOL nodes
10387! on a given processor
10388!--------------------------------------------
10389 CALL python_duplicate_nodes(itab,numnod,nspmd) ! nodes used in the python functions must be on all processors
10390 CALL igrsurf_split(scep,cep,t_monvol,igrsurf,igrsurf_proc)
10391C--------------------------------------------
10392C DOMAIN DECOMPOSITION 2 (DEFINITION DES FRONTIERES)
10393C--------------------------------------------
10394 err_msg='DOMAIN DECOMPOSITION PHASE 2'
10395 err_category='INTERNAL'
10396 CALL trace_in1(err_msg,len_trim(err_msg))
10397 sfr_iad = (nspmd+1)*2
10398 ALLOCATE(fr_iad(sfr_iad))
10399 IF(i2nsnt>0) THEN
10400 ALLOCATE(celi2(i2nsnt))
10401 ALLOCATE(cepi2(i2nsnt))
10402 ALLOCATE(addcni2(0:numnod+1))
10403 ENDIF
10404 ALLOCATE(iskwp(numskw+1))
10405 ALLOCATE(nskwp(nspmd))
10406 ALLOCATE(isensp(2*sensors%NSENSOR))
10407 ALLOCATE(nsensp(nspmd))
10408 ALLOCATE(iaccp(naccelm))
10409 ALLOCATE(naccp(nspmd))
10410 ALLOCATE(igaup(nbgauge))
10411 ALLOCATE(ngaup(nspmd))
10412 ALLOCATE(tag_skn(numskw+nsubmod+1))
10413 ALLOCATE(skews%MULTIPLE_SKEW(numskw+1))
10414 iskwp(1:numskw+1) = 0
10415 tag_skn(1:numskw+nsubmod+1) = 0
10416 nskwp(1:nspmd) = 0
10417C
10418 IF(.NOT. ALLOCATED(ibvel)) ALLOCATE(ibvel(0)) ! Deprecated option?
10419 IF(.NOT. ALLOCATED(lbvel)) ALLOCATE(lbvel(0)) ! Deprecated option?
10420
10421 CALL domdec2(
10422 1 dd_iad ,ipari ,ibcl ,npby ,
10423 2 lpby ,lrivet ,ibvel ,lbvel ,
10424 3 iparg ,cel ,ixs ,ixs10 ,ixs20 ,
10425 4 ixs16 ,ixq ,ixc ,ixt ,ixp ,
10426 5 ixr ,ixtg ,ixtg1 ,t_monvol ,
10427 6 igrsurf,addcne ,lcne ,geo ,
10428 7 nprw ,lprw ,lcni2g ,addcni2 ,cepi2 ,
10429 8 celi2 ,i2nsnt ,iskwn ,iskwp ,nskwp ,
10430 9 isensp ,nsensp ,iaccp ,naccp ,
10431 a laccelm,ibcv ,irbe3 ,lrbe3 ,front_rm,
10432 b irbym ,lnrbym ,cep ,ibcr ,irbe2 ,
10433 c lrbe2 ,cepsp ,celsph ,iloadp ,lloadp ,
10434 d lgauge ,igaup ,ngaup ,intbuf_tab,ibfflux ,
10435 e icnds10,itagnd ,igeo ,tag_skn ,skews%MULTIPLE_SKEW,
10436 f ibfv ,ibcscyc ,lbcscyc,r_skew ,ipm,
10437 g sensors,scep ,ebcs_tab,loads,iframe,
10438 h glob_therm%NICONV ,glob_therm%NIRADIA ,glob_therm%NITFLUX,
10439 i glob_therm%NUMCONV,glob_therm%NUMRADIA,glob_therm%NFXFLUX,
10440 j sensor_user_struct)
10441
10442C ELSE
10443C mise a 1 de front i.e. tous les noeuds sur Proc1, poids 1
10444C en SMP FRONT => WEIGHT a la meme addresse initialise a 1
10445C SFR_IAD = 0
10446C SDD_FRONT = 0
10447C ALLOCATE(FR_IAD(SFR_IAD))
10448C ALLOCATE(DD_FRONT(SDD_FRONT))
10449C SWEIGHT = NUMNOD
10450C ALLOCATE(WEIGHT(SWEIGHT))
10451C WEIGHT = 1
10452C ENDIF
10453C--------------------------------------------
10454C traitement for DOMDEC, P/ON w/ Itet2 of S10
10455C--------------------------------------------
10456 IF(ns10e>0) THEN
10457 IF(ipari0/=0) THEN
10458 ALLOCATE(celcnd(ns10e))
10459 ALLOCATE(cepcnd(ns10e))
10460 ALLOCATE(addcncnd(0:numnod+1))
10461 CALL pre_cndpon(icnds10,addcncnd,cepcnd,celcnd ,itagnd )
10462 lcncnd = addcncnd(numnod+1)-addcncnd(1)
10463 IF(lcncnd>0) THEN
10464 ALLOCATE(cncnd(lcncnd))
10465 cncnd(1:lcncnd)=0
10466 CALL fillcncnd(cncnd ,addcncnd,icnds10,itagnd)
10467 END IF
10468 END IF
10469 END IF
10470C Preparation traitement SPMD des ecoulements par BEM
10471 CALL trace_out1()
10472 err_msg='PROCESS BEM FOR SPMD'
10473 err_category='PROCESS BEM FOR SPMD'
10474 CALL trace_in1(err_msg,len_trim(err_msg))
10475 IF(nflow>0 .AND. nspmd > 1) CALL flowdec(iflow)
10476 CALL trace_out1()
10477C--------------------------------------------
10478C FERMETURE DU FICHIER INPUT TMP
10479C--------------------------------------------
10480 err_msg='CLOSING TMP INPUT FILE'
10481 err_category='INTERNAL'
10482 CALL trace_in1(err_msg,len_trim(err_msg))
10483 IF(ipid/=0) CLOSE (unit=iin)
10484 CALL trace_out1()
10485C--------------------------------------------
10486C ECRITURE FICHIER DESSIN
10487C--------------------------------------------
10488 err_msg='ANIMATION FILE WRITING'
10489 err_category='ANIMATION FILE WRITING'
10490 CALL trace_in1(err_msg,len_trim(err_msg))
10491 WRITE(istdo,'(A)')titre(46)
10492 IF(ioutput>0) CALL desout(
10493 . x ,ixs ,ixq ,ixc ,ixt ,
10494 . ixp ,ixr ,ixtg ,itab ,pm ,
10495 . geo ,ms ,ixs10 ,igeo ,ipm ,
10496 . kxsp ,ipart ,ipartsp,names_and_titles )
10497 mwa = zero
10498C--------------------------------------------
10499C ECRITURE FICHIER ANIM
10500C--------------------------------------------
10501 ifvani=0
10502 IF(anim_vers>=40.AND.(dsanim==1.OR.
10503 . decani==1.OR.
10504 . nmanim>0.OR.ifvani>0)) THEN
10505 nel3d = numels + numsph + 3*numels16 + 27*numelig3d
10506 nel2d = numelc + numeltg + numelq
10507 nel1d = numelt + numelp + 2*numelr
10508 nel = max(nel1d,nel2d,nel3d)
10509C
10510 siad=npart+1
10511 swaft=max(3*numnod,6*nel3d,3*nel2d,9*nel1d)
10512 smas=nel+3*numels16
10513 swa4=3*numnod+2*numels16
10514 smater=npart
10515 sel2fa=nel+1
10516 sxnorm=3*numnod+2*numels16
10517 sinvert=nel2d
10518 IF(numelx>0) THEN
10519 snfacptx=npart
10520 sixedge=2*nanim1d
10521 soffx1=nanim1d
10522 snumx1=nanim1d
10523 sfunc1=10*nanim1d
10524 ELSE
10525 snfacptx=1
10526 sixedge=1
10527 soffx1=1
10528 snumx1=1
10529 sfunc1=1
10530 ENDIF
10531C
10532 ianim=0
10533 nelem=numelc+numeltg+numels+numelr +
10534 . numelp+numelt +numelq+numelx
10535C
10536 CALL my_alloc(dnull,3*numnod)
10537 DO i=1,3*numnod
10538 dnull(i)=zero
10539 ENDDO
10540C
10541 DO i=1,mx_ani
10542 anim_n(i)=0
10543 anim_v(i)=0
10544 anim_ce(i)=0
10545 anim_ct(i)=0
10546 anim_se(i)=0
10547 anim_st(i)=0
10548 anim_fe(i)=0
10549 anim_ft(i)=0
10550 ENDDO
10551 anim_m=1
10552 nn_ani=0
10553 nv_ani=nmanim
10554 nce_ani=9*nmanim
10555 nct_ani=2*nmanim
10556 nse_ani=9*nmanim
10557 nst_ani=1*nmanim
10558 nfe_ani=8*nmanim
10559C
10560 CALL genani1(
10561 1 x ,elbuf ,ixs ,ixq ,ixc ,
10562 2 ixt ,ixp ,ixr ,ixtg ,swaft ,
10563 3 iparg ,pm ,geo ,skew ,itab ,
10564 4 lpby ,npby ,nstrf ,rwbuf ,nprw ,
10565 5 ipart ,iparts ,ipartq ,ipartc ,
10566 6 ipartt ,ipartp ,ipartr ,ipartg ,
10567 7 rby ,swa4 ,
10568 8 igrsurf ,bufsf ,ipartx ,kxsp ,ixsp ,
10569 9 ipartsp ,spbuf ,ixs10 ,ixs20 ,ixs16 ,
10570 a ipm, igeo, smater, sel2fa, snfacptx,
10571 b sixedge, soffx1, snumx1, sxnorm, sinvert,
10572 c sfunc1, siad , nmanim, dnull, smas,
10573 d ms ,fxani ,mbufel ,mdepl ,nslevel ,
10574 e elsub, dsanim, nelem, cep, cepsp,
10575 f nom_opt ,inom_opt(5),inom_opt(8),
10576 g elbuf_tab,sph2sol ,subsets )
10577 DEALLOCATE(dnull)
10578
10579 ENDIF
10580C----------------------------------------------
10581C Driver to reader of so-called "engine cards"
10582C----------------------------------------------
10583C NGINE = 0 ! Number of Engine "cards", to be counted in contrl.F
10584 IF((is_dyna /= 0 .OR. nb_dyna_include /= 0) .AND. (ngine+nanim_eng /= 0))THEN
10585 CALL read_engine_driver(igrpart,is_dyna,nb_dyna_include)
10586 END IF
10587C----------------------------------------------
10588C Driver to QAPRINT
10589C----------------------------------------------
10590 CALL st_qaprint_driver(
10591 1 igeo ,geo ,bufgeo ,ipm ,pm ,
10592 2 bufmat ,nom_opt ,inom_opt(1) ,numloadp ,iloadp ,
10593 3 lloadp ,loadp ,ibcl ,forc ,ipres ,
10594 4 pres ,npby ,lpby ,rby ,ibcr ,
10595 5 fradia ,ibcv ,fconv ,ibftemp ,fbftemp ,
10596 6 igrv ,lgrav ,grav ,ibfflux ,fbfflux ,
10597 7 itab ,v , vr ,w ,icode ,
10598 8 iskew ,icfield ,lcfield ,cfield ,dampr ,
10599 9 temp ,ibcslag ,ipari ,intbuf_tab ,clusters ,
10600 a ibox ,ipmas ,ibfv ,vel ,nimpacc ,
10601 b laccelm ,accelm ,nom_sect ,nstrf ,secbuf ,
10602 c skew ,iskwn ,xframe ,t_monvol ,t_monvol_metadata,
10603 d i2rupt ,areasl ,intbuf_fric_tab ,npfricorth ,mat_elem ,
10604 e pfricorth ,irepforth ,phiforth ,vforth ,xrefc ,
10605 f xreftg ,xrefs ,tagxref ,ixs ,ixc ,
10606 g ixtg ,rwbuf ,nprw ,lprw ,ithvar ,
10607 h ipart ,subsets ,ipartth ,nthgrpmx ,nimpdisp ,
10608 m nimpvel ,detonators ,ibcscyc ,npc ,tf ,
10609 n table ,npts ,irbe3 ,lrbe3 ,frbe3 ,
10610 p mgrby ,ixs10 ,isolnod ,ixr ,r_skew ,
10611 o ixp ,ixt ,x ,thke ,sh4ang ,
10612 q thkec ,sh3ang ,set ,lsubmodel ,igrnod ,
10613 r igrpart ,igrbric ,igrsh4n ,igrsh3n ,igrquad ,
10614 s igrbeam ,igrtruss ,igrspring ,igrsurf ,igrslin ,
10615 t ixq ,ispcond ,rtrans ,irand ,alea ,
10616 u xseed ,xlas ,ilas ,irbe2 ,lrbe2 ,
10617 v kxsp ,ipartsp ,drape ,ixr_kj ,iactiv ,
10618 w factiv ,unitab ,npbyl ,lpbyl ,rbyl ,
10619 x xyzref ,sensors ,func2d ,
10620 y inicrack ,ipreload ,preload ,iflag_bpreload,ibmpc ,
10621 z ibmpc2 ,ibmpc3 ,ibmpc4 ,rbmpc ,ljoint ,
10622 a nnlink ,lnlink ,bufsf ,sbufsf ,stack%PM ,
10623 b stack%GEO ,stack%IGEO ,iparg ,ipadmesh ,padmesh ,
10624 c liflow ,lrflow ,iflow ,rflow ,
10625 d sh4tree ,sh3tree ,sh4trim ,sh3trim ,qp_iperturb ,
10626 e qp_rperturb ,llinal ,linale ,fvm_inivel ,gjbufi ,
10627 f gjbufr ,ms ,in ,lgauge ,gauge ,
10628 g kxx ,ixx ,ipartx ,lrivet ,ixs16 ,
10629 h iconx ,fxbipm ,fxbfile_tab ,eigipm ,eigrpm ,
10630 i isphio ,vsphio ,ebcs_tab ,inimap1d ,inimap2d ,
10631 j nsigsh ,sigsh ,nsigi ,sigsp ,nsigs ,
10632 k sigi ,nsigbeam ,sigbeam ,nsigtruss ,sigtruss ,
10633 l nsigrs ,sigrs ,merge_node_tab ,merge_node_tol,
10634 m imerge ,nmerge_tot ,iexlnk ,drapeg ,user_windows ,output ,
10635 n defaults ,glob_therm ,pblast ,ibeam_vector ,rbeam_vector ,
10636 o damp_range_part)
10637!
10638 DEALLOCATE(sigi)
10639 DEALLOCATE(sigsh)
10640 DEALLOCATE(sigsp)
10641 DEALLOCATE(sigrs)
10642 DEALLOCATE(sigbeam)
10643 DEALLOCATE(sigtruss)
10644 DEALLOCATE(ibeam_vector)
10645 DEALLOCATE(rbeam_vector)
10646C--------------------------------------------
10647C DELETE HM_MODEL IN MEMORY
10648C--------------------------------------------
10649 CALL cpp_delete_model()
10650C
10651 IF(ninter > 0) THEN
10652 DEALLOCATE(i2rupt)
10653 DEALLOCATE(areasl)
10654 ENDIF
10655 IF(nrbmerge > 0) THEN
10656 DEALLOCATE(mgrby)
10657 ENDIF
10658C -------------------
10659C Memory deallocation
10660C -------------------
10661 IF(nfunc2d > 0) THEN
10662 DO kk = 1, nfunc2d
10663 DEALLOCATE(func2d(kk)%XVAL, func2d(kk)%FVAL)
10664 ENDDO
10665 DEALLOCATE(func2d)
10666 ENDIF
10667 IF(ALLOCATED(rnoise)) DEALLOCATE(rnoise)
10668 IF(ALLOCATED(perturb)) DEALLOCATE(perturb)
10669 IF(ALLOCATED(qp_iperturb)) DEALLOCATE(qp_iperturb)
10670 IF(ALLOCATED(qp_rperturb)) DEALLOCATE(qp_rperturb)
10671
10672C--------FRICTION OROTHTROPIC DIRECTIONS dealloc now after qa print -----
10673 IF(ninter > 0 .AND.ninterfric >0.AND. iorthfricmax > 0) THEN
10674
10675 DEALLOCATE(pfricorth ,irepforth , vforth ,phiforth )
10676
10677 ENDIF
10678C
10679C----------------------------------------------
10680 CALL trace_out1()
10681 err_msg='RESTART FILE(S) WRITING'
10682 err_category='RESTART FILE(S) WRITING'
10683 CALL trace_in1(err_msg,len_trim(err_msg))
10684 IF(ierr==0) THEN
10685C--------------------------------------------m
10686C SPMD : SPLIT + ECRITURE FICHIER RESTART PAR PROC
10687C--------------------------------------------
10688 IF(restart_file==1) WRITE(istdo,'(A)')titre(50)
10689 IF(restart_file==0) WRITE(istdo,'(A)')check_message(1)( 1:len_trim(check_message(1)) )
10690C--------------------------------------------
10691C Matrice de connectivite globale
10692C--------------------------------------------
10693 ilen = max(numels,numelq,numelc,numelt,numelp,numelr,numeltg)
10694 IF(lcne>0) ALLOCATE(cne(lcne),stat=stat)
10695 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='CNE')
10696 CALL fillcne(
10697 1 cne ,lcne ,ixs ,ixs10 ,ixs20 ,
10698 2 ixs16 ,ixq ,ixc ,ixt ,ixp ,
10699 3 ixr ,ixtg ,ixtg1 ,t_monvol ,
10700 4 igrsurf,ibcl ,addcne ,cep ,
10701 5 ilen ,geo ,ibcv ,ibcr ,ibfflux ,
10702 6 iloadp ,lloadp ,cel ,ebcs_tab,loads,
10703 7 glob_therm%NICONV ,glob_therm%NIRADIA ,glob_therm%NITFLUX,
10704 8 glob_therm%NUMCONV,glob_therm%NUMRADIA,glob_therm%NFXFLUX)
10705 IF(i2nsnt>0) THEN
10706 IF(lcni2g>0) ALLOCATE(cni2(lcni2g))
10707 CALL fillcni2(
10708 1 cni2 ,lcni2g,addcni2,ipari, intbuf_tab )
10709 ENDIF
10710C--------------------------------------------
10711C XDP ARRAY IN STARTER FOR SINGLE PRECISION
10712 ALLOCATE(xdp(1))
10713
10714 lenvolu = nimv*nvolu+licbag+libagjet+libaghol+libagale
10715C
10716 lnom_opt=snom_opt
10717 lenpor = snodpor
10718
10719 lenthg = output%TH%SITHBUF
10720 lenthgr = srthbuf
10721Clongueur BUFMAT et BUFGEO
10722 lbufmat = sbufmat
10723 lbufgeo = sbufgeo
10724 lbufsf = sbufsf
10725 pm1shf = 1
10726 pm1sph = 1
10727
10728C----------------------------------------------------------------------
10729 ! Allocation and filling of specific ADDCNE and CNE for non-local
10730 IF(nloc_dmg%IMOD>0) THEN
10731 ! Allocation of ADDCNE for non-local nodes
10732 IF(.NOT.ALLOCATED(nloc_dmg%ADDCNE)) ALLOCATE(nloc_dmg%ADDCNE(0:nloc_dmg%NNOD+1))
10733 nloc_dmg%ADDCNE(0:nloc_dmg%NNOD+1) = 0
10734 ! Filling ADDCNE for non-local nodes
10735 CALL build_addcnel_sub(addcne ,cne ,nloc_dmg%ADDCNE,nloc_dmg%INDX,nloc_dmg%NNOD)
10736 ! Allocation of CNE for non-local nodes
10737 IF(.NOT.ALLOCATED(nloc_dmg%CNE)) ALLOCATE(nloc_dmg%CNE(nloc_dmg%ADDCNE(nloc_dmg%NNOD+1)-1))
10738 nloc_dmg%CNE(1:nloc_dmg%ADDCNE(nloc_dmg%NNOD+1)-1) = 0
10739 ! Filling CNE for non-local nodes
10740 CALL build_cnel_sub(nloc_dmg%CNE,nloc_dmg%ADDCNE,cne,addcne,nloc_dmg%INDX,nloc_dmg%NNOD)
10741 ENDIF
10742C--------------------------------------------
10743C Multidomains -> transfert de la domdec
10744C--------------------------------------------
10745 IF((nsubdom>0).AND.(flg_r2r_err==0)) THEN
10746 CALL r2r_clean_inter(ipari,intbuf_tab,ipartc,ipartg,iparts,isolnod)
10747 IF(iddom>0) THEN
10748 WRITE(istdo,'(A)')' .. MULTIDOMAINS DOMDEC SYNCHRONIZATION '
10749 CALL r2r_domdec(iexlnk,igrnod,frontb_r2r,dt_r2r,1)
10750 ELSE
10751 CALL r2r_domdec(iexlnk,igrnod,frontb_r2r,dt_r2r,2)
10752 ENDIF
10753 ENDIF
10754
10755C deallocation of arrays that are not needed anymore
10756C The memory peak is in ddsplit: we need to deallocate everything that is not
10757C needed anmyre before ddsplit.
10758
10759 DEALLOCATE(ikine1lag)
10760 DEALLOCATE(iwcont)
10761 DEALLOCATE(iwcin2)
10762 DEALLOCATE(dsdof)
10763
10764
10765
10766
10767C-------------------------------------------------------------
10768C INTERFACE ROUTINES CALLED BEFORE DOMAIN DECOMPOSITION
10769C-------------------------------------------------------------
10770
10771C-------------------------------------------------------------
10772C Set INTERCEP (for all INTERFACES except TYPE24) (flag=1)
10773C-------------------------------------------------------------
10774
10775 CALL set_intercep(ipari,intercep,1,intbuf_tab,itab,cep)
10776
10777C ! this call is maintened here to avoid a bug
10778C-------------------------------------------------------------
10779 IF(nspmd > 1 .AND. iddlevel > 0) THEN
10780 CALL set_front8(ipari,intercep,intbuf_tab,intert8,nbt8,itab)
10781 ENDIF
10782C--------------------------------------------
10783C /INTER/TYPE25 connectivit sommets => segments
10784C-------------------------------------------------------------
10785C
10786C Dimensioning (computes NUMNOR == Nb of normals or vertices wrt ALL Interfaces TYPE25)
10787C and Initialization of IRT>LM(3:4,1:NSN)
10788 CALL prepare_int25(intbuf_tab, ipari, intercep, nrtmt_25)
10789 CALL prepare_split_i25e2e(nspmd,intbuf_tab,ipari,intercep)
10790
10791C
10792 ALLOCATE(addcsrect(numnor+1),csrect(4*nrtmt_25),stat=stat)
10793 IF(stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
10794 . msgtype=msgerror,
10795 . c1='CSRECT')
10796 addcsrect(1:numnor+1)=0
10797C
10798 IF(ninter25 /= 0)
10799 . CALL build_csrect(intbuf_tab,ipari,csrect,addcsrect)
10800C
10801C--------------------------------------------
10802C LINES : SET A CPU for splitting
10803! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
10804! /\
10805! / \
10806! / | \
10807! / | \
10808! / o \
10809! /__________\
10810!
10811! /LINE are not used in the engine and the split is wrong in
10812! case of useless line (ie. when a line is defined but not
10813! used by an interface or other stuffs) -->
10814! 2 nodes (defining a segment) can be on 2 different processors
10815! in this case, the segment is not written in the restart file
10816! one could also define the nodes on the same processor but
10817! it will increase the comm.
10818! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
10819 CALL line_decomp(igrslin)
10820!--------------------------------------------
10821C--------------------------------------------
10822C Calcul de variables globales SPMD
10823C--------------------------------------------
10824C CARE TO be computed right before DDSPLIT
10825C This routine computes array sizes for Animation file.
10826C There should not be any call to frontplus beside this point.
10827C--------------------------------------------
10828 CALL globvars(igeo,ixr ,nstrf )
10829 IF(nplymax > 0)THEN
10830 CALL spmd_anim_ply_init(igeo, geo ,iparg ,ixc ,ixtg ,
10831 . ipartc,ipartq,ipartg ,stack )
10832 ENDIF
10833C--------------------------------------------
10834
10835c start CPU timer for ddsplit
10836 CALL startime(3,1)
10837! compute the size of TAG_SCRATCH and check if /INTER/24 or /25 is used
10838 CALL get_size_inter24(i24maxnsne2,ninter,npari,ipari,flag_24_25)
10839! compute the local number of element
10840 CALL get_size_numnod_local(numnod,numnod_l)
10841
10842 ALLOCATE( ale_elm(nspmd) )
10843 IF( (numels>0).AND.(iale+ieuler+glob_therm%ITHERM+ialelag/=0) ) THEN
10844 CALL split_cfd_solide(numels,ale_connectivity,ixs,ale_elm,size_ale_elm)
10845 ELSE
10846 size_ale_elm(1:nspmd) = 0
10847 ENDIF
10848 ! -----------------------------------------
10849 ! reverse connectivity for FVM solver : useful to ensure the parith/on
10850 IF(iale+ieuler+glob_therm%ITHERM+ialelag/=0) THEN
10851 ALLOCATE( indx_s(numels) )
10852 ALLOCATE( indx_q(numelq) )
10853 ALLOCATE( indx_tg(numeltg) )
10854 ALLOCATE( face_elm_s(6*numels,2) )
10855 ALLOCATE( face_elm_q(4*numelq,2) )
10856 ALLOCATE( face_elm_tg(3*numeltg,2) )
10857
10858 indx_s(1:numels) = 0
10859 indx_q(1:numelq) = 0
10860 indx_tg(1:numeltg) = 0
10861 face_elm_s(1:6*numels,1:2) = 0
10862 face_elm_q(1:4*numelq,1:2) = 0
10863 face_elm_tg(1:3*numeltg,1:2) = 0
10864 bool_ale_tg = (n2d/=0.AND.multi_fvm%IS_USED)
10865 CALL multi_connectivity( indx_s,indx_q,indx_tg,
10866 1 face_elm_s,face_elm_q,face_elm_tg,
10867 2 ixs,ixq,ixtg,cep,ale_connectivity,bool_ale_tg)
10868
10869 ELSE
10870 ALLOCATE( indx_s(0) )
10871 ALLOCATE( indx_q(0) )
10872 ALLOCATE( indx_tg(0) )
10873 ALLOCATE( face_elm_s(0,0) )
10874 ALLOCATE( face_elm_q(0,0) )
10875 ALLOCATE( face_elm_tg(0,0) )
10876 ENDIF
10877 ! -----------------------------------------
10878
10879 ! -----------------------------------------
10880 ! split the LOADS structure on the different processors
10881 CALL split_pcyl(loads%NLOAD_CYL,loads,loads_per_proc)
10882 ! -----------------------------------------
10883
10884 ! -----------------------------------------
10885 ! split the BCs wall data structure
10886 CALL split_bcs_wall(bcs_per_proc, cep, scep, nspmd)
10887 ! -----------------------------------------
10888
10889 ! -----------------------------------------
10890 ! prepare the rwall splitting
10891 call alloc_constraint_struct(nrwall,nspmd,constraint_struct)
10892 call split_rwall(nrwall,nspmd,nnprw,slprw,nprw,lprw,constraint_struct)
10893 ! -----------------------------------------
10894
10895C Parallel
10896
10897! -------------------------------------------------------------
10898! RESTART FILE WRITING
10899! if -norst cdl is used or if /RFILE/OFF is used, then
10900! restart files are not generated
10901! -------------------------------------
10902 IF(restart_file==1) THEN
10903C CALL PREPARE_INT25_EDGE(INTBUF_TAB,INTERCEP,NSPMD,IPARI)
10904C----- create TAG_SKINS6 for /H3D/STRESS/TENS/OUTER
10905 ALLOCATE(tag_skins6(numels))
10906 CALL surfext_tagn(ixs ,knod2els,nod2els ,ixs10 ,tag_skins6,itab)
10907 p=0
10908 np=p
10909 IF(.NOT. ALLOCATED(partsav)) ALLOCATE(partsav(0))
10910 IF(.NOT. ALLOCATED(admsms)) ALLOCATE(admsms(0))
10911 IF(.NOT. ALLOCATED(dmelc)) ALLOCATE(dmelc(0))
10912 IF(.NOT. ALLOCATED(dmels)) ALLOCATE(dmels(0))
10913 IF(.NOT. ALLOCATED(dmeltg)) ALLOCATE(dmeltg(0))
10914 IF(.NOT. ALLOCATED(dmeltr)) ALLOCATE(dmeltr(0))
10915 IF(.NOT. ALLOCATED(dmelp)) ALLOCATE(dmelp(0))
10916 IF(.NOT. ALLOCATED(dmelrt)) ALLOCATE(dmelrt(0))
10917 IF(.NOT. ALLOCATED(res_sms)) ALLOCATE(res_sms(0))
10918 IF(.NOT. ALLOCATED(diag_sms)) ALLOCATE(diag_sms(0))
10919 IF(.NOT. ALLOCATED(cne_pxfem)) ALLOCATE(cne_pxfem(0))
10920 IF(.NOT. ALLOCATED(cel_pxfem)) ALLOCATE(cel_pxfem(0))
10921 IF(.NOT. ALLOCATED(msz2)) ALLOCATE(msz2(0))
10922 IF(.NOT. ALLOCATED(xfem_phantom)) ALLOCATE(xfem_phantom(0))
10923!$OMP PARALLEL PRIVATE(ITASK,P,pMEMFLOW,INDX_NM,NINDX_NM,TAG_NM)
10924!$OMP+ PRIVATE(NINDX_SCRT,INDX_SCRT,TAG_SCRATCH)
10925 nindx_nm = 0
10926 nindx_scrt = 0
10927 IF(ninter>0) THEN
10928 ALLOCATE( tag_nm(numnod) )
10929 ALLOCATE( indx_nm(numnod) )
10930 ALLOCATE( tag_scratch(i24maxnsne2+numnod+numels+numfakenodigeo) )
10931 ALLOCATE(indx_scrt(i24maxnsne2+numnod+numels+numfakenodigeo) )
10932 tag_nm(1:numnod) = 0
10933 indx_nm(1:numnod) = 0
10934 tag_scratch(1:i24maxnsne2+numnod+numels+numfakenodigeo) = 0
10935 indx_scrt(1:i24maxnsne2+numnod+numels+numfakenodigeo) = 0
10936 ELSE
10937 ALLOCATE(tag_nm(0))
10938 ALLOCATE(indx_nm(0))
10939 ALLOCATE( tag_scratch(0) )
10940 ALLOCATE(indx_scrt(0) )
10941 ENDIF
10942
10943 220 CONTINUE
10944
10945!$OMP CRITICAL
10946 np=np+1
10947 p=np
10948!$OMP END CRITICAL
10949
10950#if defined(_OPENMP)
10951 itask = omp_get_thread_num()
10952#endif
10953c
10954 IF(p > nspmd) GOTO 221
10955 !Sending clean addresses for unallocated arrays in case P=0
10956 NULLIFY(pmemflow) ; IF(nspmd > 0) pmemflow => memflow(1,p) !MEMFLOW(2,1:NSPMD) ; NSPMD =0 => MEMFLOW(1,0) is undefined
10957
10958
10959 CALL ddsplit(
10960 1 p ,cep ,cel ,igeo ,mat_elem ,
10961 2 ipm ,icode ,iskew ,iskwn ,bid13 ,
10962 3 ibcslag ,ipart ,iparts ,ipartq ,ipartc ,
10963 4 ipartt ,ipartp ,ipartr ,ipartg ,detonators ,
10964 5 ipartx ,npc ,ixtg ,group_param_tab,
10965 6 ixtg1 ,ixs ,ixs10 ,ixs20 ,ixs16 ,
10966 7 ixq ,ixc ,ixt ,ixp ,ixr ,
10967 8 itab ,itabm1 ,gjbufi ,ale_connectivity%NALE ,
10968 9 ale_connectivity,
10969 a kxx ,ixx ,ibcl ,ibfv ,
10970 b ilas ,laccelm ,nnlink ,lnlink ,
10971 c iparg ,igrv ,lgrav ,ibvel ,lbvel ,
10972 d iactiv ,factiv ,kinet ,ipari ,nprw ,
10973 e lprw ,iconx ,npby ,
10974 f lpby ,lrivet ,nstrf ,ljoint ,nodpor ,
10975 g monvol ,icontact ,lagbuf ,
10976 h fr_iad ,x ,d ,v ,vr ,
10977 i dr ,thke ,dampr ,damp ,ms ,
10978 j in ,tf ,pm ,skew ,xframe ,
10979 k geo ,eani ,bufmat ,bufgeo ,bufsf ,
10980 l rbmpc ,gjbufr ,w ,veul ,fill ,
10981 m dfill ,wb ,dsave ,asave ,msnf ,
10982 n spbuf ,forc ,vel ,fsav ,fzero ,
10983 o xlas ,accelm ,fbvel ,grav ,
10984 p fr_wave ,failwave ,parts0 ,elbuf ,
10985 q rwbuf ,rwsav ,rby ,rivet ,
10986 r secbuf ,volmon ,rconx ,nloc_dmg ,
10987 s fvmain ,libagale ,lenthg ,lbufmat ,lbufgeo ,
10988 t lbufsf ,sxlas ,lnom_opt ,silas ,
10989 u lenvolu ,npts ,cne ,lcne ,
10990 v addcne ,cni2 ,lcni2g ,addcni2 ,cepi2 ,
10991 w celi2 ,i2nsnt ,probint ,ddstat(1,p) ,pm1shf,
10992 x dd_iad ,
10993 z kxsp ,ixsp ,nod2sp ,cepsp ,
10994 a nthwa ,nairwa ,nmnt ,l_mul_lag1 ,l_mul_lag ,
10995 b lwaspio ,ipartsp ,ispcond ,pm1sph ,
10996 c wma ,
10997 d eigipm ,eigibuf ,eigrpm ,
10998 e iflow ,rflow ,pmemflow ,iexlnk ,fasolfr ,
10999 f ipartth ,
11000 j fxbipm ,fxbrpm ,fxbnod ,fxbmod ,fxbglm ,
11001 k fxbcpm ,fxbcps ,fxblm ,fxbfls ,fxbdls ,
11002 l fxbdep ,fxbvit ,fxbacc ,fxbelm ,fxbsig ,
11003 m fxbgrvi ,fxbgrvr ,iadll ,lll ,ibmpc ,
11004 n lambda ,lrbagale ,iskwp ,nskwp ,isensp ,
11005 o nsensp ,iaccp ,naccp ,ipart_state ,mcp ,
11006 p temp ,unitab ,intstamp ,iframe ,clusters ,
11007 q partsav ,ibftemp ,fbftemp ,ibcv ,
11008 r fconv ,irbe3 ,lrbe3 ,frbe3 ,front_rm ,
11009 s rbym ,irbym ,lnrbym ,inoise ,fnoise ,
11010 t ms0 ,admsms ,nom_sect ,ispsym ,
11011 u sh4tree ,sh3tree ,ipadmesh ,ibfflux ,fbfflux ,
11012 v sh4trim ,sh3trim ,padmesh ,msc ,mstg ,
11013 w inc ,intg ,ptg ,mcpc ,mcptg ,
11014 x rcontact ,acontact ,pcontact ,mscnd ,incnd ,
11015 y mssa ,mstr ,msp ,msrt ,ibcr ,
11016 z fradia ,dmelc ,dmeltg ,dmels ,dmeltr ,
11017 1 dmelp ,dmelrt ,res_sms ,isphio ,
11018 2 lprtsph ,lonfsph ,vsphio ,sphveln ,alph ,
11019 3 ifill ,ims ,irbe2 ,lrbe2 ,
11020 8 ms_ply,
11021 9 zi_ply ,inod_pxfem ,iel_pxfem ,icodep ,iskewp ,
11022 a addcne_pxfem ,cne_pxfem ,cel_pxfem ,ithvar ,xdp,table ,
11023 b celsph ,icfield ,lcfield ,cfield ,
11024 c msz2 ,itask ,diag_sms,
11025 d iloadp ,lloadp ,loadp,
11026 e inod_crkxfem ,iel_crkxfem ,addcne_crkxfem ,cne_crkxfem ,cel_crkxfem,
11027 f ibufssg_io ,intercep ,ibordnode ,iedgesh ,ibordedge ,
11028 g linale ,nodedge ,iedge ,cep_crkxfem ,iedge_tmp ,
11029 h crknodiad ,elbuf_tab ,nom_opt ,lgauge ,gauge ,
11030 i igaup ,ngaup ,nodlevxf ,frontb_r2r ,dflow ,
11031 j vflow ,wflow ,sph2sol ,sol2sph ,irst ,
11032 k elcutc ,nodenr ,kxfenod2elc ,enrtag ,intbuf_tab ,
11033 m i11flag ,xfem_tab ,lenthgr ,rthbuf ,
11034 n ixig3d ,kxig3d ,knot ,ipartig3d ,wige ,
11035 o ncrkpart ,indx_crk ,crklvset ,crkshell ,crksky ,
11036 p crkavx ,crkedge ,sensors ,
11037 q stack ,xfem_phantom, intert8 ,tab_ump ,poin_ump ,
11038 r sol2sph_typ ,addcsrect ,csrect ,drape ,loads ,
11039 s itagnd ,icnds10 ,addcncnd ,
11040 t cepcnd ,celcnd ,cncnd ,nativ_sms ,i24maxnsne ,
11041 u multi_fvm ,segquadfr ,intbuf_fric_tab,subsets ,igrnod ,
11042 v igrbric ,igrquad ,igrsh4n ,igrsh3n ,igrtruss ,
11043 w igrbeam ,igrspring ,igrpart ,igrsurf ,igrslin ,
11044 x poin_part_shell,poin_part_tri,poin_part_sol,mid_pid_shell,mid_pid_tri ,
11045 y mid_pid_sol , tag_nm ,nindx_nm ,indx_nm ,tag_scratch ,
11046 z nindx_scrt , indx_scrt ,flag_24_25 ,numnod_l(p) ,tag_skn ,
11047 a skews%MULTIPLE_SKEW, igrsurf_proc,knotlocpc ,knotlocel ,ale_elm(p),
11048 b size_ale_elm(p),pinch_data ,tag_skins6 ,ibcscyc ,lbcscyc ,t_monvol,
11049 c indx_s,indx_q,indx_tg,face_elm_s,face_elm_q,face_elm_tg,nbr_th_monvol, ebcs_tab,
11050 d kloadpinter ,loadpinter ,dgaploadint ,s_loadpinter, scep,dynain_data,
11051 e drapeg ,user_windows ,output ,interfaces ,number_load_cyl ,
11052 f loads_per_proc(p), python,dpl0cld,vel0cld ,names_and_titles,
11053 g bcs_per_proc(p),constraint_struct,glob_therm,pblast)
11054 GOTO 220
11055 221 CONTINUE
11056
11057 DEALLOCATE(tag_nm,tag_scratch)
11058 DEALLOCATE(indx_nm,indx_scrt)
11059!$OMP END PARALLEL
11060 DEALLOCATE(tag_skins6)
11061 ENDIF ! <-- end of restart file writing
11062! -------------------------------------------------------------
11063C
11064 CALL deallocate_igrsurf_split(t_monvol,igrsurf_proc)
11065 DEALLOCATE( igrsurf_proc )
11066
11067 IF( (numels>0).AND.(iale+ieuler+glob_therm%ITHERM+ialelag/=0) ) CALL deallocate_split_cfd_solide(ale_elm)
11068
11069 CALL bcs%DEALLOCATE()
11070 DO p=1,nspmd
11071 CALL bcs_per_proc(p)%DEALLOCATE()
11072 ENDDO
11073
11074 DEALLOCATE( ale_elm )
11075
11076 DEALLOCATE( indx_s )
11077 DEALLOCATE( indx_q )
11078 DEALLOCATE( indx_tg )
11079 DEALLOCATE( face_elm_s )
11080 DEALLOCATE( face_elm_q )
11081 DEALLOCATE( face_elm_tg )
11082c stop CPU timer for ddsplit
11083 CALL stoptime(3,1)
11084
11085 CALL trace_out1()
11086 err_msg='CLOSING STARTER'
11087 CALL trace_in1(err_msg,len_trim(err_msg))
11088C----
11089C
11090C Deallocation
11091C
11092 DEALLOCATE(icontact)
11093C
11094 IF(ALLOCATED(cep)) DEALLOCATE(cep)
11095 IF(ALLOCATED(cel)) DEALLOCATE(cel)
11096C
11097 IF(lcne>0)THEN
11098 DEALLOCATE(cne)
11099 END IF
11100C
11101 IF(i2nsnt>0) THEN
11102 DEALLOCATE(celi2)
11103 DEALLOCATE(cepi2)
11104 DEALLOCATE(addcni2)
11105 END IF
11106 DEALLOCATE(iskwp)
11107 DEALLOCATE(nskwp)
11108 DEALLOCATE(isensp)
11109 DEALLOCATE(nsensp)
11110 DEALLOCATE(iaccp)
11111 DEALLOCATE(naccp)
11112 DEALLOCATE(igaup)
11113 DEALLOCATE(ngaup)
11114 DEALLOCATE(ipart_state)
11115 DEALLOCATE(eigipm, eigibuf, eigrpm)
11116 DEALLOCATE(tag_skn)
11117 DEALLOCATE(skews%MULTIPLE_SKEW)
11118 IF(iddlevel ==1 .OR. ((ninter == 0).AND.(isms == 0))) THEN
11119 DEALLOCATE(tagxref)
11120 DEALLOCATE(tagrefsta)
11121 ENDIF
11122C
11123 IF(numsph>0) THEN
11124 DEALLOCATE(cepsp)
11125 END IF
11126 IF(nsphio>0)THEN
11127 DEALLOCATE(ibufssg_io)
11128 DEALLOCATE(reservep)
11129 ENDIF
11130 DEALLOCATE(celsph)
11131C
11132 IF(lag_ncf > 0) THEN
11133 DEALLOCATE(iadll)
11134 DEALLOCATE(lll)
11135 END IF
11136C
11137C IF(ALLOCATED(FVSPMD)) DEALLOCATE(FVSPMD)
11138C
11139 DEALLOCATE(addcsrect)
11140 DEALLOCATE(csrect)
11141 DEALLOCATE(igeo_stack,geo_stack)
11142 IF(ALLOCATED(ply_info))DEALLOCATE(ply_info)
11143 IF(ALLOCATED(fxbfile_tab)) DEALLOCATE(fxbfile_tab)
11144
11145 IF(ALLOCATED(tab_ump)) DEALLOCATE(tab_ump)
11146 IF(ALLOCATED(tab_ump_old)) DEALLOCATE(tab_ump_old)
11147 IF(ALLOCATED(poin_ump)) DEALLOCATE(poin_ump)
11148 IF(ALLOCATED(poin_ump_old)) DEALLOCATE(poin_ump_old)
11149
11150 DEALLOCATE( poin_part_shell )
11151 DEALLOCATE( poin_part_tri )
11152 DEALLOCATE( poin_part_sol )
11153 DO i=1,nummat
11154 IF(ALLOCATED(mid_pid_shell(i)%PID1D))DEALLOCATE( mid_pid_shell(i)%PID1D )
11155 IF(ALLOCATED(mid_pid_shell(i)%COST1D))DEALLOCATE( mid_pid_shell(i)%COST1D )
11156
11157 IF(ALLOCATED(mid_pid_shell(i)%PID1D))DEALLOCATE( mid_pid_tri(i)%PID1D )
11158 IF(ALLOCATED(mid_pid_tri(i)%COST1D))DEALLOCATE( mid_pid_tri(i)%COST1D )
11159 DO j=1,7
11160 IF(ALLOCATED(mid_pid_sol(i,j)%PID1D)) DEALLOCATE( mid_pid_sol(i,j)%PID1D )
11161 IF(ALLOCATED(mid_pid_sol(i,j)%COST1D)) DEALLOCATE( mid_pid_sol(i,j)%COST1D )
11162 ENDDO
11163 ENDDO
11164 DEALLOCATE( mid_pid_shell,mid_pid_tri )
11165 DEALLOCATE( mid_pid_sol )
11166
11167
11168 IF(ALLOCATED(ixig3d)) DEALLOCATE(ixig3d)
11169 IF(ALLOCATED(kxig3d)) DEALLOCATE(kxig3d)
11170 IF(ALLOCATED(msig3d)) DEALLOCATE(msig3d)
11171 IF(ns10e>0.AND.ipari0/=0) THEN
11172 DEALLOCATE(celcnd)
11173 DEALLOCATE(cepcnd)
11174 DEALLOCATE(addcncnd)
11175 IF(lcncnd>0) DEALLOCATE(cncnd)
11176 END IF
11177 IF(ALLOCATED(itagnd)) DEALLOCATE(itagnd)
11178 IF(ns10e>0) DEALLOCATE(icnds10)
11179 CALL monvol_deallocate(nvolu, t_monvol)
11180 IF(ALLOCATED(t_monvol)) DEALLOCATE(t_monvol)
11181 DEALLOCATE(ibcscyc,lbcscyc)
11182 IF(nbcscyc>0) DEALLOCATE(itagcyc)
11183 IF(ALLOCATED(fvm_inivel)) DEALLOCATE(fvm_inivel)
11184C
11185C-- Seatblet structures deallocation
11186 IF(n_seatbelt > 0) THEN
11187 DO i=1,n_seatbelt
11188 DEALLOCATE(seatbelt_tab(i)%SPRING)
11189 ENDDO
11190 DEALLOCATE(seatbelt_tab)
11191 ENDIF
11192C
11193 IF(nslipring > 0) THEN
11194 DO i=1,nslipring
11195 DEALLOCATE(slipring(i)%FRAM)
11196 ENDDO
11197 DEALLOCATE(slipring)
11198 ENDIF
11199C
11200 IF(nretractor > 0) THEN
11201 DO i=1,nretractor
11202 DEALLOCATE(retractor(i)%INACTI_NODE)
11203 DO j=1,2
11204 IF (retractor(i)%IFUNC(j) > 0) THEN
11205 DEALLOCATE(retractor(i)%TABLE(j)%X(1)%VALUES)
11206 DEALLOCATE(retractor(i)%TABLE(j)%X)
11207 DEALLOCATE(retractor(i)%TABLE(j)%Y%VALUES)
11208 DEALLOCATE(retractor(i)%TABLE(j)%Y)
11209 ENDIF
11210 ENDDO
11211 ENDDO
11212 DEALLOCATE(retractor)
11213 ENDIF
11214 IF((ipart_stack > 0 .OR. ipart_pcompp > 0) .AND. ndrape > 0) DEALLOCATE(iwork_t)
11215
11216 IF(ALLOCATED(mparam_r2r))THEN
11217 DO i=1,nummat ; CALL mparam_r2r(i)%DESTRUCT() ; ENDDO
11218 DEALLOCATE(mparam_r2r)
11219 ENDIF
11220
11221 ! -----------------------------------------
11222 ! deallocation of constraint_struct
11223 call dealloc_constraint_struct(nrwall,constraint_struct)
11224 ! -----------------------------------------
11225
11226C --------------------------------------
11227C Starter Memory Printout
11228C --------------------------------------
11229 CALL printstsz(detonators)
11230C --------------------------------------
11231C Stat domdec + evaluation memoire SPMD
11232C --------------------------------------
11233C
11234 IF(restart_file==1) THEN
11235 CALL ddprint(ddstat, memflow)
11236 ELSE
11237 WRITE(iout,*)
11238 WRITE(iout,*) check_message(3)(1:len_trim(check_message(3)))
11239 ENDIF
11240C
11241c ENDIF
11242 ELSE
11243 WRITE(istdo,'(A)')titre(48)
11244 ENDIF
11245C
11246 DEALLOCATE(knod2els,knod2elc,knod2eltg,
11247 . nod2els ,nod2elc ,nod2eltg,
11248 . knod2el1d,nod2el1d,knod2elig3d,
11249 . nod2elig3d,knod2elq,nod2elq)
11250C
11251 DEALLOCATE(msc,mstg,mssa,mstr,msp,msrt)
11252C
11253 DEALLOCATE(mcp,temp)
11254 DEALLOCATE(ibcv, fconv, ibcr, fradia, ibftemp, fbftemp, ibfflux, fbfflux)
11255C
11256 DEALLOCATE(rbym ,irbym ,lnrbym,weight_rm)
11257 DEALLOCATE(ms_ply,zi_ply,icode,iskew)
11258c
11259 IF(ALLOCATED(knotlocpc))DEALLOCATE(knotlocpc)
11260 IF(ALLOCATED(knotlocel))DEALLOCATE(knotlocel)
11261c
11262 CALL trace_out1()
11263 IF(ALLOCATED(ipmas))DEALLOCATE(ipmas)
11264c---------------------------
11265 IF(icrack3d > 0) THEN
11266 DEALLOCATE(inod_crkxfem,iel_crkxfem)
11267 DEALLOCATE(cne_crkxfem)
11268 DEALLOCATE(cel_crkxfem)
11269 DEALLOCATE(cep_crkxfem)
11270 DEALLOCATE(iedgesh)
11271 DEALLOCATE(ibordedge)
11272 DEALLOCATE(nodedge)
11273 DEALLOCATE(iedge)
11274 DEALLOCATE(ibordnode)
11275 END IF
11276 IF(ALLOCATED(iedge_tmp)) DEALLOCATE(iedge_tmp)
11277 IF(ALLOCATED(elcutc)) DEALLOCATE(elcutc)
11278 IF(ALLOCATED(nodenr)) DEALLOCATE(nodenr)
11279 IF(ALLOCATED(kxfenod2elc)) DEALLOCATE(kxfenod2elc)
11280 IF(ALLOCATED(enrtag)) DEALLOCATE(enrtag)
11281 IF(ALLOCATED(addcne_crkxfem))DEALLOCATE(addcne_crkxfem)
11282C----------------------------------------------
11283C ALLOCATION TO REDUCE STACKSIZE
11284C----------------------------------------------
11285 DEALLOCATE(addcne)
11286 DEALLOCATE(addcne_pxfem)
11287 DEALLOCATE(fxbtag)
11288C
11289 DEALLOCATE(isolnod)
11290 DEALLOCATE(isoloff)
11291 DEALLOCATE(isheoff)
11292 DEALLOCATE(itruoff)
11293 DEALLOCATE(ipouoff)
11294 DEALLOCATE(iresoff)
11295 DEALLOCATE(itrioff)
11296 DEALLOCATE(igrnrby)
11297 DEALLOCATE(iquaoff)
11298C
11299 DEALLOCATE(xrefc)
11300 DEALLOCATE(xreftg)
11301 DEALLOCATE(xrefs)
11302 DEALLOCATE(ifront%P,ifront%IENTRY,ientry2)
11303 DEALLOCATE(dflow,vflow,wflow)
11304 DEALLOCATE(permutation%SOLID)
11305 IF(ALLOCATED(fillsol)) DEALLOCATE(fillsol)
11306 IF(ALLOCATED(sh3ang)) DEALLOCATE(sh3ang)
11307 IF(ALLOCATED(sh4ang)) DEALLOCATE(sh4ang)
11308 IF(ALLOCATED(nativ_sms)) DEALLOCATE(nativ_sms)
11309 IF(ALLOCATED(multi_fvm%VEL)) DEALLOCATE(multi_fvm%VEL)
11310 IF(ALLOCATED(multi_fvm%ACC)) DEALLOCATE(multi_fvm%ACC)
11311 CALL ale_connectivity%ALE_DEALLOCATE_CONNECTIVITY()
11312 IF(ipart_stack > 0 .OR. ipart_pcompp > 0) DEALLOCATE(stack_info)
11313 IF(ALLOCATED(ipreload)) DEALLOCATE(ipreload)
11314 IF(ALLOCATED(preload)) DEALLOCATE(preload)
11315 IF(ALLOCATED(iflag_bpreload)) DEALLOCATE(iflag_bpreload)
11316 IF(ALLOCATED(eos_tag))DEALLOCATE(eos_tag)
11317 CALL c_delete_hash(h_node)
11318 CALL deallocate_detonators(detonators)
11319 IF(ALLOCATED(xseed)) DEALLOCATE(xseed)
11320 IF(ALLOCATED(alea)) DEALLOCATE(alea)
11321 IF(ALLOCATED(irand)) DEALLOCATE(irand)
11322 IF(ALLOCATED(sensors%SENSOR_TAB)) DEALLOCATE(sensors%SENSOR_TAB )
11323 IF(ALLOCATED(sensors%LOGICAL_SENSORS_LIST)) DEALLOCATE(sensors%LOGICAL_SENSORS_LIST)
11324 IF(ALLOCATED(damp_range_part)) DEALLOCATE(damp_range_part)
11325C
11326 CALL ebcs_tab%destroy()
11327 IF(ninimap1d > 0 .AND. .NOT. multi_fvm%IS_USED) THEN
11328 DO kk = 1, ninimap1d
11329 DEALLOCATE(inimap1d(kk)%TAGNODE)
11330 ENDDO
11331 ENDIF
11332 DEALLOCATE(inimap1d)
11333
11334 IF(ninimap2d > 0 .AND. .NOT. multi_fvm%IS_USED) THEN
11335 DO kk = 1, ninimap2d
11336 DEALLOCATE(inimap2d(kk)%TAGNODE)
11337 ENDDO
11338 ENDIF
11339 DEALLOCATE(inimap2d)
11340
11341
11342 CALL inverted_group_dealloc(inv_group)
11343
11344 CALL deallocate_joint( )
11345
11346 IF(nfxbody>0) THEN
11347 CLOSE(ifxm)
11348 CLOSE(ifxs)
11349 ENDIF
11350
11351 IF(ALLOCATED( dgapint )) DEALLOCATE(dgapint)
11352
11353 IF(ALLOCATED(dpl0cld)) DEALLOCATE(dpl0cld)
11354 IF(ALLOCATED(vel0cld)) DEALLOCATE(vel0cld)
11355 IF(ALLOCATED(ebcs_tag_cell_spmd)) DEALLOCATE(ebcs_tag_cell_spmd)
11356C----------------------------------------------
11357
11358 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
admbcs
subroutine admbcs(ixc, ipartc, ixtg, iparttg, ipart, icode, iskew, itab, sh4tree, sh3tree)
Definition admbcs.F:36
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:338
ani_fasolfr1
subroutine ani_fasolfr1(ixs, ixc, ixtg, fastag, isolnod)
Definition ani_fasolfr.F:31
ani_segquadfr1
subroutine ani_segquadfr1(ixq, segtag, knod2elq, nod2elq, x, nseg)
Definition ani_segquadfr.F:29
ani_segquadfr2
subroutine ani_segquadfr2(segtag, segquadfr)
Definition ani_segquadfr.F:107
build_addcnel_sub
subroutine build_addcnel_sub(addcnel, cnel, addcnel_sub, indx, subsize)
Definition build_addcnel_sub.F:30
build_admesh
subroutine build_admesh(ipart, ipartc, iparttg, ixc, ixtg, x, itab, itabm1, sh4tree, sh3tree, ipadmesh, padmesh)
Definition build_admesh.F:231
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:36
prepare_int25
subroutine prepare_int25(intbuf_tab, ipari, intercep, nrtmt_25)
Definition build_cnel.F:405
build_csrect
subroutine build_csrect(intbuf_tab, ipari, csrect, addcsrect)
Definition build_cnel.F:507
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
compute_connect_partelm
subroutine compute_connect_partelm(iparts, ipartq, ipartc, ipartt, ipartp, iparttg, ipartr, ipartsp, inv_group, numsph, nisp, kxsp)
Definition compute_connect_partelm.F:36
ini_h3dtmax_engine
subroutine ini_h3dtmax_engine(iparg, ipart, iparts, ipartc, ipartg, iddlevel)
Definition contrl.F:1788
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)
Definition ddsplit.F:336
ini_ifront
subroutine ini_ifront()
Definition ddtools.F:31
fill_intercep
subroutine fill_intercep(ipari, intbuf_tab, intercep)
Definition ddtools.F:972
set_intercep
subroutine set_intercep(ipari, intercep, flag, intbuf_tab, itab, cep)
Definition ddtools.F:712
set_front8
subroutine set_front8(ipari, intercep, intbuf_tab, t8, nbt8, itab)
Definition ddtools.F:406
nlocal
integer function nlocal(n, p)
Definition ddtools.F:349
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
fillcncnd
subroutine fillcncnd(cncnd, addcncnd, icnds10, itagnd)
Definition dim_s10edg.F:1262
bcscycmodif_nd
subroutine bcscycmodif_nd(ibcscyc, lbcscyc, itagnd, itab)
Definition dim_s10edg.F:1388
pre_cndpon
subroutine pre_cndpon(icnds10, adskycnd, cepcnd, celcnd, itagnd)
Definition dim_s10edg.F:1146
bcsmodif_nd
subroutine bcsmodif_nd(icode, itagnd, icnds10, itab)
Definition dim_s10edg.F:662
ind_s10edg
subroutine ind_s10edg(icnds10, ixs, ixs10, iparg, itagnd)
Definition dim_s10edg.F:90
stifn1_nd
subroutine stifn1_nd(icnds10, stifn)
Definition dim_s10edg.F:1341
reord_icnd
subroutine reord_icnd(icnds10, itagnd)
Definition dim_s10edg.F:172
rigmodif1_nd
subroutine rigmodif1_nd(npby, lpby, itagnd)
Definition dim_s10edg.F:403
stifn0_nd
subroutine stifn0_nd(icnds10, stifn)
Definition dim_s10edg.F:1306
rbe2modif1_nd
subroutine rbe2modif1_nd(irbe2, lrbe2, itagnd)
Definition dim_s10edg.F:609
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:739
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:40
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, adsky, 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
fillcni2
subroutine fillcni2(cni2, lcni2, addcni2, ipari, intbuf_tab)
Definition domdec2.F:2827
ddprint
subroutine ddprint(ddstat, memflow)
Definition domdec2.F:2903
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:2040
dsdim0
subroutine dsdim0(ndof, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, kxx, ixx, geo)
Definition dsdim.F:31
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
fail_brokmann
subroutine fail_brokmann(nel, nuparam, nuvar, time, timestep, uparam, ngl, signxx, signyy, signxy, uvar, off, ipt, nindxf, indxf, tdel)
Definition fail_brokmann.F:37
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:32
flowdec
subroutine flowdec(iflow)
Definition flowdec.F:31
ifrontplus
subroutine ifrontplus(n, p)
Definition frontplus.F:100
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:2047
fxbelnum
subroutine fxbelnum(fxbnod, nsn, iparg, itag, fxbelm, ixs, ixc, ixtg, iparts, ipartc, iparttg, ixt, ixp, ipartt, ipartp)
Definition fxbelnum.F:32
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)
Definition globmat.F:32
globvars
subroutine globvars(igeo, ixr, nstrf)
Definition globvars.F:31
lec_ddw
subroutine lec_ddw(filnam, len_filnam, tab_ump_old, cputime_mp_old)
Definition grid2mat.F:3261
prelec_ddw_poin
subroutine prelec_ddw_poin(filnam, len_filnam)
Definition grid2mat.F:3313
lec_ddw_poin
subroutine lec_ddw_poin(filnam, len_filnam, poin_ump_old)
Definition grid2mat.F:3354
reini_matprop2
subroutine reini_matprop2(taille, taille2, tab_ump_loc, tab_ump_loc2, tab_ump, tab_sol, poin_ump)
Definition grid2mat.F:3611
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
reini_matprop
subroutine reini_matprop(taille, taille2, tab_ump_loc, tab_ump_loc2, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, isolnod, poin_ump)
Definition grid2mat.F:3400
spdometis
subroutine spdometis(kxsp, ixsp, nod2sp, cepsp, reservep, sph2sol, cep)
Definition grid2mat.F:2621
prelec_ddw
subroutine prelec_ddw(filnam, len_filnam, marqueur3)
Definition grid2mat.F:3189
hm_grogronod
subroutine hm_grogronod(igrnod, icount, flag, iter, elkey, lsubmodel)
Definition hm_grogronod.F:39
hm_lecgrn
subroutine hm_lecgrn(itab, itabm1, igrnod, isubmod, x, geo, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ipart, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartg, ipartsp, kxsp, flag, maxnnod, skew, iskn, unitab, ibox, ixs10, ixs20, ixs16, rtrans, lsubmodel, ixx, kxx, ipartx, iadboxmax, igrslin, subset, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrsurf, nsets)
Definition hm_lecgrn.F:66
hm_lines_of_lines
subroutine hm_lines_of_lines(igrslin, inseg, flag, icount, iter, nsets, lsubmodel)
Definition hm_lines_of_lines.F:39
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_prelecgrns
subroutine hm_prelecgrns(itabm1, igrnod, lsubmodel)
Definition hm_prelecgrns.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:38
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_alebcs
subroutine hm_read_alebcs(icode, iskew, itab, itabm1, ikine, igrnod, ibcslag, lag_ncf, lag_nkf, lag_nhf, ikine1lag, iskn, nom_opt, lsubmodel)
Definition hm_read_alebcs.F:43
hm_read_bcs
subroutine hm_read_bcs(icode, iskew, itab, itabm1, ikine, igrnod, ibcslag, lag_ncf, lag_nkf, lag_nhf, ikine1lag, iskn, nom_opt, unitab, lsubmodel, ibcscyc, lbcscyc)
Definition hm_read_bcs.F:45
hm_read_beam
subroutine hm_read_beam(ixp, itab, itabm1, ipart, ipartp, ipm, igeo, lsubmodel, ibeam_vector, rbeam_vector)
Definition hm_read_beam.F:40
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_box
subroutine hm_read_box(ibox, unitab, itabm1, iskn, skew, x, rtrans, lsubmodel)
Definition hm_read_box.F:42
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_read_drape
subroutine hm_read_drape(drape_wrk, iwork_t, iworksh, igrsh3n, igrsh4n, ixc, ixtg, igeo, igeo_stack, lsubmodel, unitab, indxsh)
Definition hm_read_drape.F:110
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:45
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_grpart
subroutine hm_read_grpart(igrpart, ipart, isubmod, flag, ngrprt, lsubmodel, subset)
Definition hm_read_grpart.F:43
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:43
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_inicrack
subroutine hm_read_inicrack(itabm1, inicrack, unitab, lsubmodel)
Definition hm_read_inicrack.F:41
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:45
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_lines
subroutine hm_read_lines(itab, itabm1, isubmod, igrslin, igrsurf, x, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ipart, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, nsegs, flag, skew, iskn, unitab, ibox, rtrans, lsubmodel, ipartx, kxx, ixx, iadboxmax, subset, igrtruss, igrbeam, igrspring, nsets, map_tables)
Definition hm_read_lines.F:63
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_merge_node
subroutine hm_read_merge_node(x, lsubmodel, unitab, igrnod, merge_node_tab, merge_node_tol, nmerge_node_cand, nmerge_node_dest)
Definition hm_read_merge_node.F:41
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_mpc0
subroutine hm_read_mpc0(len, lsubmodel)
Definition hm_read_mpc.F:197
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_nbcs
subroutine hm_read_nbcs(icode, iskew, itab, itabm1, ikine, igrnod, ibcslag, lag_ncf, lag_nkf, lag_nhf, ikine1lag, iskn, nom_opt, lsubmodel)
Definition hm_read_nbcs.F:45
hm_read_node
subroutine hm_read_node(x, itab, itabm1, cmerge, unitab, wige, lsubmodel, is_dyna)
Definition hm_read_node.F:43
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)
Definition hm_read_preload.F:42
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)
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:40
hm_read_radiation
subroutine hm_read_radiation(ib, fac, itab, ixs, igrsurf, unitab, lsubmodel, nradia, numradia, niradia, lfacther)
Definition hm_read_radiation.F:42
hm_read_rand
subroutine hm_read_rand(x, igrnod, itab, irand, alea, xseed, unitab, lsubmodel)
Definition hm_read_rand.F:42
setrb2on
subroutine setrb2on(ixs, ixc, ixtg, igrnod, igrnrb2, isoloff, isheoff, itrioff, itabm1, lsubmodel)
Definition hm_read_rbe2.F:1184
seteloff2
subroutine seteloff2(ixs, ixc, ixt, ixp, ixr, ixtg, iparg, isoloff, isheoff, itruoff, ipouoff, iresoff, itrioff, igrnrb2, igrnod, irbe2)
Definition hm_read_rbe2.F:1078
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:329
inirbe3
subroutine inirbe3(irbe3, lrbe3, frbe3, skew, x, ms, in, nom_opt)
Definition hm_read_rbe3.F:389
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:49
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:751
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_retractor
subroutine hm_read_retractor(lsubmodel, itabm1, ixr, itab, unitab, x, func_id, nom_opt, alea, ipm)
Definition hm_read_retractor.F:47
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:47
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:1000
hm_read_sensors
subroutine hm_read_sensors(python, sensors, laccelm, itabm1, ipart, lgauge, subset, nsets, igrsurf, igrnod, bufsf, skew, iskwn, unitab, lsubmodel, hm_nsens, sensor_user_struct)
Definition hm_read_sensors.F:68
hm_read_sh3n
subroutine hm_read_sh3n(ixtg, itab, itabm1, ipart, iparttg, thk, pm, geo, icnod, igeo, ipm, unitab, angle, lsubmodel)
Definition hm_read_sh3n.F:42
hm_read_shell
subroutine hm_read_shell(ixc, itab, itabm1, ipart, ipartc, thk, ipm, igeo, unitab, itag, angle, lsubmodel)
Definition hm_read_shell.F:42
hm_read_skw
subroutine hm_read_skw(skew, iskn, x, itab, itabm1, nsn, lsubmodel, rtrans, nom_opt, unitab)
Definition hm_read_skw.F:49
hm_read_slipring
subroutine hm_read_slipring(lsubmodel, itabm1, ixr, itab, unitab, x, func_id, nom_opt, alea, igrnod, igrsh4n, ixc, ipm)
Definition hm_read_slipring.F:48
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
lce16s3
subroutine lce16s3(ixs, isel, pm, ipoint, itab, itabm1, icode, iparts, igrbric, geo, isolnod, ixs10, ipart, ixs20, ixs16, knod2els, nod2els, igrsurf, sph2sol, sol2sph)
Definition hm_read_solid.F:531
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_sphcel
subroutine hm_read_sphcel(itab, itabm1, ipart, ipartsp, ipm, igeo, kxsp, ixsp, nod2sp, reservep, ixs, iparts, isolnod, sph2sol, sol2sph, irst, x, sol2sph_typ, lsubmodel, spbuf, unitab, ipri)
Definition hm_read_sphcel.F:49
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_spring
subroutine hm_read_spring(ixr, itab, itabm1, ipart, ipartr, igeo, ixr_kj, lsubmodel, iskn, r_skew, ipm)
Definition hm_read_spring.F:40
hm_read_subset
subroutine hm_read_subset(subset, ipart, nsubs, npart, lsubmodel)
Definition hm_read_subset.F:42
hm_read_surf
subroutine hm_read_surf(itab, itabm1, igrsurf, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ipart, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, x, mfi, iskn, skew, bufsf, knod2els, nod2els, sh4tree, sh3tree, isubmod, flag, unitab, ibox, ixs10, ixs16, ixs20, rtrans, lsubmodel, knod2elc, nod2elc, knod2eltg, nod2eltg, kxig3d, ixig3d, ipartig3d, knot, igeo, wige, knod2elig3d, nod2elig3d, v, nige, rige, xige, vige, iadtabige, decaligeo, iadboxmax, knod2elq, nod2elq, subset, igrbric, igrsh4n, igrsh3n, knotlocpc, knotlocel, nsets, map_tables)
Definition hm_read_surf.F:76
hm_read_surfsurf
subroutine hm_read_surfsurf(igrsurf, inseg, flag, icount, iter, nsets, lsubmodel)
Definition hm_read_surfsurf.F:40
hm_read_table2
subroutine hm_read_table2(ntable, table, nfunct, unitab, lsubmodel)
Definition hm_read_table.F:141
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:44
hm_read_tria
subroutine hm_read_tria(ixtg, itab, itabm1, ipart, iparttg, pm, geo, icnod, igeo, ipm, unitab, lsubmodel)
Definition hm_read_tria.F:41
hm_read_truss
subroutine hm_read_truss(ixt, itab, itabm1, ipart, ipartt, ipm, igeo, lsubmodel)
Definition hm_read_truss.F:40
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_set
subroutine hm_set(set, lsubmodel, inv_group, map_tables, ipart, igrsurf, igrnod, igrslin, igrpart, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, ixs, ixs10, ixc, ixtg, knod2els, nod2els, knod2elc, nod2elc, knod2eltg, nod2eltg, ipartc, ipartg, iparts, sh4tree, sh3tree, ixq, knod2elq, nod2elq, x, ixt, ixp, ixr, ixx, kxx, kxsp, ixs20, ixs16, geo, itabm1, ibox, skew, ipartq, ipartt, ipartp, ipartr, subset, rby_msn, iskn, rtrans, unitab, bufsf, iad, siskwn, sskew, rootnam, rootlen, infile_name, infile_name_len)
Definition hm_set.F:88
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)
Definition iniebcs.F:37
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:29
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, pm_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)
Definition inintr.F:64
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:108
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
init_random
subroutine init_random()
Definition init_random.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)
Definition initia.F:188
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
inverted_group_init
subroutine inverted_group_init(mode, inv_group, numsph)
Definition inverted_group_init.F:32
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:1291
kinrem
subroutine kinrem(ikine, ikinew, rwl, itab, nprw, lprw, npby, lpby)
Definition kinchk.F:1216
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
lce16q3
subroutine lce16q3(ixq, isel, pm, ipoint, itab, itabm1, icode, ipartq, igrquad, ipm, igeo)
Definition lce16q.F:34
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
hm_preread_bcscyc
subroutine hm_preread_bcscyc(igrnod, nom_opt, lsubmodel, nbcscynn)
Definition lecbcscyc.F:40
lecextlnk
subroutine lecextlnk(iexter, ipart, lsubmodel)
Definition lecextlnk.F:41
lecfill
subroutine lecfill(ixs, fillsol, unitab, lsubmodel)
Definition lecfill.F:42
lecggroup
subroutine lecggroup(flagg, icount, iter, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrpart, lsubmodel)
Definition lecggroup.F:39
lecgroup
subroutine lecgroup(itab, itabm1, isubmod, x, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ipart, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartg, flagg, sh4tree, sh3tree, skew, iskn, unitab, ibox, ixs10, ixs16, ixs20, rtrans, lsubmodel, ixs_s, ixs_s_ind, ixq_s, ixq_s_ind, ixc_s, ixc_s_ind, ixt_s, ixt_s_ind, ixp_s, ixp_s_ind, ixr_s, ixr_s_ind, ixtg_s, ixtg_s_ind, iadboxmax, subset, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring)
Definition lecgroup.F:44
lecig3d
subroutine lecig3d(itab, ipart, ipartig3d, ipm, igeo, kxig3d, ixig3d, itabm1, nctrlmax, tabconpatch)
Definition lecig3d.F:41
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:65
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:51
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)
Definition lecsubmod.F:41
lectrans
subroutine lectrans(x, igrnod, itab, itabm1, unitab, lsubmodel, rtrans)
Definition lectrans.F:48
lectranssub
subroutine lectranssub(x, igrnod, itab, itabm1, unitab, rtrans, lsubmodel, is_dyna)
Definition lectranssub.F:46
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
merge_node
subroutine merge_node(x, itab, itabm1, imerge, imerge2, iadmerge2, nmerge_tot, merge_node_tab, merge_node_tol, nmerge_node_cand, nmerge_node_dest, ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, eani, igrnod)
Definition merge_node.F:41
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
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
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:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
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:79
detonators_mod::deallocate_detonators
subroutine deallocate_detonators(detonators)
Definition detonators_mod.F:180
drape_mod
Definition drape_mod.F:54
drape_mod::numeltg_drape
integer numeltg_drape
Definition drape_mod.F:92
drape_mod::scdrape
integer scdrape
Definition drape_mod.F:92
drape_mod::stdrape
integer stdrape
Definition drape_mod.F:92
drape_mod::numelc_drape
integer numelc_drape
Definition drape_mod.F:92
dsgraph_mod
Definition dsgraph_mod.F:31
elbuftag_mod
Definition elbuftag_mod.F:227
elbuftag_mod::maxeos
integer, save maxeos
Definition elbuftag_mod.F:369
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:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
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
inoutfile_mod::infile_name_len
integer infile_name_len
Definition inoutfile_mod.F:114
inoutfile_mod::infile_name
character(len=infile_char_len) infile_name
Definition inoutfile_mod.F:116
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:1249
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:957
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:1040
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1001
nlocal_reg_mod
Definition nlocal_reg_mod.F:117
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::flagkin_r2r
integer, dimension(:), allocatable flagkin_r2r
Definition r2r_mod.F:140
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
random_mod::rand_struct
type(random_struct) rand_struct
Definition random_mod.F:52
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::weight_rm
integer, dimension(:), allocatable weight_rm
Definition restart_mod.F:57
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::tag_skins6
integer, dimension(:), allocatable tag_skins6
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:29
sph_mod::sph2sol
integer, dimension(:), allocatable sph2sol
Definition sph_mod.F:32
sph_mod::irst
integer, dimension(:), allocatable irst
Definition sph_mod.F:32
sph_mod::sol2sph_typ
integer, dimension(:), allocatable sol2sph_typ
Definition sph_mod.F:35
sph_mod::sol2sph
integer, dimension(:), allocatable sol2sph
Definition sph_mod.F:32
split_cfd_mod
Definition split_cfd_mod.F:33
stack_mod
Definition stack_mod.F:72
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:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
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
sortgroup
subroutine sortgroup(ixs_s, ixs_s_ind, ixq_s, ixq_s_ind, ixc_s, ixc_s_ind, ixt_s, ixt_s_ind, ixp_s, ixp_s_ind, ixr_s, ixr_s_ind, ixtg_s, ixtg_s_ind, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, leni)
Definition nintrr.F:629
nodm11
subroutine nodm11(pm, ixs, ixq, icode)
Definition nodm11.F:29
outrin
subroutine outrin(ms, in, stifn, stifr, itab, dtnoda)
Definition outri.F:367
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:29
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:33
prelecig3d
subroutine prelecig3d(num)
Definition prelecig3d.F:32
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:101
preplyxfem
subroutine preplyxfem(ms_ply0, zi_ply0, iel, inod, ixc, ms_ply, zi_ply, addcne, msz20, msz2)
Definition preplyxfem.F:31
prerafig3d
subroutine prerafig3d(knot, knotlocpc, knotlocel, kxig3d, ixig3d, igeo, ipartig3d, x, v, d, ms, wige, tabconpatch, flag_pre)
Definition prerafig3d.F:43
preread_rbody_lagmul
subroutine preread_rbody_lagmul(slpbyl, igrnod, lsubmodel)
Definition preread_rbody_lagmul.F:39
preread_rbody_set
subroutine preread_rbody_set(lsubmodel, itabm1, rby_msn)
Definition preread_rbody_set.F:38
pre_stackgroup
subroutine pre_stackgroup(igrsh3n, igrsh4n, ixc, ixtg, igeo, geo, igeo_stack, iworksh, iwork_t)
Definition pres_stackgroup.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
printbcs
subroutine printbcs(icode, iskew, itab, itabm1, ikine, igrnod, ibcslag, lag_ncf, lag_nkf, lag_nhf, ikine1lag, iskn, nom_opt, nbcslag)
Definition printbcs.F:36
printgroup
subroutine printgroup(itab, itabm1, igrnod, ninicrack, bufsf, igrsurf, igrslin, inicrack, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixs10, ixs20, ixs16, ipart, kxx, ixig3d, kxig3d, igrquad, igrbric, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrpart)
Definition printgroup.F:42
qgrhead
subroutine qgrhead(ixq, pm, geo, inum, isel, itr1, eadd, index, itri, ipartq, nd, igrsurf, igrquad, cep, mat_param, xep, igeo, ipm, iquaoff)
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_check
subroutine r2r_check(iexter, igrnod, ipartl)
Definition r2r_check.F:36
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_group
subroutine r2r_group(ngrou, innod, flag, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartg, ipartsp, ixs10, ixs20, ixs16, kk, buf_nod, ixr_kj, inom_opt, ipart_l, iad, nale_r2r, flg_r2r_err, pm_stack, iworksh, igrbric2, igrquad2, igrsh4n2, igrsh3n2, igrtruss2, igrbeam2, igrspring2, igrnod2, igrsurf2, igrslin2, lsubmodel, ale_euler, igeo_, nloc_dmg, detonators, nsensor, seatbelt_shell_to_spring, nb_seatbelt_shells, mat_param)
Definition r2r_group.F:59
r2r_matparam_copy
subroutine r2r_matparam_copy(matparam_tab, matparam_ini, nummat0, nummat)
Definition r2r_matparam_copy.F:30
r2r_speedup
subroutine r2r_speedup(dtelem, dtnoda, dt_r2r, cost_r2r, isoloff, isheoff, itruoff, ipouoff, iresoff, itrioff, iquaoff)
Definition r2r_speedup.F:43
r2r_split
subroutine r2r_split(nb_line, nb_surf, flag, eani2, buf_nod, ixr_kj, inom_opt, reservep, nale_r2r, nspcond0, subset, igrsurf, igrnod, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrpart, igrslin, lsubmodel, rby_msn, iworksh, seatbelt_shell_to_spring, nb_seatbelt_shells)
Definition r2r_split.F:50
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)
Definition read_ebcs.F:55
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)
Definition read_rwall.F:48
reconnect
subroutine reconnect(ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, igrnod, igrsurf, igrslin, iskn, imerge, nmerge_tot)
Definition reconnect.F:34
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
r2r_nom_opt
subroutine r2r_nom_opt(nom_opt, inom_opt, in10, in20, snom_opt_old)
Definition routines_r2r.F:651
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
presearchigeo3d
subroutine presearchigeo3d(igrsurf, xigetmp, permige)
Definition searchigeo3d.F:32
searchigeo3d
subroutine searchigeo3d(igrsurf, iadtabigeini, perm, nigetmp, nige, rigetmp, rige, xigetmp, xige, vigetmp, vige, ndoublonstot)
Definition searchigeo3d.F:87
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
set_admesh
subroutine set_admesh(ipart, ipadmesh, padmesh, unitab, lsubmodel)
Definition set_admesh.F:40
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
setmulti
subroutine setmulti(ipari)
Definition setlenwa.F:110
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, lwamp_l, lwanmp_l, itherm)
Definition setlenwa.F:35
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)
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)
Definition sgrtails.F:51
shellthk_upd
subroutine shellthk_upd(drape, stack, thk, ixc, ixtg, igeo, iworksh, indx)
Definition shellthk_upd.F:35
sort_surf
subroutine sort_surf(igrsurf, ixs, ixc, ixtg, ixq, ixp, ixr, ixt, kxx, nixx)
Definition sort_surf.F:31
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:36
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:151
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:548
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
stackgroup
subroutine stackgroup(igrsh3n, igrsh4n, ixc, ixtg, igeo, geo, iworksh, thk, stack, ipm, igeo_stack, geo_stack, stack_info, numgeo_stack, nprop_stack)
Definition stackgroup.F:39
stackgroup_drape
subroutine stackgroup_drape(drape, drapeg, iwork_t, iworksh, igrsh3n, igrsh4n, ixc, ixtg, igeo, geo, thk, stack, igeo_stack, geo_stack, stack_info, numgeo_stack, nprop_stack, ply_info)
Definition stackgroup_drape.F:39
applysort2fvm
subroutine applysort2fvm(t_monvol)
Definition fvmesh0.F:326
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:3457
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:1178
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:1567
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:774
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:391
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:1871
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, pm, 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
subset_ini
subroutine subset_ini(subset)
Definition subset_ini.F:30
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
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:11481
set_ibufssg_io
subroutine set_ibufssg_io(isphio, igrsurf, ibufssg_io)
Definition lectur.F:11369
init_permutation
subroutine init_permutation()
Definition lectur.F:11445
arret
subroutine arret(nn)
Definition arret.F:87
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
state_admesh
subroutine state_admesh(ipart, ipartc, iparttg, ixc, ixtg, sh4tree, sh3tree, sh4trim, sh3trim, lsubmodel)
Definition state_admesh.F:41
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:30
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:78
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:100
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 11368 of file lectur.F.

11369C-----------------------------------------------
11370C M o d u l e s
11371C-----------------------------------------------
11372 USE groupdef_mod
11373C-----------------------------------------------
11374C I m p l i c i t T y p e s
11375C-----------------------------------------------
11376#include "implicit_f.inc"
11377C-----------------------------------------------
11378C C o m m o n B l o c k s
11379C-----------------------------------------------
11380#include "com01_c.inc"
11381#include "com04_c.inc"
11382#include "sphcom.inc"
11383#include "units_c.inc"
11384#include "warn_c.inc"
11385#include "param_c.inc"
11386C-----------------------------------------------
11387C D u m m y A r g u m e n t s
11388C-----------------------------------------------
11389 INTEGER ISPHIO(NISPHIO,*),
11390 . IBUFSSG_IO(SIBUFSSG_IO),
11391 . N,J,NSEG,IN1,IN2,IN3,IN4,
11392 . ISU,PROC,IAD2,ITYPE
11393 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
11394C-----------------------------------------------
11395C L o c a l V a r i a b l e s
11396C-----------------------------------------------
11397 iad2 = 1
11398
11399 DO n=1,nsphio
11400 itype = isphio(1,n)
11401 IF(isphio(12,n)==0) THEN
11402 isu = isphio(3,n)
11403 nseg= igrsurf(isu)%NSEG
11404 isphio(10,n) = nseg
11405 isphio(11,n) = iad2
11406 DO j=0,nseg-1
11407 in1=igrsurf(isu)%NODES(j+1,1)
11408 in2=igrsurf(isu)%NODES(j+1,2)
11409 in3=igrsurf(isu)%NODES(j+1,3)
11410 in4=igrsurf(isu)%NODES(j+1,4)
11411 ibufssg_io(iad2+nibsph*j) = in1
11412 ibufssg_io(iad2+nibsph*j+1) = in2
11413 ibufssg_io(iad2+nibsph*j+2) = in3
11414 ibufssg_io(iad2+nibsph*j+3) = in4
11415 DO proc=1,nspmd
11416 CALL ifrontplus(in1,proc)
11417 CALL ifrontplus(in2,proc)
11418 CALL ifrontplus(in3,proc)
11419 CALL ifrontplus(in4,proc)
11420 ENDDO
11421 ENDDO
11422 iad2 = iad2 + 4*nseg
11423 ELSEIF(isphio(12,n)==2) THEN
11424 in1 = isphio(13,n)
11425 in2 = isphio(14,n)
11426 in3 = isphio(15,n)
11427 DO proc=1,nspmd
11428 CALL ifrontplus(in1,proc)
11429 CALL ifrontplus(in2,proc)
11430 CALL ifrontplus(in3,proc)
11431 ENDDO
11432 ENDIF
11433 ENDDO
11434C=======================================================================
11435 RETURN

◆ tet4_10()

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

Definition at line 11480 of file lectur.F.

11481C-----------------------------------------------
11482C I m p l i c i t T y p e s
11483C-----------------------------------------------
11484#include "implicit_f.inc"
11485C-----------------------------------------------
11486C C o m m o n B l o c k s
11487C-----------------------------------------------
11488#include "com04_c.inc"
11489#include "param_c.inc"
11490C-----------------------------------------------
11491C D u m m y A r g u m e n t s
11492C-----------------------------------------------
11493 INTEGER IGEO(NPROPGI,*),ITET4_10
11494C-----------------------------------------------
11495C L o c a l V a r i a b l e s
11496C-----------------------------------------------
11497 INTEGER I,IGTYP,ITET4
11498
11499 DO i=1,numgeo
11500 igtyp =igeo(11,i)
11501 itet4 =igeo(20,i)
11502 IF((igtyp==14.OR.igtyp==6).AND.itet4==1) itet4_10 = 1
11503 ENDDO
11504
11505 RETURN