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
!||====================================================================
      SUBROUTINE ind_s10edg(ICNDS10, IXS, 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 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)
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"
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
C     REAL
C------treatment for /BCS ----------------------------
      ipr = 0
      DO n=1,numnod
       IF (icode(n)>0 .AND. itagnd(n) /=0 ) THEN
         id = iabs(itagnd(n))
         nd = icnds10(1,id)
         n1 = icnds10(2,id)
         n2 = icnds10(3,id)
         is1 = icode(n1)
         is2 = icode(n2)
         ismin = min(is1,is2)
         IF (is1/=icode(n).AND.is2/=icode(n).AND.ismin<icode(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 
.AND.      IF (IPR >0IPRI>=5) THEN
          CALL ANCMSG(MSGID=1207,
     .                MSGTYPE=MSGINFO,
     .                ANMODE=ANINFO_BLIND_1,
     .                C1='boundary conditions ',
     .                C2='boundary conditions',
     .                PRMOD=MSG_PRINT)
      END IF 
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
.NOT..AND..NOT.          IF ((IS1)(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      
.AND.       IF (IPR >0IPRI>=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)
.or.         IF (ILEV <= 5  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)        
.or.         IF (ILEV == 27  ILEV == 28) THEN
          DO I=1,NSN
           ISL = INTBUF_TAB(N)%NSV(I)
.AND.           IF (ITAGMD(ISL)>0 INTBUF_TAB(N)%IRUPT(I) == 1) ITAGMD(IML)=-ITAGMD(ISL)
          ENDDO
.or.         ELSEIF (ILEV == 25  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)
.OR.        IF (ITAGMD(N)>NS10EITAGMD(N)<0) THEN
.OR.         IF (ITAGS(N1)>0ITAGS(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
.AND.          IF (NOINT==0ITAGS(N1)<0)NOINT = -ITAGS(N1)
.AND.          IF (NOINT==0ITAGS(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
.or.         IF (ILEV == 25  ILEV == 26) THEN
.or.         ELSEIF (ILEV == 27  ILEV == 28) THEN
          DO I=1,NSN
            ISL = INTBUF_TAB(N)%NSV(I)
.AND.            IF (ITAGND(ISL)/=0 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)
.AND..OR..OR.               IF ((ILEV >= 10ILEV <= 22)ILEV == 27ILEV == 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
.AND..OR.              IF ((ILEV>=10  ILEV<=22 ) 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
.AND..OR..AND.              IF (( ILEV>=10  ILEV<=12)( ILEV>=20  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             
.OR.              ELSEIF (ILEV==27  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 )
.AND.         IF (IPR >0IPRI>=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 de ADDCNCND : Adresse matrice 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   CALCUL DES ADRESSES DU VECTEUR SKYLINE
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 Remplissage de CEPCND : connection Element/Local
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 Remplissage de CEL : connection Element/Local
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   CALCUL DE 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)
.AND.         IF(ITAGND(N1)==0ITAGND(N2)==0)THEN
          NSL_N = NSL_N + 1
          LBCSCYC(1,K+NSL_N) =N1
          LBCSCYC(2,K+NSL_N) =N2
.AND.         ELSEIF(ITAGND(N1)/=0ITAGND(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