Télécharger scmat.eso

Retour à la liste

scmat
C SCMAT     SOURCE    CHAT      06/03/29    21:33:05     5360
      SUBROUTINE SCMAT(IFR,NBNIFR,NBIFR,
     >                 IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
     >                 NOETRI,NBE,ITVL,IMAX,
     >                 IMAT,NPLEIN,NCREUX,iarr)
C     **********************************************************************
C     OBJET : DETERMINE LES 2 REGIONS POUR LA SCULPT : LE PLEIN (1)
C             ET LE CREUX (-1)
C     EN ENTREE  :
C       IFR      : LES ELEMENTS DES FRONTIERES
C       NBIFR    : NOMBRE D'ELEMENTS FRONTIERE
C
C       ITVL : TABLEAU DE TRAVAIL = NBE + PILE (APPEL TMA1CC)
C       IMAX     : TAILLE DU TABLEAU DE TRAVAIL
C
C     EN SORTIE  :
C       IMAT     : IMAT(I) = 1 SI L'ELEMENT EST PLEIN
C                                 -1 SI "    "  "  "  CREUX
C       NPLEIN  : NOMBRE DE COMPOSANTES CONNEXES PLEINES
C       NCREUX  : NOMBRE DE COMPOSANTES CONNEXES CREUSES
C       iarr     : CODE D'ERREUR
C                -1 UN ELEMENT FRONTIERE DE IFR N'EXISTE PAS
C                -2 ITVL TROP PETIT
C     **********************************************************************
      IMPLICIT INTEGER(I-N)
      INTEGER    IFR(*),NBIFR,NBNIFR,IDE
      INTEGER    ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX
      INTEGER    NOETRI(*),NBE,ITVL(*),IMAX,IMAT(*)
      INTEGER    NPLEIN,NCREUX,iarr
C
      INTEGER NBVUE,IT1,IT2,I1,I2,NBEMAT,IREGIO,I,J
      INTEGER NBNE,NBCE
      INTEGER STRNBN,STRNBC
      EXTERNAL STRNBN,STRNBC
C        ===================
C     --- 1. INITIALISATION ----
C        ===================
      NPLEIN = 0
      NCREUX = 0
      iarr = -1
      DO 10 I=1,NBIFR
        CALL SFRICR(IFR((I-1)*NBNIFR+1),NBNIFR,IDE,
     >               ITRNOE,NBNMAX,ITRTRI,NBCMAX,
     >               NOETRI,NBE,iarr)
      IF( iarr.NE. 0 )GOTO 999
   10 CONTINUE
      DO 20 I=1,NBE
        IMAT(I) = 0
   20 CONTINUE
      iarr = 0
C        ====================================================
C     --- 2. RECHERCHE DES FRONTIERES DONNEES NON RECONNUES ----
C         SI UNE DES REGIONS EST CONNU, L'AUTRE L'EST AUSSI
C        ====================================================
C
      NBVUE = 0
      I = 0
   30 I = MOD(I,NBIFR)+1
        CALL SFRIDE(IFR((I-1)*NBNIFR+1),NBNIFR,IDE,
     >               ITRNOE,NBNMAX,ITRTRI,NBCMAX,
     >               NOETRI,NBE,IT1,IT2,I1,I2 )
      NBEMAT = 0
C     ----- FRONTIERE DONNEE EST SUR LA FRONTIERE REELLE ---------
      IF(IT1.EQ.0)THEN
        IF(IMAT(IT2).EQ.0)THEN
         IREGIO = 1
         NPLEIN = NPLEIN + 1
         CALL SCRGCC(IT2,IREGIO,IDE,ITRTRI,NBCMAX,NBE,
     >                 ITVL,IMAT,NBEMAT,iarr)
        ENDIF
        GOTO 40
      ENDIF
      IF(IT2.EQ.0)THEN
        IF(IMAT(IT1).EQ.0)THEN
         IREGIO = 1
         NPLEIN = NPLEIN + 1
         CALL SCRGCC(IT1,IREGIO,IDE,ITRTRI,NBCMAX,NBE,
     >                 ITVL,IMAT,NBEMAT,iarr)
        ENDIF
        GOTO 40
      ENDIF
C     ----- FRONTIERE DONNEE EST A L'INTERIEUR ---------
      IF((IMAT(IT2).EQ.0).AND.
     >   (IMAT(IT1).EQ.0))GOTO 40
      IF((IMAT(IT2).NE.0).AND.
     >   (IMAT(IT1).NE.0))GOTO 40
      IF(IMAT(IT1).EQ.0)THEN
        IREGIO = - IMAT(IT2)
        IF( IREGIO .EQ. 1 )THEN
          NPLEIN = NPLEIN + 1
        ELSE
          NCREUX = NCREUX + 1
        ENDIF
        CALL SCRGCC(IT1,IREGIO,IDE,ITRTRI,NBCMAX,NBE,
     >                 ITVL,IMAT,NBEMAT,iarr)
        GOTO 40
      ENDIF
      IF(IMAT(IT2).EQ.0)THEN
        IREGIO = - IMAT(IT1)
        IF( IREGIO .EQ. 1 )THEN
          NPLEIN = NPLEIN + 1
        ELSE
          NCREUX = NCREUX + 1
        ENDIF
        CALL SCRGCC(IT2,IREGIO,IDE,ITRTRI,NBCMAX,NBE,
     >                 ITVL,IMAT,NBEMAT,iarr)
        GOTO 40
      ENDIF
C
C
   40 NBVUE = NBEMAT + NBVUE
C     --- FIN : ON A ATTRIBUE UN MAT. A TOUS LES ELEMENTS ----
      IF( NBVUE.EQ.NBE )GOTO 999
C     --- CAS PARTICULIER : ON N'A PAS PU ATTRIBUER UN IREGIO ---
      IF(( NBVUE.EQ.0 ).AND.(I.EQ.NBIFR))GOTO 50
C     --- BOUCLE : ON A PAS VU TOUS LES ELEMENTS ---
      IF( NBVUE.NE.NBE )GOTO 30
C
C        =====================================================
C     --- 3. CAS PARTICULIER :
C         LA FRONTIERE DONNEE EST TOTALEMENT A L'INTERIEUR
C         => RECHERCHE D'UN ELEMENT DE LA FRONTIERE DU CONVEXE
C        =====================================================
   50 IREGIO = -1
      DO 70 I=1,NBE
        NBNE = STRNBN(I,ITRNOE,NBNMAX)
        NBCE = STRNBC(NBNE,IDE)
        DO 60 J=1,NBCE
          IF( ITRTRI((I-1)*NBCMAX+J).EQ.0 )GOTO 80
   60   CONTINUE
   70 CONTINUE
      NCREUX = NCREUX + 1
   80 CALL SCRGCC(I,IREGIO,IDE,ITRTRI,NBCMAX,NBE,
     >                 ITVL,IMAT,NBEMAT,iarr)
      GOTO 30
C
  999 END
 
 
 
 

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