dim_s10edg.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/.
!||====================================================================
!||    dim_s10edg   ../starter/source/elements/solid/solide10/dim_s10edg.F
!||--- called by ------------------------------------------------------
!||    lectur       ../starter/source/starter/lectur.f
!||====================================================================
      SUBROUTINE dim_s10edg(NEDG, IXS10 ,IPARG ,ITAGND)
C=======================================================================
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   A n a l y s e   M o d u l e
C-----------------------------------------------
#include      "param_c.inc"
#include      "com01_c.inc"
 
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NEDG,ITAGND(*)
      INTEGER IXS10(6,*),IPARG(NPARG,NGROUP)
C     REAL
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,NG, NEL, NFT,II, NF2, N, ITY,ISOLNOD,ISROT
C     REAL
C-----------------------------------------------
      nedg = 0
      DO ng=1,ngroup
       nel=iparg(2,ng)
       nft=iparg(3,ng)
       ity=iparg(5,ng)
       isolnod = iparg(28,ng)
       isrot  = iparg(41,ng)
       IF(isolnod == 10) isrot  = iparg(74,ng)
       IF(ity == 1.AND.isolnod == 10.AND.isrot == 2)THEN
        nf2  = nft-numels8
C
        DO i=1,nel
           ii = i+nf2
         DO j = 1 , 6
            n = ixs10(j,ii)
           IF (n >0) THEN
            IF (itagnd(n)==0) THEN
             nedg = nedg + 1
             itagnd(n)=nedg
            END IF
           END IF
         ENDDO
        ENDDO
       END IF
      ENDDO 
C
      RETURN
      END
!||====================================================================
!||    ind_s10edg    ../starter/source/elements/solid/solide10/dim_s10edg.f
!||--- called by ------------------------------------------------------
!||    lectur        ../starter/source/starter/lectur.F
!||--- uses       -----------------------------------------------------
!||====================================================================
      SUBROUTINE ind_s10edg(ICNDS10, IXS, IXS10 ,IPARG,ITAGND)
C=======================================================================
      use element_mod , only : nixs
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   A n a l y s e   M o d u l e
C-----------------------------------------------
#include      "param_c.inc"
#include      "com01_c.inc"
 
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ITAGND(*)
      INTEGER ICNDS10(3,*),IXS(NIXS,*),IXS10(6,*),IPARG(NPARG,*)
C     REAL
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,NG, NEL, NFT,NF1, NF2, N, ITY,ISOLNOD,ISROT,NC(4)
      INTEGER IPERM1(6),IPERM2(6),N1,N2,NEDG,ND,II,JJ
C     REAL
      DATA iperm1/1,2,3,1,2,3/
      DATA iperm2/2,3,1,4,4,4/
C-----------------------------------------------
      nedg = 0
      DO ng=1,ngroup
       nel=iparg(2,ng)
       nft=iparg(3,ng)
       ity=iparg(5,ng)
       isolnod = iparg(28,ng)
       isrot  = iparg(41,ng)
       IF(isolnod == 10) isrot  = iparg(74,ng)
       IF(ity == 1.AND.isolnod == 10.AND.isrot == 2)THEN
        nf1  = nft
        nf2  = nft-numels8
C
        DO i=1,nel
          ii = i + nf1
          jj = i + nf2
          nc(1) =ixs(2,ii)
          nc(2) =ixs(4,ii)
          nc(3) =ixs(7,ii)
          nc(4) =ixs(6,ii)
         DO j = 1 , 6
            n = ixs10(j,jj)
            IF (n >0) THEN
             IF (itagnd(n)==0) THEN
              nedg = nedg + 1
            itagnd(n) = nedg
            n1=iperm1(j)
            n2=iperm2(j)
            icnds10(1,nedg) = n
            icnds10(2,nedg) = nc(n1)
            icnds10(3,nedg) = nc(n2)
             END IF
          END IF
         END DO
        END DO 
       END IF
      ENDDO 
      IF (nedg/=ns10e) THEN
       print *,'error!!! NEDG,NS10EDG=',nedg,ns10e
      END IF
      
C ----- ITAGND : > 0 < NS10E : Id of ICNDS10 (Nd)
C                < 0           to be degenerated      
C                > NS10E : to be tagged first and be degenerated after      
C
      RETURN
      END
!||====================================================================
!||    reord_icnd   ../starter/source/elements/solid/solide10/dim_s10edg.F
!||--- called by ------------------------------------------------------
!||    lectur       ../starter/source/starter/lectur.F
!||====================================================================
      SUBROUTINE reord_icnd(ICNDS10, ITAGND)
C=======================================================================
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICNDS10(3,*), ITAGND(*)
C     REAL
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,ICND_CP(3,NS10E),IE,N
C     REAL
C------reordering for P/ON----------------------------
      icnd_cp(1:3,1:ns10e)=icnds10(1:3,1:ns10e)
C
      ie = 0      
      DO n= 1,numnod
       IF (itagnd(n)>0) THEN
        j = itagnd(n)
        ie = ie + 1
          icnds10(1:3,ie)=icnd_cp(1:3,j)
          itagnd(n) = ie
       END IF
      END DO
      IF (ie /= ns10e) print *,'Error of re-ordering in REORD_ICND',ie,ns10e
C
      RETURN
      END
!||====================================================================
!||    remove_nd              ../starter/source/elements/solid/solide10/dim_s10edg.F
!||--- called by ------------------------------------------------------
!||    hm_read_grav           ../starter/source/loads/general/grav/hm_read_grav.F
!||    hm_read_rwall_cyl      ../starter/source/constraints/general/rwall/hm_read_rwall_cyl.F
!||    hm_read_rwall_lagmul   ../starter/source/constraints/general/rwall/hm_read_rwall_lagmul.F
!||    hm_read_rwall_paral    ../starter/source/constraints/general/rwall/hm_read_rwall_paral.F
!||    hm_read_rwall_plane    ../starter/source/constraints/general/rwall/hm_read_rwall_plane.F
!||    hm_read_rwall_spher    ../starter/source/constraints/general/rwall/hm_read_rwall_spher.F
!||    hm_read_rwall_therm    ../starter/source/constraints/general/rwall/hm_read_rwall_therm.F
!||====================================================================
      SUBROUTINE remove_nd(NN, INN, ITAGND)
