Esope source files

   1 : C SMADET    SOURCE    CHAT      06/03/29    21:34:16     5360           
   2 :       SUBROUTINE SMADET(IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE,NOETRI, 
   3 :      >                   NOEMAX,IT1,N,ISOMP,NBSOMP,iarr)
   4 : C     *****************************************************************
   5 : C     OBJET : DETRUIT 1 ELEMENTS D'UN MAILLAGE
   6 : C     EN ENTREE:
   7 : C      IDE    :  (1..3) DIMENSION DES ELEMENTS 
   8 : C      ITRNOE:  LES NOEUDS DES ELEMENTS
   9 : C      NBNMAX :  (2..8) NOMBRE DE NOEUDS MAXIMUM DES ELEMENTS 
  10 : C      ITRTRI:  LES VOISINS DES ELEMENTS
  11 : C      NBCMAX :  (2..6) NOMBRE DE COTES MAXIMUM DES ELEMENTS 
  12 : C      NBE    :  NOMBRE D'ELEMENTS DU MAILLAGE
  13 : C      NOEMAX  MISE A JOUR DE NOETRI SI NON NUL
  14 : C      IT1    :  L'ELEMENTS A DETRUIRE
  15 : C      N      :  NOMBRE DE NOEUDS DE L'ELEMENT IT1
  16 : C     EN SORTIE:
  17 : C       ITRNOE: MIS A JOUR
  18 : C       ITRTRI: MIS A JOUR 
  19 : C       NOETRI : MIS A JOUR
  20 : C         iarr : CODE D'ERREUR 0 => OK
  21 : C               -1 => DONNEES INCOHERENTES
  22 : C     CONDITION D'APPLICATION : TOUT MAILLAGE AVEC UNE RESTRICTION
  23 : C       LA DESTRUCTION DE LA MAILLE NE DOIT PAS CREER DE SINGULARITES
  24 : C       SUR LA FRONTIERE (SINON NOETRI() N'EST PLUS VALIDE). 
  25 : C               
  26 : C     *****************************************************************
  27 :       IMPLICIT INTEGER(I-N)
  28 :       INTEGER    IDE,ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX,NOETRI(*),NBE
  29 :       INTEGER    NOEMAX, IT1, N, ISOMP(*), NBSOMP, iarr
  30 : C
  31 :       INTEGER  I,J,ITR,NBFAC,IFAC(4)
  32 :       INTEGER  STRKFS
  33 :       EXTERNAL STRKFS
  34 : C      
  35 :       iarr = 0
  36 :       IF((IT1.LT.1).OR.(IT1.GT.NBE))THEN
  37 :          iarr = -1
  38 :          GO TO 999
  39 :       ENDIF
  40 : C
  41 : C     ---- MISE A JOUR DES NOEUDS FAISANT REFERENCE A IT1 ---
  42 : C
  43 :       IF( NOEMAX.NE.0 )THEN
  44 :         DO 20 I=1,NBNMAX
  45 :           IF( NOETRI(ITRNOE((IT1-1)*NBNMAX+I)) .EQ. IT1 )THEN
  46 :             NBFAC = STRKFS(IDE,I,N,IFAC)
  47 :             DO 5 J=1,NBFAC
  48 :                ITR = ITRTRI((IT1-1)*NBCMAX+IFAC(J))
  49 :                IF(ITR.NE.0)GO TO 10
  50 :     5       CONTINUE
  51 : C           --- UN SOMMET EST PERDU ---
  52 :             NBSOMP = NBSOMP+1
  53 :             ISOMP(NBSOMP) = ITRNOE((IT1-1)*NBNMAX+I)    
  54 :    10       NOETRI(ITRNOE((IT1-1)*NBNMAX+I)) = ITR
  55 :           ENDIF
  56 :    20   CONTINUE
  57 :       ENDIF
  58 : C      
  59 : C     ---- MISE A JOUR DES ELEMENTS VOISINS DE IT1 ---
  60 : C
  61 :         DO 30 I=1,NBCMAX
  62 :           ITR = ITRTRI((IT1-1)*NBCMAX+I)
  63 :           IF(ITR.NE.0)THEN
  64 :             IF( ITR .LT. 0 )ITR = - ITR
  65 :             DO 40 J=1,NBCMAX
  66 :              IF((ITRTRI((ITR-1)*NBCMAX+J).EQ.IT1) .OR.
  67 :      >          (ITRTRI((ITR-1)*NBCMAX+J).EQ.-IT1) )THEN
  68 :                ITRTRI((ITR-1)*NBCMAX+J) = 0
  69 :                GO TO 30
  70 :              ENDIF
  71 :    40       CONTINUE
  72 : C         --- IL Y A UN BUG DANS LA STRUCTURE ---
  73 :           iarr = -2
  74 :           GO TO 999
  75 :           ENDIF
  76 :    30   CONTINUE
  77 : C     ---------- INITIALISATION DE IT1 ----------
  78 :       DO 90 I=1,NBCMAX
  79 :         ITRTRI((IT1-1)*NBCMAX+I)=0
  80 :    90 CONTINUE
  81 :       DO 100 I=1,NBNMAX
  82 :         ITRNOE((IT1-1)*NBNMAX+I)=0
  83 :   100 CONTINUE
  84 : C     ------------------
  85 :   999 END
  86 :  
  87 :  
  88 :