s10cndf.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/.
!||====================================================================
!||    s10cndf1               ../engine/source/elements/solid/solide10/s10cndf.F
!||--- called by ------------------------------------------------------
!||    resol                  ../engine/source/engine/resol.F
!||--- calls      -----------------------------------------------------
!||    my_barrier             ../engine/source/system/machine.F
!||    spmd_exch_a_scnd       ../engine/source/mpi/elements/spmd_exch_a_scnd.f
!||    spmd_exch_a_scnd_pon   ../engine/source/mpi/elements/spmd_exch_a_scnd_pon.F
!||--- uses       -----------------------------------------------------
!||    message_mod            ../engine/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE s10cndf1(ICNDS10,WEIGHT ,IAD_CNDM,FR_CNDM,FR_NBCCCND,
     1                   ADDCNCND,PROCNCND,A    ,IADCND,FSKYCND,
     2                   ITAGND  , NODFTSK,NODLTSK,EFTSK ,ELTSK ,
     3                   ITSK  ,ITAB   ,STIFN ,STIFND)
C-----------------------------------------------
C   M o d u l e s
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      "com01_c.inc"
#include      "com04_c.inc"
#include      "task_c.inc"
#include      "parit_c.inc"
#include      "spmd_c.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICNDS10(3,*),WEIGHT(*),IAD_CNDM(*),FR_CNDM(*),FR_NBCCCND(2,*),
     .        ADDCNCND(*),PROCNCND(*),IADCND(2,*),ITAGND(*),ITAB(*)
      INTEGER NODFTSK,NODLTSK,EFTSK,ELTSK,ITSK
      my_real
     .   a(3,*),fskycnd(4,*),stifn(*),stifnd(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, N, K,ISIZE,LCOMM,LENS,LENR,NCT,NC,N1,N2,ND,IAD1,IAD2,IK
      my_real
     .   FX,FY,FZ ,FAC,STIF
C======================================================================|
C----pass1 : only N1,N2 are secnd nodes of Int2
       isize =4
       IF (iparit==0.AND.nspmd>1) THEN
!$OMP SINGLE
#include "vectorize.inc"
         DO i=1,iad_cndm(nspmd+1)-1
          j = fr_cndm(i)
           a(1,j) = a(1,j) * weight(j) 
           a(2,j) = a(2,j) * weight(j) 
           a(3,j) = a(3,j) * weight(j)
           stifn(j)=stifn(j)* weight(j)        
         END DO
!$OMP END SINGLE
       ENDIF
       IF (iparit/=0.AND.itsk==0) fskycnd(1:4,1:lcncnd)=zero
C------- change STIFND(I) :int  to ele
C       IF (.FALSE.) THEN
C#include "vectorize.inc"
C         DO I=EFTSK,ELTSK
C           ND  = IABS(ICNDS10(1,I))
C           !ELM     =  Total (inc. STIFI)     - ( Contact without FI
C           STIFND(I) = STIFN(ND) - STIFND(I)
C         END DO 
C       END IF 
C------------------------      
       CALL my_barrier()
C------------------------  
       IF (iparit == 0 ) THEN
         ik = itsk*numnod
#include "vectorize.inc"
         DO i=eftsk,eltsk
           nd  = iabs(icnds10(1,i))
           n1  = icnds10(2,i)
           n2  = icnds10(3,i)
          IF (itagnd(n1)==0.AND.itagnd(n2)==0) cycle
           fac = half*weight(nd)
           fx = fac*a(1,nd)
           fy = fac*a(2,nd)
           fz = fac*a(3,nd)
           stif = max(zero,fac*(stifn(nd)-stifnd(i)))
           IF (itagnd(n1)>0) THEN
            n1 = n1 + ik
            a(1,n1) = a(1,n1) + fx 
            a(2,n1) = a(2,n1) + fy 
            a(3,n1) = a(3,n1) + fz 
            stifn(n1) = stifn(n1) + stif 
           END IF 
           IF (itagnd(n2)>0) THEN
            n2 = n2 + ik
            a(1,n2) = a(1,n2) + fx 
            a(2,n2) = a(2,n2) + fy 
            a(3,n2) = a(3,n2) + fz 
            stifn(n2) = stifn(n2) + stif 
           END IF 
         END DO
C------------------------      
       CALL my_barrier()
C------------------------      
           DO k = 1,nthread-1
            ik = k*numnod
          DO i=nodftsk,nodltsk
             IF (itagnd(i)>0) THEN
            a(1,i) = a(1,i) + a(1,i+ik) 
            a(2,i) = a(2,i) + a(2,i+ik) 
            a(3,i) = a(3,i) + a(3,i+ik) 
            stifn(i) = stifn(i) + stifn(i+ik)
            a(1,i+ik) = zero 
            a(2,i+ik) = zero 
            a(3,i+ik) = zero 
            stifn(i+ik) = zero
             END IF 
            END DO
         END DO
C------------------------      
       CALL my_barrier()
C------------------------      
         IF (nspmd>1.AND.itsk==0) THEN
            lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
          CALL spmd_exch_a_scnd(
     .        a    ,stifn  ,fr_cndm,iad_cndm,lcomm,isize)
           END IF
       ELSE ! P/ON
#include "vectorize.inc"
         DO i=eftsk,eltsk
           nd  = iabs(icnds10(1,i))
           n1  = icnds10(2,i)
           n2  = icnds10(3,i)
           IF (itagnd(n1)==0.AND.itagnd(n2)==0) cycle
           fac = half*weight(nd)
           fx = fac*a(1,nd)
           fy = fac*a(2,nd)
           fz = fac*a(3,nd)
C                               TOTAL - ELEMENT = contact inc. remote
           stif = max(zero,fac*(stifn(nd)-stifnd(i)))
           iad1 = iadcnd(1,i)
           IF (iad1>0.AND.itagnd(n1)>0) THEN
            fskycnd(1,iad1) = fx
            fskycnd(2,iad1) = fy
            fskycnd(3,iad1) = fz
            fskycnd(4,iad1) = stif
           END IF
           iad2 = iadcnd(2,i)
           IF (iad2>0.AND.itagnd(n2)>0) THEN
            fskycnd(1,iad2) = fx
            fskycnd(2,iad2) = fy
            fskycnd(3,iad2) = fz
            fskycnd(4,iad2) = stif
           END IF
         END DO
C------------------------      
       CALL my_barrier()
C------------------------      
         IF (nspmd>1.AND.itsk==0) THEN
            lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
          lens = fr_nbcccnd(1,nspmd+1)
          lenr = fr_nbcccnd(2,nspmd+1)
          CALL spmd_exch_a_scnd_pon(
     1         fr_cndm,iad_cndm,addcncnd,procncnd,fr_nbcccnd,
     2         isize,lenr   ,lens   ,fskycnd)
           END IF
C------------------------      
       CALL my_barrier()
C------------------------      
C
C Routine assemblage parith/ON
C----------to be optimized after
         DO n = nodftsk,nodltsk
            IF (itagnd(n)==0) cycle
          nct = addcncnd(n)-1
          nc = addcncnd(n+1)-addcncnd(n)
          DO k = nct+1, nct+nc
            a(1,n)   = a(1,n) + fskycnd(1,k)
            a(2,n)   = a(2,n) + fskycnd(2,k)
            a(3,n)   = a(3,n) + fskycnd(3,k)
            stifn(n) = stifn(n) + fskycnd(4,k)
          ENDDO
         ENDDO
       END IF
C
C----6---------------------------------------------------------------7---------8
      RETURN
      END
!||====================================================================
!||    s10cndf2               ../engine/source/elements/solid/solide10/s10cndf.F
!||--- called by ------------------------------------------------------
!||    resol                  ../engine/source/engine/resol.F
!||--- calls      -----------------------------------------------------
!||    my_barrier             ../engine/source/system/machine.F
!||    spmd_exch_a_scnd       ../engine/source/mpi/elements/spmd_exch_a_scnd.F
!||    spmd_exch_a_scnd_pon   ../engine/source/mpi/elements/spmd_exch_a_scnd_pon.F
!||--- uses       -----------------------------------------------------
!||    message_mod            ../engine/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE s10cndf2(ICNDS10,WEIGHT ,IAD_CNDM,FR_CNDM,FR_NBCCCND,
     1                   ADDCNCND,PROCNCND,A    ,IADCND,FSKYCND,
     2                   ITAGND  , NODFTSK,NODLTSK,EFTSK ,ELTSK ,
     3                   ITSK  ,ITAB   ,STIFN ,STIFND)
C-----------------------------------------------
C   M o d u l e s
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      "com01_c.inc"
#include      "com04_c.inc"
#include      "task_c.inc"
#include      "parit_c.inc"
#include      "spmd_c.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICNDS10(3,*),WEIGHT(*),IAD_CNDM(*),FR_CNDM(*),FR_NBCCCND(2,*),
     .        ADDCNCND(*),PROCNCND(*),IADCND(2,*),ITAGND(*),ITAB(*)
      INTEGER NODFTSK,NODLTSK,EFTSK,ELTSK,ITSK
C     REAL
      my_real
     .   A(3,*),FSKYCND(4,*), STIFN(*),STIFND(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, N, K,ISIZE,LCOMM,LENS,LENR,NCT,NC,N1,N2,ND,IAD1,IAD2,IK
C     REAL
      my_real
     .   fx,fy,fz ,fac,stif
C======================================================================|
C----pass2 : all excepting N1,N2 are secnd nodes of Int2
       isize =4
       IF (iparit==0.AND.nspmd>1) THEN
!$OMP SINGLE
#include "vectorize.inc"
         DO i=1,iad_cndm(nspmd+1)-1
          j = fr_cndm(i) ! main node at the boundary for spmd (condensation main node)
           a(1,j) = a(1,j) * weight(j) 
           a(2,j) = a(2,j) * weight(j) 
           a(3,j) = a(3,j) * weight(j)
           stifn(j)=stifn(j)* weight(j)        
         END DO
!$OMP END SINGLE
       ENDIF
       IF (iparit/=0.AND.itsk==0) fskycnd(1:4,1:lcncnd)=zero
C------------------------      
       CALL my_barrier()
C------------------------      
       IF (iparit == 0 ) THEN
         ik = itsk*numnod
#include "vectorize.inc"
         DO i=eftsk,eltsk ! Middle node
           nd  = iabs(icnds10(1,i))
           n1  = icnds10(2,i)
           n2  = icnds10(3,i)
             fac = half*weight(nd)
           fx = fac*a(1,nd)
           fy = fac*a(2,nd)
           fz = fac*a(3,nd)
           stif = max(zero,fac*(stifn(nd)-stifnd(i)))
            IF (itagnd(n1)==0) THEN
             n1 = n1 + ik
           a(1,n1) = a(1,n1) + fx 
           a(2,n1) = a(2,n1) + fy 
           a(3,n1) = a(3,n1) + fz 
           stifn(n1) = stifn(n1) + stif 
            END IF 
            IF (itagnd(n2)==0) THEN
             n2 = n2 + ik
           a(1,n2) = a(1,n2) + fx 
           a(2,n2) = a(2,n2) + fy 
           a(3,n2) = a(3,n2) + fz 
           stifn(n2) = stifn(n2) + stif 
            END IF 
         END DO
C------------------------      
       CALL my_barrier()
C------------------------      
           DO k = 1,nthread-1
            ik = k*numnod
          DO i=nodftsk,nodltsk
             IF (itagnd(i)==0) THEN
            a(1,i) = a(1,i) + a(1,i+ik) 
            a(2,i) = a(2,i) + a(2,i+ik) 
            a(3,i) = a(3,i) + a(3,i+ik) 
            stifn(i) = stifn(i) + stifn(i+ik)
            a(1,i+ik) = zero 
            a(2,i+ik) = zero 
            a(3,i+ik) = zero 
            stifn(i+ik) = zero
             END IF 
            END DO
         END DO
C------------------------      
       CALL my_barrier()
C------------------------
         IF (nspmd>1.AND.itsk==0) THEN
            lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
          CALL spmd_exch_a_scnd(
     .        a    ,stifn  ,fr_cndm,iad_cndm,lcomm,isize)
           END IF
        stifnd(eftsk:eltsk) = zero
       ELSE
#include "vectorize.inc"
         DO i=eftsk,eltsk
           nd  = iabs(icnds10(1,i))
           n1  = icnds10(2,i)
           n2  = icnds10(3,i)
           fac = half*weight(nd)
           fx = fac*a(1,nd)
           fy = fac*a(2,nd)
           fz = fac*a(3,nd)
           stif = max(zero,fac*(stifn(nd)-stifnd(i)))
           iad1 = iadcnd(1,i)
           IF (iad1>0.AND.itagnd(n1)==0) THEN
            fskycnd(1,iad1) = fx
            fskycnd(2,iad1) = fy
            fskycnd(3,iad1) = fz
            fskycnd(4,iad1) = stif
           END IF
           iad2 = iadcnd(2,i)
           IF (iad2>0.AND.itagnd(n2)==0) THEN
            fskycnd(1,iad2) = fx
            fskycnd(2,iad2) = fy
            fskycnd(3,iad2) = fz
            fskycnd(4,iad2) = stif
           END IF
         END DO
C------------------------      
       CALL my_barrier()
C------------------------      
         IF (nspmd>1.AND.itsk==0) THEN
            lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
          lens = fr_nbcccnd(1,nspmd+1)
          lenr = fr_nbcccnd(2,nspmd+1)
          CALL spmd_exch_a_scnd_pon(
     1         fr_cndm,iad_cndm,addcncnd,procncnd,fr_nbcccnd,
     2         isize,lenr   ,lens   ,fskycnd)
           END IF
C------------------------      
       CALL my_barrier()
C------------------------      
C Routine assemblage parith/ON
C----------to be optimized after
         DO n = nodftsk,nodltsk
            IF (itagnd(n)/=0) cycle
          nct = addcncnd(n)-1
          nc = addcncnd(n+1)-addcncnd(n)
          DO k = nct+1, nct+nc
            a(1,n)   = a(1,n) + fskycnd(1,k)
            a(2,n)   = a(2,n) + fskycnd(2,k)
            a(3,n)   = a(3,n) + fskycnd(3,k)
            stifn(n) = stifn(n) + fskycnd(4,k)
          ENDDO
         ENDDO
       END IF
C
C----6---------------------------------------------------------------7---------8
      RETURN
      END
!||====================================================================
!||    s10cnd_ini   ../engine/source/elements/solid/solide10/s10cndf.f
!||--- called by ------------------------------------------------------
!||    resol_init   ../engine/source/engine/resol_init.F
!||====================================================================
      SUBROUTINE s10cnd_ini(ICNDS10,ITAGND,IAD_CNDM,FR_CNDM,FR_NBCCCND,
     1                      ADDCNCND,PROCNCND,VND  ,V   ,ITAB    ,
     2                      IAD_CNDM1,FR_CNDM1,FR_NBCCCND1)
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      "com01_c.inc"
#include      "com04_c.inc"
#include      "parit_c.inc"
#include      "task_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICNDS10(3,*),IAD_CNDM(*),FR_CNDM(*),FR_NBCCCND(2,*),
     .        ADDCNCND(*),PROCNCND(*),ITAGND(*),ITAB(*),
     .        IAD_CNDM1(*),FR_CNDM1(*),FR_NBCCCND1(2,*)
C     REAL
      my_real
     .   V(3,*),VND(3,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, K, NOD,LOC_PROC,CC,N1,N2
C-----------------------------------------------
C   Initialization of  ITAGND,FR_NBCCI2
C-----------------------------------------------
       DO i = 1, ns10e
        n1 = icnds10(2,i)
        n2 = icnds10(3,i)
        vnd(1,i) = half*(v(1,n1) + v(1,n2))
        vnd(2,i) = half*(v(2,n1) + v(2,n2))
        vnd(3,i) = half*(v(3,n1) + v(3,n2))
       END DO
C       
       IF (iparit/=0) THEN
        DO i = 1, nspmd+1
          fr_nbcccnd(1,i) = 0
          fr_nbcccnd(2,i) = 0
        ENDDO
C
        loc_proc = ispmd+1
        DO i = 1, nspmd
          IF(i/=loc_proc) THEN
            DO j=iad_cndm(i),iad_cndm(i+1)-1
              nod = fr_cndm(j)
              DO cc = addcncnd(nod),addcncnd(nod+1)-1
                IF(procncnd(cc)==loc_proc) THEN
                  fr_nbcccnd(1,i) = fr_nbcccnd(1,i)+1
                ELSEIF(procncnd(cc)==i) THEN
                  fr_nbcccnd(2,i) = fr_nbcccnd(2,i)+1
                ENDIF
              ENDDO
            ENDDO
          ENDIF
        ENDDO
C
        DO i = 1, nspmd
          fr_nbcccnd(1,nspmd+1) = fr_nbcccnd(1,nspmd+1)+fr_nbcccnd(1,i)
          fr_nbcccnd(2,nspmd+1) = fr_nbcccnd(2,nspmd+1)+fr_nbcccnd(2,i)
        ENDDO
       END IF !(IPARIT/=0.AND.IPARIT/=3) THEN
C------for pass1
        iad_cndm1(1) = 1
        DO i = 1, nspmd
         k = 0
         DO j=iad_cndm(i),iad_cndm(i+1)-1
          nod = fr_cndm(j)
          IF (itagnd(nod)>0) THEN
             k = k + 1
             fr_cndm1(k+iad_cndm1(i)-1) = nod
            END IF
         ENDDO
         iad_cndm1(i+1) = iad_cndm1(i) + k
        ENDDO
       IF (iparit/=0) THEN
        DO i = 1, nspmd+1
          fr_nbcccnd1(1,i) = 0
          fr_nbcccnd1(2,i) = 0
        ENDDO
C
        DO i = 1, nspmd
          IF(i/=loc_proc) THEN
            DO j=iad_cndm1(i),iad_cndm1(i+1)-1
              nod = fr_cndm1(j)
              DO cc = addcncnd(nod),addcncnd(nod+1)-1
                IF(procncnd(cc)==loc_proc) THEN
                  fr_nbcccnd1(1,i) = fr_nbcccnd1(1,i)+1
                ELSEIF(procncnd(cc)==i) THEN
                  fr_nbcccnd1(2,i) = fr_nbcccnd1(2,i)+1
                ENDIF
              ENDDO
            ENDDO
          ENDIF
        ENDDO
        DO i = 1, nspmd
          fr_nbcccnd1(1,nspmd+1) = fr_nbcccnd1(1,nspmd+1)+fr_nbcccnd1(1,i)
          fr_nbcccnd1(2,nspmd+1) = fr_nbcccnd1(2,nspmd+1)+fr_nbcccnd1(2,i)
        ENDDO
       END IF !(IPARIT/=0.AND.IPARIT/=3) THEN
C
      RETURN
      END
!||====================================================================
!||    s10cndi2_ini         ../engine/source/elements/solid/solide10/s10cndf.f
!||--- called by ------------------------------------------------------
!||    resol_init           ../engine/source/engine/resol_init.F
!||--- calls      -----------------------------------------------------
!||    spmd_exch_tag_scnd   ../engine/source/mpi/elements/spmd_exch_tag_scnd.F
!||--- uses       -----------------------------------------------------
!||    intbufdef_mod        ../common_source/modules/interfaces/intbufdef_mod.F90
!||====================================================================
      SUBROUTINE s10cndi2_ini(IPARI,INTBUF_TAB,ICNDS10,ITAGND,WEIGHT,
     1                        FR_CNDS,IAD_CNDS,itab  )
C-----------------------------------------------
C   M o d u l e s
C----------------------------------------------- 
      USE intbufdef_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      "com01_c.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARI(NPARI,NINTER),ITAGND(*),ICNDS10(3,*),WEIGHT(*),
     1             FR_CNDS(*),IAD_CNDS(*),itab(*)  
      TYPE(INTBUF_STRUCT_), DIMENSION(NINTER) :: INTBUF_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,NTY,NSN,NMN,IM,II,N1,N2,NS,ILEV,L,NUS,SIZ
      INTEGER ITAGS(NUMNOD)
C=======================================================================
       DO i = 1, ns10e
        n = icnds10(1,i)
        IF (n > 0) THEN
         itagnd(n) = i
        ELSEIF(n < 0) THEN 
         itagnd(-n) = -i
        END IF
       END DO
C -------add RBE3  after    
      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)
         nus   = ipari(15,n)
         IF (ilev == 27 .or. ilev == 28) THEN
          DO i=1,nsn
           IF (intbuf_tab(n)%IRUPT(i) /= 1) THEN
            ns = intbuf_tab(n)%NSV(i)
            IF (itags(ns)==0) itags(ns)=nus
            l = intbuf_tab(n)%IRTLM(i)
              DO j = 1, 4
               ii = 4*(l-1)+j
               im = intbuf_tab(n)%IRECTM(ii)
             IF (itagnd(im)>0) THEN
              itagnd(im) = itagnd(im) + ns10e
             ELSEIF(itagnd(im)<0) THEN
              itagnd(im) = itagnd(im) - ns10e
             END IF
            END DO
           END IF !(INTBUF_TAB(N)%IRUPT(I) /= 1) THEN
          END DO 
         ELSEIF (ilev <= 5 .or. ilev == 30) THEN
          DO i=1,nsn
           ns = intbuf_tab(n)%NSV(i)
           IF (itags(ns)==0) itags(ns)=nus
           l = intbuf_tab(n)%IRTLM(i)
             DO j = 1, 4
              ii = 4*(l-1)+j
              im = intbuf_tab(n)%IRECTM(ii)
            IF (itagnd(im)>0) THEN
             itagnd(im) = itagnd(im) + ns10e
            ELSEIF(itagnd(im)<0) THEN
             itagnd(im) = itagnd(im) - ns10e
            END IF
           END DO 
          END DO 
         END IF
        END IF
      END DO 
C--------comm to synchro the case iabs(ITAGND(Nd))>NS10E main of int2
       IF (nspmd>1) THEN
        siz = iad_cnds(nspmd+1)-iad_cnds(1)
        CALL spmd_exch_tag_scnd(itagnd,fr_cnds,iad_cnds,siz)
       END IF
C--------add edge nodes at the end :Secnd of int2 ->used in pass1
       DO i = 1, ns10e
        n1 = icnds10(2,i)
        n2 = icnds10(3,i)
        itagnd(n1) = itags(n1)
        itagnd(n2) = itags(n2)
       END DO
C------Change FR_CNDS(J) from Nd to id of ICNDS10 for STIFND        
       IF (nspmd>1) THEN
        DO i = 1, ns10e
         n = iabs(icnds10(1,i))
         itags(n) = i
        END DO
        DO i=1,nspmd
         DO j=iad_cnds(i),iad_cnds(i+1)-1
           n =  fr_cnds(j)
           fr_cnds(j) = itags(n)
         ENDDO
        ENDDO
       END IF
C
      RETURN
      END
!||====================================================================
!||    s10cndamp              ../engine/source/elements/solid/solide10/s10cndf.F
!||--- calls      -----------------------------------------------------
!||    spmd_exch_a_scnd       ../engine/source/mpi/elements/spmd_exch_a_scnd.F
!||    spmd_exch_a_scnd_pon   ../engine/source/mpi/elements/spmd_exch_a_scnd_pon.F
!||====================================================================
      SUBROUTINE s10cndamp(ICNDS10,MS   ,A   ,V    ,VD    ,
     1                     IADCND ,ADDCNCND,FSKYCND,WEIGHT ,IAD_CNDM,
     2                     FR_CNDM,FR_NBCCCND,PROCNCND)
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      "com01_c.inc"
#include      "com04_c.inc"
#include      "com06_c.inc"
#include      "comlock.inc"
#include      "parit_c.inc"
#include      "spmd_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICNDS10(3,*),WEIGHT(*),IAD_CNDM(*),FR_CNDM(*),
     .        FR_NBCCCND(2,*),ADDCNCND(*),PROCNCND(*),IADCND(2,*)
C     REAL
      my_real
     .   A(3,*),V(3,*),VD(3,*),MS(*),FSKYCND(4,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J,N, K,ID1,ID2,NC,N1,N2,ND,NCT,
     .         ISIZE,LCOMM,LENS,LENR
CC     REAL
      my_real
     .   fx1,fy1,fz1 ,fx2,fy2,fz2,fac,fac1,fac2,vx,vy,vz
      my_real
     .   tmp(numnod)
C======================================================================|
       IF (iparit/=0) fskycnd(1:3,1:lcncnd)=zero
       isize = 4
C                                                           
       IF (iparit == 0 ) THEN
         IF (nspmd>1) THEN
#include "vectorize.inc"
          DO i=1,iad_cndm(nspmd+1)-1
           j = fr_cndm(i)
           a(1,j) = a(1,j) * weight(j) 
           a(2,j) = a(2,j) * weight(j) 
           a(3,j) = a(3,j) * weight(j)
          END DO
         END IF
         DO i=1,ns10e
           nd  = iabs(icnds10(1,i))
           n1  = icnds10(2,i)
           n2  = icnds10(3,i)
           fac= dampa*ms(nd)*weight(nd)
           fac1 = fac/ms(n1)
           fac2 = fac/ms(n2)
           vx = v(1,nd)-vd(1,i)
           vy = v(2,nd)-vd(2,i)
           vz = v(3,nd)-vd(3,i)
           fx1 = fac1*vx
           fy1 = fac1*vy
           fz1 = fac1*vz
           fx2 = fac2*vx
           fy2 = fac2*vy
           fz2 = fac2*vz
           a(1,n1) = a(1,n1) - fx1 
           a(2,n1) = a(2,n1) - fy1 
           a(3,n1) = a(3,n1) - fz1 
           a(1,n2) = a(1,n2) - fx2 
           a(2,n2) = a(2,n2) - fy2 
           a(3,n2) = a(3,n2) - fz2 
         END DO
        IF (nspmd>1) THEN
          lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
          tmp(1:numnod)=zero
          CALL spmd_exch_a_scnd(
     .        a    ,tmp  ,fr_cndm,iad_cndm,lcomm,isize)
        END IF
        ELSE
         DO i=1,ns10e
           nd  = iabs(icnds10(1,i))
           n1  = icnds10(2,i)
           n2  = icnds10(3,i)
           fac= dampa*ms(nd)
           fac1 = fac/ms(n1)
           fac2 = fac/ms(n2)
           vx = v(1,nd)-vd(1,i)
           vy = v(2,nd)-vd(2,i)
           vz = v(3,nd)-vd(3,i)
           fx1 = fac1*vx
           fy1 = fac1*vy
           fz1 = fac1*vz
           fx2 = fac2*vx
           fy2 = fac2*vy
           fz2 = fac2*vz
           id1 = iadcnd(1,i)
           IF (id1>0) THEN
            fskycnd(1,id1) = fx1
            fskycnd(2,id1) = fy1
            fskycnd(3,id1) = fz1
            fskycnd(4,id1) = zero
           END IF
           id2 = iadcnd(2,i)
           IF (id2>0) THEN
            fskycnd(1,id2) = fx2
            fskycnd(2,id2) = fy2
            fskycnd(3,id2) = fz2
            fskycnd(4,id2) = zero
           END IF
         END DO
        IF (nspmd>1) THEN
          lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
          lens = fr_nbcccnd(1,nspmd+1)
          lenr = fr_nbcccnd(2,nspmd+1)
          CALL spmd_exch_a_scnd_pon(
     1         fr_cndm,iad_cndm,addcncnd,procncnd,fr_nbcccnd,
     2         isize,lenr   ,lens   ,fskycnd)
        END IF
C
C Routine assemblage parith/ON
C
        DO n = 1, numnod
          nct = addcncnd(n)-1
          nc = addcncnd(n+1)-addcncnd(n)
          DO k = nct+1, nct+nc
            a(1,n)   = a(1,n) - fskycnd(1,k)
            a(2,n)   = a(2,n) - fskycnd(2,k)
            a(3,n)   = a(3,n) - fskycnd(3,k)
          ENDDO
        ENDDO
       END IF
C----6---------------------------------------------------------------7---------8
      RETURN
      END
!||====================================================================
!||    s10cndfnd    ../engine/source/elements/solid/solide10/s10cndf.F
!||--- called by ------------------------------------------------------
!||    resol        ../engine/source/engine/resol.F
!||--- calls      -----------------------------------------------------
!||    my_barrier   ../engine/source/system/machine.F
!||====================================================================
      SUBROUTINE s10cndfnd(ICNDS10,WEIGHT ,IAD_CNDS,FR_CNDS,ITAB   ,
     2                     NODFTSK,NODLTSK,EFTSK ,ELTSK ,ITSK   ,
     3                     STIFN ,STIFND)
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      "task_c.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICNDS10(3,*),WEIGHT(*),IAD_CNDS(*),FR_CNDS(*),ITAB(*)
      INTEGER NODFTSK,NODLTSK,EFTSK,ELTSK,ITSK
C     REAL
      my_real
     .   STIFN(*),STIFND(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, K,IK,ND
C     REAL
C======================================================================|
C-----get STIFND from interface part
C STIFN of contact (element not done yet)
         ik = 0
       DO k = 1,nthread
         DO i = eftsk,eltsk
           nd  = iabs(icnds10(1,i))
           stifnd(i) = stifnd(i)+ stifn(nd+ik)
         END DO
         ik = ik + numnod
       END DO
C------------------------      
       CALL my_barrier()
C------------------------      
c        IF (NSPMD>1.AND.ITSK==0) THEN
c          LCOMM =IAD_CNDS(NSPMD+1)-IAD_CNDS(1)
c          CALL SPMD_EXCH_STIF_SCND(
c     .        STIFND  ,FR_CNDS,IAD_CNDS,LCOMM)
c        END IF
C----6---------------------------------------------------------------7---------8
      RETURN
      END
!||====================================================================
!||    s10cnds_dim   ../engine/source/elements/solid/solide10/s10cndf.F
!||--- called by ------------------------------------------------------
!||    resol_init    ../engine/source/engine/resol_init.F
!||====================================================================
      SUBROUTINE s10cnds_dim(ICNDS10,ITAGS,FR_ELEM,IAD_ELEM,NBDDS  )
C-----------------------------------------------
C   M o d u l e s
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      "com01_c.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICNDS10(3,*),FR_ELEM(*),IAD_ELEM(2,*),NBDDS,ITAGS(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,IP
C=======================================================================
       DO I = 1, ns10e
         n = iabs(icnds10(1,i))
         itags(n) = i
       END DO
C--------
       nbdds = 0
       DO ip = 1,nspmd
         DO j= iad_elem(1,ip),iad_elem(1,ip+1)-1
          n = fr_elem(j)
          IF (itags(n)>0) nbdds = nbdds + 1
         END DO
       END DO
C
      RETURN
      END
!||====================================================================
!||    s10cnds_ini   ../engine/source/elements/solid/solide10/s10cndf.F
!||--- called by ------------------------------------------------------
!||    resol_init    ../engine/source/engine/resol_init.F
!||====================================================================
      SUBROUTINE s10cnds_ini(ICNDS10,ITAGS,FR_ELEM,IAD_ELEM,IAD_CDNS,FR_CDNS)
C-----------------------------------------------
C   M o d u l e s
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      "com01_c.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICNDS10(3,*),FR_ELEM(*),IAD_ELEM(2,*),IAD_CDNS(*),FR_CDNS(*),
     .        ITAGS(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER J,N,IP,NB
C=======================================================================
       NB = 1
       do ip = 1,nspmd
         iad_cdns(ip) =nb
         DO j= iad_elem(1,ip),iad_elem(1,ip+1)-1
          n = fr_elem(j)
          IF (itags(n)>0) THEN
C------ will be changed to ITAGS(N) in  S10CNDI2_INI         
           fr_cdns(nb) = n
c           FR_CDNS(NB) = ITAGS(N)
           nb = nb + 1
          END IF
         END DO
         iad_cdns(ip+1) = nb
       END DO
       itags(1:numnod) = 0
C
      RETURN
      END
!||====================================================================
!||    s10print   ../engine/source/elements/solid/solide10/s10cndf.F
!||====================================================================
      SUBROUTINE s10print(ICNDS10,A   ,V, ITAB    )
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "units_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICNDS10(3,*),itab(*)
C     REAL
      my_real
     .   A(3,*),V(3,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,N1,N2,ND
C     REAL
         DO I=1,ns10e
           n1  = icnds10(2,i)
           n2  = icnds10(3,i)
            if (itab(n1)==1294333.and.itab(n2)==1338494) then
           nd  = iabs(icnds10(1,i))
           write(iout,*)'ND,N1,N2, A,V=',itab(nd),itab(n1),itab(n2)
           write(iout,*)a(1,nd),a(2,nd),a(3,nd)
           write(iout,*)v(1,nd),v(2,nd),v(3,nd)
            end if
         END DO
C----6---------------------------------------------------------------7---------8
      RETURN
      END
!||====================================================================
!||    cndmasi2_dim         ../engine/source/elements/solid/solide10/s10cndf.F
!||--- called by ------------------------------------------------------
!||    resol_init           ../engine/source/engine/resol_init.F
!||--- calls      -----------------------------------------------------
!||    spmd_exch_tag_scnd   ../engine/source/mpi/elements/spmd_exch_tag_scnd.F
!||--- uses       -----------------------------------------------------
!||    intbufdef_mod        ../common_source/modules/interfaces/intbufdef_mod.F90
!||====================================================================
      SUBROUTINE cndmasi2_dim(IPARI,INTBUF_TAB,ICNDS10,ITAGND,WEIGHT,NKEND,
     1                        IAD_CNDS,FR_CNDS,S_FR ,NSPMD)
C-----------------------------------------------
C   M o d u l e s
C----------------------------------------------- 
      USE intbufdef_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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER  NSPMD,S_FR
      INTEGER, INTENT(IN),DIMENSION(NSPMD+1) :: IAD_CNDS
      INTEGER, INTENT(IN),DIMENSION(S_FR)    :: FR_CNDS
      INTEGER IPARI(NPARI,NINTER),ITAGND(*),ICNDS10(3,*),WEIGHT(*),
     1             NKEND 
      TYPE(INTBUF_STRUCT_), DIMENSION(NINTER) :: INTBUF_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,NTY,NSN,NMN,IM,II,NS,ILEV,L,SIZ
C=======================================================================
       DO I = 1, ns10e
        n = icnds10(1,i)
        IF (n > 0) THEN
         itagnd(n) = i
        ELSEIF(n < 0) THEN 
         itagnd(-n) = -i
        END IF
       END DO
! ----tag first the middle nodes which are on the main side of int2 (added mass compute)
      DO n=1,ninter
        nty  = ipari(7,n)
        IF (nty == 2 ) THEN
         nmn =ipari(6,n)                                 
         nsn   = ipari(5,n)
         ilev = ipari(20,n)
         IF (ilev == 27 .or. ilev == 28) THEN
          DO i=1,nsn
           IF (intbuf_tab(n)%IRUPT(i) /= 1) THEN
            ns = intbuf_tab(n)%NSV(i)
            l = intbuf_tab(n)%IRTLM(i)
              DO j = 1, 4
               ii = 4*(l-1)+j
               im = intbuf_tab(n)%IRECTM(ii)
               IF (itagnd(im)>0.AND.itagnd(im)<= ns10e) THEN
                itagnd(im) = itagnd(im) + ns10e
               ELSEIF(itagnd(im)<0.AND.itagnd(im)>= -ns10e) THEN
                itagnd(im) = itagnd(im) - ns10e
               END IF
            END DO
           END IF !(INTBUF_TAB(N)%IRUPT(I) /= 1) THEN
          END DO 
         ELSEIF (ilev <= 5 .or. ilev == 30) THEN
          DO i=1,nsn
           ns = intbuf_tab(n)%NSV(i)
           l = intbuf_tab(n)%IRTLM(i)
             DO j = 1, 4
              ii = 4*(l-1)+j
              im = intbuf_tab(n)%IRECTM(ii)
              IF (itagnd(im)>0.AND.itagnd(im)<= ns10e) THEN
               itagnd(im) = itagnd(im) + ns10e
              ELSEIF(itagnd(im)<0.AND.itagnd(im)>= -ns10e) THEN
               itagnd(im) = itagnd(im) - ns10e
              END IF
           END DO 
          END DO 
         END IF
        END IF
      END DO 
!--------comm to synchro the case iabs(ITAGND(Nd))>NS10E main of int2
       IF (nspmd>1) THEN
        siz = iad_cnds(nspmd+1)-iad_cnds(1)
        CALL spmd_exch_tag_scnd(itagnd,fr_cnds,iad_cnds,siz)
       END IF
! ----change setting of IMAP2ND by adding a comm to avoid missing the case due to weight=0
       nkend = 0
       DO i = 1, ns10e
         n = iabs(icnds10(1,i))
         ii = iabs(itagnd(n))
         IF (ii >ns10e  .AND. weight(n)/=0) nkend = nkend + 1
       END DO
C
      RETURN
      END
!||====================================================================
!||    cndmasi2_ini    ../engine/source/elements/solid/solide10/s10cndf.F
!||--- called by ------------------------------------------------------
!||    resol_init      ../engine/source/engine/resol_init.F
!||--- uses       -----------------------------------------------------
!||    intbufdef_mod   ../common_source/modules/interfaces/intbufdef_mod.F90
!||====================================================================
      SUBROUTINE cndmasi2_ini(IPARI,INTBUF_TAB,ICNDS10,ITAGND,
     .                        NKEND,IMAP2ND,MASI2ND0,MS ,WEIGHT,itab )
C-----------------------------------------------
C   M o d u l e s
C----------------------------------------------- 
      USE intbufdef_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"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARI(NPARI,NINTER),ITAGND(*),ICNDS10(3,*),
     1             NKEND,IMAP2ND(*),WEIGHT(*),itab(*)  
      TYPE(intbuf_struct_), DIMENSION(NINTER) :: INTBUF_TAB
      my_real
     .   MASI2ND0(*),MS(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,N,II,NK
C=======================================================================
C -------only cinematic--> mass condensation
C-----MASI2ND0 will be modified (as added mass) after DTNODA 
       NK = 0
       do i = 1, ns10e
         n = iabs(icnds10(1,i))
         ii = iabs(itagnd(n)) 
         IF (ii >ns10e .AND. weight(n)/=0) THEN
            nk = nk + 1
            imap2nd(nk) = i
            masi2nd0(nk) = ms(n)
         END IF
       END DO
!
      RETURN
      END
!||====================================================================
!||    cnd_dmasi2   ../engine/source/elements/solid/solide10/s10cndf.F
!||--- called by ------------------------------------------------------
!||    resol        ../engine/source/engine/resol.F
!||====================================================================
      SUBROUTINE cnd_dmasi2(ICNDS10,NKEND,IMAP2ND,MASI2ND0,MS  ,WEIGHT)
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      "com08_c.inc"
#include      "itet2_c.inc"
#include      "scr07_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,*),NKEND,IMAP2ND(*),WEIGHT(*)
      my_real
     .   MASI2ND0(*),MS(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,N,NS
      my_real
     .   DMAS,DMAS2,MASND
C=======================================================================
C---- for /CHKPT and restart : just affect output in ecrit
       IF (MCHECK>0.OR.IRUN>1) THEN
C---- can't do it precisely unless to store MASI2ND0
        IF (NKEND<0.OR.IRUN>1) THEN
          DMAS2 = msi20
          nkend =iabs(nkend)
          masi2nd0(1:nkend)=dmas2/nkend
        END IF
        IF (imassi /= 0) THEN
          ms_nd =zero
          DO i = 1, ns10e
            ns = iabs(icnds10(1,i))
            IF (weight(ns)/=0) ms_nd = ms_nd + ms(ns)
          ENDDO
        END IF
       ELSE
        dmas2 = zero
         DO i = 1, nkend
           n = imap2nd(i)
           ns = iabs(icnds10(1,n))
           dmas=ms(ns)-masi2nd0(i)
           masi2nd0(i) = max(zero,dmas)
           dmas2 = dmas2 + masi2nd0(i)
         ENDDO
C         
        masnd = zero
         DO i = 1, ns10e
           ns = iabs(icnds10(1,i))
           IF (weight(ns)/=0) masnd = masnd + ms(ns)
         ENDDO
C---due to the part w/ weight(ns)=0; DMSI2 in itet2_c.inc for restart
        IF (tt==zero) THEN      
         dmsi2 = masnd-ms_nd-dmas2
         dmsi2 = max(zero,dmsi2)
         msi20 = dmas2
        END IF      
       END IF !(MCHECK>0.AND.NKEND>0) THEN
C
      RETURN
      END
!||====================================================================
!||    cndmasi2      ../engine/source/elements/solid/solide10/s10cndf.F
!||--- called by ------------------------------------------------------
!||    sortie_main   ../engine/source/output/sortie_main.F
!||====================================================================
      SUBROUTINE cndmasi2(ICNDS10,NKEND,IMAP2ND,MASI2ND0,MS ,V  ,A   ,
     .                    WEIGHT ,MAS_ND ,KEND)
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      "com08_c.inc"
#include      "itet2_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICNDS10(3,*),NKEND,IMAP2ND(*),WEIGHT(*)
      my_real
     .   masi2nd0(*),ms(*),v(3,*),a(3,*),kend,mas_nd
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,N,NS
      my_real
     .   DMAS,VX,VY,VZ,DT05
C=======================================================================
        KEND = zero
        dt05 = half*dt1
        dmas = zero
         DO i = 1, nkend
           n = imap2nd(i)
           ns = iabs(icnds10(1,n))
c           DMAS=MS(NS)-MASI2ND0(I)
           vx = v(1,ns) + dt05*a(1,ns)
           vy = v(2,ns) + dt05*a(2,ns)
           vz = v(3,ns) + dt05*a(3,ns)
           kend = kend + ( vx*vx + vy*vy + vz*vz)*half*masi2nd0(i)
           dmas = dmas + masi2nd0(i)
         ENDDO
         dmas = dmas + dmsi2
C         
        mas_nd = zero
         DO i = 1, ns10e
           ns = iabs(icnds10(1,i))
           IF (weight(ns)/=0) mas_nd = mas_nd + ms(ns)
         ENDDO
         mas_nd = mas_nd - dmas
C
      RETURN
      END
!||====================================================================
!||    s10cnidamp             ../engine/source/elements/solid/solide10/s10cndf.F
!||--- calls      -----------------------------------------------------
!||    spmd_exch_a_scnd       ../engine/source/mpi/elements/spmd_exch_a_scnd.F
!||    spmd_exch_a_scnd_pon   ../engine/source/mpi/elements/spmd_exch_a_scnd_pon.F
!||--- uses       -----------------------------------------------------
!||    groupdef_mod           ../common_source/modules/groupdef_mod.F
!||====================================================================
      SUBROUTINE s10cnidamp(ICNDS10,MS   ,A   ,V    ,VD    ,
     1                      IADCND ,ADDCNCND,FSKYCND,SKEW  ,DAMPR  ,
     3                      DAMP   ,IGRNOD  ,DIM   ,WEIGHT ,IAD_CNDM,
     4                      FR_CNDM,FR_NBCCCND,PROCNCND)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE groupdef_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      "com01_c.inc"
#include      "com04_c.inc"
#include      "com08_c.inc"
#include      "comlock.inc"
#include      "parit_c.inc"
#include      "spmd_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICNDS10(3,*),WEIGHT(*),IAD_CNDM(*),FR_CNDM(*),DIM,
     .        fr_nbcccnd(2,*),addcncnd(*),procncnd(*),iadcnd(2,*)
C     REAL
      my_real
     .   a(3,*),v(3,*),vd(3,*),ms(*),fskycnd(4,*),
     .   dampr(nrdamp,*), damp(dim,*), skew(lskew,*)
C-----------------------------------------------
      TYPE (GROUP_)  , DIMENSION(NGRNOD) :: IGRNOD
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J,NMD,N, K,ID1,ID2,NC,N1,N2,ND,NCT,ISK,IGR
      INTEGER ITAGS(NUMNOD),ISIZE,LCOMM,LENS,LENR
C     REAL
      my_real
     .   FACTB,DAMPT,D_TSTART,D_TSTOP,DAMP_A(3),VSKW(3),DA_G(3),
     .   FX1,FY1,FZ1 ,FX2,FY2,FZ2,FAC,FAC1,FAC2,VX,VY,VZ
      my_real
     .   TMP(NUMNOD)
C======================================================================|
C=======================================================================
       itags(1:numnod) = 0
       DO i = 1, ns10e
        n = icnds10(1,i)
        IF (n > 0) THEN
         itags(n) = i
        END IF
       END DO
       isize = 4
      IF (iparit == 0 ) THEN
        IF (nspmd>1) THEN
#include "vectorize.inc"
          DO i=1,iad_cndm(nspmd+1)-1
           j = fr_cndm(i)
           a(1,j) = a(1,j) * weight(j) 
           a(2,j) = a(2,j) * weight(j) 
           a(3,j) = a(3,j) * weight(j)
          END DO
        END IF
      DO nd=1,ndamp
        igr   = nint(dampr(2,nd))
        isk   = nint(dampr(15,nd))
        factb = dampr(16,nd)
        dampt  = min(dt1,dt2)*factb
        d_tstart = dampr(17,nd)
        d_tstop  = dampr(18,nd)
       IF (tt>=d_tstart .AND. tt<=d_tstop) THEN
Cdamping only on rotational dof
          IF (dampr(19,nd)>0) cycle
C-------------------------------------------------
          damp_a(1) = dampr(3,nd)
          damp_a(2) = dampr(5,nd)
          damp_a(3) = dampr(7,nd)
        IF(isk<=1)THEN
#include "vectorize.inc"
          DO n=1,igrnod(igr)%NENTITY
           i=igrnod(igr)%ENTITY(n)
           IF (itags(i)==0) cycle
             j = itags(i)
           nmd  = iabs(icnds10(1,j))
           n1  = icnds10(2,j)
           n2  = icnds10(3,j)
           fac= ms(nmd)*weight(nmd)
           IF (ms(n1)<=em20) THEN
            fac1 = zero
           ELSE
            fac1 = fac/ms(n1)
           END IF
           IF (ms(n2)<=em20) THEN
            fac2 = zero
           ELSE
            fac2 = fac/ms(n2)
           END IF
           vx = v(1,nmd)-vd(1,j)
           vy = v(2,nmd)-vd(2,j)
           vz = v(3,nmd)-vd(3,j)
           fx1 = fac1*damp_a(1)*vx
           fy1 = fac1*damp_a(2)*vy
           fz1 = fac1*damp_a(3)*vz
           fx2 = fac2*damp_a(1)*vx
           fy2 = fac2*damp_a(2)*vy
           fz2 = fac2*damp_a(3)*vz
           a(1,n1) = a(1,n1) - fx1 
           a(2,n1) = a(2,n1) - fy1 
           a(3,n1) = a(3,n1) - fz1 
           a(1,n2) = a(1,n2) - fx2 
           a(2,n2) = a(2,n2) - fy2 
           a(3,n2) = a(3,n2) - fz2 
          ENDDO
        ELSE
C-------------------------------------------------
#include "vectorize.inc"
          DO n=1,igrnod(igr)%NENTITY
            i=igrnod(igr)%ENTITY(n)
           IF (itags(i)==0) cycle
             j = itags(i)
           nmd  = iabs(icnds10(1,j))
           n1  = icnds10(2,j)
           n2  = icnds10(3,j)
           fac= ms(nmd)
           IF (ms(n1)<=em20) THEN
            fac1 = zero
           ELSE
            fac1 = fac/ms(n1)
           END IF
           IF (ms(n2)<=em20) THEN
            fac2 = zero
           ELSE
            fac2 = fac/ms(n2)
           END IF
           vx = v(1,nmd)-vd(1,j)
           vy = v(2,nmd)-vd(2,j)
           vz = v(3,nmd)-vd(3,j)
            vskw(1)=damp_a(1)*(skew(1,isk)*vx
     .                +skew(2,isk)*vy
     .                +skew(3,isk)*vz)
            vskw(2)=damp_a(2)*(skew(4,isk)*vx
     .                +skew(5,isk)*vy
     .                +skew(6,isk)*vz)
            vskw(3)=damp_a(3)*(skew(7,isk)*vx
     .                +skew(8,isk)*vy
     .                +skew(9,isk)*vz)
            da_g(1)= skew(1,isk)*vskw(1)
     .             +skew(4,isk)*vskw(2)
     .             +skew(7,isk)*vskw(3)
            da_g(2)= skew(2,isk)*vskw(1)
     .             +skew(5,isk)*vskw(2)
     .             +skew(8,isk)*vskw(3)
            da_g(3)= skew(3,isk)*vskw(1)
     .              +skew(6,isk)*vskw(2)
     .              +skew(9,isk)*vskw(3)
           fx1 = fac1*da_g(1)
           fy1 = fac1*da_g(2)
           fz1 = fac1*da_g(3)
           fx2 = fac2*da_g(1)
           fy2 = fac2*da_g(2)
           fz2 = fac2*da_g(3)
           a(1,n1) = a(1,n1) - fx1 
           a(2,n1) = a(2,n1) - fy1 
           a(3,n1) = a(3,n1) - fz1 
           a(1,n2) = a(1,n2) - fx2 
           a(2,n2) = a(2,n2) - fy2 
           a(3,n2) = a(3,n2) - fz2 
          END DO
        END IF
       ENDIF
      ENDDO ! ND=1,NDAMP
C      
       IF (nspmd>1) THEN
          lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
          tmp(1:numnod)=zero
          CALL spmd_exch_a_scnd(
     .        a    ,tmp  ,fr_cndm,iad_cndm,lcomm,isize)
       END IF
      ELSE
C-------P/ON    
       fskycnd(1:3,1:lcncnd)=zero
      DO nd=1,ndamp
        igr   = nint(dampr(2,nd))
        isk   = nint(dampr(15,nd))
        factb = dampr(16,nd)
        dampt  = min(dt1,dt2)*factb
        d_tstart = dampr(17,nd)
        d_tstop  = dampr(18,nd)
       IF (tt>=d_tstart .AND. tt<=d_tstop) THEN
Cdamping only on rotational dof
          IF (dampr(19,nd)>0) cycle
C-------------------------------------------------
          damp_a(1) = dampr(3,nd)
          damp_a(2) = dampr(5,nd)
          damp_a(3) = dampr(7,nd)
        IF(isk<=1)THEN
#include "vectorize.inc"
          DO n=1,igrnod(igr)%NENTITY
           i=igrnod(igr)%ENTITY(n)
           IF (itags(i)==0) cycle
             j = itags(i)
           nmd  = iabs(icnds10(1,j))
           n1  = icnds10(2,j)
           n2  = icnds10(3,j)
           fac= ms(nmd)
           IF (ms(n1)<=em20) THEN
            fac1 = zero
           ELSE
            fac1 = fac/ms(n1)
           END IF
           IF (ms(n2)<=em20) THEN
            fac2 = zero
           ELSE
            fac2 = fac/ms(n2)
           END IF
           vx = v(1,nmd)-vd(1,j)
           vy = v(2,nmd)-vd(2,j)
           vz = v(3,nmd)-vd(3,j)
           fx1 = fac1*damp_a(1)*vx
           fy1 = fac1*damp_a(2)*vy
           fz1 = fac1*damp_a(3)*vz
           fx2 = fac2*damp_a(1)*vx
           fy2 = fac2*damp_a(2)*vy
           fz2 = fac2*damp_a(3)*vz
           id1 = iadcnd(1,j)
           IF (id1>0) THEN
            fskycnd(1,id1) = fx1
            fskycnd(2,id1) = fy1
            fskycnd(3,id1) = fz1
           END IF
           id2 = iadcnd(2,j)
           IF (id2>0) THEN
            fskycnd(1,id2) = fx2
            fskycnd(2,id2) = fy2
            fskycnd(3,id2) = fz2
           END IF
          ENDDO
        ELSE
C-------------------------------------------------
#include "vectorize.inc"
          DO n=1,igrnod(igr)%NENTITY
            i=igrnod(igr)%ENTITY(n)
           IF (itags(i)==0) cycle
             j = itags(i)
           nmd  = iabs(icnds10(1,j))
           n1  = icnds10(2,j)
           n2  = icnds10(3,j)
           fac= ms(nmd)
           IF (ms(n1)<=em20) THEN
            fac1 = zero
           ELSE
            fac1 = fac/ms(n1)
           END IF
           IF (ms(n2)<=em20) THEN
            fac2 = zero
           ELSE
            fac2 = fac/ms(n2)
           END IF
           vx = v(1,nmd)-vd(1,j)
           vy = v(2,nmd)-vd(2,j)
           vz = v(3,nmd)-vd(3,j)
            vskw(1)=damp_a(1)*(skew(1,isk)*vx
     .                +skew(2,isk)*vy
     .                +skew(3,isk)*vz)
            vskw(2)=damp_a(2)*(skew(4,isk)*vx
     .                +skew(5,isk)*vy
     .                +skew(6,isk)*vz)
            vskw(3)=damp_a(3)*(skew(7,isk)*vx
     .                +skew(8,isk)*vy
     .                +skew(9,isk)*vz)
            da_g(1)= skew(1,isk)*vskw(1)
     .             +skew(4,isk)*vskw(2)
     .             +skew(7,isk)*vskw(3)
            da_g(2)= skew(2,isk)*vskw(1)
     .             +skew(5,isk)*vskw(2)
     .             +skew(8,isk)*vskw(3)
            da_g(3)= skew(3,isk)*vskw(1)
     .              +skew(6,isk)*vskw(2)
     .              +skew(9,isk)*vskw(3)
           fx1 = fac1*da_g(1)
           fy1 = fac1*da_g(2)
           fz1 = fac1*da_g(3)
           fx2 = fac2*da_g(1)
           fy2 = fac2*da_g(2)
           fz2 = fac2*da_g(3)
           id1 = iadcnd(1,j)
           IF (id1>0) THEN
            fskycnd(1,id1) = fx1
            fskycnd(2,id1) = fy1
            fskycnd(3,id1) = fz1
            fskycnd(4,id1) = zero
            END IF
           id2 = iadcnd(2,j)
           IF (id2>0) THEN
            fskycnd(1,id2) = fx2
            fskycnd(2,id2) = fy2
            fskycnd(3,id2) = fz2
            fskycnd(4,id2) = zero
            END IF
          END DO
        END IF
       ENDIF
      ENDDO
C      
        IF (nspmd>1) THEN
          lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
          lens = fr_nbcccnd(1,nspmd+1)
          lenr = fr_nbcccnd(2,nspmd+1)
          CALL spmd_exch_a_scnd_pon(
     1         fr_cndm,iad_cndm,addcncnd,procncnd,fr_nbcccnd,
     2         isize,lenr   ,lens   ,fskycnd)
        END IF
C
C Routine assemblage parith/ON
C
        DO n = 1, numnod
          nct = addcncnd(n)-1
          nc = addcncnd(n+1)-addcncnd(n)
          DO k = nct+1, nct+nc
            a(1,n)   = a(1,n) - fskycnd(1,k)
            a(2,n)   = a(2,n) - fskycnd(2,k)
            a(3,n)   = a(3,n) - fskycnd(3,k)
          ENDDO
        ENDDO
       END IF !(IPARIT == 0 ) THEN
C                                                           
C----6---------------------------------------------------------------7---------8
      RETURN
      END
!||====================================================================
!||    s10cnistat             ../engine/source/elements/solid/solide10/s10cndf.F
!||--- calls      -----------------------------------------------------
!||    ngr2usr                ../engine/source/input/freform.F
!||    spmd_exch_a_scnd       ../engine/source/mpi/elements/spmd_exch_a_scnd.F
!||    spmd_exch_a_scnd_pon   ../engine/source/mpi/elements/spmd_exch_a_scnd_pon.F
!||--- uses       -----------------------------------------------------
!||    groupdef_mod           ../common_source/modules/groupdef_mod.F
!||====================================================================
      SUBROUTINE s10cnistat(ICNDS10,MS   ,A   ,V    ,VD    ,
     1                      IADCND ,ADDCNCND,FSKYCND,IGRNOD ,WEIGHT ,
     2                      IAD_CNDM,FR_CNDM,FR_NBCCCND,PROCNCND)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE groupdef_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      "com01_c.inc"
#include      "com04_c.inc"
#include      "com08_c.inc"
#include      "comlock.inc"
#include      "parit_c.inc"
#include      "spmd_c.inc"
#include      "stati_c.inc"
#include      "statr_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICNDS10(3,*),WEIGHT(*),IAD_CNDM(*),FR_CNDM(*),
     .        FR_NBCCCND(2,*),ADDCNCND(*),PROCNCND(*),IADCND(2,*)
C     REAL
      my_real
     .   a(3,*),v(3,*),vd(3,*),ms(*),fskycnd(4,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J,N, K,ID1,ID2,NC,N1,N2,ND,NCT,NGR2USR,
     .         ISIZE,LCOMM,LENS,LENR
C     REAL
      my_real
     .   FX1,FY1,FZ1 ,FX2,FY2,FZ2,FAC,FAC1,FAC2,VX,VY,VZ,DAMPC,DOMEGA
      my_real
     .   TMP(NUMNOD)
      INTEGER ITAG(NUMNOD)
C-----------------------------------------------
      TYPE (GROUP_)  , DIMENSION(NGRNOD) :: IGRNOD
      EXTERNAL NGR2USR
C======================================================================|
       IF (ISTAT/=1.AND.istat/=3) RETURN
C-------0.5*alpha     
       dampc=betate/(one + betate * dt12)
c       DT05 = HALF*DT1   
       IF (iparit/=0) fskycnd(1:3,1:lcncnd)=zero
       IF (istatg/=0) THEN      
        IF(istatg<0) istatg=ngr2usr(-istatg,igrnod,ngrnod)
        itag(1:numnod)=0
        DO n=1,igrnod(istatg)%NENTITY
         i=igrnod(istatg)%ENTITY(n)
         itag(i)=1
        ENDDO
       ELSE
        itag(1:numnod)=1
       ENDIF
       isize = 4
C------correction for nd due to V_nd=V_nd-0.5*(V1+V2)        
       domega = two*betate
       IF(istatg==0)THEN
#include "vectorize.inc"
         DO i=1,ns10e
          nd  = iabs(icnds10(1,i))
          a(1,nd)  = a(1,nd)+domega*vd(1,i)
          a(2,nd)  = a(2,nd)+domega*vd(2,i)
          a(3,nd)  = a(3,nd)+domega*vd(3,i)
         END DO
        ELSE
#include "vectorize.inc"
         DO i=1,ns10e
          nd  = iabs(icnds10(1,i))
          IF(itag(nd)==0) cycle
          a(1,nd)  = a(1,nd)+domega*vd(1,i)
          a(2,nd)  = a(2,nd)+domega*vd(2,i)
          a(3,nd)  = a(3,nd)+domega*vd(3,i)
         END DO
        END IF
C                                                           
       IF (iparit == 0 ) THEN
         IF (nspmd>1) THEN
#include "vectorize.inc"
          DO i=1,iad_cndm(nspmd+1)-1
           j = fr_cndm(i)
           a(1,j) = a(1,j) * weight(j) 
           a(2,j) = a(2,j) * weight(j) 
           a(3,j) = a(3,j) * weight(j)
          END DO
         END IF
#include "vectorize.inc"
        DO i=1,ns10e
           nd  = iabs(icnds10(1,i))
           IF(itag(nd)==0) cycle
           n1  = icnds10(2,i)
           n2  = icnds10(3,i)
           fac= dampc*ms(nd)* weight(nd)
           IF (ms(n1)<=em20) THEN
            fac1 = zero
           ELSE
            fac1 = fac/ms(n1)
           END IF
           IF (ms(n2)<=em20) THEN
            fac2 = zero
           ELSE
            fac2 = fac/ms(n2)
           END IF
           vx = v(1,nd)-vd(1,i)
           vy = v(2,nd)-vd(2,i)
           vz = v(3,nd)-vd(3,i)
           fx1 = fac1*vx
           fy1 = fac1*vy
           fz1 = fac1*vz
           fx2 = fac2*vx
           fy2 = fac2*vy
           fz2 = fac2*vz
           a(1,n1) = a(1,n1) - fx1 
           a(2,n1) = a(2,n1) - fy1 
           a(3,n1) = a(3,n1) - fz1 
           a(1,n2) = a(1,n2) - fx2 
           a(2,n2) = a(2,n2) - fy2 
           a(3,n2) = a(3,n2) - fz2 
         END DO
         IF (nspmd>1) THEN
          lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
          tmp(1:numnod)=zero
          CALL spmd_exch_a_scnd(
     .        a    ,tmp  ,fr_cndm,iad_cndm,lcomm,isize)
         END IF
       ELSE
#include "vectorize.inc"
         DO i=1,ns10e
           nd  = iabs(icnds10(1,i))
           IF(itag(nd)==0) cycle
           n1  = icnds10(2,i)
           n2  = icnds10(3,i)
           fac= dampc*ms(nd)
           IF (ms(n1)<=em20) THEN
            fac1 = zero
           ELSE
            fac1 = fac/ms(n1)
           END IF
           IF (ms(n2)<=em20) THEN
            fac2 = zero
           ELSE
            fac2 = fac/ms(n2)
           END IF
           vx = v(1,nd)-vd(1,i)
           vy = v(2,nd)-vd(2,i)
           vz = v(3,nd)-vd(3,i)
           fx1 = fac1*vx
           fy1 = fac1*vy
           fz1 = fac1*vz
           fx2 = fac2*vx
           fy2 = fac2*vy
           fz2 = fac2*vz
           id1 = iadcnd(1,i)
           IF (id1>0) THEN
            fskycnd(1,id1) = fx1
            fskycnd(2,id1) = fy1
            fskycnd(3,id1) = fz1
            fskycnd(4,id1) = zero
           END IF
           id2 = iadcnd(2,i)
           IF (id2>0) THEN
            fskycnd(1,id2) = fx2
            fskycnd(2,id2) = fy2
            fskycnd(3,id2) = fz2
            fskycnd(4,id2) = zero
           END IF
         END DO
         IF (nspmd>1) THEN
          lcomm =iad_cndm(nspmd+1)-iad_cndm(1)
          lens = fr_nbcccnd(1,nspmd+1)
          lenr = fr_nbcccnd(2,nspmd+1)
          CALL spmd_exch_a_scnd_pon(
     1         fr_cndm,iad_cndm,addcncnd,procncnd,fr_nbcccnd,
     2         isize,lenr   ,lens   ,fskycnd)
         END IF
C
C Routine assemblage parith/ON
C
        DO n = 1, numnod
          nct = addcncnd(n)-1
          nc = addcncnd(n+1)-addcncnd(n)
          DO k = nct+1, nct+nc
            a(1,n)   = a(1,n) - fskycnd(1,k)
            a(2,n)   = a(2,n) - fskycnd(2,k)
            a(3,n)   = a(3,n) - fskycnd(3,k)
          ENDDO
        ENDDO
       END IF
C----6---------------------------------------------------------------7---------8
      RETURN
      END
!||====================================================================
!||    s10stfe_poff          ../engine/source/elements/solid/solide10/s10cndf.f
!||--- called by ------------------------------------------------------
!||    resol                 ../engine/source/engine/resol.F
!||--- calls      -----------------------------------------------------
!||    my_barrier            ../engine/source/system/machine.F
!||    spmd_exch_stif_scnd   ../engine/source/mpi/elements/spmd_exch_stif_scnd.F
!||====================================================================
      SUBROUTINE s10stfe_poff(ICNDS10,WEIGHT ,IAD_CNDS,FR_CNDS,ITAB   ,
     2                     NODFTSK,NODLTSK,EFTSK ,ELTSK ,ITSK   ,
     3                     STIFN ,STIFND)
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      "com01_c.inc"
#include      "com04_c.inc"
#include      "task_c.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ICNDS10(3,*),WEIGHT(*),IAD_CNDS(*),FR_CNDS(*),ITAB(*)
      INTEGER NODFTSK,NODLTSK,EFTSK,ELTSK,ITSK
      my_real STIFN(*),STIFND(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, K,LCOMM,IK,ND
      my_real
     .   STIFEL(NS10E)
C======================================================================|
C-----get STIFND from elem part, called after Forint
       STIFEL(EFTSK:ELTSK) = zero
       ik = 0
       DO k = 1,nthread
         DO i = eftsk,eltsk
           nd  = iabs(icnds10(1,i))
           stifel(i) = stifel(i)+ stifn(nd+ik)
         END DO
         ik = ik + numnod
       END DO
       DO i = eftsk,eltsk
         stifnd(i) = stifel(i)- stifnd(i)
       END DO
C------------------------      
       CALL my_barrier()
C------------------------      
        IF (nspmd>1) THEN
!$OMP SINGLE
          lcomm =iad_cnds(nspmd+1)-iad_cnds(1)
          CALL spmd_exch_stif_scnd(
     .        stifnd  ,fr_cnds,iad_cnds,lcomm)
!$OMP END SINGLE
        END IF
C----6---------------------------------------------------------------7---------8
      RETURN
      END