1 | include(dom.inc)
2 |
3 | SUBROUTINE TAB_CASE(celldata, kabs, wquad, allkabs, DYH, DYC, &
4 | & DYCO, nYH, nYC, nYCO, DT, nT, nkabs, ntcells, &
5 | & nallbandes, all_WVNB, all_DWVNB, Lb)
6 |
7 | IMPLICIT NONE
8 |
9 | include 'dom_constants.h'
10 |
11 | DOM_INT :: nYH, nYC, nYCO, nT
12 | DOM_INT :: nkabs, ntcells, ierr
13 | DOM_INT :: i_bande,nallbandes
14 | DOM_REAL :: DYH, DYC, DYCO, DT
15 | DOM_REAL :: DYH2,DYC2,DYCO2, ave
16 | DOM_INT :: iq,ielt,i
17 | DOM_REAL, DIMENSION(8,ntcells) :: celldata
18 | DOM_INT, DIMENSION(8) :: neighbors
19 | DOM_REAL, DIMENSION(nkabs,ntcells) :: kabs
20 | DOM_REAL, DIMENSION(nYH,nYC,nYCO,nT,nkabs) :: allkabs
21 | DOM_REAL, DIMENSION(16) :: d
22 | DOM_REAL, DIMENSION(4) :: dist
23 |
24 | DOM_REAL,DIMENSION(nallbandes) :: all_WVNB,all_DWVNB
25 | DOM_REAL,DIMENSION(ntcells) :: Lb
26 | DOM_REAL,DIMENSION(ntcells) :: K_SOOT, FSK_SOOT
27 | DOM_REAL :: blae, planck
28 | DOM_REAL :: WVNB_SI,DWVNB_SI
29 | DOM_REAL,DIMENSION(nallbandes) :: F
30 |
31 | DOM_REAL, PARAMETER :: x_min=0.0
32 | DOM_REAL, PARAMETER :: x_max=1.0
33 | DOM_REAL, dimension(nkabs) :: x_pts,wquad
34 |
35 | CALL gauleg(x_min,x_max,x_pts,wquad,nkabs)
36 |
37 | kabs = 0.
38 | FSK_SOOT = 0.
39 |
40 | DYH2 = DYH*(DT/DYH)
41 | DYC2 = DYC*(DT/DYC)
42 | DYCO2 = DYCO*(DT/DYCO)
43 |
44 | DO ielt=1,ntcells
45 |
46 | ! ---------------------------------!
47 | ! Mean soot absorption calculation !
48 | ! ---------------------------------!
49 |
50 | DO i_bande=1,nallbandes
51 |
52 | WVNB_SI = 100.*all_WVNB(i_bande)
53 | DWVNB_SI= 100.*all_DWVNB(i_bande)
54 |
55 | F(i_bande)=blae(WVNB_SI,celldata(1,ielt))/(pi*Lb(ielt))* &
56 | & DWVNB_SI
57 |
58 | K_SOOT(ielt)=WVNB_SI*5.5*celldata(8,ielt)
59 |
60 | FSK_SOOT(ielt)=FSK_SOOT(ielt)+F(i_bande)*K_SOOT(ielt)
61 |
62 | ENDDO
63 |
64 | FSK_SOOT(ielt) = FSK_SOOT(ielt) / SUM(F)
65 |
66 | ! ------------------------------------------------!
67 | ! Calculationn of the closest points in the table !
68 | ! ------------------------------------------------!
69 |
70 | IF (celldata(1,ielt).lt.300.d0) THEN
71 | neighbors(1) = 1
72 | dist(1) = 0.d0
73 | ELSEIF (celldata(1,ielt).gt.2900.d0) THEN
74 | neighbors(1) = int((2900.d0 - 300.d0)/DT) +1
75 | dist(1) = 0
76 | ELSE
77 | neighbors(1) = int((celldata(1,ielt)-300.d0)/DT)+1
78 | dist(1) =(celldata(1,ielt)-300.d0)-((neighbors(1)-1)*1.0)*DT
79 | ENDIF
80 |
81 | IF ((modulo(celldata(1,ielt)-300.d0,DT).eq.0.).or. &
82 | & (celldata(1,ielt).gt.2900.d0)) THEN
83 | neighbors(2) = neighbors(1)
84 | ELSE
85 | neighbors(2) = neighbors(1) + 1
86 | ENDIF
87 |
88 | neighbors(3) = int(celldata(3,ielt)/DYH)+1
89 | neighbors(4) = int(celldata(4,ielt)/DYC)+1
90 | neighbors(5) = int(celldata(5,ielt)/DYCO)+1
91 |
92 | IF( modulo(celldata(3,ielt),DYH).eq.0.) THEN
93 | neighbors(6) = neighbors(3)
94 | ELSE
95 | neighbors(6) = neighbors(3) + 1
96 | ENDIF
97 |
98 | IF( modulo(celldata(4,ielt),DYC).eq.0.) THEN
99 | neighbors(7) = neighbors(4)
100 | ELSE
101 | neighbors(7) = neighbors(4) + 1
102 | ENDIF
103 |
104 | IF( modulo(celldata(5,ielt),DYCO).eq.0.) THEN
105 | neighbors(8) = neighbors(5)
106 | ELSE
107 | neighbors(8) = neighbors(5) + 1
108 | ENDIF
109 |
110 | ! ------------------------------------------------!
111 | ! Calculationn of the distances for interpolation !
112 | ! ------------------------------------------------!
113 |
114 | dist(2)=(celldata(3,ielt)-((neighbors(3)-1)*1.0)*DYH)*(DT/DYH)
115 |
116 | dist(3)=(celldata(4,ielt)-((neighbors(4)-1)*1.0)*DYC)*(DT/DYC)
117 |
118 | dist(4) = (celldata(5,ielt)-((neighbors(5)-1)*1.0) &
119 | & *DYCO)*(DT/DYCO)
120 |
121 | d(1) = sqrt(dist(1)**2 + dist (2)**2 + &
122 | & dist(3)**2 + 0.04*(dist(4)**2))
123 |
124 | d(2) = sqrt((DT - dist(1))**2 + dist(2)**2 + &
125 | & dist(3)**2 + 0.04*(dist(4)**2))
126 |
127 | d(3) = sqrt(dist(1)**2 + (DYH2 - dist(2))**2 + &
128 | & dist(3)**2 + 0.04*(dist(4)**2))
129 |
130 | d(4) = sqrt(dist(1)**2 + dist(2)**2 + &
131 | & (DYC2 - dist(3))**2 + 0.04*(dist(4)**2))
132 |
133 | d(5) = sqrt(dist(1)**2 + dist(2)**2 + &
134 | & dist(3)**2 + 0.04*(DYCO2 - dist(4))**2)
135 |
136 | d(6) = sqrt((DT - dist(1))**2 + &
137 | & (DYH2 - dist(2))**2 + dist(3)**2 + 0.04*(dist(4)**2))
138 |
139 | d(7) = sqrt((DT - dist(1))**2 + dist(2)**2 + &
140 | & (DYC2 - dist(3))**2 + 0.04*(dist(4)**2))
141 |
142 | d(8) = sqrt((DT - dist(1))**2 + dist(2)**2 + &
143 | & dist(3)**2 + 0.04*(DYCO2 - dist(4))**2)
144 |
145 | d(9) = sqrt(dist(1)**2 + (DYH2 - dist(2))**2 + &
146 | & (DYC2 - dist(3))**2 + 0.04*(dist(4)**2))
147 |
148 | d(10) = sqrt(dist(1)**2 + (DYH2 - dist(2))**2 + &
149 | & dist(3)**2 + 0.04*(DYCO2 - dist(4))**2)
150 |
151 | d(11) = sqrt(dist(1)**2 + dist(2)**2 + &
152 | & (DYC2 - dist(3))**2 + 0.04*(DYCO2 - dist(4))**2)
153 |
154 | d(16) = sqrt((DT - dist(1))**2 + (DYH2- dist(2))**2 + (DYC2 - &
155 | & dist(3))**2 + 0.04*(DYCO2 - dist(4))**2)
156 |
157 | d(12) = sqrt((DT - dist(1))**2 + (DYH2 - dist(2))**2 + &
158 | & (DYC2 - dist(3))**2 + 0.04*(dist(4)**2))
159 |
160 | d(13) = sqrt((DT - dist(1))**2 + (DYH2 - dist(2))**2 + &
161 | & dist(3)**2 + 0.04*(DYCO2 - dist(4))**2)
162 |
163 | d(14) = sqrt((DT - dist(1))**2 + dist(2)**2 + &
164 | & (DYC2 - dist(3))**2 + 0.04*(DYCO2 - dist(4))**2)
165 |
166 | d(15) = sqrt(dist(1)**2 + (DYH2 - dist(2))**2 + &
167 | & (DYC2 - dist(3))**2 + 0.04*(DYCO2 - dist(4))**2)
168 |
169 | ave = SUM(d(:))/16.d0
170 |
171 | ! -------------------------------------------------------!
172 | ! Interpolation of the tabulated absorption coefficients !
173 | ! -------------------------------------------------------!
174 |
175 | DO iq=1,nkabs
176 | kabs(iq,ielt) = &
177 | & allkabs(neighbors(3),neighbors(4),neighbors(5), &
178 | & neighbors(1),iq)*(ave/d(1)) + &
179 | & allkabs(neighbors(3),neighbors(4),neighbors(5), &
180 | & neighbors(2),iq)*(ave/d(2)) + &
181 | & allkabs(neighbors(6),neighbors(4),neighbors(5), &
182 | & neighbors(1),iq)*(ave/d(3)) + &
183 | & allkabs(neighbors(3),neighbors(7),neighbors(5), &
184 | & neighbors(1),iq)*(ave/d(4)) + &
185 | & allkabs(neighbors(3),neighbors(4),neighbors(8), &
186 | & neighbors(1),iq)*(ave/d(5)) + &
187 | & allkabs(neighbors(6),neighbors(4),neighbors(5), &
188 | & neighbors(2),iq)*(ave/d(6)) + &
189 | & allkabs(neighbors(3),neighbors(7),neighbors(5), &
190 | & neighbors(2),iq)*(ave/d(7)) + &
191 | & allkabs(neighbors(3),neighbors(4),neighbors(8), &
192 | & neighbors(2),iq)*(ave/d(8)) + &
193 | & allkabs(neighbors(6),neighbors(7),neighbors(5), &
194 | & neighbors(1),iq)*(ave/d(9)) + &
195 | & allkabs(neighbors(6),neighbors(5),neighbors(8), &
196 | & neighbors(1),iq)*(ave/d(10)) + &
197 | & allkabs(neighbors(3),neighbors(7),neighbors(8), &
198 | & neighbors(1),iq)*(ave/d(11)) + &
199 | & allkabs(neighbors(6),neighbors(7),neighbors(5), &
200 | & neighbors(2),iq)*(ave/d(12)) + &
201 | & allkabs(neighbors(6),neighbors(4),neighbors(8), &
202 | & neighbors(2),iq)*(ave/d(13)) + &
203 | & allkabs(neighbors(3),neighbors(7),neighbors(8), &
204 | & neighbors(2),iq)*(ave/d(14)) + &
205 | & allkabs(neighbors(6),neighbors(7),neighbors(8), &
206 | & neighbors(1),iq)*(ave/d(15)) + &
207 | & allkabs(neighbors(6),neighbors(7),neighbors(8), &
208 | & neighbors(2),iq)*(ave/d(16))
209 | ENDDO
210 |
211 | IF (celldata(1,ielt).lt.300.d0) THEN
212 | kabs(:,ielt) = 0.0d0
213 | ELSE
214 | kabs(:,ielt) = kabs(:,ielt)/16.d0 + FSK_SOOT(ielt)
215 | ENDIF
216 |
217 | ENDDO
218 |
219 | END SUBROUTINE TAB_CASE