Télécharger la plaquette Cast3M


fr en

Télécharger voisin.eso

Retour à la liste

Numérotation des lignes : 

voisin

  1. C VOISIN    SOURCE    CHAT      05/01/13    04:08:55     5004
  2.       SUBROUTINE VOISIN(NDIM,MELEME,IPT1,IELL,INOEUD,IVOISI,NVOISI)
  3. *************************************************************************
  4. *** SP 'VOISIN' : lorsque la particule passe par un noeud ou une arete
  5. *** de l'element, 'VOISIN' cherche elements ayant le noeud 'INOEUD' en
  6. *** commun avec l'élément considéré.
  7. ***
  8. *** APPELES 1 = aucun
  9. *** APPELES 2 = aucun
  10. ***
  11. *** E = 'NDIM' dimension de l'espace
  12. ***     'MELEME' pteur sur maillage du domaine étudié
  13. ***     'IPT1' pteur sur sous-maillage contenant élément considéré
  14. ***     'IELL' n° local dans sous-maillage 'IPT1' de élémt considéré
  15. ***     'INOEUD' n° local du noeud traversé dans élément considéré
  16. ***
  17. *** S = 'IVOISI' n° globaux des elemts ayant en commun le noeud 'INOEUD'
  18. ***     'NVOISI' nbre d'elements ayant en commun le noeud 'INOEUD'
  19. ***
  20. *** Rq : dans le cas d'une arete traversée (cas 3D seulement), 'INOEUD'
  21. *** represente l'un des noeuds de l'arete.
  22. ***
  23. *** ORIGINE = PATRICK MEYNIEL, MODIFICATION = CYRIL NOU
  24. *************************************************************************
  25.  
  26.       IMPLICIT INTEGER(I-N)
  27.       IMPLICIT REAL*8 (A-H,O-Z)
  28. -INC SMELEME
  29.       DIMENSION XDEP(3),XARI(3),IVOISI(20)
  30.  
  31. ***   initialisation de départ
  32.       IPT2=MELEME
  33.       NVOISI=0
  34.       NCOMPT=0
  35. ***   recuperation ds 'NBSOBJ' du nbre de sous-maillages de 'MELEME'
  36.       NBSOUS=LISOUS(/1)
  37.       NBSOBJ=NBSOUS
  38.       IF (NBSOUS.EQ.0) NBSOBJ=1
  39. ***** BOUCLE SUR LES SOUS-MAILLAGES DE MELEME
  40.       DO 10 ISOUS=1,NBSOBJ
  41. ***      'IPT2' pteur sur le iousième sous-maillage
  42.          IF (NBSOUS.GT.0) IPT2=LISOUS(ISOUS)
  43. ***      recuperation nbre elemts et noeuds par elemt de 'IPT2'
  44.          SEGACT IPT2
  45.          NBELE=IPT2.NUM(/2)
  46.          NBNOEU=IPT2.NUM(/1)
  47. ******** BOUCLE SUR LES ELEMENTS DU ISOUSIEME SOUS-MAILLAGE
  48.          DO 20 IELL2=1,NBELE
  49. ***         on saute le cas ou le iell2ieme element est l'element courant
  50. *            IF ((IELL2.NE.IELL).OR.(IPT2.NE.IPT1)) THEN
  51. ************** BOUCLE SUR LES NOEUDS DU IELL2IEME ELEMENT
  52.                DO 30 INO=1,NBNOEU
  53. ***               test correspondance noeud de 'IPT2' avec celui de 'IPT1'
  54.                   IF ((IPT2.NUM(INO,IELL2)).EQ.
  55.      $                 (IPT1.NUM(INOEUD,IELL))) THEN
  56.                      NVOISI=NVOISI+1
  57.                      IVOISI(NVOISI)=IELL2+NCOMPT
  58.                   ENDIF
  59.  30            CONTINUE
  60. *            ENDIF
  61.  20      CONTINUE
  62. ***      recuperation nbre elements avant le prochain sous-maillage
  63.          NCOMPT=NCOMPT+NBELE
  64.          IF (IPT2.NE.IPT1) SEGDES IPT2
  65.  10   CONTINUE
  66.       RETURN
  67.       END
  68.  
  69.  
  70.  

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