r2r_prelec.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    r2r_prelec                 ../starter/source/coupling/rad2rad/r2r_prelec.F
!||--- called by ------------------------------------------------------
!||    r2r_group                  ../starter/source/coupling/rad2rad/r2r_group.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                     ../starter/source/output/message/message.F
!||    hm_get_float_array_index   ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
!||    hm_get_floatv              ../starter/source/devtools/hm_reader/hm_get_floatv.F
!||    hm_get_int_array_index     ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
!||    hm_get_intv                ../starter/source/devtools/hm_reader/hm_get_intv.F
!||    hm_option_count            ../starter/source/devtools/hm_reader/hm_option_count.F
!||    hm_option_read_key         ../starter/source/devtools/hm_reader/hm_option_read_key.F
!||    hm_option_start            ../starter/source/devtools/hm_reader/hm_option_start.F
!||    modif_tag                  ../starter/source/coupling/rad2rad/routines_r2r.F
!||    prelecsec                  ../starter/source/tools/sect/prelecsec.F
!||    r2r_count                  ../starter/source/coupling/rad2rad/r2r_count.F
!||    tag_elem_void_r2r          ../starter/source/coupling/rad2rad/tagelem_r2r.F
!||    tag_elem_void_r2r_lin      ../starter/source/coupling/rad2rad/tagelem_r2r.F
!||    tagint_r2r                 ../starter/source/coupling/rad2rad/tagint_r2r.F
!||    usr2sys                    ../starter/source/system/sysfus.F
!||--- uses       -----------------------------------------------------
!||    detonators_mod             ../starter/share/modules1/detonators_mod.F
!||    hm_option_read_mod         ../starter/share/modules1/hm_option_read_mod.F
!||    inivol_def_mod             ../starter/share/modules1/inivol_mod.F
!||    message_mod                ../starter/share/message_module/message_mod.F
!||    nod2el_mod                 ../starter/share/modules1/nod2el_mod.F
!||    r2r_mod                    ../starter/share/modules1/r2r_mod.F
!||    reader_old_mod             ../starter/share/modules1/reader_old_mod.F90
!||    restmod                    ../starter/share/modules1/restart_mod.F
!||    submodel_mod               ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE r2r_prelec(IPARTS,
     2           IPARTC,IPARTG,IPARTT,IPARTP,IPARTR,IPARTSP,COMPT_T2,
     3           MODIF,PASSE,INOM_OPT,NSPCONDN,NSPHION,IPART_L,MEMTR,
     4           PM_STACK ,IWORKSH   ,IGRNOD  ,IGRSURF ,IGRSLIN ,
     5           IGRBRIC  ,IGRQUAD   ,IGRSH4N ,IGRSH3N ,IGRTRUSS,
     6           IGRBEAM  ,IGRSPRING ,NEW_NSLASH_INT,LSUBMODEL,NEW_HM_NINTER,
     7           NEW_NINTSUB,NEW_NINIVOL,IXS10,IXS20,IXS16,
     8           DETONATORS,SEATBELT_SHELL_TO_SPRING,NB_SEATBELT_SHELLS,
     9           NEBCS,NEW_NEBCS)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE restmod
        USE r2r_mod
        USE nod2el_mod
        USE message_mod
        USE groupdef_mod
        USE submodel_mod
        USE hm_option_read_mod
        USE inivol_def_mod , ONLY : num_inivol
        USE detonators_mod
        USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
        USE reader_old_mod , ONLY : kinter, kcur, line, nslash
        use element_mod , only : nixc
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "units_c.inc"
#include      "scr17_c.inc"
#include      "param_c.inc"
#include      "r2r_c.inc"
#include      "lagmult.inc"
#include      "sphcom.inc"
#include      "sms_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        TYPE(submodel_data) LSUBMODEL(NSUBMOD)
        INTEGER IPARTS(*),IPARTC(*),IPARTG(*),IPARTT(*),IPARTP(*),
     .     IPARTR(*),COMPT_T2,MODIF,PASSE,INOM_OPT(*),IPARTSP(*),NSPCONDN,
     .     NSPHION,IPART_L(LIPART1,*),MEMTR(*),IWORKSH(*),NEW_NSLASH_INT,NEW_HM_NINTER,NEW_NINTSUB,
     .     NEW_NINIVOL,IXS10(*), IXS16(*), IXS20(*)
        INTEGER ,INTENT(IN) :: NB_SEATBELT_SHELLS
        INTEGER ,INTENT(IN) :: SEATBELT_SHELL_TO_SPRING(NUMELC,2)
        INTEGER ,INTENT(IN) :: NEBCS
        INTEGER ,INTENT(INOUT) :: NEW_NEBCS
        my_real
     .    pm_stack(*)
C-----------------------------------------------
        TYPE (GROUP_)  , DIMENSION(NGRNOD)  :: IGRNOD
        TYPE (SURF_)   , DIMENSION(NSURF)   :: IGRSURF
        TYPE (SURF_)   , DIMENSION(NSLIN)   :: IGRSLIN
        TYPE (GROUP_)  , DIMENSION(NGRBRIC) :: IGRBRIC
        TYPE (GROUP_)  , DIMENSION(NGRQUAD) :: IGRQUAD
        TYPE (GROUP_)  , DIMENSION(NGRSHEL) :: IGRSH4N
        TYPE (GROUP_)  , DIMENSION(NGRSH3N) :: IGRSH3N
        TYPE (GROUP_)  , DIMENSION(NGRTRUS) :: IGRTRUSS
        TYPE (GROUP_)  , DIMENSION(NGRBEAM) :: IGRBEAM
        TYPE (GROUP_)  , DIMENSION(NGRSPRI) :: IGRSPRING
        TYPE(detonators_struct_),TARGET,INTENT(IN) :: DETONATORS
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
        INTEGER USR2SYS
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER I,J,L,NI,GRM,GRS,IGU,MAIN,NUL,NOD,ISK,NRB
        INTEGER GR_ID,COMPT,TAG,IAD,CUR_ID,NB_RBY
        INTEGER NB_KIN,NB_LAG,N1,N2,ID_RBY,DOMA,ISTER
        INTEGER ID_CYL,CCPL,DIFF,D1,D2,G1,G2,GX,IP,JOE,JIE
        INTEGER COMPT_M,COMPT_S,CUR_TYP,SUM,CONT,K,TYPE2
        INTEGER NB_INT,ID_INTER,LNM,LNS,L1,L2,ISENS,VAL,WARN
        INTEGER ID_RLINK,NUL50(50),ID_RBE3,ID_RBE2,ID_JOIN
        INTEGER NU(4),NS(4),JREC,ID_MPC,ISUR,ISURS,ID_MON,FLG
        INTEGER COMPT2,IGR9_TEMP,IGR8_TEMP,IGR2_TEMP,ID,ID_PART,IDS
        INTEGER SPTFL,BID(LNOPT1),IUD,IGRPP_R2R(2,NGRNOD),FLAG_T24T25
        INTEGER SUB_ID,IDTITL,IDINT,GR_BRIC,NUMC
        INTEGER NTRANS,NNODE_TRANSFORM,NODE_TRANSFORM(6)
        INTEGER GRNOD_T24T25
        INTEGER NSENSOR
        my_real f,nul_m
        CHARACTER MESS*40,TSENS*40
        CHARACTER(LEN=NCHARTITLE) :: TITR
        CHARACTER(LEN=NCHARKEY) :: KEY,KEY2
        CHARACTER(LEN=NCHARFIELD) :: STRING
        INTEGER, DIMENSION(:), ALLOCATABLE :: BUF_TEMP
        DATA mess/'MULTIDOMAIN PREREADING OF OPTIONS'/
        LOGICAL :: IS_AVAILABLE
C=======================================================================
 
C--------------------------------------------------------------------C
C---Counting of nodes / elts for groups and surfaces-----------------C
C--------------------------------------------------------------------C
 
        CALL r2r_count(passe,iparts,
     .                 ipartc,ipartg,igrpp_r2r ,pm_stack , iworksh,
     .                 igrnod,igrsurf,igrslin,igrbric,ixs10,
     .                 ixs20,ixs16)
 
C--------------------------------------------------------------------C
C------Detection of incompatible options-----------------------------C
C--------------------------------------------------------------------C
 
        IF (passe==0) THEN
 
C-----DAMPING--------------------------------------------------------
 
          IF (ndamp>0) THEN
            CALL ancmsg(msgid=837,
     .                  msgtype=msgwarning,
     .                  anmode=aninfo_blind_1,
     .                  c1="/DAMP")
            ndamp = 0
          ENDIF
 
