1 | include(dom.inc)
   2 |       SUBROUTINE SCHEME_EXPO(neighs, nfcelt, mu, eta, ksi, w, pathway,  &
   3 |      &                Lb, Lpi, Gi, G, V, k_scat, k_abs, maxlen,         &
   4 |      &                Q_rtot, Li,     H, S, s_s, norm, ndir,            &
   5 |      &                nfacemax, ncells, nkabs, dir_d, dir_f, bcell,     &
   6 |      &                bface, nbface)
   7 | 
   8 |         IMPLICIT NONE
   9 | 
  10 | !       IN
  11 |         DOM_INT           :: ndir, ncells, nfacemax, nkabs, nbface
  12 |         DOM_INT           :: dir_d, dir_f
  13 |         DOM_INT, DIMENSION (2*nfacemax,ncells)        :: neighs
  14 |         DOM_INT, DIMENSION (ncells)                   :: nfcelt
  15 |         DOM_INT, DIMENSION (ncells,ndir)              :: pathway
  16 | 
  17 |         DOM_REAL  :: alpha
  18 |         DOM_REAL,DIMENSION(ndir)              :: mu, eta, ksi, w
  19 |         DOM_REAL,DIMENSION(ncells)            :: Lb, V, k_scat
  20 |         DOM_REAL,DIMENSION(ncells)            :: k_abs
  21 |         DOM_REAL,DIMENSION(ncells)            :: Lpi,Gi
  22 |         DOM_REAL,DIMENSION(ncells,ndir)       :: maxlen
  23 |         DOM_REAL,DIMENSION(nfacemax,ncells)   :: S
  24 |         DOM_INT ,DIMENSION(nbface)            :: bcell, bface
  25 |         DOM_REAL,DIMENSION(3,nfacemax,ncells) :: norm
  26 |         DOM_REAL,DIMENSION(nfacemax,ncells,ndir) :: s_s
  27 | 
  28 | !       OUT
  29 |         DOM_REAL,DIMENSION(ncells)            :: G
  30 |         DOM_REAL,DIMENSION(3,ncells)          :: Q_rtot
  31 |         DOM_REAL,DIMENSION(nfacemax,ncells)   :: Li
  32 |         DOM_REAL,DIMENSION(nfacemax,ncells)   :: H
  33 | 
  34 | !       LOCAL
  35 |         DOM_INT           :: iquad,icell,i,j,n,ibnd,k
  36 |         DOM_REAL,DIMENSION(nfacemax)          :: Dm_ij
  37 |         DOM_REAL,DIMENSION(nfacemax,ncells)   :: Le
  38 | 
  39 | !       ----------------------------------!
  40 | !       Looping over all slave directions !
  41 | !       ----------------------------------!
  42 | 
  43 |         DO iquad=dir_d, dir_f
  44 |           
  45 |           DO icell=1,ncells
  46 |                
  47 |             j=pathway(icell,iquad)
  48 |                
  49 |             DO i=1,nfcelt(j)
  50 |               Dm_ij(i)=norm(1,i,j)*mu(iquad)+norm(2,i,j)*eta(iquad)+    &
  51 |      &                 norm(3,i,j)*ksi(iquad)
  52 |             ENDDO
  53 |                 
  54 |             CALL EXPOSCHEME(k_abs(j),k_scat(j),V(j),nfcelt(j),S(:,j),   &
  55 |      &                      Dm_ij,Lb(j),maxlen(icell,iquad),            &
  56 |      &                      s_s(:,icell,iquad),Gi(j),Li(j,:),           &
  57 |      &                      Le(:,j),Lpi(j),nfacemax)
  58 | 
  59 |             G(j)= G(j) + Lpi(j)*w(iquad)
  60 |             Q_rtot(1,j) = Q_rtot(1,j) + Lpi(j)*w(iquad)*mu (iquad)
  61 |             Q_rtot(2,j) = Q_rtot(2,j) + Lpi(j)*w(iquad)*eta(iquad)
  62 |             Q_rtot(3,j) = Q_rtot(3,j) + Lpi(j)*w(iquad)*ksi(iquad)
  63 | 
  64 | !           -----------------------------------------------!
  65 | !           Mise a jour des faces de sorties de la cellule !
  66 | !           Calcul du flux incident Hw a la parois         !
  67 | !           -----------------------------------------------!
  68 | 
  69 |             DO i=1,nfcelt(j)                  
  70 |               IF (Dm_ij(i).ge.0.) THEN
  71 | 
  72 | !               ----------------------------------!
  73 | !               Detect if face is in the boundary !
  74 | !               ----------------------------------!
  75 | 
  76 |                 ibnd = 0
  77 |                 k    = 1
  78 | 
  79 |                 DO WHILE (k.le.nbface)
  80 |                   IF ((bcell(k).eq.j).and.(bface(k).eq.i)) THEN
  81 |                     ibnd = k
  82 |                     k = 10 * k
  83 |                   ENDIF
  84 |                   k = k + 1
  85 |                 ENDDO
  86 | 
  87 | !               ----------------------------------------------!
  88 | !               Apply luminance to the neighbor/boundary face !
  89 | !               ----------------------------------------------!
  90 | 
  91 |                 IF (ibnd.eq.0) THEN
  92 |                   Li(neighs((2*i-1),j),neighs((2*i),j)) = Le(i,j)
  93 |                 ELSE
  94 |                   H(i,j)= H(i,j) + Le(i,j)*w(iquad)*Dm_ij(i)
  95 |                 ENDIF
  96 | 
  97 |               ENDIF
  98 |             ENDDO
  99 |           
 100 |            ENDDO
 101 |         ENDDO
 102 | 
 103 |       END SUBROUTINE SCHEME_EXPO