Sources Esope | Cast3M

initpa
C INITPA    SOURCE    CHAT      05/01/13    00:38:17     5004
      SUBROUTINE INITPA(EPSILO,IPART,IZPART,TMIN,NSAUV,MLREE6
     $     ,MELEME,IPT9,NDIM,NPOS,ITER,IPARPO,IVPT,IEL1,XDEP2,TDEP
     $     ,JFACE,JREBO,XIREB,XNREB,ICHGZ,Z,KSAUV,DTSTOC,DTCUMU,IZSH,
     $      IELTFA)
****************************************************************************
*** SP 'INITPA' : met en place les conditions initiales liées à la particule
*** considérée lors de son avancée dans le domaine.
***
*** APPELES 1 = 'MELNEL', 'DOXE'
*** APPELES 2 = 'REFREE', 'TRJSTO', 'TRJDTS', 'TESTFA'
***
*** E = 'EPSILO' marge relative acceptée position pt % face de l'element
***     'IPART' n° de la particule concernée par l'avancée
***     'IZPART' segment content coords référence des différentes particules
***     'TMIN' instant de départ de la particule concernée
***     'NSAUV' taille de la liste des tps de sauvegarde
***     'MLREE6' liste des tps de sauvegarde
***     'MELEME' pteur sur maillage du domaine etudié
***     'IPT9' pteur sur maillage faces impermeables
***     'IELTFA' pointeur du maillage contenant les numeros de
***               faces par elements
***
*** S = 'NDIM' dimension de l'espace
***     'NPOS' nbre de traversées d'éléments fixé arbitrairement
***     'ITER' n° de traversée considérée pour le stockage position particule
***     'IPARPO' segment ou sont sauvegardés resultats trajectoire
***     'IVPT' entier valant 1 en régime permanent
***     'IEL1' n° global d'élément contenant la particule
***     'XDEP2' coords reelles de départ particule
***     'TDEP' tps ecoulé jusqu'au pt de départ
***     'JFACE' n° local face de l'element considéré depart particule
***     'JREBO' n° local face impermeable depart particule
***     'XIREB' pt d'impact sur la face impermeable
***     'XNREB' vecteur normal à la face impermeable
***     'ICHGZ' vaut 1 si saut précédent effectif, 0 sinon
***     'Z' vecteur aleatoire entre -1 et 1 pour le saut diffusif
***     'KSAUV' indice considéré dans la liste des tps de sauvegarde
***     'DTSTOC' pas de tps de sauvegarde considéré
***     'DTCUMU' cumul des pas de tps entre deux sauvegardes
***     'IZSH' segment content coords reelles noeuds element initial
***
*** Rq : 'IZPART' et 'IPARPO' sont activés en sortie de module
******************************************************************************
*** ORIGINE = PATRICK MEYNIEL modifie par CYRIL NOU
******************************************************************************
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMELEME
-INC SMLREEL
      POINTEUR MLREE6.MLREEL
      POINTEUR IELTFA.MELEME
      SEGMENT IZSH
          REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
      ENDSEGMENT
      SEGMENT IZPART
         INTEGER NLEPA(NPART),NUMPA(NPART)
         REAL*8  COORPA(NDIM,NPART)
      ENDSEGMENT
      SEGMENT  IPARPO
         INTEGER NAPAR(NPOS),NUMP(NPOS)
         REAL*8 CREF(NDIM,NPOS),TPAR(NPOS)
      ENDSEGMENT
      DIMENSION XDEP(3),XDEP2(3),Z(3),XIREB(3),XNREB(3)
      DIMENSION PT1(3),PT2(3),PT3(3),PT4(3)
 
**************************************
*** INITIALISATION VARIABLES DU PB ***
**************************************
 
***   dimension de l'espace
      NDIM=IDIM
***   taille max et indice des tableaux du segment 'IPARPO'
      NPOS=50
      ITER=0
***   'IVPT' vaut 1 en regime permanent
      IVPT=1
***   affectation du n° global d'elemt de départ contenant particule 'IPART'
      IEL1=NLEPA(IPART)
***   variable test valant 1 si saut précédent effectif, 0 sinon
      ICHGZ=1
***   'Z' vecteur aleatoire entre -1 et 1 pour la diffusion
      DO 10 I=1,3
         Z(I)=0.D0
 10   CONTINUE
***   initialisation à 0 indice liste des tps de sauvegarde
      KSAUV=0
***   initialisation à 0 des variables liées au rebond
      JREBO=-1
      DO 20 I=1,3
         XIREB(I)=0.D0
         XNREB(I)=0.D0
 20   CONTINUE
 
****************************************************
*** SAUVEGARDE DE LA POSITION INITIALE PARTICULE ***
****************************************************
 
***   initialisation ou activation des segments liés à particule
C     SEGACT IZPART
      SEGINI IPARPO
***   affectation des coord référence de depart de la particule 'IPART'
      DO 30 I=1,NDIM
         XDEP(I)=COORPA(I,IPART)
 30   CONTINUE
***   affectation du tps réel de départ de la particule 'IPART'
      TDEP=TMIN
***   recuperation des propriétés de 'IEL1' pour sp 'DOXE' et sauvegarde
      CALL MELNEL(IEL1,MELEME,IPT1,NEL0,1)
      SEGACT IPT1
      NOEL1=IPT1.NUM(/1)
      IELL=IEL1-NEL0
      ITY1=IPT1.ITYPEL
      ITYG=NUMGEO(ITY1)
***   recuperation des positions reelles des noeuds de 'IEL1'
      CALL DOXE(XCOOR,NDIM,NOEL1,IPT1.NUM,IELL,XYZL)
***   initialisation sauvegarde initiale % position lacher particule
      CALL REFREE(NDIM,ITY1,NOEL1,IZSH,XDEP,XDEP2)
      CALL TRJSTO(NDIM,IEL1,NPOS,ITER,IPARPO,TDEP,XDEP2)
      CALL TRJDTS(NSAUV,MLREE6,TMIN,KSAUV,DTSTOC,DTCUMU)
 
***********************************************
*** PARTICULE APPARTIENT À FACE DE 'IEL1' ? ***
***********************************************
 
***   sp renvoie n° local appartenance face de 'IEL1'
      CALL TESTFA(EPSILO,NDIM,ITYG,XDEP2,IZSH,JFACE,PT1,PT2,PT3,PT4)
***   sp renvoie n° local appartenance face impermeable
      IF (JFACE.GT.0) THEN
         CALL LOCIMP(NDIM,JFACE,XDEP2
     $     ,PT1,PT2,PT3,PT4,IPT9,JREBO,XIREB,XNREB,IEL1,IELTFA)
      ENDIF
 
      RETURN
      END