Télécharger la plaquette Cast3M


fr en

Télécharger nunonu.eso

Retour à la liste

Numérotation des lignes : 

nunonu

  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.  
  128.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales