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
scheme_exp.F could be called by: