Télécharger la plaquette Cast3M


fr en

Télécharger nugcnu.eso

Retour à la liste

Numérotation des lignes : 

nugcnu

  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