Esope source files

   1 : C NUNONU    SOURCE    CHAT      06/03/29    21:28:36     5360           
   2 : C
   3 : C     *****************************************************************
   4 : C     MODULE  : ST (STRUCTURE DES DONNEES)
   5 : C     FICHIER : ST_NOEUD.F
   6 : C     OBJET   : RENUMEROTE LES NOEUDS D'UN MAILLAGE 2D OU 3D
   7 : C     FONCT.  : 
   8 : C
   9 : C     OBJET NUNONU : RENUMEROTE LES NOEUDS D'UN MAILLAGE
  10 : C     OBJET NUNOCP : COMPRIME LES NUMEROS DES NOEUDS D'UN MAILLAGE
  11 : C     OBJET          EN DEBUT : DE 1 A "NBNUM"
  12 : C     OBJET NUNISO : RENUMEROTATION, LES NOEUDS ISOLES SONT MIS EN FIN 
  13 : C     OBJET NUENUL : RENUMEROTATION, LES ELEMENTS NULS SONT MIS EN FIN 
  14 : C     OBJET NUGCNU : GARBAGE COLLECTOR ELEMENTS ET POINTS
  15 : C
  16 : C     AUTEUR  : O. STAB 
  17 : C     DATE    : 08.96
  18 : C     TESTS   :  
  19 : C     MODIFICATIONS :
  20 : C      AUTEUR, DATE, OBJET :
  21 : C
  22 : C
  23 : C     *****************************************************************
  24 : C
  25 : C
  26 :       SUBROUTINE NUNONU(ITRNOE,NBNMAX,NOETRI,NOEMAX,NBE,
  27 :      >                  COORD,IDIMC,
  28 :      >                  NUM,NBNUM,ITRAMA,iarr)
  29 : C     *****************************************************************
  30 : C     OBJET NUNONU : RENUMEROTE LES NOEUDS D'UN MAILLAGE
  31 : C
  32 : C     EN ENTREE:
  33 : C      ITRNOE,NBNMAX,NBE,NOETRI,NOEMAX :  LE MAILLAGE
  34 : C      NBNMAX: SI NBNMAX = 0 ALORS ITRNOE N'EST PAS CONSIDERE
  35 : C      NOEMAX: SI NOEMAX = 0 ALORS NOETRI N'EST PAS CONSIDERE
  36 : C      
  37 : C
  38 : C      COORD,IDIMC : COORDONNEES DES NOEUDS
  39 : C      IDIMC : SI IDIMC = 0 ALORS COORD N'EST PAS CONSIDERE
  40 : C
  41 : C      NUM    :  NUM(I) EST NUMERO DE L'ELEMENT QUI DOIT ETRE MIS EN I
  42 : C                ATTENTION !! NUM DOIT ETRE TRIE AVEC ENSTRI
  43 : C      NBNUM  :  NOMBRE DE NOEUDS A RENUMEROTER
  44 : C      ITRAMA :  TABLEAU DE TRAVAIL DE TAILLE = MAX(NUM(I))
  45 : C
  46 : C     EN SORTIE:
  47 : C       ITRNOE : MIS A JOUR
  48 : C       NOETRI : MIS A JOUR
  49 : C       COORD  : MIS A JOUR
  50 : C
  51 : C     CONDITION D'APPLICATION : TOUT MAILLAGE
  52 : C     REMARQUE : COPIE DE IORDRE DE S.M. TIJANI
  53 : C     *****************************************************************
  54 :       IMPLICIT INTEGER(I-N)
  55 :       INTEGER    ITRNOE(*),NBNMAX,NOETRI(*),NBE
  56 :       REAL*8       COORD(*)
  57 :       INTEGER    IDIMC
  58 :       INTEGER    NOEMAX, NUM(*), NBNUM, ITRAMA(*), iarr
  59 : C
  60 : C     ---- COPIE DE IORDRE (S.M.TIJANI )----
  61 : C
  62 :       INTEGER I,J,LI,MI
  63 :       INTEGER NUMOLD,ITAMPO
  64 :       REAL*8    RTAMPO
  65 : C
  66 : C     ON N'A RIEN A FAIRE
  67 : C
  68 :       iarr = 0
  69 :       IF(NBNUM.LE.1) GOTO 9999
  70 : C
  71 :       DO 20 I=1,NBE
  72 : C           -----------------------------------
  73 : C       --- MISE A JOUR DES NOEUDS DES ELEMENTS ---
  74 : C           -----------------------------------
  75 :         DO 10 J=1,NBNMAX
  76 :           NUMOLD = ITRNOE((I-1)*NBNMAX + J)
  77 :           IF((NUMOLD.GT.0 ).AND.(NUMOLD.LE.NBNUM))THEN
  78 :             ITRNOE((I-1)*NBNMAX + J) = NUM(NUMOLD)
  79 :           ENDIF  
  80 :    10   CONTINUE
  81 :    20 CONTINUE
  82 : C
  83 : C     PERMUTATION M INVERSE DE L :
  84 : C
  85 :       DO 30 I=1,NBNUM
  86 :         ITRAMA(NUM(I))=I
  87 :    30 CONTINUE
  88 : C
  89 : C     IMPOSER A NARG L'ORDRE DEFINI PAR L.
  90 : C     LES TABLEAUX L ET M SONT CASSES.
  91 : C
  92 :       DO 50 I=1,NBNUM
  93 :         LI=NUM(I)
  94 :         MI=ITRAMA(I)
  95 : C           ----------------------
  96 : C       --- PERMUTATION DES NOEUDS ---
  97 : C           ----------------------
  98 :           IF( NOEMAX.NE.0)THEN
  99 :             ITAMPO         = NOETRI(I)
 100 :             NOETRI(I)      = NOETRI(LI)
 101 :             NOETRI(LI) = ITAMPO
 102 :           ENDIF
 103 :           DO 40 J=1,IDIMC
 104 :             RTAMPO                = COORD((I-1)*IDIMC+J)
 105 :             COORD((I-1)*IDIMC+J)  = COORD((LI-1)*IDIMC+J)
 106 :             COORD((LI-1)*IDIMC+J) = RTAMPO
 107 :    40     CONTINUE
 108 : C
 109 : C       LE NOUVEAU NUMERO DE LI EST I
 110 : C       LE NOUVEAU NUMERO DE MI A CHANGE, C'EST DEVENU LI
 111 : C
 112 :         NUM(MI)=LI
 113 :         ITRAMA(LI)=MI
 114 :    50 CONTINUE
 115 : C
 116 : C     RESTAURATION DES TABLEAUX L (INITIAL) ET M (SON INVERSE).
 117 : C
 118 :       DO 60 I=1,NBE
 119 :         LI=NUM(I)
 120 :         MI=ITRAMA(I)
 121 :         NUM(MI)=I
 122 :         ITRAMA(LI)=I
 123 :    60 CONTINUE
 124 :  9999 END
 125 :  
 126 :  
 127 :