Esope source files

   1 : C LOCIMP    SOURCE    CHAT      05/01/13    01:24:46     5004           
   2 : 
   3 :       SUBROUTINE LOCIMP(NDIM,JFACE,XDEP2
   4 :      $     ,PT1,PT2,PT3,PT4,IPT9,JREBO,XIREB,XNREB,IEL1,IELTFA)
   5 : *************************************************************************
   6 : *** SP 'LOCIMP' : a partir d'un n° de face permet de dire s'il s'agit
   7 : *** d'une face impermeable. renvoie alors les caracteristiques de cette
   8 : *** face.
   9 : ***
  10 : *** E = 'NDIM' dimension de l'espace
  11 : ***     'JFACE' face ou se situe la particule
  12 : ***     'XDEP2' position initiale de la particule
  13 : ***     'PT1', 'PT2', 'PT3', 'PT4' noeuds appartenant à element considéré
  14 : ***     'IPT9' pteur sur maillage faces impermeables
  15 : ***     'IEL1' numero de l'element dans lequel on se trouve
  16 : ***     'IELTFA' pointeur du maillage des connectivités elements->face
  17 : ***
  18 : *** S = 'JREBO' n° local face impermeable ou se trouve particule, -1 sinon
  19 : ***     'XIREB' pt d'impact sur la face impermeable
  20 : ***     'XNREB' vecteur normal à la face impermeable
  21 : ***
  22 : ***  Auteur   CYRIL NOU
  23 : *************************************************************************
  24 :       IMPLICIT INTEGER(I-N)
  25 :       IMPLICIT REAL*8 (A-H,O-Z)
  26 : -INC CCOPTIO
  27 : -INC SMCOORD
  28 : -INC SMELEME
  29 :       SEGMENT IZSH
  30 :           REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
  31 :       ENDSEGMENT
  32 :       DIMENSION XIMP(3),XDEP2(3),XIREB(3),XNREB(3)
  33 :       DIMENSION PT1(3),PT2(3),PT3(3),PT4(3),XN1(3),XN2(3),XN3(3),XINT(3)
  34 :       JREBO=-1
  35 :       DO 30 I=1,3
  36 :          XIREB(I)=0.D0
  37 :          XNREB(I)=0.D0
  38 :  30   CONTINUE
  39 : ***   sortie de programme s'il n'y a pas de face impermeable
  40 :       IF (IPT9.LE.0) RETURN
  41 : ***   recuperation dimensions des tableaux du maillage faces impermeables
  42 :       NBSOUS=IPT9.LISOUS(/1)
  43 :       NBNOEU=IPT9.NUM(/1) 
  44 : ***   On a verifié plus haut que NBNOEU=1
  45 :       NBELE=IPT9.NUM(/2)
  46 : ***   Recherche du numero de la face JFACE dans le maillage general
  46 :       CALL MELNEL(IEL1,IELTFA,IPT2,NEL2,1)
  47 :       NF=IPT2.NUM(JFACE,IEL1-NEL2)
  48 : ***   boucle sur les elements du maillage faces impermeables 
  49 :       DO 10 IELL2=1,NBELE
  50 :          NFI=IPT9.NUM(1,IELL2)
  51 :          IF(NF.EQ.NFI)THEN
  52 : ***      recuperation de la position reelle du pt face impermeable
  52 :                CALL DOXE(XCOOR,NDIM,NBNOEU,IPT9.NUM,IELL2,XIMP)
  53 : ***            recuperation n°face, intersection, normale si face imper
  53 :                CALL FACTR1(NDIM,PT1,PT2,PT3
  54 :      $              ,XIMP,XIMP,XN1,XN2,XN3,XINT,KTEST)
  55 :                JREBO=JFACE
  56 :                DO 20 I=1,NDIM
  57 :                   XIREB(I)=XDEP2(I)
  58 :                   XNREB(I)=XN1(I)
  59 :  20            CONTINUE
  60 :                RETURN
  61 :          ENDIF
  62 :  10   CONTINUE
  63 :       RETURN
  64 :       END
  65 :  
  66 :