C----- Flexible body -----------------------------------------------------------------------------
 
          IF (nfxbody>0) THEN
            CALL ancmsg(msgid=837,
     .                  msgtype=msgwarning,
     .                  anmode=aninfo,
     .                  c1="/FXBODY")
            nfxbody = 0
          ENDIF
 
C-----AMS - temporarily incompatible----------------------------------
          IF (isms>0) THEN
            CALL ancmsg(msgid=835,
     .                  msgtype=msgerror,
     .                  anmode=aninfo,
     .                  c1="/AMS")
          ENDIF
 
C--------------------------------------------------------------------C
C------Prereading and tag of SECTIONS--------------------------------C
C--------------------------------------------------------------------C
 
          CALL prelecsec(
     1    nul     ,nul       ,itabm1  ,1        ,nom_opt(lnopt1*inom_opt(8)+1),
     2    igrbric ,igrquad   ,igrsh4n ,igrsh3n  ,igrtruss,
     3    igrbeam ,igrspring ,igrnod, lsubmodel , seatbelt_shell_to_spring,
     4    nb_seatbelt_shells)
 
C--------------------------------------------------------------------C
C------Prereading and tag of Accelerometers--------------------------C
C--------------------------------------------------------------------C
          CALL hm_option_start('/ACCEL')
          DO i = 1, naccelm
            CALL hm_option_read_key(lsubmodel, option_titr = titr, option_id = id)
            CALL hm_get_intv('nodeid', nod, is_available, lsubmodel)
            CALL hm_get_intv('skewid', isk, is_available, lsubmodel)
            CALL hm_get_floatv('cutoff', f, is_available, lsubmodel, unitab)
            nod = usr2sys(nod, itabm1, mess, id)
            CALL modif_tag(tagno(npart + nod), 2, modif)
          ENDDO
C--------------------------------------------------------------------C
C------Prereading and tag of Transformations-------------------------C
C--------------------------------------------------------------------C
          ntrans = 0
          CALL hm_option_count('TRANSFORM',ntrans)
          CALL hm_option_start('TRANSFORM')
          DO i=1,ntrans
            CALL hm_option_read_key(lsubmodel,
     .                           option_id = id,
     .                           option_titr = titr,
     .                           keyword2 = key)
C----
            IF (key(1:3)/='MAT') THEN
              CALL hm_get_intv('node1',n1,is_available,lsubmodel)
              CALL hm_get_intv('node2',n2,is_available,lsubmodel)
              IF (n1/=0) THEN
                n1=usr2sys(n1,itabm1,mess,ni)
                IF (tagno(npart+n1)==-1) CALL modif_tag(tagno(npart+n1),0,modif)
              ENDIF
              IF (n2/=0) THEN
                n2=usr2sys(n2,itabm1,mess,ni)
                IF (tagno(npart+n2)==-1) CALL modif_tag(tagno(npart+n2),0,modif)
              ENDIF
            ENDIF
C----
          ENDDO
C--------------------------------------------------------------------C
C------Prereading and tag of Sensors---------------------------------C
C--------------------------------------------------------------------C
 
          CALL hm_option_start('/SENSOR')
          CALL hm_option_count('/SENSOR', nsensor)
C
          DO i=1,nsensor
            CALL hm_option_read_key(lsubmodel,
     .           option_id   = isens, keyword2    = key   )
            IF (key(1:4) == 'DIST'.OR. key(1:5) == 'TYPE2') THEN
              CALL hm_get_intv  ('N1' ,n1 ,is_available,lsubmodel)
              CALL hm_get_intv  ('N2' ,n2 ,is_available,lsubmodel)
              n1 = usr2sys(n1,itabm1,mess,ni)
              CALL modif_tag(tagno(npart+n1),2,modif)
              n2 = usr2sys(n2,itabm1,mess,ni)
              CALL modif_tag(tagno(npart+n2),2,modif)
            ELSEIF (key(1:5) == 'INTER'.OR.key(1:5) == 'TYPE6') THEN
              CALL ancmsg(msgid=835, msgtype=msgerror, anmode=aninfo,
     .                  c1="/SENSOR/INTER")
            ELSEIF (key(1:4) == 'RWAL'.OR.key(1:5) == 'TYPE7') THEN
              CALL ancmsg(msgid=835, msgtype=msgerror, anmode=aninfo,
     .                  c1="/SENSOR/RWALL")
            ELSEIF (key(1:3) == 'VEL' .OR. key(1:5) == 'TYPE9') THEN
c          READ(IIN,REC=IREC,ERR=999,FMT=FMT_I_2F)N1,NUL,NUL
c          N1 = USR2SYS(N1,ITABM1,MESS,NI)
c           CALL MODIF_TAG(TAGNO(NPART+N1),2,MODIF)
            ELSEIF (key(1:4) /='SENS'.AND.key(1:5)/='TYPE3'
     .          .AND.key(1:3)/='AND'.AND.key(1:5)/='TYPE4'
     .          .AND.key(1:2)/='OR'.AND.key(1:5)/='TYPE5'
     .          .AND.key(1:3)/='NOT'.AND.key(1:5)/='TYPE8'
     .          .AND.key(1:4)/='TIME'.AND.key(1:5)/='TYPE0'
     .          .AND.key(1:4)/='ACCE'.AND.key(1:5)/='TYPE1') THEN
              tsens = '/SENSOR/'//key(1:5)
              CALL ancmsg(msgid=835, msgtype=msgerror, anmode=aninfo,
     .                 c1=tsens)
            ENDIF
          END DO
C
C----------------------------------------------------------------------------------C
C------Prereading and tag of elements/nodes for GAUGES-----------------------------C
C----------------------------------------------------------------------------------C
 
          CALL hm_option_start('/GAUGE')
 
          ALLOCATE(taggau(nbgauge))
          taggau(:)=0
 
          DO i=1,nbgauge
            key=''
            CALL hm_option_read_key(lsubmodel,
     .                             option_id   = id,
     .                             keyword2    = key   )
 
            flg = 0
            IF (key(1:3) == 'SPH') cycle
 
            taggau(i) = id
 
            CALL hm_get_intv  ('NODE1'    ,nod ,is_available,lsubmodel)
            CALL hm_get_intv  ('shell_ID' ,ids ,is_available,lsubmodel)
            IF ((nod== 0).AND.(ids /= 0)) THEN
              flg = 1
              !gauges defined by element-------------------------------------
              DO j=1,numelc
                IF(ixc(nixc*j)==ids)THEN
                  ids = j
                  EXIT
                ENDIF
              ENDDO
              IF (tag_elc(ids+npart) < 1) THEN
                CALL modif_tag(tag_elc(ids+npart),1,modif)
              ENDIF
            ELSEIF ((nod/=0).AND.(ids==0)) THEN
              !gauges defined by nodes---------------------------------------
              nod=usr2sys(nod,itabm1,mess,id)
              CALL modif_tag(tagno(npart+nod),2,modif)
            ENDIF
          END DO
 
C-----Prereading and tag of elements/nodes for GAUGES and /GAUGE/SPH-------
          CALL hm_option_start('/GAUGE')
          DO i=1,nbgauge
            key=''
            CALL hm_option_read_key(lsubmodel,
     .                               option_id   = id,
     .                               keyword2    = key   )
 
            flg = 0
            IF (key(1:3) == 'SPH') THEN
 
              taggau(i) = -id
 
              CALL hm_get_intv  ('NODE1'    ,nod ,is_available,lsubmodel)
              CALL hm_get_intv  ('shell_ID' ,ids ,is_available,lsubmodel)
              IF ((nod== 0).AND.(ids /= 0)) THEN
                flg = 1
                !gauges defined by element-------------------------------------
                DO j=1,numelc
                  IF(ixc(nixc*j)==ids)THEN
                    ids = j
                    EXIT
                  ENDIF
                ENDDO
                IF (tag_elc(ids+npart) < 1) THEN
                  CALL modif_tag(tag_elc(ids+npart),1,modif)
                ENDIF
              ELSEIF ((nod/=0).AND.(ids==0)) THEN
                !gauges defined by nodes---------------------------------------
                nod=usr2sys(nod,itabm1,mess,id)
                CALL modif_tag(tagno(npart+nod),2,modif)
              ENDIF
            ENDIF
          END DO
C----------------------------------------------------------------------------------C
C------Prereading and tag of MONVOL------------------------------------------------C
C----------------------------------------------------------------------------------C
 
          ni=0
          ALLOCATE(tagmon(nmonvol + nvolu))
          tagmon(:)=0
 
C-------------------------------------------------------------------C
C---------------------------- New Reader ---------------------------C
C-------------------------------------------------------------------C
 
          CALL hm_option_start('/MONVOL')
          compt = 0
C
          DO i=1,nmonvol
