i10trc.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/.
!||====================================================================
!||    i10trc        ../engine/source/interfaces/intsort/i10trc.F
!||--- called by ------------------------------------------------------
!||    i10main_tri   ../engine/source/interfaces/intsort/i10main_tri.F
!||====================================================================
      SUBROUTINE i10trc(
     1      NSN   ,I_STOK   ,CAND_N ,CAND_E,CAND_F,
     2      CAND_A,NUM_IMP  ,IND_IMP)
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,NUM_IMP,IND_IMP(*)
      INTEGER CAND_N(*),CAND_E(*),CAND_A(*),
     .        cand_t
      my_real cand_f(6,*),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=======================================================================
      IF(num_imp>0)THEN
        DO i=1,i_stok
         iput(i)=0
        END DO
        DO n=1,num_imp
            i= ind_imp(n)
          iput(i)=1
        END DO
        DO i=1,i_stok
         IF(cand_f(1,i)==zero.AND.iput(i)==0)THEN
          cand_n(i) = nsn+1
         ENDIF
        END DO
      ELSE
      DO i=1,i_stok
        IF(cand_f(1,i)==zero .OR. cand_n(i) == 0)THEN
          cand_n(i) = nsn+1
        ENDIF
      ENDDO
      ENDIF !IF(NUM_IMP>0)
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_F
C     SUR N CROISSANT
C     PERMUTATION 1 PASSE
C=======================================================================
      DO n=1,num_imp
        k=ind_imp(n)
        i = iput(k)
        ind_imp(n)=i
      END DO
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
        cand_tf = cand_f(1,k)
        cand_f(1,k) = cand_f(1,i)
        cand_f(1,i) = cand_tf
C
        cand_tf = cand_f(2,k)
        cand_f(2,k) = cand_f(2,i)
        cand_f(2,i) = cand_tf
C
        cand_tf = cand_f(3,k)
        cand_f(3,k) = cand_f(3,i)
        cand_f(3,i) = cand_tf
C
        cand_tf = cand_f(4,k)
        cand_f(4,k) = cand_f(4,i)
        cand_f(4,i) = cand_tf
C
        cand_tf = cand_f(5,k)
        cand_f(5,k) = cand_f(5,i)
        cand_f(5,i) = cand_tf
C
        cand_tf = cand_f(6,k)
        cand_f(6,k) = cand_f(6,i)
        cand_f(6,i) = cand_tf
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