i23trc.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/.
!||====================================================================
!||    i23trc        ../engine/source/interfaces/intsort/i23trc.F
!||--- called by ------------------------------------------------------
!||    i23main_tri   ../engine/source/interfaces/intsort/i23main_tri.F
!||====================================================================
      SUBROUTINE i23trc(
     1      NSN    ,I_STOK  ,CAND_N ,CAND_E,CAND_P ,
     2      CAND_FX,CAND_FY ,CAND_FZ,CAND_A,IFPEN  )
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-----------------------------------------------
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,NSN
      INTEGER CAND_N(*),CAND_E(*),CAND_A(*), IFPEN(*),
     .        cand_t
      my_real cand_fx(*),cand_fy(*),cand_fz(*),cand_p(*),cand_tf
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, I_ST0,N,NN,K,IGET(I_STOK),IPUT(I_STOK)
C=======================================================================
C
      DO n=1,nsn+3
        cand_a(n) = 0
      ENDDO
C=======================================================================
C     LES NOEUDS DELETES DEVIENNENT NSN+1 
C=======================================================================
      DO i=1,i_stok
        IF(ifpen(i)==0)THEN
          cand_n(i) = nsn+1
        ENDIF
      ENDDO
C=======================================================================
C     CAND_A : DENOMBREMENT DE CHAQUE NOEUD 
C     APRES 300 CAND_A[3:NSN+3] : OCCURENCE DES NOEUDS [1:NSN+1] 
C=======================================================================
      DO i=1,i_stok
        nn = cand_n(i) + 2
        cand_a(nn) = cand_a(nn) + 1
      ENDDO
C=======================================================================
C     CAND_A : ADRESSE DE CHAQUE NOEUD 
C     APRES 400 CAND_A[2:NSN+2] : ADRESSE DES NOEUDS [1:NSN+1] 
C=======================================================================
      cand_a(1) = 1
      cand_a(2) = 1
      DO n=3,nsn+2
        cand_a(n) = cand_a(n) + cand_a(n-1)
      ENDDO
C=======================================================================
C     IPUT(I) ADRESSE OU DOIT ALLER I
C     IGET(K) ADRESSE D'OU DOIT VENIR K
C     APRES 500 CAND_A[1:NSN+1] : ADRESSE DES NOEUDS [1:NSN+1] 
C=======================================================================
      DO i=1,i_stok
        nn = cand_n(i) + 1
        k = cand_a(nn)
        iput(i) = k
        iget(k) = i
        cand_a(nn) = cand_a(nn) + 1
      ENDDO
C=======================================================================
C     TRI DE CAND_N CAND_E CAND_P
C     SUR N CROISSANT
C     PERMUTATION 1 PASSE
C=======================================================================
      DO k=1,i_stok
        i = iget(k)
C
        cand_t    = cand_n(k)
        cand_n(k) = cand_n(i)
        cand_n(i) = cand_t
C
        cand_t    = cand_e(k)
        cand_e(k) = cand_e(i)
        cand_e(i) = cand_t
C------ Fx
        cand_tf    = cand_fx(k)
        cand_fx(k) = cand_fx(i)
        cand_fx(i) = cand_tf
C------ Fy
        cand_tf    = cand_fy(k)
        cand_fy(k) = cand_fy(i)
        cand_fy(i) = cand_tf
C------ Fz
        cand_tf    = cand_fz(k)
        cand_fz(k) = cand_fz(i)
        cand_fz(i) = cand_tf
C
        cand_tf   = cand_p(k)
        cand_p(k) = cand_p(i)
        cand_p(i) = cand_tf
 
        cand_t    = ifpen(k)
        ifpen(k)  = ifpen(i)
        ifpen(i)  = cand_t 
C 
        iput(i) = iput(k)
        iget(iput(i)) = i
      ENDDO
C=======================================================================
C     CAND_A[NSN+1] : ADRESSE DE NSN+1 
C=======================================================================
      i_stok = cand_a(nsn+1) - 1
      cand_a(nsn+2) = cand_a(nsn+1)
C
      RETURN
      END