ininode_rm.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/.
!||====================================================================
!||    ininode_rm   ../starter/source/materials/mat/mat019/ininode_rm.F
!||--- called by ------------------------------------------------------
!||    initia       ../starter/source/elements/initia/initia.F
!||====================================================================
      SUBROUTINE ininode_rm(CONNEC,IRIG_NODE,IRBY,SLN,NRB,NRSLN,
     .                      STIFN,STIFR, RMSTIFN, RMSTIFR,NUMEL,
     .                      NER)
C=======================================================================
C            EN SORTIE    
C    IRBY    Rigid node 
C    SLN     secnd node number by rigid material
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      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER  IRBY(*),SLN(*),NRSLN,NRB,NUMEL,NER
      INTEGER  RBYID,IRIG_NODE(*),CONNEC(NUMEL,*)
      my_real
     .    stifn(*),stifr(*),rmstifn(*), rmstifr(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,II,JJ,NR,NR1,NR0,KK,NRC,IR,N,NREST,IE,
     .        NER1,NER0,IEL
C     REAL
 
       INTEGER, DIMENSION(:), ALLOCATABLE :: 
     .                             IRN,INDX,INDX0,ITAG,IRE,
     .                             indxe, indxe0, itage
C
C  construction des materiaux rigides
C
      ALLOCATE (irn(numnod))  
      irn = 0
      nr = 0
      nrsln =0
      DO i = 1, numnod
         IF(irig_node(i) > 0) THEN
           nr = nr + 1
           irn(nr)= i
         ENDIF
      ENDDO 
C     
C  allocation de tableau de travail
C 
      ALLOCATE (indx(nr),indx0(nr),itag(numnod))
      ALLOCATE (indxe(ner),indxe0(ner),itage(ner)) 
C initialisation      
      itag = 0
      itage = 0
      indx  = 0
      indx0 = 0
      indxe  = 0
      indxe0 = 0
C      
      nr1 = 0 
      nrb = 1
      itage(1) = nrb
      indxe(1) = 1
C           
       DO j=1,10
        ie = indxe(1)
        ii = connec(ie,j)
        IF(ii > 0 ) THEN
          itag(ii) = nrb
          nr1 = nr1 + 1
          indx(nr1) = ii 
        ENDIF
      ENDDO
C      
      nrest = nr - nr1
      ner1 = 0
      
      DO i=2,ner
          ner1 = ner1 + 1
          indxe(ner1) = i
      ENDDO  
c      NRC = NR1
      kk = 0
       DO WHILE(nrest >  0 )
          nr0  = 0
          ner0 = 0
          DO i=1,nr1
             ii = indx(i)
             DO ie =1 , ner1
                iel = indxe(ie)
                IF(itage(iel) == 0) THEN
                  DO j=1,10
                    IF(ii == connec(iel, j)) THEN
                      ner0 = ner0 + 1
                      indxe0(ner0) = iel
                      itage(iel) = nrb
                    ENDIF
                  ENDDO
                ENDIF
             ENDDO 
          ENDDO  
          nr1 = 0
          IF(ner0 > 0) THEN
              DO i=1,ner0
               iel = indxe0(i)
               DO j=1,10
                  ii= connec(iel,j)
                   IF(ii > 0) THEN
               IF(itag(ii) == 0)THEN
                       itag(ii) = nrb
                       nr1 = nr1 + 1
                       indx(nr1) = ii
               END IF
                  ENDIF
                ENDDO
              ENDDO
              IF(nr1 > 0) THEN
C nbre d'element restant  
                 ner0 = 0
                 DO ie = 1, ner1
                   iel = indxe(ie) 
                   IF(itage(iel) == 0) THEN
                      ner0 = ner0 + 1
                      indxe0(ner0) = iel
                   ENDIF        
                 ENDDO 
                 ner1  = ner0
                 DO i=1,ner0
                    indxe(i)  = indxe0(i)
                ENDDO
C noeud restant
                 nrest = nrest - nr1 
              ELSE
               nrb = nrb  + 1 
               ner0 = 0
                DO ie =1 , ner1
                  iel = indxe(ie)
                  IF(itage(iel) == 0) THEN
                    ner0 = ner0 + 1
                    indxe0(ner0) = iel
                  ENDIF
                ENDDO    
C creation d'un autre corps rigid 
               ner1 = ner0
               DO i=1,ner1
                 indxe(i) = indxe0(i)
               ENDDO
C                 
               iel = indxe(1)
               nr1 = 0
               DO j=1,10
                  iel = indxe(1)
                  ii = connec(iel,j)
                  itage(iel) = nrb
                  IF(ii > 0 ) THEN
                      itag(ii) = nrb
                      nr1 = nr1 + 1
                      indx(nr1) = ii 
                  ENDIF
                ENDDO 
C                
                   nrest = nrest - nr1
              ENDIF          
          ELSE 
               nrb = nrb + 1
C creation d'un autre corps rigid 
                ner0 = 0
                DO ie =1 , ner1
                  iel = indxe(ie)
                  IF(itage(iel) == 0) THEN
                    ner0 = ner0 + 1
                    indxe0(ner0) = iel
                  ENDIF
                ENDDO    
C creation d'un autre corps rigid 
               ner1 = ner0
               DO i=1,ner1
                 indxe(i) = indxe0(i)
               ENDDO 
               iel = indxe(1)
               itage(iel) = nrb
               nr1 = 0    
               DO j=1,10
cc                  IEL = INDXE(1)
                  ii = connec(iel,j)
                  IF(ii > 0 ) THEN
                      itag(ii) = nrb
                      nr1 = nr1 + 1
                      indx(nr1) = ii 
                  ENDIF
               ENDDO 
C
               nrest = nrest - nr1  
             ENDIF
           ENDDO 
C
C   creation des corps rigide
C
      kk = 0
      DO ir =1,nrb
        ii = 0
         DO i=1,nr
            n = irn(i)
            IF(itag(n) == ir) THEN
               ii = ii + 1
               irby(ii + kk) = n
               rmstifn(ii + kk) = stifn(n)
               rmstifr(ii + kk) = stifr(n)
               stifn(n) = em20
               stifr(n) = em20
            ENDIF
         ENDDO
         sln(ir) = ii
         kk = kk + ii 
         nrsln = nrsln + ii
      ENDDO
C          
       DEALLOCATE(itag,irn,indx,indx0)
       DEALLOCATE(indxe,indxe0,itage)
      RETURN
      END