Télécharger initpa.eso

Retour à la liste

Numérotation des lignes :

initpa
  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 PPARAM
  51. -INC CCOPTIO
  52. -INC SMCOORD
  53. -INC SMELEME
  54. -INC SMLREEL
  55. POINTEUR MLREE6.MLREEL
  56. POINTEUR IELTFA.MELEME
  57. SEGMENT IZSH
  58. REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
  59. ENDSEGMENT
  60. SEGMENT IZPART
  61. INTEGER NLEPA(NPART),NUMPA(NPART)
  62. REAL*8 COORPA(NDIM,NPART)
  63. ENDSEGMENT
  64. SEGMENT IPARPO
  65. INTEGER NAPAR(NPOS),NUMP(NPOS)
  66. REAL*8 CREF(NDIM,NPOS),TPAR(NPOS)
  67. ENDSEGMENT
  68. DIMENSION XDEP(3),XDEP2(3),Z(3),XIREB(3),XNREB(3)
  69. DIMENSION PT1(3),PT2(3),PT3(3),PT4(3)
  70.  
  71. **************************************
  72. *** INITIALISATION VARIABLES DU PB ***
  73. **************************************
  74.  
  75. *** dimension de l'espace
  76. NDIM=IDIM
  77. *** taille max et indice des tableaux du segment 'IPARPO'
  78. NPOS=50
  79. ITER=0
  80. *** 'IVPT' vaut 1 en regime permanent
  81. IVPT=1
  82. *** affectation du n° global d'elemt de départ contenant particule 'IPART'
  83. IEL1=NLEPA(IPART)
  84. *** variable test valant 1 si saut précédent effectif, 0 sinon
  85. ICHGZ=1
  86. *** 'Z' vecteur aleatoire entre -1 et 1 pour la diffusion
  87. DO 10 I=1,3
  88. Z(I)=0.D0
  89. 10 CONTINUE
  90. *** initialisation à 0 indice liste des tps de sauvegarde
  91. KSAUV=0
  92. *** initialisation à 0 des variables liées au rebond
  93. JREBO=-1
  94. DO 20 I=1,3
  95. XIREB(I)=0.D0
  96. XNREB(I)=0.D0
  97. 20 CONTINUE
  98.  
  99. ****************************************************
  100. *** SAUVEGARDE DE LA POSITION INITIALE PARTICULE ***
  101. ****************************************************
  102.  
  103. *** initialisation ou activation des segments liés à particule
  104. C SEGACT IZPART
  105. SEGINI IPARPO
  106. *** affectation des coord référence de depart de la particule 'IPART'
  107. DO 30 I=1,NDIM
  108. XDEP(I)=COORPA(I,IPART)
  109. 30 CONTINUE
  110. *** affectation du tps réel de départ de la particule 'IPART'
  111. TDEP=TMIN
  112. *** recuperation des propriétés de 'IEL1' pour sp 'DOXE' et sauvegarde
  113. CALL MELNEL(IEL1,MELEME,IPT1,NEL0,1)
  114. SEGACT IPT1
  115. NOEL1=IPT1.NUM(/1)
  116. IELL=IEL1-NEL0
  117. ITY1=IPT1.ITYPEL
  118. ITYG=NUMGEO(ITY1)
  119. *** recuperation des positions reelles des noeuds de 'IEL1'
  120. CALL DOXE(XCOOR,NDIM,NOEL1,IPT1.NUM,IELL,XYZL)
  121. *** initialisation sauvegarde initiale % position lacher particule
  122. CALL REFREE(NDIM,ITY1,NOEL1,IZSH,XDEP,XDEP2)
  123. CALL TRJSTO(NDIM,IEL1,NPOS,ITER,IPARPO,TDEP,XDEP2)
  124. CALL TRJDTS(NSAUV,MLREE6,TMIN,KSAUV,DTSTOC,DTCUMU)
  125.  
  126. ***********************************************
  127. *** PARTICULE APPARTIENT À FACE DE 'IEL1' ? ***
  128. ***********************************************
  129.  
  130. *** sp renvoie n° local appartenance face de 'IEL1'
  131. CALL TESTFA(EPSILO,NDIM,ITYG,XDEP2,IZSH,JFACE,PT1,PT2,PT3,PT4)
  132. *** sp renvoie n° local appartenance face impermeable
  133. IF (JFACE.GT.0) THEN
  134. CALL LOCIMP(NDIM,JFACE,XDEP2
  135. $ ,PT1,PT2,PT3,PT4,IPT9,JREBO,XIREB,XNREB,IEL1,IELTFA)
  136. ENDIF
  137.  
  138. RETURN
  139. END
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  

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