Sources Esope | Cast3M

except
C EXCEPT    SOURCE    PV        09/03/12    21:21:42     6325
      SUBROUTINE EXCEPT(EPSILO,NDIM,JREBO,XNREB,MELEME,IZCENT
     $ ,IELTFA,IZVIT,IVPT,IEL1,TDEP,DTREEL,XDEP2,IZSH,IZUN,IEL2,NVOISI)
 
************************************************************************
*** SP 'EXCEPT' : permet de traiter les cas particuliers ou trajectoire
*** passe par un noeud ou une arete. Apres tests sur noeuds et aretes,
*** renvoie n° global de l'elemt ou trajectoire a effectivement lieu.
***
*** APPELES 1 = aucun
*** APPELES 2 = 'TRJLOC', 'REEREF', 'TESTNO', 'TESTAR', 'VOISIN',
***             'JCBIEN', 'SAUCO1', 'REFREE', 'SAUCO2', 'LIEUPT'
***
*** E = 'EPSILO' erreur de précision de calcul (calibrage) acceptable
***     'NDIM' dimension de l'espace
***     'JREBO' n° local face impermeable ou se trouve particule, -1 sinon
***     'XNREB' vecteur normal à la face impermeable
***     'MELEME' pteur sur maillage du domaine étudié
***     'IZCENT' pteur sur la table "DOMAINE.CENTRE"
***     'IELTFA' pteur sur la table "DOMAINE.ELTFA"
***     'IZVIT' pteur sur le segment des vitesses
***     'IVPT' entier valant 1 dans le cas du régime permanent
***     'IEL1' n° global elemt courant à partir duquel on cherche voisins
***     'TDEP' tps réel courant écoulé
***     'DTREEL' pas de temps considéré pour saut particule
***     'XDEP2' position reelle courante particule dans maillage
***     'IZSH' segmt content fcts forme,base et coord réelles noeuds
***     'IZUN' segmt content les flux aux faces % sous-maillage
***
*** S = 'IEL2' n° global elemt ou trajectoire a lieu, 0 sinon
***     'NVOISI' nbre d'elements voisins lorsque noeud ou arete en commun
***
*** Rq : 'XZPREC' (-INC CCREEL) erreur precision calcul machine
***
***             Auteur Cyril Nou
************************************************************************
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC SMELEME
-INC CCREEL
-INC SMCHAML
      POINTEUR IZCENT.MELEME,IELTFA.MELEME
      SEGMENT IZSH
          REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
      ENDSEGMENT
      SEGMENT IZVIT
         REAL*8 TEMTRA(NVIPT)
         INTEGER IPUN(NBS),IDUN(NBS),IPVPT(NVIPT),IFORML
      ENDSEGMENT
      SEGMENT IZVPT
         INTEGER IPUN1(NBS),IPUMAX
      ENDSEGMENT
      SEGMENT IZUN
         REAL*8 UN(I1,I2,I3)
      ENDSEGMENT
      SEGMENT IZUMAX
           REAL*8 UMAX(NBREL)
      ENDSEGMENT
      DIMENSION XDEP2(3),XREF(3),XTEST2(3),XTEST(3),IVOISI(200)
      DIMENSION UTEST(3),XNREB(3)
      DO 10 I=1,200
         IVOISI(I)=0
 10   CONTINUE
      DTTEST=DTREEL/100
      NVOISI=0
      IEL2=0
      IEL3=0
 
**************************************
*** RECHERCHE DES ELEMENTS VOISINS ***
**************************************
 
      CALL TRJLOC(NDIM,MELEME,IZCENT,IELTFA,IZVIT,IVPT,IEL1
     $     ,TDEP,NOEL1,ITY1,ITYG,IZSH,IZUN,NOUN1,IELL,DIAM,IPT1)
      CALL REEREF(NDIM,ITY1,NOEL1,IZSH,XDEP2,XREF)
      CALL TESTNO(EPSILO,ITYG,XREF,INOEUD)
***   cas ou trajectoire passe par un noeud
      IF (INOEUD.GT.0) THEN
         CALL VOISIN(NDIM,MELEME,IPT1,IELL,INOEUD,IVOISI,NVOISI)
      ELSEIF (NDIM.EQ.3) THEN
         CALL TESTAR(EPSILO,ITYG,XREF,IARETE,JNOEU1,JNOEU2)
***      cas ou la trajectoire passe par une arete
         IF (IARETE.GT.0) THEN
            CALL VOISIN(NDIM,MELEME,IPT1,IELL,JNOEU1,IVOISI,NVOISI)
         ENDIF
      ENDIF
 
****************************************
*** RECHERCHE ELEMENT OU TRAJ A LIEU ***
****************************************
 
      IF (NVOISI.GT.0) THEN
         IREBCO=0
         NTEST=0
 40      CONTINUE
         IF( NVOISI.GT.200)THEN
C           write(6,*)' except un noeud a plus de 200 voisins '
            CALL ERREUR (21)
           RETURN
         ENDIF
         DO 20 I=1,NVOISI
***         recuperation caractéristiques du ieme element voisin
            CALL TRJLOC(NDIM,MELEME,IZCENT,IELTFA,IZVIT,IVPT,IVOISI(I)
     $           ,TDEP,NOEL2,ITY2,JTYG,IZSH,IZUN,NOUN2,IELL2,DIAM2,IPT2)
***         test du saut convectif dans le ieme element voisin
            CALL SAUCON(NDIM,ITY2,JTYG,NOEL2,NOUN2,DIAM2
     $      ,UN(1,1,IELL2),XREF,XDEP2,DTTEST,XTEST2,IZSH,UTEST,LTEST)
***         cas ou Jacobien lors approximation vitesse efmh
            IF (LTEST.EQ.0) THEN
               IEL1=-1
               RETURN
            ENDIF
            CALL NORMVI(NDIM,UTEST,XNORM,UXY)
            COEFC=SCVECT(UTEST,XNREB,NDIM)
            COEFC=COEFC*DTTEST
            DO 30 J=1,NDIM
               XTEST2(J)=XTEST2(J)-IREBCO*COEFC*XNREB(J)
 30         CONTINUE
***         test sur la position arrivee % ieme element voisin
            CALL LIEUPT(XZPREC,NDIM,JTYG,XTEST2,IZSH,JTEST)
***         recuperation du n° global element ou a lieu trajectoire
            IF (JTEST.EQ.1) THEN
               IEL3=IVOISI(I)
               IF(IEL3.NE.IEL1) THEN
                  IEL2=IEL3
                  RETURN
               ENDIF
            ENDIF
            IF ((I.EQ.NVOISI).AND.(IEL3.NE.0)) THEN
               IEL2=IEL3
               RETURN
            ENDIF
 20      CONTINUE
***      si test sans rebond echoue, tentative avec rebond
         IF ((IEL2.EQ.0).AND.(JREBO.GT.0)) THEN
            IF (NTEST.EQ.1) THEN
               RETURN
            ELSE
               IREBCO=1
               NTEST=1
               GOTO 40
            ENDIF
         ENDIF
      ENDIF
 
      RETURN
      END