C
            CALL hm_option_read_key(lsubmodel,
     .                              option_id = id_mon,
     .                              keyword2 = key)
C
            IF (key(1:7) == 'AIRBAG1') THEN
              CALL hm_get_intv('surf_IDex', isur, is_available, lsubmodel)
            ELSEIF ((key(1:4) == 'PRES').OR.(key(1:6) == 'AIRBAG')) THEN
              CALL hm_get_intv('entityiddisplayed', isur, is_available, lsubmodel)
            ELSE
              CALL hm_get_intv('surf_IDex', isur, is_available, lsubmodel)
            ENDIF
C
            isurs = 0
            DO j=1,nsurf
              IF(isur==igrsurf(j)%ID) isurs=j
            ENDDO
C             ---> error - tag for error in in reading of monvol  <---
            IF (isurs==0) GOTO 139
C
            IF (igrsurf(isurs)%NSEG>0) THEN
              IF (isurf_r2r(3,isurs)==igrsurf(isurs)%NSEG) THEN
C             ---> case normal <---
                GOTO 139
              ELSEIF (isurf_r2r(3,isurs)/=0) THEN
C             ---> case monvol between domains - not allowed <---
                CALL ancmsg(msgid=836,
     .                      msgtype=msgerror,
     .                      anmode=aninfo,
     .                      i1=id_mon)
              ENDIF
            ENDIF
C
            GOTO 140
139         tagmon(i)=id_mon
            compt = compt+1
140         CONTINUE
C
          END DO
C
          new_hm_nvolu = compt
          new_nvolu = 0
 
        ENDIF
 
C--------------------------------------------------------------------C
C------Prereading and tag of Cyl joints -> icompatible with interface-C
C--------------------------------------------------------------------C
 
        CALL hm_option_start('/CYL_JOINT')
        IF (passe==0) ALLOCATE(tagcyl(njoint))
        tagcyl(:)=0
        compt = 0
 
        DO i=1,njoint
          CALL hm_option_read_key(lsubmodel,
     .                            option_id = id_cyl)
          CALL hm_get_intv('independentnode',n1,is_available,lsubmodel)
          CALL hm_get_intv('dependentnodes',n2,is_available,lsubmodel)
          CALL hm_get_intv('dependentnodeset',igu,is_available,lsubmodel)
C---------------------------------------------------------------------
          gr_id = 0
          DO j=1,ngrnod
            IF (igrnod(j)%ID==igu) gr_id = j
          END DO
          n1=usr2sys(n1,itabm1,mess,id_cyl)
          n2=usr2sys(n2,itabm1,mess,id_cyl)
C---------Tag of error situation--------------------------------------
          IF (gr_id==0) THEN
            igr2_temp = 0
            igr8_temp = 0
            igr9_temp = 0
          ELSE
            igr2_temp = igrnod(gr_id)%NENTITY
            igr8_temp = igrnod(gr_id)%R2R_ALL
            igr9_temp = igrnod(gr_id)%R2R_SHARE
          ENDIF
C--------- n1 et n2 must be taken into account in the interface-------
          IF (tagno(n1+npart)>1) igr9_temp=igr9_temp+1
          IF (tagno(n2+npart)>1) igr9_temp=igr9_temp+1
          IF (tagno(n1+npart)>0) igr8_temp=igr8_temp+1
          IF (tagno(n2+npart)>0) igr8_temp=igr8_temp+1
          IF (tagno(n1+npart)/=0) igr2_temp=igr2_temp+1
          IF (tagno(n2+npart)/=0) igr2_temp=igr2_temp+1
C---------------------------------------------------------------------
          IF (igr8_temp>0) THEN
            diff = igr2_temp-igr8_temp
            IF ((igr9_temp>0).OR.(diff/=0)) THEN
C--------CYL_JOINTS on the interface----------------------------------
              IF (gr_id>0) THEN
                DO j=1,igrnod(gr_id)%NENTITY
                  cur_id = igrnod(gr_id)%ENTITY(j)
                  IF (tagno(cur_id+npart)<3) THEN
                    CALL modif_tag(tagno(npart+cur_id),5,modif)
                  ENDIF
                END DO
              ENDIF
              IF (tagno(n1+npart)<3) THEN
                CALL modif_tag(tagno(npart+n1),5,modif)
              ENDIF
              IF (tagno(n2+npart)<3) THEN
                CALL modif_tag(tagno(npart+n2),5,modif)
              ENDIF
            ENDIF
            compt = compt + 1
C--------Tag of CYL_JOINT to keep it----------------------------------
            tagcyl(i)=id_cyl
          ENDIF
 
350       CONTINUE
        END DO
 
        new_njoint = compt
 
C--------------------------------------------------------------------C
C------Prereading and tag of MPC -> icompatible with interface-------C
C--------------------------------------------------------------------C
 
        CALL hm_option_start('/MPC')
        IF (passe==0) ALLOCATE(tagmpc(nummpc))
        tagmpc(:)=0
        compt = 0
 
        DO i=1,nummpc
          compt_m = 0
          compt_s = 0
          CALL hm_option_read_key(lsubmodel,
     .                         option_id = id_mpc,
     .                         option_titr = titr)
          CALL hm_get_intv('number_of_nodes',numc,is_available,lsubmodel)
          DO j=1,numc
            CALL hm_get_int_array_index('node_ID',n1,j,is_available,lsubmodel)
            n2 = usr2sys(n1,itabm1,mess,id_mpc)
            IF (tagno(n2+npart)>=0) compt_m=compt_m+1
            IF (tagno(n2+npart)>1) compt_s=compt_s+1
            IF (tagno(n2+npart)<=0) compt_s=compt_s+1
          END DO
C-----check if MPC must be kept----------------------------------
          IF (compt_m>0) THEN
            IF (compt_s==0) THEN
C-----MPC intern ->
              tagmpc(i) = id_mpc
              compt = compt + 1
            ELSE
C--------Temporarily MPC is not allowed on interface
              CALL ancmsg(msgid=896,
     .                    msgtype=msgerror,
     .                    anmode=aninfo,
     .                    c1="/MPC",
     .                    i1=id_mpc)
            ENDIF
          ENDIF
        END DO
 
        new_nummpc = compt
 
C--------------------------------------------------------------------C
C------Prereading and tag of GJOINTS -> icompatible with interface---C
C--------------------------------------------------------------------C
C
        CALL hm_option_start('/GJOINT')
        IF (passe==0) ALLOCATE(tagjoin(ngjoint))
        tagjoin(:)=0
        compt = 0
 
        DO i=1,ngjoint
          compt_m = 0
          compt_s = 0
C
          CALL hm_option_read_key(lsubmodel,
     .                       option_id = id_join,
     .                       option_titr = titr,
     .                       keyword2 = key2)
C
          CALL hm_get_intv('node_ID0',nu(1),is_available,lsubmodel)
          CALL hm_get_intv('node_ID1',nu(2),is_available,lsubmodel)
          CALL hm_get_intv('node_ID2',nu(3),is_available,lsubmodel)
          CALL hm_get_intv('node_ID3',nu(4),is_available,lsubmodel)
C
          val = 3
          IF(key2(1:4)=='DIFF') val = 4
 
          DO j=1,val
            ns(j) = usr2sys(nu(j),itabm1,mess,id_join)
            IF (tagno(ns(j)+npart)>=0) compt_m=compt_m+1
            IF (tagno(ns(j)+npart)>1) compt_s=compt_s+1
            IF (tagno(ns(j)+npart)<=0) compt_s=compt_s+1
          END DO
 
C-----check if GJOINT must be kept----------------------------------
          IF (compt_m>0) THEN
            IF (compt_s==0) THEN
C-----GJOINT intern ->
              tagjoin(i) = id_join
              compt = compt + 1
            ELSE
C--------Temporarily GJOINT is not allowed on interface
              CALL ancmsg(msgid=896,
     .                    msgtype=msgerror,
     .                    anmode=aninfo,
     .                    c1="/GJOINT",
     .                    i1=id_join)
            ENDIF
          ENDIF
        END DO
 
        new_ngjoint = compt
 
C--------------------------------------------------------------------C
C------Prereading and tag of RBE2 -> icompatible with interface------C
C--------------------------------------------------------------------C
 
        IF (passe==0) ALLOCATE(tagrb2(nrbe2))
        tagrb2(:)=0
        compt = 0
 
        CALL hm_option_start('/RBE2')
        DO i=1,nrbe2
 
          CALL hm_option_read_key(lsubmodel,
     .                         option_id = id_rbe2,
     .                         option_titr = titr)
C
          CALL hm_get_intv('independentnode',n1,is_available,lsubmodel)
          CALL hm_get_intv('dependentnodeset',igu,is_available,lsubmodel)
