Télécharger initpa.eso

Retour à la liste

Numérotation des lignes :

  1. C INITPA SOURCE CHAT 05/01/13 00:38:17 5004
  2. SUBROUTINE INITPA(EPSILO,IPART,IZPART,TMIN,NSAUV,MLREE6
  3. $ ,MELEME,IPT9,NDIM,NPOS,ITER,IPARPO,IVPT,IEL1,XDEP2,TDEP
  4. $ ,JFACE,JREBO,XIREB,XNREB,ICHGZ,Z,KSAUV,DTSTOC,DTCUMU,IZSH,
  5. $ IELTFA)
  6. ****************************************************************************
  7. *** SP 'INITPA' : met en place les conditions initiales liées à la particule
  8. *** considérée lors de son avancée dans le domaine.
  9. ***
  10. *** APPELES 1 = 'MELNEL', 'DOXE'
  11. *** APPELES 2 = 'REFREE', 'TRJSTO', 'TRJDTS', 'TESTFA'
  12. ***
  13. *** E = 'EPSILO' marge relative acceptée position pt % face de l'element
  14. *** 'IPART' n° de la particule concernée par l'avancée
  15. *** 'IZPART' segment content coords référence des différentes particules
  16. *** 'TMIN' instant de départ de la particule concernée
  17. *** 'NSAUV' taille de la liste des tps de sauvegarde
  18. *** 'MLREE6' liste des tps de sauvegarde
  19. *** 'MELEME' pteur sur maillage du domaine etudié
  20. *** 'IPT9' pteur sur maillage faces impermeables
  21. *** 'IELTFA' pointeur du maillage contenant les numeros de
  22. *** faces par elements
  23. ***
  24. *** S = 'NDIM' dimension de l'espace
  25. *** 'NPOS' nbre de traversées d'éléments fixé arbitrairement
  26. *** 'ITER' n° de traversée considérée pour le stockage position particule
  27. *** 'IPARPO' segment ou sont sauvegardés resultats trajectoire
  28. *** 'IVPT' entier valant 1 en régime permanent
  29. *** 'IEL1' n° global d'élément contenant la particule
  30. *** 'XDEP2' coords reelles de départ particule
  31. *** 'TDEP' tps ecoulé jusqu'au pt de départ
  32. *** 'JFACE' n° local face de l'element considéré depart particule
  33. *** 'JREBO' n° local face impermeable depart particule
  34. *** 'XIREB' pt d'impact sur la face impermeable
  35. *** 'XNREB' vecteur normal à la face impermeable
  36. *** 'ICHGZ' vaut 1 si saut précédent effectif, 0 sinon
  37. *** 'Z' vecteur aleatoire entre -1 et 1 pour le saut diffusif
  38. *** 'KSAUV' indice considéré dans la liste des tps de sauvegarde
  39. *** 'DTSTOC' pas de tps de sauvegarde considéré
  40. *** 'DTCUMU' cumul des pas de tps entre deux sauvegardes
  41. *** 'IZSH' segment content coords reelles noeuds element initial
  42. ***
  43. *** Rq : 'IZPART' et 'IPARPO' sont activés en sortie de module
  44. ******************************************************************************
  45. *** ORIGINE = PATRICK MEYNIEL modifie par CYRIL NOU
  46. ******************************************************************************
  47. C
  48. IMPLICIT INTEGER(I-N)
  49. IMPLICIT REAL*8 (A-H,O-Z)
  50. -INC CCOPTIO
  51. -INC SMCOORD
  52. -INC SMELEME
  53. -INC SMLREEL
  54. POINTEUR MLREE6.MLREEL
  55. POINTEUR IELTFA.MELEME
  56. SEGMENT IZSH
  57. REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
  58. ENDSEGMENT
  59. SEGMENT IZPART
  60. INTEGER NLEPA(NPART),NUMPA(NPART)
  61. REAL*8 COORPA(NDIM,NPART)
  62. ENDSEGMENT
  63. SEGMENT IPARPO
  64. INTEGER NAPAR(NPOS),NUMP(NPOS)
  65. REAL*8 CREF(NDIM,NPOS),TPAR(NPOS)
  66. ENDSEGMENT
  67. DIMENSION XDEP(3),XDEP2(3),Z(3),XIREB(3),XNREB(3)
  68. DIMENSION PT1(3),PT2(3),PT3(3),PT4(3)
  69.  
  70. **************************************
  71. *** INITIALISATION VARIABLES DU PB ***
  72. **************************************
  73.  
  74. *** dimension de l'espace
  75. NDIM=IDIM
  76. *** taille max et indice des tableaux du segment 'IPARPO'
  77. NPOS=50
  78. ITER=0
  79. *** 'IVPT' vaut 1 en regime permanent
  80. IVPT=1
  81. *** affectation du n° global d'elemt de départ contenant particule 'IPART'
  82. IEL1=NLEPA(IPART)
  83. *** variable test valant 1 si saut précédent effectif, 0 sinon
  84. ICHGZ=1
  85. *** 'Z' vecteur aleatoire entre -1 et 1 pour la diffusion
  86. DO 10 I=1,3
  87. Z(I)=0.D0
  88. 10 CONTINUE
  89. *** initialisation à 0 indice liste des tps de sauvegarde
  90. KSAUV=0
  91. *** initialisation à 0 des variables liées au rebond
  92. JREBO=-1
  93. DO 20 I=1,3
  94. XIREB(I)=0.D0
  95. XNREB(I)=0.D0
  96. 20 CONTINUE
  97.  
  98. ****************************************************
  99. *** SAUVEGARDE DE LA POSITION INITIALE PARTICULE ***
  100. ****************************************************
  101.  
  102. *** initialisation ou activation des segments liés à particule
  103. C SEGACT IZPART
  104. SEGINI IPARPO
  105. *** affectation des coord référence de depart de la particule 'IPART'
  106. DO 30 I=1,NDIM
  107. XDEP(I)=COORPA(I,IPART)
  108. 30 CONTINUE
  109. *** affectation du tps réel de départ de la particule 'IPART'
  110. TDEP=TMIN
  111. *** recuperation des propriétés de 'IEL1' pour sp 'DOXE' et sauvegarde
  112. CALL MELNEL(IEL1,MELEME,IPT1,NEL0,1)
  113. SEGACT IPT1
  114. NOEL1=IPT1.NUM(/1)
  115. IELL=IEL1-NEL0
  116. ITY1=IPT1.ITYPEL
  117. ITYG=NUMGEO(ITY1)
  118. *** recuperation des positions reelles des noeuds de 'IEL1'
  119. CALL DOXE(XCOOR,NDIM,NOEL1,IPT1.NUM,IELL,XYZL)
  120. *** initialisation sauvegarde initiale % position lacher particule
  121. CALL REFREE(NDIM,ITY1,NOEL1,IZSH,XDEP,XDEP2)
  122. CALL TRJSTO(NDIM,IEL1,NPOS,ITER,IPARPO,TDEP,XDEP2)
  123. CALL TRJDTS(NSAUV,MLREE6,TMIN,KSAUV,DTSTOC,DTCUMU)
  124.  
  125. ***********************************************
  126. *** PARTICULE APPARTIENT À FACE DE 'IEL1' ? ***
  127. ***********************************************
  128.  
  129. *** sp renvoie n° local appartenance face de 'IEL1'
  130. CALL TESTFA(EPSILO,NDIM,ITYG,XDEP2,IZSH,JFACE,PT1,PT2,PT3,PT4)
  131. *** sp renvoie n° local appartenance face impermeable
  132. IF (JFACE.GT.0) THEN
  133. CALL LOCIMP(NDIM,JFACE,XDEP2
  134. $ ,PT1,PT2,PT3,PT4,IPT9,JREBO,XIREB,XNREB,IEL1,IELTFA)
  135. ENDIF
  136.  
  137. RETURN
  138. END
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  

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