Esope source files

   1 : C SCMAT     SOURCE    CHAT      06/03/29    21:33:05     5360           
   2 :       SUBROUTINE SCMAT(IFR,NBNIFR,NBIFR,
   3 :      >                 IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
   4 :      >                 NOETRI,NBE,ITVL,IMAX,
   5 :      >                 IMAT,NPLEIN,NCREUX,iarr)
   6 : C     **********************************************************************
   7 : C     OBJET : DETERMINE LES 2 REGIONS POUR LA SCULPT : LE PLEIN (1)
   8 : C             ET LE CREUX (-1)
   9 : C     EN ENTREE  :
  10 : C       IFR      : LES ELEMENTS DES FRONTIERES
  11 : C       NBIFR    : NOMBRE D'ELEMENTS FRONTIERE
  12 : C
  13 : C       ITVL : TABLEAU DE TRAVAIL = NBE + PILE (APPEL TMA1CC)
  14 : C       IMAX     : TAILLE DU TABLEAU DE TRAVAIL
  15 : C
  16 : C     EN SORTIE  : 
  17 : C       IMAT     : IMAT(I) = 1 SI L'ELEMENT EST PLEIN
  18 : C                                 -1 SI "    "  "  "  CREUX
  19 : C       NPLEIN  : NOMBRE DE COMPOSANTES CONNEXES PLEINES
  20 : C       NCREUX  : NOMBRE DE COMPOSANTES CONNEXES CREUSES
  21 : C       iarr     : CODE D'ERREUR
  22 : C                -1 UN ELEMENT FRONTIERE DE IFR N'EXISTE PAS
  23 : C                -2 ITVL TROP PETIT
  24 : C     **********************************************************************
  25 :       IMPLICIT INTEGER(I-N)
  26 :       INTEGER    IFR(*),NBIFR,NBNIFR,IDE
  27 :       INTEGER    ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX
  28 :       INTEGER    NOETRI(*),NBE,ITVL(*),IMAX,IMAT(*)
  29 :       INTEGER    NPLEIN,NCREUX,iarr
  30 : C
  31 :       INTEGER NBVUE,IT1,IT2,I1,I2,NBEMAT,IREGIO,I,J
  32 :       INTEGER NBNE,NBCE
  33 :       INTEGER STRNBN,STRNBC
  34 :       EXTERNAL STRNBN,STRNBC
  35 : C        ===================
  36 : C     --- 1. INITIALISATION ----
  37 : C        ===================
  38 :       NPLEIN = 0
  39 :       NCREUX = 0
  40 :       iarr = -1
  41 :       DO 10 I=1,NBIFR
  41 :         CALL SFRICR(IFR((I-1)*NBNIFR+1),NBNIFR,IDE,
  42 :      >               ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  43 :      >               NOETRI,NBE,iarr)
  44 :       IF( iarr.NE. 0 )GOTO 999
  45 :    10 CONTINUE
  46 :       DO 20 I=1,NBE
  47 :         IMAT(I) = 0
  48 :    20 CONTINUE   
  49 :       iarr = 0
  50 : C        ====================================================
  51 : C     --- 2. RECHERCHE DES FRONTIERES DONNEES NON RECONNUES ----
  52 : C         SI UNE DES REGIONS EST CONNU, L'AUTRE L'EST AUSSI
  53 : C        ====================================================      
  54 : C
  55 :       NBVUE = 0
  56 :       I = 0      
  57 :    30 I = MOD(I,NBIFR)+1
  57 :         CALL SFRIDE(IFR((I-1)*NBNIFR+1),NBNIFR,IDE,
  58 :      >               ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  59 :      >               NOETRI,NBE,IT1,IT2,I1,I2 )
  60 :       NBEMAT = 0
  61 : C     ----- FRONTIERE DONNEE EST SUR LA FRONTIERE REELLE ---------
  62 :       IF(IT1.EQ.0)THEN
  63 :         IF(IMAT(IT2).EQ.0)THEN
  64 :          IREGIO = 1
  65 :          NPLEIN = NPLEIN + 1
  65 :          CALL SCRGCC(IT2,IREGIO,IDE,ITRTRI,NBCMAX,NBE,
  66 :      >                 ITVL,IMAT,NBEMAT,iarr)
  67 :         ENDIF
  68 :         GOTO 40
  69 :       ENDIF
  70 :       IF(IT2.EQ.0)THEN
  71 :         IF(IMAT(IT1).EQ.0)THEN
  72 :          IREGIO = 1
  73 :          NPLEIN = NPLEIN + 1
  73 :          CALL SCRGCC(IT1,IREGIO,IDE,ITRTRI,NBCMAX,NBE,
  74 :      >                 ITVL,IMAT,NBEMAT,iarr)
  75 :         ENDIF
  76 :         GOTO 40
  77 :       ENDIF
  78 : C     ----- FRONTIERE DONNEE EST A L'INTERIEUR ---------
  79 :       IF((IMAT(IT2).EQ.0).AND.
  80 :      >   (IMAT(IT1).EQ.0))GOTO 40
  81 :       IF((IMAT(IT2).NE.0).AND.
  82 :      >   (IMAT(IT1).NE.0))GOTO 40
  83 :       IF(IMAT(IT1).EQ.0)THEN
  84 :         IREGIO = - IMAT(IT2)
  85 :         IF( IREGIO .EQ. 1 )THEN
  86 :           NPLEIN = NPLEIN + 1
  87 :         ELSE 
  88 :           NCREUX = NCREUX + 1
  89 :         ENDIF
  89 :         CALL SCRGCC(IT1,IREGIO,IDE,ITRTRI,NBCMAX,NBE,
  90 :      >                 ITVL,IMAT,NBEMAT,iarr)
  91 :         GOTO 40
  92 :       ENDIF
  93 :       IF(IMAT(IT2).EQ.0)THEN
  94 :         IREGIO = - IMAT(IT1)
  95 :         IF( IREGIO .EQ. 1 )THEN
  96 :           NPLEIN = NPLEIN + 1
  97 :         ELSE 
  98 :           NCREUX = NCREUX + 1
  99 :         ENDIF
  99 :         CALL SCRGCC(IT2,IREGIO,IDE,ITRTRI,NBCMAX,NBE,
 100 :      >                 ITVL,IMAT,NBEMAT,iarr)
 101 :         GOTO 40
 102 :       ENDIF
 103 : C      
 104 : C
 105 :    40 NBVUE = NBEMAT + NBVUE
 106 : C     --- FIN : ON A ATTRIBUE UN MAT. A TOUS LES ELEMENTS ----
 107 :       IF( NBVUE.EQ.NBE )GOTO 999
 108 : C     --- CAS PARTICULIER : ON N'A PAS PU ATTRIBUER UN IREGIO ---
 109 :       IF(( NBVUE.EQ.0 ).AND.(I.EQ.NBIFR))GOTO 50
 110 : C     --- BOUCLE : ON A PAS VU TOUS LES ELEMENTS ---
 111 :       IF( NBVUE.NE.NBE )GOTO 30
 112 : C
 113 : C        =====================================================
 114 : C     --- 3. CAS PARTICULIER :
 115 : C         LA FRONTIERE DONNEE EST TOTALEMENT A L'INTERIEUR
 116 : C         => RECHERCHE D'UN ELEMENT DE LA FRONTIERE DU CONVEXE  
 117 : C        =====================================================
 118 :    50 IREGIO = -1
 119 :       DO 70 I=1,NBE
 120 :         NBNE = STRNBN(I,ITRNOE,NBNMAX)
 121 :         NBCE = STRNBC(NBNE,IDE)
 122 :         DO 60 J=1,NBCE
 123 :           IF( ITRTRI((I-1)*NBCMAX+J).EQ.0 )GOTO 80
 124 :    60   CONTINUE
 125 :    70 CONTINUE
 126 :       NCREUX = NCREUX + 1
 126 :    80 CALL SCRGCC(I,IREGIO,IDE,ITRTRI,NBCMAX,NBE,
 127 :      >                 ITVL,IMAT,NBEMAT,iarr)
 128 :       GOTO 30
 129 : C
 130 :   999 END      
 131 :  
 132 :  
 133 :