C
          n2 = usr2sys(n1,itabm1,mess,id_rbe2)
          gr_id=0
          DO j=1,ngrnod
            IF (igrnod(j)%ID==igu) gr_id = j
          END DO
C---------tag of error situation--------------------------------------
          IF (gr_id==0) THEN
            compt = compt + 1
            tagrb2(i)=id_rbe2
            GOTO 360
          ENDIF
C---------------------------------------------------------------------
          compt_m = igrnod(gr_id)%R2R_ALL
          compt_s = igrnod(gr_id)%R2R_SHARE
          IF (tagno(n2+npart)>=0) compt_m=compt_m+1
          IF (tagno(n2+npart)>1) compt_s=compt_s+1
          IF (tagno(n2+npart)<=0) compt_s=compt_s+1
C-----check if RBE2 must be kept--------------------------------------
          IF (compt_m>0) THEN
            IF (compt_s==0) THEN
C-----RBE2 intern ->
              tagrb2(i) = id_rbe2
              compt = compt + 1
            ELSE
C--------Temporarily RBE2 is not allowed on interface
              CALL ancmsg(msgid=896,
     .                    msgtype=msgerror,
     .                    anmode=aninfo,
     .                    c1="/RBE2",
     .                    i1=id_rbe2)
            ENDIF
          ENDIF
360       CONTINUE
        END DO
 
        new_nrbe2 = compt
 
C--------------------------------------------------------------------C
C------Prereading and tag of RBE. -> icompatible with interface------C
C--------------------------------------------------------------------C
 
        IF (passe==0) ALLOCATE(tagrb3(nrbe3))
        tagrb3(:)=0
        compt = 0
        CALL hm_option_start('/RBE3')
 
        DO i=1,nrbe3
          compt_s = 0
          compt_m = 0
          CALL hm_option_read_key(lsubmodel,
     .                         option_id = id_rbe3,
     .                         option_titr = titr)
          CALL hm_get_intv('dependentnode',N1,IS_AVAILABLE,LSUBMODEL)
          CALL HM_GET_INTV('nset',val,is_available,lsubmodel)
 
          ALLOCATE(buf_temp(val))
          n2 = usr2sys(n1,itabm1,mess,id_rbe3)
C-----Reading of groups------------------------------------------
          DO l=1,val
            CALL hm_get_float_array_index('independentnodesetcoeffs',f,l,is_available,lsubmodel,unitab)
            CALL hm_get_int_array_index('independentnodesets',igu,l,is_available,lsubmodel)
            DO j=1,ngrnod
              IF (igrnod(j)%ID==igu) gr_id = j
            END DO
            buf_temp(l)=gr_id
            compt_m = compt_m + igrnod(gr_id)%R2R_ALL
            compt_s = compt_s + igrnod(gr_id)%R2R_SHARE
          END DO
 
          IF (tagno(n2+npart)>=0) compt_m=compt_m+1
          IF (tagno(n2+npart)>1) compt_s=compt_s+1
          IF (tagno(n2+npart)<=0) compt_s=compt_s+1
 
C-----check if RBE3 must be kept----------------------------------
          IF (compt_m>0) THEN
            IF (compt_s==0) THEN
C-----RBE3 intern ->
              tagrb3(i) = id_rbe3
              compt = compt + 1
            ELSE
C-----RBE3 between domains -> all nodes on the interface
              IF (tagno(npart+n2)/=-1) THEN
C-----tag of rbe3 that can see secondary nodes
                tagrb3(i) = id_rbe3
                compt = compt +1
              ENDIF
              DO l=1,val
                gr_id = buf_temp(l)
                DO j=1,igrnod(gr_id)%NENTITY
                  cur_id = igrnod(gr_id)%ENTITY(j)
                  IF (tagno(cur_id+npart)<3) THEN
                    CALL modif_tag(tagno(npart+cur_id),4,modif)
                  ENDIF
                END DO
              END DO
            ENDIF
          ENDIF
          DEALLOCATE(buf_temp)
        END DO
 
        new_nrbe3 = compt
 
C--------------------------------------------------------------------C
C------Prereading and tag of Rigid links -> icompatible with interface-C
C--------------------------------------------------------------------C
 
        IF (passe==0) ALLOCATE(taglnk(nlink))
        taglnk(:)=0
        compt = 0
        CALL hm_option_start('/RLINK')
 
        DO i=1,nlink
          CALL hm_option_read_key(lsubmodel,
     .                            option_id      = id_rlink,
     .                            option_titr    = titr)
          CALL hm_get_intv('dependentnodeset'  ,igu ,is_available,lsubmodel)
C---------------------------------------------------------------------
          gr_id = 0
          DO j=1,ngrnod
            IF (igrnod(j)%ID==igu) gr_id = j
          END DO
C
          IF (gr_id > 0) THEN
C-----check if rlink must be kept-----------------------------------
            tag = 0
            nod=igrnod(gr_id)%R2R_ALL
            IF (igrnod(gr_id)%R2R_SHARE==0) tag = 1
C-----tag of rlink and of all nodes--------------------------------
            IF (nod>0) THEN
              compt = compt+1
              taglnk(i)=id_rlink
              IF(tag/=1) THEN
C-----RLINK between domains -> all nodes on the interface
                DO j=1,igrnod(gr_id)%NENTITY
                  cur_id = igrnod(gr_id)%ENTITY(j)
                  IF (tagno(cur_id+npart)<3) THEN
                    CALL modif_tag(tagno(npart+cur_id),5,modif)
                  ENDIF
                END DO
              ENDIF
            ENDIF
          ENDIF
C
        END DO
 
        new_nlink = compt
C
C-------------------------------------------------------------------C
C------Prereading and tag of contact interfaces --------------------C
C----  if contact between domains > pretag of needed elements-------C
C-------------------------------------------------------------------C
C
        compt_t2 = 0
        nb_int = 0
        kcur = kinter
C
C-->  for TYPE19 interfaces NSLASH(KCUR) > NINTER because of specific /card for TYPE19
        IF (passe==0) ALLOCATE(tagint(hm_ninter+nslash(kcur)),tagint_warn(ninter+1))
C
C--     -> FOR TAGINT subinterfaces are stored with interfaces in order of the reader
C--     -> TAGINT( --- INTER new reader + SUB interfaces --- INTER old reader -- )
C
        tagint(:)=0
        tagint_warn(:)=0
        flg_tied(:) = 0
C
C-------------------------------------------------------------------C
C---------------------------- New Reader ---------------------------C
C-------------------------------------------------------------------C
C
        CALL hm_option_start('/INTER')
        ni = 0
        compt = 0
C
        DO i=1,hm_ninter
C
          tag = 0
          val = iddom
          type2 = 0
C
          CALL hm_option_read_key(lsubmodel,
     .                            option_id = id_inter,
     .                            unit_id = nul,
     .                            submodel_id = sub_id,
     .                            option_titr = titr,
     .                            keyword2 = key,
     .                            keyword3 = key2)
C
          tag = 0
          val = iddom
          type2 = 0
C
          flg = 0
          IF (key(6:6)=='/') flg = 1
          IF ((len_trim(key))==5) flg = 1
c
          grnod_t24t25 = 0
          flag_t24t25 = 0
          IF ((key(1:6)=='TYPE24').OR.(key(1:6)=='TYPE25')) THEN
            flag_t24t25 = 1
            CALL hm_get_intv('secondaryentityids',grs,is_available,lsubmodel)
            CALL hm_get_intv('GRNOD_ID',grnod_t24t25,is_available,lsubmodel)
C           if grs and grnod are defined grnod is ignored            
            IF ((grs > 0).AND.(grnod_t24t25 > 0)) grnod_t24t25 = 0         
          ENDIF
C
C ---------> case nodes/surfaces---------------------------------------
          IF (((key(1:5)=='TYPE2').AND.(flg==1)).OR.
     .         (key(1:5)=='TYPE7').OR.(key(1:5)=='TYPE5').OR.(key(1:5)=='TYPE8').OR.
     .         (key(1:6)=='TYPE10').OR.(key(1:6)=='TYPE14').OR.
     .         ((key(1:6)=='TYPE24').AND.(grnod_t24t25 > 0)).OR.
     .         ((key(1:6)=='TYPE25').AND.(grnod_t24t25 > 0))) THEN
            cont = 1
            CALL hm_get_intv('secondaryentityids',grs,is_available,lsubmodel)
            CALL hm_get_intv('mainentityids',grm,is_available,lsubmodel)
C            
C--         TYPE24 and TYPE25 with secondary side defined by grnod         
            IF (flag_t24t25 == 1) grs = grnod_t24t25
