exposcheme.F [SRC] [CPP] [JOB] [SCAN]
SEQCODE / SCHEMESSOURCES/SCHEMES [=]



   1 | include(dom.inc)
   2 | 
   3 |        SUBROUTINE EXPOSCHEME(k_abs,wkabs,k_scat,V,S,Di,maxlen,s_s,      &
   4 |      &                 Lb,Gi,Li,epsil,Le,X,X3,nfacemax)
   5 | 
   6 |   !******************************************************************
   7 |   !    k_abs   -->  Coeff. d'absorption gris                        !
   8 |   !    nkabs   -->  Nombre de coeff gris ( le + svt  =  1 )         !
   9 |   !    wkabs   -->  Poids associe au numero du coeff                !
  10 |   !    k_scat  -->  Coeff de diffusion isotrope                     !
  11 |   !    maxlen  -->  Longueur carac. du phenomene d'absorption       !
  12 |   !    ntype   -->  Type de la cellule v-a-v. du la dir. discrete   !
  13 |   !    s_s     -->  Vecteur des Coeff. d'echange surface/surface    !
  14 |   !    V       -->  Volume de la cellule                            !
  15 |   !    S       -->  Vecteur des 4 surfaces (ABC, ABD, ACD et BCD)   !
  16 |   !    Di      -->  Vecteur des Dij  (normales*direction discrete)  !
  17 |   !    Lb      -->  Luminace noire emise au centre de la cellule    !
  18 |   !    Gi      -->  Luminance incidente a l'iteration precedente    !
  19 |   !    Li      -->  Lminance aux faces d'entree                     !
  20 |   !    epsil   -->  Emissivite ( -1 pour les faces non parietales ) !
  21 |   !    Le      -->  Luminance calculees aux faces de sortie         !
  22 |   !    X       -->  Lpi au centre de la cellule                     !  
  23 |   !    Y0      -->  Terme Source par Emission et diffusion incidente!  
  24 |   !    Y1      -->  Terme ne dependant que de l'epaisseur optique   !  
  25 |   !******************************************************************
  26 | 
  27 |        IMPLICIT NONE
  28 | 
  29 |        INCLUDE 'dom_constants.h'
  30 | 
  31 |        DOM_REAL :: Lb,Gi,Lpi,V,maxlen, KSI,k_abs
  32 |        DOM_REAL :: wkabs,k_scat,omega,tau
  33 |        DOM_REAL :: X,X3
  34 |        DOM_INT :: nfacemax
  35 |        DOM_REAL, DIMENSION (nfacemax) :: Li, Le, Di, S
  36 |        DOM_REAL, DIMENSION (nfacemax) :: epsil, s_s, X2
  37 | 
  38 |        DOM_REAL :: beta, y0, y2, x0, x1
  39 |        DOM_INT :: ici1
  40 | 
  41 |        X=0.
  42 |        beta=k_scat+k_abs
  43 |        omega=k_scat/beta
  44 |        tau=beta*maxlen
  45 |        Y0=(1.-omega)*Lb+omega*Gi/(4*pi)
  46 |        KSI=(2./tau)*(1.-(1./tau)*(1.-exp(-tau)))
  47 |        Y2=KSI*sum(Li*s_s)+Y0*(1-KSI)
  48 |        X0=Y2/(beta*V)
  49 |        X2=Li/(beta*V)
  50 |        X1=Y0
  51 | 
  52 |        !---------------------------!
  53 |        ! Sommation sur les 4 faces !
  54 |        !---------------------------!
  55 | 
  56 |        DO ici1=1,4                             
  57 |           IF (Di(ici1)>0.) THEN
  58 |              X=X+X0*S(ici1)*Di(ici1)       ! Faces de sorties
  59 |              IF (epsil(ici1)==-1.) THEN
  60 |                 Le(ici1)=Y2                ! Faces parietales
  61 |              ENDIF
  62 |           ELSEIF (Di(ici1)<0.) THEN
  63 |              X=X+X2(ici1)*S(ici1)*Di(ici1) ! Faces d'entrees
  64 |           ENDIF
  65 |        ENDDO
  66 | 
  67 |        X=X1-X
  68 | 
  69 |        END SUBROUTINE EXPOSCHEME


exposcheme.F could be called by:
Makefile [SEQCODE] - 90
Makefile [SOURCES] - 103 - 201
scheme_exp.F [SEQCODE/SCHEMES] - 38
scheme_exp.F [SOURCES/SCHEMES] - 54