Télécharger nunonu.eso

Retour à la liste

Numérotation des lignes :

  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