C
C--> type2 interfaces with penality are treated like type7  <------C
            IF ((key(1:5)=='TYPE2').AND.(flg==1)) THEN
              CALL hm_get_intv('WFLAG',sptfl,is_available,lsubmodel)
              IF ((sptfl/=25).AND.(sptfl/=26)) THEN
                cont = 0
                type2 = 1
              ENDIF
            ENDIF
 
C--> check if the contact is between domains and if it is asymmetric  <------C
            CALL tagint_r2r(g1,g2,grs,grm,id_inter,
     .                      type2,val,tag,i,compt,passe,0,igrpp_r2r,
     .                      igrnod ,igrsurf ,igrslin, igrbric)
 
C--> for type 2 contact type5 r2r coupling is used to prevent null mass on nodes
            IF (type2==1) THEN
              DO j=1,igrnod(g1)%NENTITY
                cur_id = igrnod(g1)%ENTITY(j)
                IF (tagno(cur_id+npart)==2) flg_tied(4) = 1
                IF (tagno(cur_id+npart)==4) flg_tied(5) = 1
              END DO
            ENDIF
C-->
            IF (tag>0) THEN
              compt_t2 = compt_t2 + 1
C--> pretag of elts on main side of contact to keep them with void material <---C
              IF ((tag==3).OR.(tag==1).OR.(tag==4)) THEN
                CALL tag_elem_void_r2r(igrsurf(g2)%NSEG,iparts,
     .          ipartc,ipartg,ipartsp,val,cont,modif,memtr,0,0,eani,
     .          igrsurf(g2),igrnod,g2)
              ENDIF
C--> pretag of elts on second. side of contact to keep them with void material <---C
              IF ((tag==2).OR.(tag==1)) THEN
                CALL tag_elem_void_r2r(igrnod(g1)%NENTITY,iparts,
     .          ipartc,ipartg,ipartsp,val,cont,modif,memtr,0,1,eani,
     .          igrsurf,igrnod,g1)
              ENDIF
            ENDIF
C
C ---------> case of TYPE18 contact interface---------------------------------------
          ELSEIF (key(1:6) == 'TYPE18') THEN
            cont = 1
            CALL hm_get_intv('ALEelemsEntityids',gr_bric,is_available,lsubmodel)
            CALL hm_get_intv('ALEnodesEntityids',grs,is_available,lsubmodel)
            CALL hm_get_intv('mainentityids',grm,is_available,lsubmodel)
 
C--> check if the contact is between domains and if it is asymmetric  <------C
            IF (grs > 0) THEN
              CALL tagint_r2r(g1,g2,grs,grm,id_inter,
     .                        type2,val,tag,i,compt,passe,0,igrpp_r2r,
     .                        igrnod ,igrsurf ,igrslin, igrbric)
            ELSEIF (gr_bric > 0) THEN
              CALL tagint_r2r(g1,g2,gr_bric,grm,id_inter,
     .                        type2,val,tag,i,compt,passe,3,igrpp_r2r,
     .                        igrnod ,igrsurf ,igrslin, igrbric)
            ENDIF
C-->
            IF (tag > 0) THEN
              compt_t2 = compt_t2 + 1
C--> pretag of elts on main side of contact to keep them with void material <---C
              IF ((tag == 3) .OR. (tag == 1) .OR. (tag == 4)) THEN
                CALL tag_elem_void_r2r(igrsurf(g2)%NSEG,iparts,
     .          ipartc,ipartg,ipartsp,val,cont,modif,memtr,0,0,eani,
     .          igrsurf(g2),igrnod,g2)
              ENDIF
C--> pretag of elts on second. side of contact to keep them with void material <---C
              IF ((tag == 2) .OR. (tag == 1)) THEN
                IF (grs > 0) THEN
                  CALL tag_elem_void_r2r(igrnod(g1)%NENTITY,iparts,
     .            ipartc,ipartg,ipartsp,val,cont,modif,memtr,0,1,eani,
     .            igrsurf,igrnod,g1)
                ELSEIF (gr_bric > 0) THEN
                  DO j=1,igrbric(g1)%NENTITY
                    cur_id = igrbric(g1)%ENTITY(j)
C------------------------>   Tag of solid elements of grbric  <-------------C
                    IF ((tag_els(cur_id+npart)<(1+cont)).AND.(tagno(iparts(cur_id))/=val)) THEN
                      CALL modif_tag(tag_els(cur_id+npart),1+cont,modif)
                    ENDIF
                  ENDDO
                ENDIF
              ENDIF
            ENDIF
C
          ELSEIF (key(1:6)=='TYPE11') THEN
            cont = 1
            warn = 0
            CALL hm_get_intv('secondaryentityids',grs,is_available,lsubmodel)
            CALL hm_get_intv('mainentityids',grm,is_available,lsubmodel)
C--> check if the contact is between domains and if it is asymmetric  <------C
            CALL tagint_r2r(g1,g2,grs,grm,id_inter,
     .                      type2,val,tag,i,compt,passe,2,igrpp_r2r,
     .                      igrnod ,igrsurf ,igrslin, igrbric)
            IF (tag>0) THEN
              compt_t2 = compt_t2 + 1
C--> pretag of elts of line1 to keep them with void material <---C
              IF ((tag==2).OR.(tag==1)) THEN
                CALL tag_elem_void_r2r_lin(igrslin(g1)%NSEG,
     .          iparts,ipartc,ipartg,ipartt,ipartp,ipartr,val,cont,
     .          modif,warn,igrslin(g1))
              ENDIF
C--> pretag of elts of line2 to keep them with void material <---C
              IF ((tag==3).OR.(tag==1)) THEN
                CALL tag_elem_void_r2r_lin(igrslin(g2)%NSEG,
     .          iparts,ipartc,ipartg,ipartt,ipartp,ipartr,val,cont,
     .          modif,warn,igrslin(g2))
              ENDIF
            ENDIF
            IF (warn==1) THEN
              CALL ancmsg(msgid=892,
     .                    msgtype=msgerror,
     .                    anmode=anstop,
     .                    i1=id_inter)
            ENDIF
          ELSEIF (key(1:6)=='TYPE24'.OR.key(1:6)=='TYPE21'.OR.key(1:5)=='TYPE6'.OR.
     .              key(1:6)=='TYPE23'.OR.key(1:6)=='TYPE20'.OR.key(1:6)=='TYPE15'.OR.
     .              key(1:6)=='TYPE25'.OR.((key(1:5)=='TYPE3').AND.(flg==1))) THEN
            cont = 1
            CALL hm_get_intv('secondaryentityids',grs,is_available,lsubmodel)
            CALL hm_get_intv('mainentityids',grm,is_available,lsubmodel)
            IF ((flag_t24t25 == 1).AND.(grm==0)) grm = grs
C--> check if the contact is between domains and if it is asymmetric  <------C
            CALL tagint_r2r(g1,g2,grs,grm,id_inter,
     .                      type2,val,tag,i,compt,passe,1,igrpp_r2r,
     .                      igrnod ,igrsurf ,igrslin, igrbric)
            IF (tag>0) THEN
              compt_t2 = compt_t2 + 1
C--> pretag of elts of surface 1 to keep them with void material <---C
              IF ((tag==2).OR.(tag==1)) THEN
                CALL tag_elem_void_r2r(igrsurf(g1)%NSEG,iparts,
     .          ipartc,ipartg,ipartsp,val,cont,modif,memtr,0,0,eani,
     .          igrsurf(g1),igrnod,g1)
              ENDIF
C--> pretag of elts of surface 2 to keep them with void material <---C
              IF ((tag==3).OR.(tag==1)) THEN
                CALL tag_elem_void_r2r(igrsurf(g2)%NSEG,iparts,
     .          ipartc,ipartg,ipartsp,val,cont,modif,memtr,0,0,eani,
     .          igrsurf(g2),igrnod,g2)
              ENDIF
            ENDIF
C
C ---------> other contact interfaces not compatible with multidomains
          ELSEIF (key(1:3)/='SUB') THEN
            CALL ancmsg(msgid=835,
     .                msgtype=msgerror,
     .                anmode=aninfo,
     .                i1=id_inter,
     .                c1=line(1:13))
          ENDIF
 
        END DO
C
        new_hm_ninter = compt
        new_ninter     = 0
        new_nslash_int = 0
C
C-------------------------------------------------------------------C
C------Prereading and tag of ∕INTER/SUB ----------------------------C
C-------------------------------------------------------------------C
C
        CALL hm_option_start('/INTER')
C
        compt = 0
        DO i=1,hm_ninter
C
          CALL hm_option_read_key(lsubmodel,
     .                            option_id = id_inter,
     .                            unit_id = nul,
     .                            submodel_id = sub_id,
     .                            option_titr = titr,
     .                            keyword2 = key,
     .                            keyword3 = key2)
