Esope source files

   1 : C TRJLOC    SOURCE    CHAT      05/01/13    03:50:09     5004           
   2 :       SUBROUTINE TRJLOC(NDIM,MELEME,IZCENT,IELTFA,IZVIT,IVPT
   3 :      $     ,IEL1,TCOUR,NOEL1,ITY1,ITYG,IZSH,IZUN,NOUN1,IELL,DIAM,IPT1)
   4 : ***************************************************************************
   5 : *** SP 'TRJLOC' : recupere infos caractérisant l'élément effectivement
   6 : *** traversée par la particule (sous maillage, n° elemt, nbre noeuds,...).
   7 : ***
   8 : *** APPELES 1 = 'MELNEL', 'DOXE', 'TRJVEL'
   9 : *** APPELES 2 = aucun
  10 : ***
  11 : *** E = 'NDIM' dimension de l'espace
  12 : ***     'MELEME' pteur sur le maillage du domaine étudié
  13 : ***     'IZCENT' pteur sur la table "DOMAINE.CENTRE"
  14 : ***     'IELTFA' pteur sur la table "DOMAINE.ELTFA"
  15 : ***     'IZVIT' segment décrivant les vitesses (<- 'TRJVIT' OU 'TRJFLU')
  16 : ***     'IVPT' entier valant 1 dans le cas permanent
  17 : ***     'IEL1' n° global de l'élément contenant particule            
  18 : ***     'TCOUR' tps courant considéré
  19 : ***
  20 : *** S = 'NOEL1' nbre de noeuds de l'élément 'IEL1'
  21 : ***     'ITY1' entier caractérisant le type de l'élément 'IEL1'
  22 : ***     'ITYG' entier caractérisant la géométrie de 'IEL1'
  23 : ***     'IZSH' segmt content fcts forme,base et coord réelles noeuds de 'IEL1'
  24 : ***     'IZUN' segmt content les flux aux faces % sous-maillage de 'IEL1'
  25 : ***     'NOUN1' nbre de flux (ou faces' de l'élément considéré 
  26 : ***     'IELL' n° local de l'élément 'IEL1' dans sous maillage
  27 : ***     'DIAM' "longueur caracteristique" de l'element considéré
  28 : ***     'IPT1' pteur sur sous-maillage contenant element considéré
  29 : ***
  30 : *** ORIGINE = PATRICK MEYNIEL ,MODIFICATION = CYRIL NOU
  31 : ******************************************************************************                                                                               
  32 : 
  33 :       IMPLICIT INTEGER(I-N)
  34 :       IMPLICIT REAL*8 (A-H,O-Z)
  35 : -INC CCOPTIO                                                
  36 : -INC SMCOORD
  37 : -INC SMELEME
  38 :       POINTEUR IZCENT.MELEME,IELTFA.MELEME,IZFAC1.MELEME
  39 :       SEGMENT IZSH
  40 :           REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
  41 :       ENDSEGMENT
  42 :       SEGMENT IZVIT 
  43 :          REAL*8 TEMTRA(NVIPT)
  44 :          INTEGER IPUN(NBS),IDUN(NBS),IPVPT(NVIPT),IFORML
  45 :       ENDSEGMENT
  46 :       SEGMENT IZVPT
  47 :          INTEGER IPUN1(NBS),IPUMAX
  48 :       ENDSEGMENT
  49 :       SEGMENT IZUN
  50 :          REAL*8 UN(I1,I2,I3)
  51 :       ENDSEGMENT
  52 :       SEGMENT IZUMAX
  53 :            REAL*8 UMAX(NBREL)
  54 :       ENDSEGMENT
  55 : 
  56 : ***   recherche le bon sous maillage pour l'elem 'IEL1' qui est alors pté par 'IPT1'
  57 : ***   'NEL0' = nbre elemts avant sous maillage pté par 'IPT1'
  57 :       CALL MELNEL(IEL1,MELEME,IPT1,NEL0,1)
  58 : ***   recuperation nbre de noeuds de l'elemt de n° global 'IEL1' dans 'NOEL1'
  59 :       NOEL1=IPT1.NUM(/1)
  60 : ***   recuperation n° local de l'elemt de n° global 'IEL1' dans 'IELL'
  61 :       IELL=IEL1-NEL0
  62 : ***   sp 'DOXE', donnt les coordonnées reelles des noeuds de l'elem de n°
  63 : ***   'IELL' (ou 'IEL1') sous le format defini par le tableau 'XYZL' de 'IZSH'
  63 :       CALL DOXE(XCOOR,NDIM,NOEL1,IPT1.NUM,IELL,XYZL)
  64 : ***   recuperation du type des elemts du sous maillage de 'IPT1'
  65 :       ITY1=IPT1.ITYPEL
  66 : ***   recuperation de la géometrie des elements du sous maillage de 'IPT1'
  67 :       ITYG=NUMGEO(ITY1)
  68 : ***   en permanent, active le segment des flux 'IZUN' % sous-maillage de 'IEL1' 
  68 :       CALL TRJVEL(IZVIT,IZUN,IEL1,IVPT,TCOUR)
  69 : ***   determination du nombre de flux (ou faces) pour l'élément considéré
  70 :       IF (ITYG.EQ.14) THEN
  71 :          NOUN1=6
  72 :       ELSEIF (ITYG.EQ.16) THEN
  73 :          NOUN1=5
  74 :       ELSE
  75 :          NOUN1=NOEL1
  76 :       ENDIF
  77 : ***   'NUCENT' recupere n° global noeud centre de l'element 'IEL1'
  78 :       NUCENT=IZCENT.NUM(1,IEL1)
  79 : ***   'IZFAC1' pte sur sous-maillage de 'IELTFA' contenant 'IEL1'
  79 :       CALL MELNEL(IEL1,IELTFA,IZFAC1,NEL1,1)
  80 : ***   recuperation + petite distance entre centre et faces element
  81 :       NF=IZFAC1.NUM(/1)
  82 :       IPCENT=(NUCENT-1)*(IDIM+1)
  83 :       NF1=(IZFAC1.NUM(1,IELL)-1)*(IDIM+1)
  84 :       VINT=0.D0
  85 :       DO 10 I=1,IDIM
  86 :          VINT=VINT+(XCOOR(IPCENT+I)-XCOOR(NF1+I))**2
  87 :  10   CONTINUE
  88 :       DIAM=VINT
  89 :       DO 20 J=2,NF
  90 :          NF1=(IZFAC1.NUM(J,IELL)-1)*(IDIM+1)
  91 :          VINT=0.D0
  92 :          DO 30 I=1,IDIM
  93 :             VINT=VINT+(XCOOR(IPCENT+I)-XCOOR(NF1+I))**2
  94 :  30      CONTINUE
  95 :          IF (VINT.LT.DIAM) DIAM=VINT
  96 :  20   CONTINUE
  97 : ***   'DIAM' = "longueur caracteristique" choisi
  98 :       DIAM=SQRT(DIAM)*2.D0
  99 : 
 100 :       RETURN
 101 :       END
 102 : 
 103 : 
 104 : 
 105 : 
 106 : 
 107 : 
 108 : 
 109 :  
 110 :