Esope source files

   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 :