C
          IF (key(1:3)=='SUB') THEN
            CALL hm_get_intv('InterfaceId',idint,is_available,lsubmodel)
C
            DO j=1,hm_ninter+nslash(kcur)
              IF (tagint(j)==idint) THEN
                tagint(i) = id_inter
                compt = compt + 1
              ENDIF
            END DO
 
          ENDIF
C
        END DO
C
        new_nintsub = compt
        new_hm_ninter = new_hm_ninter + compt
C
C--------------------------------------------------------------------C
C------Prereading and tag of rigid bodies ---------------------------C
C--------------------------------------------------------------------C
 
        ni=0
        nb_rby = 0
        nb_kin = 0
        nb_lag = 0
        IF (passe==0) ALLOCATE(tagrby(nrbody))
        tagrby(:)=0
        doma = 1
 
C--------------------------------------------------
C START BROWSING MODEL RBODY
C--------------------------------------------------
        CALL hm_option_start('/RBODY')
        nrb = 0
        DO i=1,nrbody
C--------------------------------------------------
C EXTRACT DATAS OF /RBODY/... LINE
C--------------------------------------------------
          key=''
          CALL hm_option_read_key(lsubmodel,
     .                       option_id = id_rby,
     .                       keyword2 = key,
     .                       option_titr = titr)
C---------
          IF(key(1:6)=='LAGMUL') cycle
C---------
          nrb=nrb+1
C---------
          CALL hm_get_intv('node_ID',main,is_available,lsubmodel)
          CALL hm_get_intv('sens_ID',isens,is_available,lsubmodel)
          CALL hm_get_intv('grnd_ID',igu,is_available,lsubmodel)
C---------
          main=usr2sys(main,itabm1,mess,id_rby)
          DO j=1,ngrnod
            IF (igrnod(j)%ID==igu) gr_id = j
          END DO
C-----check if RBODY must be kept----------------------------------
          tag = 0
          compt=igrnod(gr_id)%R2R_ALL
          compt2=igrnod(gr_id)%R2R_SHARE
C--> check of tag of the main node
          IF (tagno(main+npart)>1) compt = compt + 1
          IF (tagno(main+npart)>1) compt2 = compt2 + 1
          IF (compt2==0) tag = 1
C-----tag of the main node-----------------------------------------
          IF (compt>0) THEN
            IF(tag==1) THEN
C-----RGBODY intern ->
              CALL modif_tag(tagno(npart+main),1,modif)
            ELSE
C-----RGBODY between domains -> all nodes one the r2r interface
              IF (tagno(main+npart)<3) THEN
                CALL modif_tag(tagno(npart+main),3,modif)
                IF (isens/=0) THEN
                  CALL ancmsg(msgid=976,
     .                        msgtype=msgerror,
     .                        anmode=aninfo,
     .                        c1="FOR RBODY ID=",
     .                        i1=id_rby,
     .                        c2="- RBODY WITH SENSOR")
                ENDIF
              ENDIF
            ENDIF
C-----tag of the RBODY to keep it
            tagrby(i)=id_rby
            nb_rby = nb_rby + 1
            nb_kin = nb_kin + 1
          ENDIF
        END DO
        new_nrbykin=nb_kin
 
C--------------------------------------------------
C START BROWSING MODEL /RBODY/LAGMUL
C--------------------------------------------------
        CALL hm_option_start('/RBODY')
        nrb = 0
        DO i=1,nrbody
C--------------------------------------------------
C EXTRACT DATAS OF /RBODY/... LINE
C--------------------------------------------------
          key=''
          CALL hm_option_read_key(lsubmodel,
     .                        option_id = id_rby,
     .                        keyword2 = key,
     .                        option_titr = titr)
C---------
          IF(key(1:6)=='LAGMUL') THEN
            nrb=nrb+1
C--------Temporarily RBY/LAGMUL are not allowed
            CALL ancmsg(msgid=835,
     .                  msgtype=msgerror,
     .                  anmode=aninfo,
     .                  c1=line(1:l+9))
C-----------------------------------------------------------------
            CALL hm_get_intv('node_ID',main,is_available,lsubmodel)
            CALL hm_get_intv('grnd_ID',igu,is_available,lsubmodel)
C--------Temporarily RBY/LAGMUL are not allowed
            main=usr2sys(main,itabm1,mess,id_rby)
            DO j=1,ngrnod
              IF (igrnod(j)%ID==igu) gr_id = j
            END DO
 
C-----check if RBODY kas to be kept--------------------------------
 
            tag = 0
            compt=igrnod(gr_id)%R2R_ALL
            compt2=igrnod(gr_id)%R2R_SHARE
C--> check of tag of the main node
            IF (tagno(main+npart)>1) compt = compt + 1
            IF (tagno(main+npart)>1) compt2 = compt2 + 1
            IF (compt2==0) tag = 1
 
C-----Tag of the main node-----------------------------------------
 
            IF (compt>0) THEN
              IF(tag==1) THEN
C-----RGBODY intern ->
                CALL modif_tag(tagno(npart+main),1,modif)
              ELSE
C-----RGBODY between domains -> all nodes one the r2r interface
                IF (tagno(main+npart)<3) THEN
                  CALL modif_tag(tagno(npart+main),3,modif)
                ENDIF
              ENDIF
C-----tag of the RBODY to keep it-----------------------------------
              tagrby(i)=id_rby
              nb_rby = nb_rby + 1
              nb_lag = nb_lag + 1
            ENDIF  ! IF (COMPT>0) THEN
          END IF ! IF(KEY(1:6)=='LAGMUL') THEN
        END DO
 
        new_nrby     = nb_rby
        nrbylag      = nb_lag
 
C--------------------------------------------------------------------C
C------Prereading and tag of /SPHBCS --------------------------------C
C--------------------------------------------------------------------C
 
        nspcondn = 0
        CALL hm_option_start('/SPHBCS')
        IF (passe==0) ALLOCATE(tagsphbcs(nspcond))
        tagsphbcs(:) = 0
        DO i=1,nspcond
          CALL hm_option_read_key(lsubmodel,
     .                         option_id = id,
     .                         option_titr = titr,
     .                         keyword2 = key)
          CALL hm_get_intv('entityid',igu,is_available,lsubmodel)
C---------------------------------------------------------------------
          gr_id = 0
          DO j=1,ngrnod
            IF (igrnod(j)%ID==igu) gr_id = j
          END DO
C---------------------------------------------------------------------
          compt = 0
          DO l=1,igrnod(gr_id)%NENTITY
            cur_id = nod2sp(igrnod(gr_id)%ENTITY(l))
            IF (tagno(ipartsp(cur_id))/=0) THEN
              compt = compt + 1
            ENDIF
          ENDDO
C---------------------------------------------------------------------
          IF (compt>0) THEN
            nspcondn = nspcondn + 1
            tagsphbcs(i) = id
          ENDIF
        END DO
 
C--------------------------------------------------------------------C
C------Prereading /EBCS (for ALE)------------------------------------C
C--------------------------------------------------------------------C
C
        new_nebcs = 0
        CALL hm_option_start('/EBCS')
        DO i=1,nebcs
          CALL hm_option_read_key(lsubmodel,
     .                            option_id = id,
     .                            option_titr = titr)
          CALL hm_get_intv('entityid',isur,is_available,lsubmodel)
C---------------------------------------------------------------------
          isurs = 0
          DO j=1,nsurf
            IF(isur==igrsurf(j)%ID) isurs=j
          ENDDO
C---------------------------------------------------------------------
C         Surface defined on ALE elements only
C         All EBCS in the domain is ALE -> TAG_EBCS not nedded
C         detection with segments initially on the domain             
          IF (isurf_r2r(3,isurs)>0) THEN
            new_nebcs = new_nebcs + 1
          ENDIF
        END DO
C
C--------------------------------------------------------------------C
C------Prereading and tag of inlets/outlets for SPH -----------------C
C--------------------------------------------------------------------C
 
 
        nsphion = 0
        IF (passe == 0) ALLOCATE(tagsphio(nsphio))
        tagsphio(:) = 0
        CALL hm_option_start('/SPH/INOUT')
        DO i = 1,nsphio
          ! Title and ID
          titr = ''
          CALL hm_option_read_key(lsubmodel,
     .                            option_id   = id,
     .                            option_titr = titr)
          CALL hm_get_intv('pid'     ,id_part  ,is_available,lsubmodel)
          CALL hm_get_intv('SURF_ID' ,isur     ,is_available,lsubmodel)
