i11trc.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/.
!||====================================================================
!||    i11trc        ../engine/source/interfaces/intsort/i11trc.F
!||--- called by ------------------------------------------------------
!||    i11main_tri   ../engine/source/interfaces/intsort/i11main_tri.F
!||--- uses       -----------------------------------------------------
!||    tri7box       ../engine/share/modules/tri7box.F
!||====================================================================
      SUBROUTINE i11trc(
     1      I_STOK  ,CAND_N ,CAND_E,CAND_FX,CAND_FY ,
     2      CAND_FZ ,MFROT  ,ADDCM ,CHAINE ,NSN4    ,
     3      ITAB    , JLT   , NFT  ,IFPEN,STFS ,NIN ,NRTS)
C============================================================================
      USE tri7box      
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C   ROLE DE LA ROUTINE:
C   ===================
C   TRI sur N de CAND_N CAND_E CAND_F
C   et elimination des noeuds en rebond 
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER I_STOK,MFROT,NSN4,JLT,NFT ,NIN,NRTS
      INTEGER CAND_N(*),CAND_E(*),ADDCM(*),CHAINE(2,*),IFPEN(*),ITAB(*)
C     REAL
      my_real
     .   cand_fx(*),cand_fy(*),cand_fz(*),stfs(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,N,K,IADFIN,IAD,IAD0,J,II,SLVE,NN
C-----------------------------------------------
C=======================================================================
C
C Remove deleted Candidates from impacting list.
C
      DO i=1,jlt
        ii = i + nft
        IF(ifpen(ii) == 1)THEN
          slve = cand_n(ii)
          IF(slve<=nrts)THEN
             IF(stfs(slve)==zero)THEN
                ifpen(ii) = 0 
             ENDIF
          ELSE
             nn = slve - nrts
             IF(stifi(nin)%P(nn)==zero)THEN
                ifpen(ii) = 0  
             ENDIF
          ENDIF
        ENDIF
      ENDDO
C
 
      iad0 = 0
      DO i=1,jlt
        ii = i + nft
        IF(ifpen(ii) == 1)THEN
          iad=addcm(cand_e(ii))
          j=0
          DO WHILE(iad/=0.AND.j<nsn4)
            j=j+1
            IF(chaine(1,iad)==cand_n(ii))THEN
              ifpen(ii) = 0
              iad=0
            ELSE
              iad0=iad
              iad=chaine(2,iad)
            ENDIF
          ENDDO
          IF(ifpen(ii) == 1)THEN
            i_stok = i_stok + 1
              iadfin=i_stok
              IF(iadfin>nsn4) THEN
                RETURN
              ENDIF   
            chaine(1,iadfin)=cand_n(ii)
            chaine(2,iadfin)=0
            IF(addcm(cand_e(ii))==0)THEN
              addcm(cand_e(ii))=iadfin
            ELSE
              chaine(2,iad0)=iadfin
            ENDIF
            cand_fx(i_stok) = cand_fx(ii)
 
            cand_fy(i_stok) = cand_fy(ii)
            cand_fz(i_stok) = cand_fz(ii)
            cand_e(i_stok) = cand_e(ii)
            cand_n(i_stok) = cand_n(ii)
            ifpen(i_stok) = ifpen(ii)
          ENDIF
        ENDIF
      ENDDO
C
      RETURN
      END