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