Télécharger except.eso

Retour à la liste

Numérotation des lignes :

  1. C EXCEPT SOURCE PV 09/03/12 21:21:42 6325
  2. SUBROUTINE EXCEPT(EPSILO,NDIM,JREBO,XNREB,MELEME,IZCENT
  3. $ ,IELTFA,IZVIT,IVPT,IEL1,TDEP,DTREEL,XDEP2,IZSH,IZUN,IEL2,NVOISI)
  4.  
  5. ************************************************************************
  6. *** SP 'EXCEPT' : permet de traiter les cas particuliers ou trajectoire
  7. *** passe par un noeud ou une arete. Apres tests sur noeuds et aretes,
  8. *** renvoie n° global de l'elemt ou trajectoire a effectivement lieu.
  9. ***
  10. *** APPELES 1 = aucun
  11. *** APPELES 2 = 'TRJLOC', 'REEREF', 'TESTNO', 'TESTAR', 'VOISIN',
  12. *** 'JCBIEN', 'SAUCO1', 'REFREE', 'SAUCO2', 'LIEUPT'
  13. ***
  14. *** E = 'EPSILO' erreur de précision de calcul (calibrage) acceptable
  15. *** 'NDIM' dimension de l'espace
  16. *** 'JREBO' n° local face impermeable ou se trouve particule, -1 sinon
  17. *** 'XNREB' vecteur normal à la face impermeable
  18. *** 'MELEME' pteur sur maillage du domaine étudié
  19. *** 'IZCENT' pteur sur la table "DOMAINE.CENTRE"
  20. *** 'IELTFA' pteur sur la table "DOMAINE.ELTFA"
  21. *** 'IZVIT' pteur sur le segment des vitesses
  22. *** 'IVPT' entier valant 1 dans le cas du régime permanent
  23. *** 'IEL1' n° global elemt courant à partir duquel on cherche voisins
  24. *** 'TDEP' tps réel courant écoulé
  25. *** 'DTREEL' pas de temps considéré pour saut particule
  26. *** 'XDEP2' position reelle courante particule dans maillage
  27. *** 'IZSH' segmt content fcts forme,base et coord réelles noeuds
  28. *** 'IZUN' segmt content les flux aux faces % sous-maillage
  29. ***
  30. *** S = 'IEL2' n° global elemt ou trajectoire a lieu, 0 sinon
  31. *** 'NVOISI' nbre d'elements voisins lorsque noeud ou arete en commun
  32. ***
  33. *** Rq : 'XZPREC' (-INC CCREEL) erreur precision calcul machine
  34. ***
  35. *** Auteur Cyril Nou
  36. ************************************************************************
  37.  
  38. IMPLICIT INTEGER(I-N)
  39. IMPLICIT REAL*8 (A-H,O-Z)
  40. -INC SMELEME
  41. -INC CCREEL
  42. -INC SMCHAML
  43. POINTEUR IZCENT.MELEME,IELTFA.MELEME
  44. SEGMENT IZSH
  45. REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
  46. ENDSEGMENT
  47. SEGMENT IZVIT
  48. REAL*8 TEMTRA(NVIPT)
  49. INTEGER IPUN(NBS),IDUN(NBS),IPVPT(NVIPT),IFORML
  50. ENDSEGMENT
  51. SEGMENT IZVPT
  52. INTEGER IPUN1(NBS),IPUMAX
  53. ENDSEGMENT
  54. SEGMENT IZUN
  55. REAL*8 UN(I1,I2,I3)
  56. ENDSEGMENT
  57. SEGMENT IZUMAX
  58. REAL*8 UMAX(NBREL)
  59. ENDSEGMENT
  60. DIMENSION XDEP2(3),XREF(3),XTEST2(3),XTEST(3),IVOISI(200)
  61. DIMENSION UTEST(3),XNREB(3)
  62. DO 10 I=1,200
  63. IVOISI(I)=0
  64. 10 CONTINUE
  65. DTTEST=DTREEL/100
  66. NVOISI=0
  67. IEL2=0
  68. IEL3=0
  69.  
  70. **************************************
  71. *** RECHERCHE DES ELEMENTS VOISINS ***
  72. **************************************
  73.  
  74. CALL TRJLOC(NDIM,MELEME,IZCENT,IELTFA,IZVIT,IVPT,IEL1
  75. $ ,TDEP,NOEL1,ITY1,ITYG,IZSH,IZUN,NOUN1,IELL,DIAM,IPT1)
  76. CALL REEREF(NDIM,ITY1,NOEL1,IZSH,XDEP2,XREF)
  77. CALL TESTNO(EPSILO,ITYG,XREF,INOEUD)
  78. *** cas ou trajectoire passe par un noeud
  79. IF (INOEUD.GT.0) THEN
  80. CALL VOISIN(NDIM,MELEME,IPT1,IELL,INOEUD,IVOISI,NVOISI)
  81. ELSEIF (NDIM.EQ.3) THEN
  82. CALL TESTAR(EPSILO,ITYG,XREF,IARETE,JNOEU1,JNOEU2)
  83. *** cas ou la trajectoire passe par une arete
  84. IF (IARETE.GT.0) THEN
  85. CALL VOISIN(NDIM,MELEME,IPT1,IELL,JNOEU1,IVOISI,NVOISI)
  86. ENDIF
  87. ENDIF
  88.  
  89. ****************************************
  90. *** RECHERCHE ELEMENT OU TRAJ A LIEU ***
  91. ****************************************
  92.  
  93. IF (NVOISI.GT.0) THEN
  94. IREBCO=0
  95. NTEST=0
  96. 40 CONTINUE
  97. IF( NVOISI.GT.200)THEN
  98. C write(6,*)' except un noeud a plus de 200 voisins '
  99. CALL ERREUR (21)
  100. RETURN
  101. ENDIF
  102. DO 20 I=1,NVOISI
  103. *** recuperation caractéristiques du ieme element voisin
  104. CALL TRJLOC(NDIM,MELEME,IZCENT,IELTFA,IZVIT,IVPT,IVOISI(I)
  105. $ ,TDEP,NOEL2,ITY2,JTYG,IZSH,IZUN,NOUN2,IELL2,DIAM2,IPT2)
  106. *** test du saut convectif dans le ieme element voisin
  107. CALL SAUCON(NDIM,ITY2,JTYG,NOEL2,NOUN2,DIAM2
  108. $ ,UN(1,1,IELL2),XREF,XDEP2,DTTEST,XTEST2,IZSH,UTEST,LTEST)
  109. *** cas ou Jacobien lors approximation vitesse efmh
  110. IF (LTEST.EQ.0) THEN
  111. IEL1=-1
  112. RETURN
  113. ENDIF
  114. CALL NORMVI(NDIM,UTEST,XNORM,UXY)
  115. COEFC=SCVECT(UTEST,XNREB,NDIM)
  116. COEFC=COEFC*DTTEST
  117. DO 30 J=1,NDIM
  118. XTEST2(J)=XTEST2(J)-IREBCO*COEFC*XNREB(J)
  119. 30 CONTINUE
  120. *** test sur la position arrivee % ieme element voisin
  121. CALL LIEUPT(XZPREC,NDIM,JTYG,XTEST2,IZSH,JTEST)
  122. *** recuperation du n° global element ou a lieu trajectoire
  123. IF (JTEST.EQ.1) THEN
  124. IEL3=IVOISI(I)
  125. IF(IEL3.NE.IEL1) THEN
  126. IEL2=IEL3
  127. RETURN
  128. ENDIF
  129. ENDIF
  130. IF ((I.EQ.NVOISI).AND.(IEL3.NE.0)) THEN
  131. IEL2=IEL3
  132. RETURN
  133. ENDIF
  134. 20 CONTINUE
  135. *** si test sans rebond echoue, tentative avec rebond
  136. IF ((IEL2.EQ.0).AND.(JREBO.GT.0)) THEN
  137. IF (NTEST.EQ.1) THEN
  138. RETURN
  139. ELSE
  140. IREBCO=1
  141. NTEST=1
  142. GOTO 40
  143. ENDIF
  144. ENDIF
  145. ENDIF
  146.  
  147. RETURN
  148. END
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  

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