Download nuniso.eso

Back to the list

   1 : C NUNISO    SOURCE    CHAT      05/01/13    02:03:40     5004           
   2 : C
   3 :       SUBROUTINE NUNISO(NOETRI,NBN,NUM,NBISOL,IERR)
   4 : C     *****************************************************************
   5 : C     OBJET NUNISO : PROPOSE UNE RENUMEROTATION POUR METTRE EN FIN LES
   6 : C     OBJET          NOEUDS ISOLES.
   7 : C              
   8 : C     EN ENTREE:
   9 : C      NOETRI: TABLEAU DES ELEMENTS INCIDENTS AUX NOEUDS
  10 : C      NBN   : NOMBRE DE NOEUDS
  11 : C
  12 : C     EN SORTIE:
  13 : C       NBISOL : NOMBRE DE NOEUDS ISOLES
  14 : C       NUM    : NOUVELLE NUMEROTATION 
  15 : C                NUM(I) =  NOUVEAU NUMERO DU NOEUD I
  16 : C                NUM EST UN TABLEAU DE TAILLE NBN
  17 : C
  18 : C     CONDITION D'APPLICATION : TOUT MAILLAGE
  19 : C     *****************************************************************
  20 :       IMPLICIT INTEGER(I-N)
  21 :       INTEGER    NOETRI(*),NBN
  22 :       INTEGER    NUM(*),NBISOL,IERR
  23 : C
  24 :       INTEGER I
  25 : C
  26 :       NBISOL = 0
  27 :       I = 1 
  28 :    10 IF(I.GT.(NBN-NBISOL))GOTO 9999
  29 : C     --- LE NOEUD EST ISOLE ---
  30 :       IF( NOETRI(I).EQ.0 )THEN
  31 : C
  32 : C       --- RECHERCHE D'UN NOEUD (A LA FIN) POUR PERMUTER ---
  33 :    20   IF( NOETRI(NBN-NBISOL).EQ. 0 )THEN
  34 :            NUM(NBN-NBISOL) = NBN-NBISOL
  35 :            NBISOL = NBISOL + 1
  36 : C          --- TOUS LES NOEUDS SONT ISOLES ---
  37 :            IF( NBISOL.EQ.NBN )GOTO 9999
  38 : C          --- ON A TROUVE TOUS LES NOEUDS ISOLES ---
  39 :            IF( I.GT.(NBN-NBISOL))GOTO 9999
  40 :            GOTO 20  
  41 :         ENDIF
  42 : C
  43 : C       --- ON A LE NOEUD POUR PERMUTER ---
  44 :         NUM(NBN-NBISOL) = I
  45 :         NUM(I) = NBN-NBISOL
  46 :         NBISOL = NBISOL + 1
  47 :       ELSE
  48 :         NUM(I) = I
  49 :       ENDIF
  50 :       I = I + 1
  51 :       GOTO 10
  52 : C      
  53 :  9999 END
  54 :  
  55 :  

© Cast3M 2003 - All rights reserved.
Disclaimer