C--------------------------------------------------------------------
          DO j=1,npart
            IF (ipart_l(4,j) == id_part) ids = j
          ENDDO
          DO j=1,nsurf
            IF (igrsurf(j)%ID == isur)   g2  = j
          END DO
C--------------------------------------------------------------------
          IF (tagno(ids) /= 0) THEN
            CALL tag_elem_void_r2r(igrsurf(g2)%NSEG,iparts,
     .          ipartc,ipartg,ipartsp,1,0,modif,memtr,-2,0,eani,
     .          igrsurf(g2),igrnod,g2)
            nsphion     = nsphion + 1
            tagsphio(i) = id
          ENDIF
        END DO
 
C--------------------------------------------------------------------C
C------Prereading of ALE/LINK----------------------------------------C
C--------------------------------------------------------------------C
 
        CALL hm_option_count('/ALE/LINK/VEL', nalelk)
        IF (nalelk > 0) THEN
          CALL hm_option_start('/ALE/LINK/VEL')
          DO i = 1, nalelk
            CALL hm_option_read_key(lsubmodel, option_id = id, option_titr = titr)
            CALL hm_get_intv('node_ID1', n1, is_available, lsubmodel)
            CALL hm_get_intv('node_ID2', n2, is_available, lsubmodel)
            CALL hm_get_intv('grnod_ID', gr_id, is_available, lsubmodel)
            DO j = 1, ngrnod
              IF (igrnod(j)%ID == gr_id) THEN
                gr_id = j
                EXIT
              ENDIF
            ENDDO
            n1 = usr2sys(n1, itabm1, mess, id)
            n2 = usr2sys(n2, itabm1, mess, id)
            IF (n1 > 0) THEN
              IF ((igrnod(gr_id)%R2R_ALL > 0) .AND. (tagno(npart+n1) < 1)) THEN
                CALL modif_tag(tagno(npart + n1), 2, modif)
              ELSEIF ((igrnod(gr_id)%R2R_SHARE > 0) .AND. (tagno(npart+n1) == 1)) THEN
                CALL modif_tag(tagno(npart+n1), 2, modif)
              ELSEIF (tagno(npart+n1) == 0) THEN
                CALL modif_tag(tagno(npart+n1), 2, modif)
              ELSEIF (tagno(npart+n1) == -1) THEN
                CALL modif_tag(tagno(npart+n1), 0, modif)
              ENDIF
            ENDIF
            IF (n2 > 0) THEN
              IF ((igrnod(gr_id)%R2R_ALL > 0) .AND. (tagno(npart+n2) < 1)) THEN
                CALL modif_tag(tagno(npart+n2), 2, modif)
              ELSEIF ((igrnod(gr_id)%R2R_SHARE > 0) .AND. (tagno(npart+n2) == 1)) THEN
                CALL modif_tag(tagno(npart+n2), 2, modif)
              ELSEIF (tagno(npart+n2) == 0) THEN
                CALL modif_tag(tagno(npart+n2), 2, modif)
              ELSEIF (tagno(npart+n2) == -1) THEN
                CALL modif_tag(tagno(npart+n2), 0, modif)
              ENDIF
            ENDIF
          ENDDO
        ENDIF
 
C--------------------------------------------------------------------C
C------Prereading and tag of RWALL-----------------------------------C
C--------------------------------------------------------------------C
 
        CALL hm_option_start('/RWALL')
C
        DO i=1,nrwall
C
          CALL hm_option_read_key(lsubmodel,
     .                            option_id = id_mon,
     .                            keyword2 = key)
C
          IF (key(1:7) == 'LAGMUL') THEN
C--------RWALL /LAGMUL not allowed with multidomains
            CALL ancmsg(msgid=835,
     .                  msgtype=msgerror,
     .                  anmode=aninfo,
     .                  c1=line(1:l+6))
          ELSE
            CALL hm_get_intv('Node1',nod,is_available,lsubmodel)
            IF (nod>0) THEN
              nod=usr2sys(nod,itabm1,mess,id)
              CALL modif_tag(tagno(npart+nod),4,modif)
            ENDIF
          ENDIF
        ENDDO
 
C--------------------------------------------------------------------C
C------Prereading and tag of INIVOL----------------------------------C
C--------------------------------------------------------------------C
 
        new_ninivol = 0
        IF (passe==0) ALLOCATE(tag_inivol(num_inivol))
        tag_inivol(:) = 0
        CALL hm_option_start('/INIVOL')
 
        DO i=1,num_inivol
          CALL hm_option_read_key(lsubmodel, option_id=id, option_titr=titr)
          CALL hm_get_intv('secondarycomponentlist', id_part, is_available, lsubmodel)
C
          DO j=1,npart
            IF(ipart_l(4,j)==id_part) ids=j
          ENDDO
C
          IF (tagno(ids) > 0) THEN
            tag_inivol(i) = id
            new_ninivol = new_ninivol + 1
          ENDIF
        ENDDO
 
C--------------------------------------------------------------------C
C------Prereading of /TRANSFORM--------------------------------------C
C--------------------------------------------------------------------C
C
        CALL hm_option_count('TRANSFORM',ntrans)
        CALL hm_option_start('TRANSFORM')
C
        DO i=1,ntrans
C
          CALL hm_option_read_key(lsubmodel,
     .                            option_id = id,
     .                            keyword2 = key)
C
          nnode_transform = 0
          node_transform(1:6) = 0
C
          IF ((key(1:3)=='TRA').OR.(key(1:3)=='ROT').OR.(key(1:3)=='SYM')) THEN
            nnode_transform = 2
            CALL hm_get_intv('node1',node_transform(1),is_available,lsubmodel)
            CALL hm_get_intv('node2',node_transform(2),is_available,lsubmodel)
          ELSEIF (key(1:3)=='SCA') THEN
            nnode_transform = 1
            CALL hm_get_intv('node1',node_transform(1),is_available,lsubmodel)
          ELSEIF (key(1:3)=='POS') THEN
            nnode_transform = 6
            CALL hm_get_intv('node1',node_transform(1),is_available,lsubmodel)
            CALL hm_get_intv('node2',node_transform(2),is_available,lsubmodel)
            CALL hm_get_intv('node3',node_transform(3),is_available,lsubmodel)
            CALL hm_get_intv('node4',node_transform(4),is_available,lsubmodel)
            CALL hm_get_intv('node5',node_transform(5),is_available,lsubmodel)
            CALL hm_get_intv('node6',node_transform(6),is_available,lsubmodel)
          ENDIF
C
          DO j=1,nnode_transform
            IF (node_transform(j) > 0) THEN
              nod=usr2sys(node_transform(j),itabm1,mess,id)
              IF (tagno(npart+nod) == -1) CALL modif_tag(tagno(npart+nod),0,modif)
            ENDIF
          ENDDO
C
        ENDDO
C
C--------------------------------------------------------------------C
C------Prereading of detonation points-------------------------------C
C--------------------------------------------------------------------C
        CALL hm_option_start('/DFS/DETPOIN')
        DO i=1,detonators%N_DET_POINT
          CALL hm_option_read_key(lsubmodel,option_id = id,keyword2 = key)
          CALL hm_get_intv('rad_det_node1', nod, is_available, lsubmodel)
          IF (nod>0) THEN
            nod=usr2sys(nod,itabm1,mess,id)
            IF (tagno(npart+nod) == -1) CALL modif_tag(tagno(npart+nod),0,modif)
          ENDIF
        ENDDO
 
C------------------------------------------------------------------
 
        RETURN
 
C------------------------------------------------------------------
 
      END SUBROUTINE r2r_prelec
 
!||====================================================================
!||    r2r_monvol               ../starter/source/coupling/rad2rad/r2r_prelec.F
!||--- called by ------------------------------------------------------
!||    r2r_split                ../starter/source/coupling/rad2rad/r2r_split.F
!||--- calls      -----------------------------------------------------
!||    hm_get_int_array_index   ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
!||    hm_get_intv              ../starter/source/devtools/hm_reader/hm_get_intv.F
!||    hm_option_read_key       ../starter/source/devtools/hm_reader/hm_option_read_key.F
!||    hm_option_start          ../starter/source/devtools/hm_reader/hm_option_start.F
!||    usr2sys                  ../starter/source/system/sysfus.F
!||--- uses       -----------------------------------------------------
!||    hm_option_read_mod       ../starter/share/modules1/hm_option_read_mod.F
!||    r2r_mod                  ../starter/share/modules1/r2r_mod.F
!||    restmod                  ../starter/share/modules1/restart_mod.F
!||    submodel_mod             ../starter/share/modules1/submodel_mod.F
!||====================================================================
      SUBROUTINE r2r_monvol(TAGPART,TAGPRO,IGRSURF,LSUBMODEL)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE restmod
        USE r2r_mod
        USE groupdef_mod
        USE submodel_mod
        USE hm_option_read_mod
        USE names_and_titles_mod , ONLY : nchartitle, ncharkey
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "r2r_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER TAGPART(*),TAGPRO(*)
        TYPE (SURF_)   , DIMENSION(NSURF)   :: IGRSURF
        TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
        INTEGER USR2SYS
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER I,NUL,COMPT,TYPE,J,ISUR,ISURS,FLAG,K,CCPL
        INTEGER CPT_NOD,CPT_SEG,CPT_CPL,CUR_ID,IAD,CPT_SEG2
        INTEGER MAT_ID,NJET,IJET,N1,N2,N3,WARN
        CHARACTER MESS*40
        CHARACTER(LEN=NCHARTITLE)::TITR
        CHARACTER(LEN=NCHARKEY)::KEY
        DATA MESS/'INJECTORS '/
        LOGICAL :: IS_AVAILABLE
