Télécharger nugcnu.eso

Retour à la liste

Numérotation des lignes :

  1. C NUGCNU SOURCE CHAT 06/03/29 21:28:32 5360
  2. C
  3. C
  4. SUBROUTINE NUGCNU(IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  5. > NOETRI,NOEMAX,NBE,COORD,IDIMC,NBP,
  6. > ITVL,NITMAX,iarr)
  7. C *****************************************************************
  8. C OBJET NUGCNU : GARBAGE COLLECTOR ELEMENTS ET POINTS
  9. C OBJET SUPPRIME LES ELEMENTS NULS ET LES POINTS ISOLES
  10. C OBJET LES POINTS ET LES ELEMENTS SONT RENUMEROTES !!!
  11. C
  12. C EN ENTREE:
  13. C ITRNOE,NBNMAX,ITRITRI,NBCMAX,NOETRI,NOEMAX,NBE : LE MAILLAGE
  14. C NBNMAX: SI NBNMAX = 0 ALORS ITRNOE N'EST PAS CONSIDERE
  15. C NOEMAX: SI NOEMAX = 0 ALORS NOETRI N'EST PAS CONSIDERE
  16. C COORD,NBP : COORDONNEES ET NOMBRE DE NOEUDS
  17. C IDIMC : DIMENSION DE L'ESPACE, SI IDIMC = 0 ALORS ON NE COMPRIME
  18. C PAS LES NOEUDS.
  19. C
  20. C ITVL(NITMAX) : TABLEAU DE TRAVAIL (ENTIERS), SA TAILLE EST DE
  21. C 2*NBP POUR LA RENUMEROTATION DES NOEUDS
  22. C + 2*NBE POUR LA RENUMEROTATION DES ELEMENTS
  23. C + NBP SI NOETRI N4EST PAS DONNE (NOEMAX=0)
  24. C
  25. C EN SORTIE:
  26. C ITRNOE,NBE,ITRTRI,NOETRI,COORD,NBN : MIS A JOUR
  27. C
  28. C CONDITION D'APPLICATION : TOUT MAILLAGE
  29. C *****************************************************************
  30. IMPLICIT INTEGER(I-N)
  31. INTEGER IDE,ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX
  32. INTEGER NOETRI(*),NOEMAX,NBE
  33. REAL*8 COORD(*)
  34. INTEGER IDIMC,NBP,ITVL(*),NITMAX,iarr
  35. C
  36. INTEGER I,J,NUM,ITRAMA,NUM1,NBISOL,NBENUL
  37. INTEGER NOETR2
  38. C
  39. NUM = 1
  40. NBISOL = 0
  41. NBENUL = 0
  42. IF(IDIMC.EQ.0)GOTO 40
  43. C ============================
  44. C --- 1. COMPRESSION DES NOEUDS ---
  45. C ============================
  46. IF( NOEMAX.EQ. 0 )THEN
  47. NOETR2 = 0
  48. NUM = NBP + NOETR2
  49. ENDIF
  50. ITRAMA = NUM + NBP
  51. IF( NITMAX .LT. ITRAMA+NBP )THEN
  52. iarr = -2
  53. CALL DSERRE(1,iarr,'NUCGNU',' POUR COMPRIMER LES NOEUDS')
  54. CALL ESEINT(1,'PLACE NECESSAIRE : ',ITRAMA+NBP,1)
  55. CALL ESEINT(1,'PLACE DISPONIBLE : ',NITMAX,1)
  56. GOTO 9999
  57. ENDIF
  58. C
  59. C ---- RECHERCHE DES NOEUDS CONNECTES ----
  60. C --------------------------------
  61. IF( NOEMAX.EQ. 0 )THEN
  62. DO 105 I=1,NBP
  63. ITVL(NOETR2+I) = 0
  64. 105 CONTINUE
  65. DO 120 I=1,NBE
  66. DO 110 J=1,NBNMAX
  67. NUM1 = ITRNOE((I-1)*NBNMAX+J)
  68. IF( NUM1.NE.0 )ITVL(NOETR2+NUM1) = I
  69. 110 CONTINUE
  70. 120 CONTINUE
  71. C
  72. CALL NUNISO(ITVL(NOETR2+1),NBP,ITVL(NUM+1),NBISOL,iarr)
  73. ELSE
  74. C
  75. CALL NUNISO(NOETRI,NBP,ITVL(NUM+1),NBISOL,iarr)
  76. ENDIF
  77. C
  78. IF( iarr.NE. 0 )THEN
  79. CALL DSERRE(1,iarr,'NUCGNU',' APPEL NUNISO ')
  80. GOTO 9999
  81. ENDIF
  82. C
  83. C ---- SUPPRESSION DES NOEUDS PAS CONNECTES ----
  84. C --------------------------------------
  85. CALL NUNONU(ITRNOE,NBNMAX,NOETRI,NOEMAX,NBE,
  86. > COORD,IDIMC,
  87. > ITVL(NUM+1),NBP,ITVL(ITRAMA+1),iarr)
  88. IF( iarr.NE. 0 )THEN
  89. CALL DSERRE(1,iarr,'NUCGNU',' APPEL NUNONU ')
  90. GOTO 9999
  91. ENDIF
  92. NBP = NBP - NBISOL
  93. C
  94. C ==============================
  95. C --- 2. COMPRESSION DES ELEMENTS ---
  96. C ==============================
  97. C
  98. 40 IF( IDE.EQ. 0 )GOTO 9999
  99. CALL NUENUL(ITRNOE,NBNMAX,NBE,ITVL(NUM+1),NBENUL,iarr)
  100. IF( iarr.NE. 0 )THEN
  101. CALL DSERRE(1,iarr,'NUCGNU',' APPEL NUENUL ')
  102. GOTO 9999
  103. ENDIF
  104. C
  105. ITRAMA = NUM + NBE
  106. CALL NURENU(IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,NOETRI,
  107. > NOEMAX,NBE,ITVL(NUM+1),ITVL(ITRAMA+1),iarr)
  108. C
  109. IF( iarr.NE. 0 )THEN
  110. CALL DSERRE(1,iarr,'NUCGNU',' APPEL NURENU ')
  111. GOTO 9999
  112. ENDIF
  113. C
  114. NBE = NBE - NBENUL
  115. C
  116. C
  117. 9999 END
  118.  
  119.  
  120.  
  121.  

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