Esope source files

   1 : C TRJTIN    SOURCE    CHAT      05/01/13    03:51:24     5004           
   2 :       SUBROUTINE TRJTIN(EPSILO,NDIM,IEL1,DTREEL,TARI,XARI2,NSAUV,MLREE6,
   3 :      $TMIN,NPOS,ITER,IPARPO,KSAUV,DTSTOC,DTCUMU,TDEP,XDEP2,ICALIB,ICHGZ)
   4 : **********************************************************************
   5 : *** Traitement à effectuer lorsque la particule est tjs
   6 : *** ds la maille apres une avancee (convection + diffusion) de la 
   7 : *** particule apres un pas de tps. Il effectue aussi la sauvegarde
   8 : *** eventuelle des resultats.
   9 : *** 
  10 : *** APPELES 2 = 'TRJSTO', 'TRJDTS'
  11 : ***
  12 : *** E = 'EPSILO' marge relative acceptée % sauvegarde resultats
  13 : ***     'NDIM' dimension de l'espace
  14 : ***     'IEL1' n° global element content particule
  15 : ***     'DTREEL' pas de tps d'avancée particule au sein de la maille
  16 : ***     'TARI' temps reel d'arrivee de la particule
  17 : ***     'XARI2' coord reelles d'arrivee de la particule
  18 : ***     'NSAUV' taille de la liste des tps de sauvegarde
  19 : ***     'MLREE6' liste des tps de sauvegarde
  20 : ***     'TMIN' instant de depart du lacher de la particule
  21 : ***
  22 : *** E/S = 'NPOS' taille maximale des tableaux du segment 'IPARPO'
  23 : ***       'ITER' indice des tableaux de 'IPARPO' pour sauvegarde
  24 : ***       'IPARPO' segment utilisé pour sauvegarde des resultats
  25 : ***       'KSAUV' indice liste des tps de sauvegarde considéré 
  26 : ***       'DTSTOC' pas de tps de sauvegarde considéré
  27 : ***       'DTCUMU' cumul des pas de tps entre deux sauvegardes
  28 : ***       'TDEP' temps reel de depart de la particule
  29 : ***       'XDEP2' coordonnees de depart de la particule
  30 : ***       'ICALIB' vaut 1 si module 'CALIDT' applicable, 0 sinon
  31 : ***       'ICHGZ' vaut 1 si saut précédent effectif, 0 sinon
  32 : **********************************************************************    
  33 : 
  34 :       IMPLICIT INTEGER(I-N)
  35 :       IMPLICIT REAL*8 (A-H,O-Z)
  36 : -INC SMLREEL
  37 :       POINTEUR MLREE6.MLREEL
  38 :       SEGMENT  IPARPO
  39 :          INTEGER NAPAR(NPOS),NUMP(NPOS)
  40 :          REAL*8 CREF(NDIM,NPOS),TPAR(NPOS)
  41 :       ENDSEGMENT
  42 :       DIMENSION XARI2(3),XDEP2(3),XSTOC(3)
  43 : 
  44 : ******************************************************************
  45 : **** MISE A JOUR DES VARIABLES POUR LE PROCHAIN SAUT PARTICULE ***
  46 : ******************************************************************
  47 : 
  48 : ***   saut effectif puisque pas tps <> 0 -> chgt vecteur aleatoire possible
  49 :       ICHGZ=1
  50 : ***   applicabilité 'CALIDT' possible car particule n'est pas sur une face
  51 :       ICALIB=1
  52 : ***   données entree sont utilisées pour determiner donnees sauvegarde
  53 :       TSTOC=TDEP
  54 :       DO 10 I=1,NDIM
  55 :          XSTOC(I)=XDEP2(I)
  56 :  10   CONTINUE
  57 : ***   données arrivee deviennent données de depart
  58 :       TDEP=TARI
  59 :       DO 20 I=1,NDIM
  60 :          XDEP2(I)=XARI2(I)
  61 :  20   CONTINUE
  62 : 
  63 : *******************************************
  64 : *** SAUVEGARDE EVENTUELLE DES RESULTATS ***
  65 : *******************************************
  66 : 
  67 : ***   initialisation du pas de tps "restant" à tester pour la sauvegarde
  68 :       DTREST=DTREEL
  69 : ***   cas ou 'DTSTOC' depassé pdt traversée element
  70 :  40   IF ((DTCUMU+DTREST).GE.((1-EPSILO)*DTSTOC)) THEN
  71 : ***      calcul pas de tps interpolé % pas de tps de sauvegarde 'DTSTOC'
  72 :          IF (DTSTOC.GT.0.D0) THEN
  73 :             DTINT=ABS(DTSTOC-DTCUMU)
  74 :          ELSE
  75 :             DTINT=DTREST
  76 :          ENDIF
  77 : ***      calcul position interpole % pas de tps de sauvegarde 'DTSTOC'
  78 :          DO 30 I=1,NDIM
  79 :             XSTOC(I)=(1-DTINT/DTREST)*XSTOC(I)+(DTINT/DTREST)*XARI2(I)
  80 :  30      CONTINUE
  81 :          TSTOC=TSTOC+DTINT
  82 : ***      sauvegarde resultats et nouveau pas de tps de sauvegarde 
  82 :          CALL TRJSTO(NDIM,IEL1,NPOS,ITER,IPARPO,TSTOC,XSTOC)
  82 :          CALL TRJDTS(NSAUV,MLREE6,TMIN,KSAUV,DTSTOC,DTCUMU)
  83 : ***      mise à jour du pas de tps restant et rebelote eventuellement
  84 :          IF (DTSTOC.GT.0) THEN
  85 :             DTREST=DTREST-DTINT
  86 :             GOTO 40
  87 :          ELSE
  88 :             DTREST=0.D0
  89 :          ENDIF
  90 :       ENDIF
  91 : ***   mise à jour du cumul des pas de tps entre 2 sauvegardes
  92 :       DTCUMU=DTCUMU+DTREST
  93 : 
  94 :       RETURN
  95 :       END
  96 : 
  97 : 
  98 :  
  99 :