C=======================================================================
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NN, INN(*), ITAGND(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,NG, NEL, NFT,NF1, NF2, N,ND
C     REAL
C------remove tagged nodes in INN(*)----------------------------
      nd = 0
      DO i=1,nn
       n = inn(i)
       IF (itagnd(n) ==0 ) THEN
        nd = nd + 1
          inn(nd) =inn(i)
       END IF
      ENDDO 
C      
      nn = nd
C
      RETURN
      END
!||====================================================================
!||    remdeg_nd   ../starter/source/elements/solid/solide10/dim_s10edg.F
!||====================================================================
      SUBROUTINE remdeg_nd(NN, INN, ITAGND)
C=======================================================================
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NN, INN(*), ITAGND(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,NG, NEL, NFT,NF1, NF2, N,ND
C     REAL
C------remove tagged nodes in INN(*) and will be degenerated-----------
      nd = 0
      DO i=1,nn
       n = inn(i)
       IF (itagnd(n) ==0 ) THEN
        nd = nd + 1
          inn(nd) =inn(i)
       ELSEIF (itagnd(n) >0 ) THEN
        itagnd(n) = -itagnd(n)
       END IF
      ENDDO 
C
      nn = nd
C
      RETURN
      END
!||====================================================================
!||    rigmodif_nd     ../starter/source/elements/solid/solide10/dim_s10edg.F
!||--- called by ------------------------------------------------------
!||    hm_read_rbody   ../starter/source/constraints/general/rbody/hm_read_rbody.F
!||--- calls      -----------------------------------------------------
!||    ancmsg          ../starter/source/output/message/message.F
!||    intab           ../starter/source/interfaces/inter3d1/i24tools.F
!||--- uses       -----------------------------------------------------
!||    message_mod     ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE rigmodif_nd(NN, INN, ITAGND,ICNDS10,IU,TITR,ITAB)
C=======================================================================
      USE message_mod
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      "scr03_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NN, INN(*), ITAGND(*),ICNDS10(3,*),IU,ITAB(*)
      CHARACTER TITR*(*)
C     REAL
C-----------------------------------------------
C   External function
C-----------------------------------------------
      LOGICAL INTAB
      EXTERNAL intab
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,NG, NEL, NFT,NF1, NF2, N,ND,N1,N2,NNEW,ID,IER1,IER2
      LOGICAL IS1,IS2
C     REAL
C------treatment for tagged nodes in INN(*) first passe-
C----- IER >0 warning; <0 error out 
C--- 1: (1,nd,2) are in Rbody, nd will be removed from Rbody
C--- 2: (1,nd) or (2,nd) are in Rbody, nd will be removed from Rbody
C--- -1: nd alone is in Rbody
      nnew = 0
      ier1 = 0
      ier2 = 0
      DO i=1,nn
       n = inn(i)
       IF (itagnd(n) /=0 ) THEN
        id = iabs(itagnd(n))
        nd = icnds10(1,id)
        n1 = icnds10(2,id)
        n2 = icnds10(3,id)
        is1 = intab(nn,inn,n1)
        is2 = intab(nn,inn,n2)
        IF (is1.AND.is2) THEN
C----removed from INN and degenerating in 2nd passe----------
         itagnd(n) = itagnd(n) + ns10e
         nnew = nnew + 1
         inn(nnew) =inn(i)
         ier1 =1
         IF (ipri>=5)
     .    CALL ancmsg(msgid=1213,
     .                msgtype=msginfo,
     .                anmode=aninfo_blind_1,
     .                c1='RIGID BODY ',
     .                i1=itab(nd),
     .                prmod=msg_cumu)
        ELSEIF (.NOT.(is1).AND..NOT.(is2)) THEN
C----error out  ND is along in RB
          CALL ancmsg(msgid=1216,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                i1=itab(nd),
     .                c1='RIGID BODY ',
     .                i2=iu,
     .                c2='RIGID BODY ')
        ELSE
C----removed from INN directly----------
         ier2 =1
         IF (ipri>=5)
     .    CALL ancmsg(msgid=1210,
     .                msgtype=msginfo,
     .                anmode=aninfo_blind_1,
     .                c1='RIGID BODY ',
     .                i1=itab(nd),
     .                prmod=msg_cumu)
        END IF
       ELSE
        nnew = nnew + 1
        inn(nnew) =inn(i)
       END IF
      ENDDO 
C      
      nn = nnew
       IF (ier1 >0.AND.ipri>=5) THEN
          CALL ancmsg(msgid=1213,
     .                msgtype=msginfo,
     .                anmode=aninfo_blind_1,
     .                c1='RIGID BODY ',
     .                c2='RIGID BODY ',
     .                i1=iu,
     .                prmod=msg_print)
       END IF 
       IF (ier2 >0.AND.ipri>=5) THEN
          CALL ancmsg(msgid=1210,
     .                msgtype=msginfo,
     .                anmode=aninfo_blind_1,
     .                c1='RIGID BODY ',
     .                c2='RIGID BODY ',
     .                i1=iu,
     .                prmod=msg_print)
       END IF 
      RETURN
      END
!||====================================================================
!||    rigmodif1_nd   ../starter/source/elements/solid/solide10/dim_s10edg.F
!||--- called by ------------------------------------------------------
!||    lectur         ../starter/source/starter/lectur.F
!||====================================================================
      SUBROUTINE rigmodif1_nd(NPBY,LPBY,ITAGND)
C=======================================================================
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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NPBY(NNPBY,*), LPBY(*) ,ITAGND(*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,K,KK,NSL,NSL_N,K_N,NN
C     REAL
C------removing Nd from LPBY(*)--degenerating--
      k = 0
      k_n = 0
      DO n = 1, nrbykin
        nsl=npby(2,n)
        nsl_n = 0
        DO kk = 1, nsl
          nn = lpby(k+kk)
          IF(itagnd(nn)>ns10e)THEN
             itagnd(nn) = -(itagnd(nn)-ns10e)
          ELSE
           nsl_n = nsl_n + 1
             lpby(k_n+nsl_n) =nn
          END IF
        ENDDO
        k = k + nsl
        k_n = k_n + nsl_n
          npby(2,n) = nsl_n
      ENDDO
C
      RETURN
      END
!||====================================================================
!||    rbe2modif_nd   ../starter/source/elements/solid/solide10/dim_s10edg.F
!||--- called by ------------------------------------------------------
!||    hm_read_rbe2   ../starter/source/constraints/general/rbe2/hm_read_rbe2.F
!||--- calls      -----------------------------------------------------
!||    ancmsg         ../starter/source/output/message/message.F
!||    intab          ../starter/source/interfaces/inter3d1/i24tools.f
!||--- uses       -----------------------------------------------------
!||    message_mod    ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE rbe2modif_nd(NN, INN, ITAGND,ICNDS10,IU,ITAB,ITAGM,M,ITAGIC)
C=======================================================================
      USE message_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NN, INN(*), ITAGND(*),ICNDS10(3,*),ITAGM(*),IU,ITAB(*),
     .        M,ITAGIC(*)
C     REAL
C-----------------------------------------------
C   External function
C-----------------------------------------------
      LOGICAL INTAB
      EXTERNAL intab
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "scr03_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,NG, NEL, NFT,NF1, NF2, N,ND,N1,N2,NNEW,IER1,ID,IER2,M_1,M_2
      LOGICAL IS1,IS2
C     REAL
C----- IER >0 warning; <0 error out 
C--- 1: (1,nd,2) are in RBE2, nd will be removed from RBE2
C--- 2: (1,nd) or (2,nd) are in RBE2, nd will be removed from RBE2
C--- -1: nd alone is in RBE2
C--- -2: RBE2 has partial dof
C------treatment for tagged nodes in INN(*)---ICPAT=1: partial dof------------
      nnew = 0
      ier1 = 0
      ier2 = 0
C----Allow only +2 Hierarchy levers
      m_1= itagm(m)
      IF (m_1==0) THEN
       m_2=0
      ELSE
       m_2= itagm(m_1)
      END IF      
      DO i=1,nn
       n = inn(i)
C---- ITAGND(N) > NS10E  due the same N defined in sereval RBE2 (per dof)   
       IF (itagnd(n) > ns10e) THEN
C---- removed in the 2nd passe
        nnew = nnew + 1
        inn(nnew) =inn(i)
       ELSEIF (itagnd(n) /=0 ) THEN 
        id = iabs(itagnd(n))
        nd = icnds10(1,id)
        n1 = icnds10(2,id)
        n2 = icnds10(3,id)
        IF (n1==m.OR.n1==m_1.OR.n1==m_2) THEN
         is1 = .true.
        ELSEIF (itagm(n1)==0) THEN
         is1 = .false.
        ELSEIF (itagm(n1)==m.OR.itagm(n1)==m_1.OR.itagm(n1)==m_2) THEN
         IF (itagic(n1)==itagic(nd)) THEN
          is1 = .true.
         ELSE
          is1 = .false.
         END IF
        ELSE
         is1 = .false.
        END IF
C        
        IF (n2==m.OR.n2==m_1.OR.n2==m_2) THEN
         is2 = .true.
        ELSEIF (itagm(n2)==0) THEN
         is2 = .false.
        ELSEIF (itagm(n2)==m.OR.itagm(n2)==m_1.OR.itagm(n2)==m_2) THEN
         IF (itagic(n2)==itagic(nd)) THEN
          is2 = .true.
         ELSE
C------!!!!add detail for message         
          is2 = .false.
         END IF
        ELSE
         is2 = .false.
        END IF
        IF (is1.AND.is2) THEN
C----degenerating in 2nd passe------ and removed from RBE2 in 2nd passe
         nnew = nnew + 1
         inn(nnew) =inn(i)
         itagnd(n) = itagnd(n) + ns10e
         ier1 = 1
         IF (ipri>=5)
     .    CALL ancmsg(msgid=1213,
     .                msgtype=msginfo,
     .                anmode=aninfo_blind_1,
     .                i1=itab(nd),
     .                c1='RBE2 ',
     .                prmod=msg_cumu)
        ELSEIF (.NOT.(is1).AND..NOT.(is2)) THEN
C----error out  ND is along in RBE2
          CALL ancmsg(msgid=1216,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                i1=itab(nd),
     .                c1='RBE2 ',
     .                i2=iu,
     .                c2='RBE2 ')
        ELSE
C----remove Nd from RBE2 directly
         ier2 = 1
         IF (ipri>=5)
     .     CALL ancmsg(msgid=1210,
     .                msgtype=msginfo,
     .                anmode=aninfo_blind_1,
     .                c1='RBE2 ',
     .                i1=itab(nd),
     .                prmod=msg_cumu)
          END IF
       ELSE
        nnew = nnew + 1
        inn(nnew) =inn(i)
       END IF !IF (ITAGND(N) /=0 )
      ENDDO 
C      
      nn = nnew
       IF (ier1 >0.AND.ipri>=5) THEN
          CALL ancmsg(msgid=1213,
     .                msgtype=msginfo,
     .                anmode=aninfo_blind_1,
     .                c1='RBE2 ',
     .                c2='RBE2 ',
     .                i1=iu,
     .                prmod=msg_print)
       END IF 
       IF (ier2 >0.AND.ipri>=5) THEN
          CALL ancmsg(msgid=1210,
     .                msgtype=msginfo,
     .                anmode=aninfo_blind_1,
     .                c1='RBE2 ',
     .                c2='RBE2 ',
     .                i1=iu,
     .                prmod=msg_print)
       END IF 
C
      RETURN
      END
!||====================================================================
!||    rbe2modif1_nd   ../starter/source/elements/solid/solide10/dim_s10edg.F
!||--- called by ------------------------------------------------------
!||    lectur          ../starter/source/starter/lectur.F
!||--- uses       -----------------------------------------------------
!||    message_mod     ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE rbe2modif1_nd(IRBE2,LRBE2,ITAGND)
C=======================================================================
      USE message_mod
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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IRBE2(NRBE2L,*), LRBE2(*), ITAGND(*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,K,KK,NSL,NSL_N,K_N,NS
      INTEGER ITAG(NUMNOD)
C     REAL
C-----
      IF (nrbe2==0) RETURN 
      itag(1:numnod) = itagnd(1:numnod)
      DO i = 1, nrbe2
        nsl = irbe2(5,i)
        k = irbe2(1,i)
        nsl_n = 0
        DO j = 1, nsl
         ns = lrbe2(k+j)
         IF(itag(ns)>ns10e)THEN
          IF(itagnd(ns)>ns10e) itagnd(ns) = -(itagnd(ns)-ns10e)
         ELSE
          nsl_n = nsl_n + 1
          lrbe2(k+nsl_n) =ns
         END IF
        ENDDO
        irbe2(5,i) = nsl_n
      ENDDO
C
      RETURN
      END
!||====================================================================
!||    bcsmodif_nd   ../starter/source/elements/solid/solide10/dim_s10edg.F
!||--- called by ------------------------------------------------------
!||    lectur        ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    ancmsg        ../starter/source/output/message/message.F
!||--- uses       -----------------------------------------------------
!||    message_mod   ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE bcsmodif_nd(ICODE, ITAGND,ICNDS10,ITAB  ,
     .                       NNPBY,SLRBODY,NRBE2L ,SLRBE2,
     .                       NPBY ,LPBY   ,IRBE2  ,LRBE2 )
C=======================================================================
      USE message_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICODE(*), ITAGND(*),ICNDS10(3,*),ITAB(*)
C     REAL
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "scr03_c.inc"
      INTEGER, INTENT (IN) :: NNPBY,SLRBODY,NRBE2L,SLRBE2
      INTEGER, DIMENSION(NNPBY,NRBYKIN),INTENT (IN) :: NPBY
      INTEGER, DIMENSION(SLRBODY)      ,INTENT (IN) :: LPBY
      INTEGER, DIMENSION(NRBE2L,NRBE2) ,INTENT (IN) :: IRBE2
      INTEGER, DIMENSION(SLRBE2)       ,INTENT (IN) :: LRBE2
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,NG, NEL, NFT,NF1, NF2, N,ND,N1,N2,ID,IPR
      INTEGER IS1,IS2,ISMIN,NSL,M,K,KK
      INTEGER, ALLOCATABLE, DIMENSION(:) :: ICODEM
C     REAL
C------treatment for /BCS ----------------------------
! case of BCS by RBODY or RBE2
      ALLOCATE(icodem(numnod))
      icodem(1:numnod) = icode(1:numnod)
      k = 0
      DO n = 1, nrbykin
        m = npby(1,n)
        IF (icodem(m) == 0) cycle
        nsl=npby(2,n)
        DO kk = 1, nsl
          nd = lpby(k+kk)
          icodem(nd)=max(icodem(nd),icodem(m))
        ENDDO
        k = k + nsl
      ENDDO
      DO n = 1, nrbe2
        k = irbe2(1,n)
        m = irbe2(3,n)
        IF (icodem(m) == 0) cycle
        nsl = irbe2(5,n)
        DO kk = 1, nsl
          nd = lrbe2(k+kk)
          icodem(nd)=max(icodem(nd),icodem(m))
        ENDDO
      ENDDO
      ipr = 0
      DO n=1,numnod
       IF (icodem(n)>0 .AND. itagnd(n) /=0 ) THEN
         id = iabs(itagnd(n))
         nd = icnds10(1,id)
         n1 = icnds10(2,id)
         n2 = icnds10(3,id)
         is1 = icodem(n1)
         is2 = icodem(n2)
         ismin = min(is1,is2)
         IF (is1/=icodem(n).AND.is2/=icodem(n).AND.ismin<icodem(n)) THEN
C----error out  ND has more /BCS than edge node
            CALL ancmsg(msgid=1208,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                i1=itab(nd),
     .                c1='Boundary conditions ',
     .                c2='Boundary conditions')
         ELSE
C----remove Nd from /BCS +degenerating
           icode(n) = 0
           ipr = 1
           IF (itagnd(n)>0)itagnd(n) = -itagnd(n) 
           IF (ipri>=5)
     .     CALL ancmsg(msgid=1207,
     .                msgtype=msginfo,
     .                anmode=aninfo_blind_1,
     .                i1=itab(nd),
     .                prmod=msg_cumu)
         END IF
       END IF
      ENDDO 
      IF (ipr >0.AND.ipri>=5) THEN
          CALL ancmsg(msgid=1207,
     .                msgtype=msginfo,
     .                anmode=aninfo_blind_1,
     .                c1='Boundary conditions ',
     .                c2='Boundary conditions',
     .                prmod=msg_print)
      END IF 
      DEALLOCATE(icodem)
C
      RETURN
      END
!||====================================================================
!||    fixmodif_nd   ../starter/source/elements/solid/solide10/dim_s10edg.F
!||--- called by ------------------------------------------------------
!||    lectur        ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    ancmsg        ../starter/source/output/message/message.F
!||    samefvid      ../starter/source/elements/solid/solide10/dim_s10edg.F
!||--- uses       -----------------------------------------------------
!||    message_mod   ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE fixmodif_nd(IBFV, ITAGND,ICNDS10,ITAB)
C=======================================================================
      USE message_mod
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      "param_c.inc"
#include      "com04_c.inc"
#include      "scr03_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IBFV(NIFV,*), ITAGND(*),ICNDS10(3,*),ITAB(*)
C     REAL
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,NG, NEL, DIR, N,ND,N1,N2,K,ID,IPR
      LOGICAL IS1,IS2
C-----------------------------------------------
C   External function
C-----------------------------------------------
      LOGICAL SAMEFVID
      EXTERNAL SAMEFVID
C     REAL
C------treatment for tagged nodes in INN(*)----------------------------
      ipr = 0
      DO i=1,nfxvel
       n = iabs(ibfv(1,i))
       k = ibfv(12,i)
       IF (itagnd(n) /=0 ) THEN
        id = iabs(itagnd(n))
          nd = icnds10(1,id)
          n1 = icnds10(2,id)
          n2 = icnds10(3,id)
C--------quadratic, but---
          is1 = samefvid(k,ibfv,n1)
          is2 = samefvid(k,ibfv,n2)
c  IF (IS1.AND.IS2) THEN
C----remove Nd from ICNDS10
c         ITAGND(N) = ITAGND(N) + NS10E
          IF (.NOT.(is1).AND..NOT.(is2)) THEN
C----error out  ND is along in FV
          CALL ancmsg(msgid=1208,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                i1=itab(nd),
     .                c1='Imposed VEL/DISP/ACC ',
     .                c2='Imposed VEL/DISP/ACC')
          ELSE
C----remove Nd from FV and warning out-- will be done in ddsplit
         ipr = 1
         IF (ibfv(3,i)>0) ibfv(3,i) = -ibfv(3,i)
         IF (itagnd(n)>0)itagnd(n) = -itagnd(n) 
         IF (ipri>=5) 
     .    CALL ancmsg(msgid=1207,
     .                msgtype=msginfo,
     .                anmode=aninfo_blind_1,
     .                i1=itab(nd),
     .                prmod=msg_cumu)
          END IF
       END IF
      ENDDO 
C      
       IF (ipr >0.AND.ipri>=5) THEN
          CALL ancmsg(msgid=1207,
     .                msgtype=msginfo,
     .                anmode=aninfo_blind_1,
     .                c1='Imposed VEL/DISP/ACC',
     .                c2='Imposed VEL/DISP/ACC',
     .                prmod=msg_print)
       END IF 
C
      RETURN
      END
!||====================================================================
!||    samefvid      ../starter/source/elements/solid/solide10/dim_s10edg.F
!||--- called by ------------------------------------------------------
!||    fixmodif_nd   ../starter/source/elements/solid/solide10/dim_s10edg.F
!||====================================================================
      LOGICAL FUNCTION samefvid(ID,IBFV,N)
C----6---------------------------------------------------------------7---------8
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      "param_c.inc"
#include      "com04_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER id,ibfv(nifv,*),n
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER i,j,ni,k
C----6---------------------------------------------------------------7---------8
       samefvid=.false.
       DO i =1,nfxvel
        ni = iabs(ibfv(1,i))
        IF (ni==n) THEN
           k = ibfv(12,i)
         IF (k==id) samefvid=.true.
         RETURN
        ENDIF
       ENDDO 
C
      RETURN
      END
!||====================================================================
!||    int2modif_nd           ../starter/source/elements/solid/solide10/dim_s10edg.F
!||--- called by ------------------------------------------------------
!||    inintr2                ../starter/source/interfaces/inter3d1/inintr2.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||    intab                  ../starter/source/interfaces/inter3d1/i24tools.F
!||--- uses       -----------------------------------------------------
!||    message_mod            ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE int2modif_nd(IPARI,INTBUF_TAB,ITAGND,ICNDS10,ITAB)
C-----------------------------------------------
C   M o d u l e s
C----------------------------------------------- 
      USE message_mod
      USE intbufdef_mod
      USE names_and_titles_mod , ONLY : nchartitle
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      "param_c.inc"
#include      "com04_c.inc"
#include      "scr03_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARI(NPARI,NINTER),ITAGND(*),ITAB(*),ICNDS10(3,*)
      TYPE(INTBUF_STRUCT_), DIMENSION(NINTER) :: INTBUF_TAB
C-----------------------------------------------
C   External function
C-----------------------------------------------
      LOGICAL INTAB
      EXTERNAL INTAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,NTY,NSN,NMN,ISL,NKIN,NOINT,IMODI,II,N1,N2,ND
      INTEGER K,ILEV,NUVAR,IDEL7N,INTTH,IPR,IML,ICOM
      INTEGER, DIMENSION(NUMNOD) :: ITAGS,ITAGMD
      CHARACTER(LEN=NCHARTITLE):: TITR
      LOGICAL IS1,IS2,ISD
C=======================================================================
C--------done before : switch to penalty if only ND is secnd (N1,N2 not)
C-----------NOT necessary after tests---------------
c      DO N=1,NINTER
c        NTY  = IPARI(7,N)
c        IF (NTY == 2 ) THEN
c         NSN   = IPARI(5,N)
c         NOINT = IPARI(15,N)
c         IPR = 0
c         DO I=1,NS10E
c          ND = ICNDS10(1,I)
c          N1 = ICNDS10(2,I)
c          N2 = ICNDS10(3,I)
c    IF (ITAGND(ND)>NS10E) CYCLE
c    ISD = INTAB(NSN,INTBUF_TAB(N)%NSV,ND)
c          IF (.NOT.(ISD)) THEN
c     IS1 = INTAB(NSN,INTBUF_TAB(N)%NSV,N1)
c     IF (IS1) THEN
c      IS2 = INTAB(NSN,INTBUF_TAB(N)%NSV,N2)
c      IF (IS2.AND.ITAGND(ND)>0) THEN
c       ITAGND(ND)=-ITAGND(ND)
c             IPR = IPR +1
c             CALL ANCMSG(MSGID=1212,
c     .                MSGTYPE=MSGWARNING,
c     .                ANMODE=ANINFO_BLIND_1,
c     .                I1=ITAB(ND),
c     .                I2=ITAB(N1),
c     .                I3=ITAB(N2),
c     .                PRMOD=MSG_CUMU)
c      END IF
c           END IF      
c          END IF 
c         END DO 
c         IF (IPR >0) THEN
c          CALL ANCMSG(MSGID=1212,
c     .                MSGTYPE=MSGWARNING,
c     .                ANMODE=ANINFO_BLIND_1,
c     .                I1=NOINT,
c     .                PRMOD=MSG_PRINT)
c         END IF 
c        END IF !(NTY == 2 ) THEN
c      END DO 
C--error out in case N1,N2 are S of int2 (kinematic)and Nd is M or S (/w penality)
      itagmd(1:numnod)   = 0
      itags(1:numnod)   = 0
       DO n=1,ninter
        nty  = ipari(7,n)
        IF (nty == 2 ) THEN
         nmn =ipari(6,n)                                 
         nsn   = ipari(5,n)
         ilev = ipari(20,n)
         noint   = ipari(15,n)
         IF (ilev <= 5 .or. ilev == 30) THEN
          DO i=1,nsn
           isl = intbuf_tab(n)%NSV(i)
           IF (itags(isl)==0) itags(isl)=noint
          END DO 
         END IF
        END IF
       END DO 
C       
       DO i = 1, ns10e
        n = iabs(icnds10(1,i))
        itagmd(n) = i
       END DO
      DO n=1,ninter
        nty  = ipari(7,n)
        ilev = ipari(20,n)
        IF (nty == 2 ) THEN
         nmn =ipari(6,n)                                 
          DO i=1,nmn
           iml = intbuf_tab(n)%MSR(i)
           IF (itagmd(iml)>0) itagmd(iml) = itagmd(iml) + ns10e
          ENDDO
         nsn   = ipari(5,n)        
         IF (ilev == 27 .or. ilev == 28) THEN
          DO i=1,nsn
           isl = intbuf_tab(n)%NSV(i)
           IF (itagmd(isl)>0 .AND.intbuf_tab(n)%IRUPT(i) == 1) itagmd(iml)=-itagmd(isl)
          ENDDO
         ELSEIF (ilev == 25 .or. ilev == 26) THEN
          DO i=1,nsn
            isl = intbuf_tab(n)%NSV(i)
            IF (itagmd(isl)>0 ) itagmd(iml)=-itagmd(isl)
          ENDDO
           END IF
        END IF
      END DO
C
      icom = 0 
      isl=0
      noint =0      
       DO i = 1, ns10e
        n = iabs(icnds10(1,i))
        n1 = icnds10(2,i)
        n2 = icnds10(3,i)
        IF (itagmd(n)>ns10e.OR.itagmd(n)<0) THEN
         IF (itags(n1)>0.OR.itags(n2)>0) THEN
          icom=icom+1
          IF (itags(n1)>0) itags(n1)=-itags(n1)
          IF (itags(n2)>0) itags(n2)=-itags(n2)
          IF (isl==0) isl = n
          IF (noint==0.AND.itags(n1)<0)noint = -itags(n1)
          IF (noint==0.AND.itags(n2)<0)noint = -itags(n2)
         END IF
        END IF
       END DO
      IF (icom>0) THEN
          CALL ancmsg(msgid=1638,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                i1=icom,
     .                i2=itab(isl),
     .                i3=noint,
     .                i4=noint)
      END IF      
C
      DO n=1,ninter
        nty  = ipari(7,n)
        ilev = ipari(20,n)
        IF (nty == 2 ) THEN
          nsn   = ipari(5,n)
          noint = ipari(15,n)
            imodi = 0
          ipr = 0
         IF (ilev == 25 .or. ilev == 26) THEN
         ELSEIF (ilev == 27 .or. ilev == 28) THEN
          DO i=1,nsn
            isl = intbuf_tab(n)%NSV(i)
            IF (itagnd(isl)/=0 .AND.intbuf_tab(n)%IRUPT(i) /= 1)THEN
               intbuf_tab(n)%NSV(i) = -isl
               IF (itagnd(isl)>0 ) itagnd(isl) = -itagnd(isl)
               imodi = imodi + 1
              END IF
          ENDDO
         ELSE
          DO i=1,nsn
            isl = intbuf_tab(n)%NSV(i)
            IF (itagnd(isl)/=0 )THEN
               intbuf_tab(n)%NSV(i) = -isl
               IF (itagnd(isl)>0 ) itagnd(isl) = -itagnd(isl)
               imodi = imodi + 1
              END IF
          ENDDO
           END IF
C-----------------------------------------------
C     Compact INT,REAL BUFFER
C-----------------------------------------------
         IF (imodi > 0 ) THEN
          idel7n = ipari(17,n)                
          nuvar  = ipari(35,n)
          intth  = ipari(47,n)
           ii = 0                                  
           DO i = 1,nsn
             IF (intbuf_tab(n)%NSV(i) > 0) THEN               
               ii = ii+1   
               intbuf_tab(n)%NSV(ii) = intbuf_tab(n)%NSV(i)
               intbuf_tab(n)%IRTLM(ii) = intbuf_tab(n)%IRTLM(i)
               IF ((ilev >= 10.AND.ilev <= 22).OR.ilev == 27.OR.ilev == 28) THEN
                  intbuf_tab(n)%IRUPT(ii) = intbuf_tab(n)%IRUPT(i)
                 END IF
              intbuf_tab(n)%CSTS(1+2*(ii-1))   = intbuf_tab(n)%CSTS(1+2*(i-1))
              intbuf_tab(n)%CSTS(1+2*(ii-1)+1) = intbuf_tab(n)%CSTS(1+2*(i-1)+1)
              intbuf_tab(n)%DPARA(1+7*(ii-1))   = intbuf_tab(n)%DPARA(1+7*(i-1))
              intbuf_tab(n)%DPARA(1+7*(ii-1)+1) = intbuf_tab(n)%DPARA(1+7*(i-1)+1)
              intbuf_tab(n)%DPARA(1+7*(ii-1)+2) = intbuf_tab(n)%DPARA(1+7*(i-1)+2)
              intbuf_tab(n)%DPARA(1+7*(ii-1)+3) = intbuf_tab(n)%DPARA(1+7*(i-1)+3)
              intbuf_tab(n)%DPARA(1+7*(ii-1)+4) = intbuf_tab(n)%DPARA(1+7*(i-1)+4)
              intbuf_tab(n)%DPARA(1+7*(ii-1)+5) = intbuf_tab(n)%DPARA(1+7*(i-1)+5)
              intbuf_tab(n)%DPARA(1+7*(ii-1)+6) = intbuf_tab(n)%DPARA(1+7*(i-1)+6)
              IF (idel7n /= 0)THEN
               intbuf_tab(n)%SMAS(ii)  = intbuf_tab(n)%SMAS(i)
               intbuf_tab(n)%SINER(ii) = intbuf_tab(n)%SINER(i)
                END IF
              IF ((ilev>=10 .AND. ilev<=22 ).OR. intth > 0) THEN
               intbuf_tab(n)%AREAS2(ii) = intbuf_tab(n)%AREAS2(i)
                DO k = 0,nuvar-1
                 intbuf_tab(n)%UVAR(1+nuvar*(ii-1)+k) = 
     .                     intbuf_tab(n)%UVAR(1+nuvar*(i-1)+k)
                ENDDO                                  
                END IF
              IF (( ilev>=10 .AND. ilev<=12).OR.( ilev>=20 .AND. ilev<=22)) THEN
               intbuf_tab(n)%SMAS(ii)  = intbuf_tab(n)%SMAS(i)
               intbuf_tab(n)%SINER(ii) = intbuf_tab(n)%SINER(i)
               DO k = 0,nuvar-1
                intbuf_tab(n)%UVAR(1+nuvar*(ii-1)+k) = 
     .                     intbuf_tab(n)%UVAR(1+nuvar*(i-1)+k)
               ENDDO                       
               DO k = 0,2
                intbuf_tab(n)%XM0(1+3*(ii-1)+k) = intbuf_tab(n)%XM0(1+3*(i-1)+k)
                intbuf_tab(n)%DSM(1+3*(ii-1)+k) = intbuf_tab(n)%DSM(1+3*(i-1)+k)
                intbuf_tab(n)%FSM(1+3*(ii-1)+k) = intbuf_tab(n)%FSM(1+3*(i-1)+k)
               ENDDO             
              ELSEIF (ilev==27 .OR. ilev==28) THEN
               intbuf_tab(n)%SMAS(ii)  = intbuf_tab(n)%SMAS(i)
               intbuf_tab(n)%SINER(ii) = intbuf_tab(n)%SINER(i)
               intbuf_tab(n)%SPENALTY(ii)  = intbuf_tab(n)%SPENALTY(i)
               intbuf_tab(n)%STFR_PENALTY(ii) = intbuf_tab(n)%STFR_PENALTY(i)
               DO k = 0,8
                intbuf_tab(n)%SKEW(1+9*(ii-1)+k) = intbuf_tab(n)%SKEW(1+9*(i-1)+k)
               ENDDO                       
               DO k = 0,2
                intbuf_tab(n)%DSM(1+3*(ii-1)+k) = intbuf_tab(n)%DSM(1+3*(i-1)+k)
                intbuf_tab(n)%FSM(1+3*(ii-1)+k) = intbuf_tab(n)%FSM(1+3*(i-1)+k)
                intbuf_tab(n)%FINI(1+3*(ii-1)+k) = intbuf_tab(n)%FINI(1+3*(i-1)+k)
               ENDDO             
                END IF
              IF (intbuf_tab(n)%S_CSTS_BIS>0) THEN
               DO k = 0,1
                intbuf_tab(n)%CSTS_BIS(1+2*(ii-1)+k) = intbuf_tab(n)%CSTS_BIS(1+2*(i-1)+k)
               ENDDO             
              END IF
               ELSE
C-----warning out   
             isl = -intbuf_tab(n)%NSV(i)
             ipr = 1
           IF (ipri>=5) 
     .       CALL ancmsg(msgid=1209,
     .                msgtype=msginfo,
     .                anmode=aninfo_blind_1,
     .                i1=itab(isl),
     .                prmod=msg_cumu)
             ENDIF                                
           ENDDO                                  
           ipari(5,n) = ii
           END IF !(IMODI > 0 )
         IF (ipr >0.AND.ipri>=5) THEN
          CALL ancmsg(msgid=1209,
     .                msgtype=msginfo,
     .                anmode=aninfo_blind_1,
     .                c1='Interface Type2 ',
     .                i1=noint,
     .                prmod=msg_print)
         END IF 
        END IF !(NTY == 2 )
      ENDDO
C
c-----------
      RETURN
      END
!||====================================================================
!||    pre_cndpon   ../starter/source/elements/solid/solide10/dim_s10edg.f
!||--- called by ------------------------------------------------------
!||    lectur       ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    nlocal       ../starter/source/spmd/node/ddtools.F
!||====================================================================
      SUBROUTINE pre_cndpon(ICNDS10,ADSKYCND,CEPCND,CELCND  ,ITAGND)
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      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER 
     .        ICNDS10(3,*), ADSKYCND(0:*),CEPCND(*),CELCND(*),ITAGND(*)
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER  NLOCAL
      EXTERNAL NLOCAL    
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER K, I, IS,IAD, J, KK,  N, NL,NIR,NL_L,P,NI,ICOMP(NSPMD)
C-----------------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------------
C
C Itet=2 of Tetra10 same than int2
C
C-----------------------------------------------------
C Preparation of ADDCNCND : Address matrix CNCND 
C-----------------------------------------------------
        DO n=0,numnod+1
          adskycnd(n) = 0
        ENDDO
C
        nir = 2
        DO i=1,ns10e
          k = iabs(icnds10(1,i))
            IF (itagnd(k)>ns10e) cycle
          DO j=1,nir
            kk = icnds10(1+j,i)
            adskycnd(kk) = adskycnd(kk) + 1
          END DO
        END DO
C-----------------------------------------------
C   CALCULATION OF SKYLINE VECTOR ADDRESSES
C-----------------------------------------------
C------remove zero value nodes at the beginning---
       IF (adskycnd(1)>0) THEN
        ni= 1
       ELSE
        ni = 0
        DO i=2,numnod
          IF (adskycnd(i)>0) THEN
             ni = i
             GOTO 100
            END IF
        ENDDO
 100     CONTINUE
       END IF
C-----------first activate node should begin from 1       
        IF (ni==1) THEN
           adskycnd(1) = adskycnd(1)+1
          ELSE
           adskycnd(1) = 1
          END IF
        DO i=2,numnod+1
          adskycnd(i)=adskycnd(i)+adskycnd(i-1)
        ENDDO
        DO i=numnod+1,ni+1,-1
          adskycnd(i)=adskycnd(i-1)
        ENDDO
        adskycnd(1:ni) = 1
C-----------------------------------------------
C Filling of Cepcnd: Element/Local Connection
C-----------------------------------------------
           icomp(1:nspmd)=0
            DO i=1,ns10e
              k = iabs(icnds10(1,i))
                IF (itagnd(k)>ns10e) cycle
              DO p = 1, nspmd
                IF(nlocal(k,p)==1)THEN
                  cepcnd(i) = p-1
            icomp(p) = icomp(p) + 1
                  celcnd(i)= icomp(p)
                    GOTO 200
                ENDIF
              ENDDO
 200        CONTINUE
            ENDDO
C-----------------------------------------------
C CEL filling: Element/Local Connection
C-----------------------------------------------
c        DO P = 1, NSPMD
c          NL_L = 0
c          DO I=1,NS10E
c            K = IABS(ICNDS10(1,I))
c      IF (ITAGND(K)>NS10E) CYCLE
c            IF(CELCND(I)==0) THEN
c              IF(NLOCAL(K,P)==1)THEN
c                NL_L = NL_L + 1
c                CELCND(I) = NL_L
c              END IF
c            END IF
c          END DO
c        END DO
C
      RETURN
      END
!||====================================================================
!||    fillcncnd   ../starter/source/elements/solid/solide10/dim_s10edg.F
!||--- called by ------------------------------------------------------
!||    lectur      ../starter/source/starter/lectur.F
!||====================================================================
      SUBROUTINE fillcncnd(CNCND  ,ADDCNCND, ICNDS10,ITAGND)
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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ADDCNCND(0:*), CNCND(*),ICNDS10(3,*),ITAGND(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, L, K, N, OFF, NTY, NRTS, NRTM, NSN, NMN,
     .        KK, NIR,ADSKY(NUMNOD+1)
C-----------------------------------------------
C   CALCULATION OF CNE ADDCNE
C-----------------------------------------------
      DO i = 1, numnod+1
        adsky(i) = addcncnd(i)
      ENDDO
C
C ADDCNCND(I+1)-ADDCNCND(I): nb of node I (main)
        nir = 2
        DO i=1,ns10e
          k = icnds10(1,i)
            IF (itagnd(k)>ns10e) cycle
          DO j=1,nir
            kk = icnds10(1+j,i)
            cncnd(adsky(kk)) = i
            adsky(kk) = adsky(kk) + 1
          END DO
        END DO
C
      RETURN
      END
!||====================================================================
!||    stifn0_nd   ../starter/source/elements/solid/solide10/dim_s10edg.F
!||--- called by ------------------------------------------------------
!||    lectur      ../starter/source/starter/lectur.F
!||====================================================================
      SUBROUTINE stifn0_nd(ICNDS10,STIFN)
C=======================================================================
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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICNDS10(3,*)
C     REAL
      my_real
     .   stifn(*) 
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,ND
C     REAL
C------put STIFN(ND)=0 for mscalling dt estimation
      DO i=1,ns10e
       nd = iabs(icnds10(1,i))
       stifn(nd)=zero
      ENDDO 
C      
      RETURN
      END
!||====================================================================
!||    stifn1_nd   ../starter/source/elements/solid/solide10/dim_s10edg.F
!||--- called by ------------------------------------------------------
!||    lectur      ../starter/source/starter/lectur.F
!||====================================================================
      SUBROUTINE stifn1_nd(ICNDS10,STIFN)
C=======================================================================
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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICNDS10(3,*)
C     REAL
      my_real
     .   stifn(*) 
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,ND,N1,N2
C     REAL
      my_real
     .   stif 
C------condense STIFN(ND)
      DO i=1,ns10e
       nd = iabs(icnds10(1,i))
       IF (stifn(nd)<=zero) cycle
       stif =half*stifn(nd)
       n1 = icnds10(2,i)
       n2 = icnds10(3,i)
       stifn(n1)=stifn(n1)+stif
       stifn(n2)=stifn(n2)+stif
       stifn(nd)=zero
      ENDDO 
C      
      RETURN
      END
!||====================================================================
!||    bcscycmodif_nd   ../starter/source/elements/solid/solide10/dim_s10edg.F
!||--- called by ------------------------------------------------------
!||    lectur           ../starter/source/starter/lectur.f
!||--- calls      -----------------------------------------------------
!||    ancmsg           ../starter/source/output/message/message.F
!||--- uses       -----------------------------------------------------
!||    message_mod      ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE bcscycmodif_nd(IBCSCYC,LBCSCYC,ITAGND,ITAB)
C=======================================================================
      USE message_mod
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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IBCSCYC(4,*), LBCSCYC(2,*), ITAGND(*),ITAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,K,KK,NSL,NSL_N,K_N,NS,ID,N1,N2
C     REAL
C------removing Nd from LBCSCYC(*)--
      DO i = 1, nbcscyc
        k = ibcscyc(1,i)
        nsl =ibcscyc(3,i)
        nsl_n = 0
        id =ibcscyc(4,i)
        DO j = 1, nsl
         n1 = lbcscyc(1,k+j)
         n2 = lbcscyc(2,k+j)
         IF(itagnd(n1)==0.AND.itagnd(n2)==0)THEN
          nsl_n = nsl_n + 1
          lbcscyc(1,k+nsl_n) =n1
          lbcscyc(2,k+nsl_n) =n2
         ELSEIF(itagnd(n1)/=0.AND.itagnd(n2)/=0) THEN
C--- remove         
         ELSE
C--- error out        
           CALL ancmsg(msgid=1758,anmode=aninfo,msgtype=msgerror,i1=id)
         END IF
        ENDDO
        IF (nsl>nsl_n) THEN
         kk = nsl-nsl_n
         ibcscyc(3,i) = nsl_n
         ibcscyc(1,i) = k+nsl_n
         CALL ancmsg(msgid=1759,anmode=aninfo,msgtype=msgwarning,i1=kk,i2=id)
        END IF
      ENDDO
C
      RETURN
      END