1 | include(dom.inc)
   2 | 
   3 |       SUBROUTINE MFSCHEME(k_abs,k_scat,V,nface,S,Di,Lb,Gi,Li,Le,Lp,     &
   4 |      &                    alpha,nfacemax)
   5 | 
   6 | !     ******************************************************************!
   7 | !         kabs   -->  Coeff. d'absorption gris                          !
   8 | !         k_scat -->  Coeff de diffusion isotrope                       !
   9 | !         V      -->  Volume de la cellule                              !
  10 | !         S      -->  Vecteur des 4 surfaces (ABC, ABD, ACD et BCD)     !
  11 | !         Di     -->  Vecteur des produits (normes*direction discrete)  !
  12 | !         Lb     -->  Luminace noire emise au centre de la cellule      !
  13 | !         Gi     -->  Luminance incidente a l'iteration precedente      !
  14 | !         Li     -->  Lminance aux faces d'entree                       !
  15 | !         Le     -->  Luminance calculees aux faces de sortie           !
  16 | !         Lp     -->  Lp total au centre de la cellule                  !
  17 | !     ******************************************************************!
  18 | 
  19 |         IMPLICIT NONE
  20 | 
  21 |         include 'dom_constants.h'
  22 | 
  23 | !       IN
  24 |         DOM_INT          :: nface, nfacemax
  25 | 
  26 |         DOM_REAL :: k_abs, alpha
  27 |         DOM_REAL :: Lb, Gi, k_scat, V
  28 |         DOM_REAL, DIMENSION (nfacemax) :: Li, Di, S
  29 | 
  30 | !       OUT
  31 |         DOM_REAL                       :: Lp
  32 |         DOM_REAL,DIMENSION(nfacemax)   :: Le
  33 | 
  34 | !       LOCAL
  35 |         DOM_REAL :: L_IN, AREA_IN
  36 |         DOM_REAL :: SD
  37 |         DOM_INT  :: i
  38 | 
  39 |         L_IN    = 0.
  40 |         AREA_IN = 0.
  41 | 
  42 |         DO i=1,nface
  43 |           IF (Di(i)<0.) THEN
  44 |             SD      = S(i)*Di(i)
  45 |             L_IN    = L_IN    + SD*Li(i)
  46 |             AREA_IN = AREA_IN + SD
  47 |           ENDIF
  48 |         ENDDO
  49 | 
  50 |         Lp = ( alpha*V*(k_abs*Lb + k_scat/(4*pi)*Gi) - L_IN ) /         &
  51 |      &       ( alpha*V*(k_abs+k_scat) - AREA_IN )
  52 | 
  53 |         DO i=1,nface
  54 |           IF (Di(i)>0.) THEN
  55 |             Le(i)=( Lp - (1.-alpha)*L_IN/AREA_IN ) / alpha
  56 |             IF ( Le(i).lt.0. ) THEN
  57 |               Le(i) = 0.
  58 |             ENDIF
  59 |           ENDIF
  60 |         ENDDO
  61 | 
  62 |       END SUBROUTINE MFSCHEME