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