Télécharger la plaquette Cast3M


fr en

Télécharger smadet.eso

Retour à la liste

Numérotation des lignes : 

smadet

  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.  
  89.  

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