Download nucomp.eso

Back to the list

   1 : C NUCOMP    SOURCE    CHAT      06/03/29    21:28:27     5360           
   2 :       SUBROUTINE NUCOMP(IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,NOETRI,
   3 :      >                   NOEMAX,NBE,NUM,NBNUM,iarr)
   4 : C     *****************************************************************
   5 : C     OBJET : RENUMEROTE LES ELEMENTS D'UN MAILLAGE POUR LES COMPACTER
   6 : C             EN DEBUT : DE 1 A "NBNUM"
   7 : C     EN ENTREE:
   8 : C      IDE    :  (1..3) DIMENSION DES ELEMENTS 
   9 : C      ITRNOE:  LES NOEUDS DES ELEMENTS
  10 : C      NBNMAX :  (2..8) NOMBRE DE NOEUDS MAXIMUM DES ELEMENTS 
  11 : C      ITRTRI:  LES VOISINS DES ELEMENTS
  12 : C      NBCMAX :  (2..6) NOMBRE DE COTES MAXIMUM DES ELEMENTS 
  13 : C      NBE    :  NOMBRE D'ELEMENTS DU MAILLAGE
  14 : C      NOEMAX: SI NOEMAX = 0 ALORS NOETRI N'EST PAS CONSIDERE
  15 : C      NUM    :  NUM(I) EST NUMERO DE L'ELEMENT QUI DOIT ETRE MIS EN I
  16 : C                ATTENTION !! NUM DOIT ETRE TRIE AVEC ENSTRI
  17 : C      NBNUM  :  NOMBRE D'ELEMENTS A RENUMEROTER
  18 : C     EN SORTIE:
  19 : C       ITRNOE: MIS A JOUR
  20 : C       ITRTRI: MIS A JOUR 
  21 : C       NOETRI : MIS A JOUR
  22 : C     CONDITION D'APPLICATION : TOUT MAILLAGE
  23 : C     COMPLEXITE : O(NBNUM) ALORS QUE STRRENUM EST EN O(NBE)
  24 : C     PRINCIPE   : LES PERMUTATIONS FONCTIONNENT SI NUM(I)>I
  25 : C                  C.A.D. L'ANCIENNE POSITION > A LA NOUVELLE
  26 : C                  ON EST DANS CE CAS SI NUM EST TRIE PAR ORDRE CROISS.
  27 : C     *****************************************************************
  28 :       IMPLICIT INTEGER(I-N)
  29 :       INTEGER    IDE,ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX,NOETRI(*),NBE
  30 :       INTEGER    NOEMAX,NUM(*),NBNUM,iarr
  31 : C
  32 :       INTEGER I
  33 : C
  34 :       DO 10 I=1,NBNUM
  34 :         CALL NUPERM(IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,NOETRI,
  35 :      >                NOEMAX,NBE,NUM(I),I,iarr)
  36 :         IF( iarr .NE. 0 )GOTO 999
  37 :    10 CONTINUE
  38 :   999 END
  39 :  
  40 :  
  41 :  

© Cast3M 2003 - All rights reserved.
Disclaimer