C=======================================================================
 
C--------------------------------------------------------------------C
C------Prereading and tag of injectors (MONVOL)----------------------C
C--------------------------------------------------------------------C
 
        CALL hm_option_start('/MONVOL')
C
        DO i=1,nmonvol
C
          CALL hm_option_read_key(lsubmodel,
     .                            keyword2 = key)
C
          IF(key(1:7)=='AIRBAG1')THEN
            TYPE = 1
            CALL hm_get_intv('surf_IDex', isur, is_available, lsubmodel)
          ELSEIF(key(1:6)=='AIRBAG')THEN
            TYPE = 2
            CALL hm_get_intv('entityiddisplayed', isur, is_available, lsubmodel)
          ELSEIF(key(1:6)=='COMMU1')THEN
            TYPE = 3
            CALL hm_get_intv('surf_IDex', isur, is_available, lsubmodel)
          ELSEIF(key(1:5)=='COMMU')THEN
            TYPE = 4
            CALL hm_get_intv('surf_IDex', isur, is_available, lsubmodel)
          ELSE
            TYPE = 0
            CALL hm_get_intv('surf_IDex', isur, is_available, lsubmodel)
          ENDIF
 
C----------------------------------------------------------
          DO j=1,nsurf
            IF (isur==igrsurf(j)%ID) isurs=j
          ENDDO
          cpt_seg=0
          ccpl=0
          flag=0
          DO j=1,igrsurf(isurs)%NSEG
            cpt_nod=0
            cpt_cpl=0
            DO k=1,4
              cur_id = igrsurf(isurs)%NODES(j,k)
C             --> count of taged nodes <--
              IF (tagno(cur_id+npart)>=0) THEN
                cpt_nod=cpt_nod+1
                IF (tagno(cur_id+npart)==2) cpt_cpl=cpt_cpl+1
              ENDIF
            END DO
C             --> if all the nodes of the segment are in the subdomain -it's validated <--
            IF (cpt_cpl/=0) warn = 1
            IF (cpt_nod==4) cpt_seg=cpt_seg+1
          END DO
C--------MONVOL not allowed on multidomains interface--------------------------
C    IF (WARN>0) THEN
C          CALL ANSTCKC(LEN_TRIM(LINE),LINE)
C                CALL ANCWARN(843,ANINFO_BLIND_1)
C    ENDIF
C-------Case AIRBAG1----------------------------------------
          IF ((type==1).AND.(tagmon(i)>0)) THEN
            CALL hm_get_intv('nb_jet', njet, is_available, lsubmodel)
C             --> loop on injectors <--
            DO j=1,njet
              CALL hm_get_int_array_index('ijet', ijet, j, is_available, lsubmodel)
              CALL hm_get_int_array_index('node1', n1, j, is_available, lsubmodel)
              CALL hm_get_int_array_index('node2', n2, j, is_available, lsubmodel)
              CALL hm_get_int_array_index('node3', n3, j, is_available, lsubmodel)
              IF (ijet==1) THEN
                IF (n1/=0) THEN
                  n1=usr2sys(n1,itabm1,mess,nul)
                  IF(tagno(n1+npart)<2) tagno(n1+npart) = 1
                ENDIF
                IF (n2/=0) THEN
                  n2=usr2sys(n2,itabm1,mess,nul)
                  IF(tagno(n2+npart)<2) tagno(n2+npart) = 1
                ENDIF
                IF (n3/=0) THEN
                  n3=usr2sys(n3,itabm1,mess,nul)
                  IF(tagno(n3+npart)<2) tagno(n3+npart) = 1
                ENDIF
              ENDIF
            END DO
          ENDIF
C-------Case AIRBAG----------------------------------------
          IF ((type==2).AND.(tagmon(i)>0)) THEN
            CALL hm_get_intv('ABG_Njet', njet, is_available, lsubmodel)
C             --> loop on injectors <--
            DO j=1,njet
              CALL hm_get_int_array_index('ABG_Ijet', ijet, j,is_available, lsubmodel)
              CALL hm_get_int_array_index('ABG_N1', n1, j,is_available, lsubmodel)
              CALL hm_get_int_array_index('ABG_N2', n2, j,is_available, lsubmodel)
              CALL hm_get_int_array_index('ABG_N3', n3, j,is_available, lsubmodel)
C
              IF (ijet==1) THEN
                IF (n1/=0) THEN
                  n1=usr2sys(n1,itabm1,mess,nul)
                  IF(tagno(n1+npart)<2) tagno(n1+npart) = 1
                ENDIF
                IF (n2/=0) THEN
                  n2=usr2sys(n2,itabm1,mess,nul)
                  IF(tagno(n2+npart)<2) tagno(n2+npart) = 1
                ENDIF
                IF (n3/=0) THEN
                  n3=usr2sys(n3,itabm1,mess,nul)
                  IF(tagno(n3+npart)<2) tagno(n3+npart) = 1
                ENDIF
              ENDIF
            END DO
          ENDIF
C-------Case COMMU-----------------------------------------
          IF ((type==4).AND.(tagmon(i)>0)) THEN
            CALL hm_get_intv('Njet', njet, is_available, lsubmodel)
C             --> loop on injectors <--
            DO j=1,njet
              CALL hm_get_int_array_index('Ijet', ijet, j,is_available, lsubmodel)
              CALL hm_get_int_array_index('ABG_N1',   n1, j,is_available, lsubmodel)
              CALL hm_get_int_array_index('node_ID2', n2, j,is_available, lsubmodel)
              CALL hm_get_int_array_index('node_ID3', n3, j,is_available, lsubmodel)
C
              IF (ijet==1) THEN
                IF (n1/=0) THEN
                  n1=usr2sys(n1,itabm1,mess,nul)
                  IF(tagno(n1+npart)<2) tagno(n1+npart) = 1
                ENDIF
                IF (n2/=0) THEN
                  n2=usr2sys(n2,itabm1,mess,nul)
                  IF(tagno(n2+npart)<2) tagno(n2+npart) = 1
                ENDIF
                IF (n3/=0) THEN
                  n3=usr2sys(n3,itabm1,mess,nul)
                  IF(tagno(n3+npart)<2) tagno(n3+npart) = 1
                ENDIF
              ENDIF
            END DO
          ENDIF
C-------Case COMMU1----------------------------------------
          IF ((type==3).AND.(tagmon(i)>0)) THEN
            CALL hm_get_intv('Njet', njet, is_available, lsubmodel)
C             --> loop on injectors <--
            DO j=1,njet
              CALL hm_get_int_array_index('Ijet', ijet, j,is_available, lsubmodel)
              CALL hm_get_int_array_index('ABG_N1', n1, j,is_available, lsubmodel)
              CALL hm_get_int_array_index('ABG_N2', n2, j,is_available, lsubmodel)
              CALL hm_get_int_array_index('ABG_N3', n3, j,is_available, lsubmodel)
C
              IF (ijet==1) THEN
                IF (n1/=0) THEN
                  n1=usr2sys(n1,itabm1,mess,nul)
                  IF(tagno(n1+npart)<2) tagno(n1+npart) = 1
                ENDIF
                IF (n2/=0) THEN
                  n2=usr2sys(n2,itabm1,mess,nul)
                  IF(tagno(n2+npart)<2) tagno(n2+npart) = 1
                ENDIF
                IF (n3/=0) THEN
                  n3=usr2sys(n3,itabm1,mess,nul)
                  IF(tagno(n3+npart)<2) tagno(n3+npart) = 1
                ENDIF
              ENDIF
            END DO
          ENDIF
C---------------------------------------------------------
        END DO
C
        nmonvol = new_hm_nvolu
        nvolu = new_nvolu
 
C-----------
        RETURN
 
C------------------------------------------------------------------
 
      END SUBROUTINE r2r_monvol