Sources Esope | Cast3M

trjtin
C TRJTIN    SOURCE    CHAT      05/01/13    03:51:24     5004
      SUBROUTINE TRJTIN(EPSILO,NDIM,IEL1,DTREEL,TARI,XARI2,NSAUV,MLREE6,
     $TMIN,NPOS,ITER,IPARPO,KSAUV,DTSTOC,DTCUMU,TDEP,XDEP2,ICALIB,ICHGZ)
**********************************************************************
*** Traitement à effectuer lorsque la particule est tjs
*** ds la maille apres une avancee (convection + diffusion) de la
*** particule apres un pas de tps. Il effectue aussi la sauvegarde
*** eventuelle des resultats.
***
*** APPELES 2 = 'TRJSTO', 'TRJDTS'
***
*** E = 'EPSILO' marge relative acceptée % sauvegarde resultats
***     'NDIM' dimension de l'espace
***     'IEL1' n° global element content particule
***     'DTREEL' pas de tps d'avancée particule au sein de la maille
***     'TARI' temps reel d'arrivee de la particule
***     'XARI2' coord reelles d'arrivee de la particule
***     'NSAUV' taille de la liste des tps de sauvegarde
***     'MLREE6' liste des tps de sauvegarde
***     'TMIN' instant de depart du lacher de la particule
***
*** E/S = 'NPOS' taille maximale des tableaux du segment 'IPARPO'
***       'ITER' indice des tableaux de 'IPARPO' pour sauvegarde
***       'IPARPO' segment utilisé pour sauvegarde des resultats
***       'KSAUV' indice liste des tps de sauvegarde considéré
***       'DTSTOC' pas de tps de sauvegarde considéré
***       'DTCUMU' cumul des pas de tps entre deux sauvegardes
***       'TDEP' temps reel de depart de la particule
***       'XDEP2' coordonnees de depart de la particule
***       'ICALIB' vaut 1 si module 'CALIDT' applicable, 0 sinon
***       'ICHGZ' vaut 1 si saut précédent effectif, 0 sinon
**********************************************************************
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
-INC SMLREEL
      POINTEUR MLREE6.MLREEL
      SEGMENT  IPARPO
         INTEGER NAPAR(NPOS),NUMP(NPOS)
         REAL*8 CREF(NDIM,NPOS),TPAR(NPOS)
      ENDSEGMENT
      DIMENSION XARI2(3),XDEP2(3),XSTOC(3)
 
******************************************************************
**** MISE A JOUR DES VARIABLES POUR LE PROCHAIN SAUT PARTICULE ***
******************************************************************
 
***   saut effectif puisque pas tps &lt;> 0 -> chgt vecteur aleatoire possible
      ICHGZ=1
***   applicabilité 'CALIDT' possible car particule n'est pas sur une face
      ICALIB=1
***   données entree sont utilisées pour determiner donnees sauvegarde
      TSTOC=TDEP
      DO 10 I=1,NDIM
         XSTOC(I)=XDEP2(I)
 10   CONTINUE
***   données arrivee deviennent données de depart
      TDEP=TARI
      DO 20 I=1,NDIM
         XDEP2(I)=XARI2(I)
 20   CONTINUE
 
*******************************************
*** SAUVEGARDE EVENTUELLE DES RESULTATS ***
*******************************************
 
***   initialisation du pas de tps "restant" à tester pour la sauvegarde
      DTREST=DTREEL
***   cas ou 'DTSTOC' depassé pdt traversée element
 40   IF ((DTCUMU+DTREST).GE.((1-EPSILO)*DTSTOC)) THEN
***      calcul pas de tps interpolé % pas de tps de sauvegarde 'DTSTOC'
         IF (DTSTOC.GT.0.D0) THEN
            DTINT=ABS(DTSTOC-DTCUMU)
         ELSE
            DTINT=DTREST
         ENDIF
***      calcul position interpole % pas de tps de sauvegarde 'DTSTOC'
         DO 30 I=1,NDIM
            XSTOC(I)=(1-DTINT/DTREST)*XSTOC(I)+(DTINT/DTREST)*XARI2(I)
 30      CONTINUE
         TSTOC=TSTOC+DTINT
***      sauvegarde resultats et nouveau pas de tps de sauvegarde
         CALL TRJSTO(NDIM,IEL1,NPOS,ITER,IPARPO,TSTOC,XSTOC)
         CALL TRJDTS(NSAUV,MLREE6,TMIN,KSAUV,DTSTOC,DTCUMU)
***      mise à jour du pas de tps restant et rebelote eventuellement
         IF (DTSTOC.GT.0) THEN
            DTREST=DTREST-DTINT
            GOTO 40
         ELSE
            DTREST=0.D0
         ENDIF
      ENDIF
***   mise à jour du cumul des pas de tps entre 2 sauvegardes
      DTCUMU=DTCUMU+DTREST
 
      RETURN
      END