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, celld, &
6 | & cellf)
7 |
8 | USE mod_inout
9 | USE mod_pmm
10 |
11 | IMPLICIT NONE
12 |
13 | include 'dom_constants.h'
14 |
15 | DOM_INT :: nYH, nYC, nYCO, nT
16 | DOM_INT :: nkabs, ntcells, ierr
17 | DOM_INT :: i_bande,nallbandes
18 | DOM_REAL :: DYH, DYC, DYCO, DT
19 | DOM_REAL :: DYH2,DYC2,DYCO2, ave
20 | DOM_INT :: celld,cellf,n_cl
21 | DOM_INT :: iq,ielt,i
22 | DOM_REAL, DIMENSION(8,ntcells) :: celldata
23 | DOM_INT, DIMENSION(8) :: bornes
24 | DOM_REAL, DIMENSION(nkabs,ntcells) :: kabs, local_kabs
25 | DOM_REAL, DIMENSION(nYH,nYC,nYCO,nT,nkabs) :: allkabs
26 | DOM_REAL, DIMENSION(16) :: d
27 | DOM_REAL, DIMENSION(4) :: dist
28 |
29 | DOM_REAL,DIMENSION(nallbandes) :: all_WVNB,all_DWVNB
30 | DOM_REAL,DIMENSION(ntcells) :: Lb
31 | DOM_REAL,DIMENSION(ntcells) :: K_SOOT, FSK_SOOT
32 | DOM_REAL :: blae, planck
33 | DOM_REAL :: WVNB_SI,DWVNB_SI
34 | DOM_REAL,DIMENSION(nallbandes) :: F
35 |
36 | DOM_REAL, PARAMETER :: x_min=0.0
37 | DOM_REAL, PARAMETER :: x_max=1.0
38 | DOM_REAL, dimension(nkabs) :: x_pts,wquad
39 |
40 | CALL gauleg(x_min,x_max,x_pts,wquad,nkabs)
41 |
42 | local_kabs = 0.
43 | kabs = 0.
44 | FSK_SOOT = 0.
45 |
46 | DYH2 = DYH*(DT/DYH)
47 | DYC2 = DYC*(DT/DYC)
48 | DYCO2 = DYCO*(DT/DYCO)
49 |
50 | ! ---------------------------------------------!
51 | ! Non-homogeneous system or homogeneous system !
52 | ! ---------------------------------------------!
53 |
54 | IF (homosyst.eq.'NO') THEN
55 | n_cl=cellf
56 | ELSEIF (homosyst.eq.'YES') THEN
57 | n_cl=celld
58 | ENDIF
59 |
60 | DO ielt=celld,n_cl
61 |
62 | ! ---------------------------------!
63 | ! Mean soot absorption calculation !
64 | ! ---------------------------------!
65 |
66 | DO i_bande=1,nallbandes
67 |
68 | WVNB_SI = 100.*all_WVNB(i_bande)
69 | DWVNB_SI= 100.*all_DWVNB(i_bande)
70 |
71 | F(i_bande)=blae(WVNB_SI,celldata(1,ielt))/(pi*Lb(ielt))* &
72 | & DWVNB_SI
73 |
74 | K_SOOT(ielt)=WVNB_SI*5.5*celldata(8,ielt)
75 |
76 | FSK_SOOT(ielt)=FSK_SOOT(ielt)+F(i_bande)*K_SOOT(ielt)
77 |
78 | ENDDO
79 |
80 | FSK_SOOT(ielt) = FSK_SOOT(ielt) / SUM(F)
81 |
82 | ! ------------------------------------------------!
83 | ! Calculationn of the closest points in the table !
84 | ! ------------------------------------------------!
85 |
86 | IF (celldata(1,ielt).lt.300.d0) THEN
87 | bornes(1) = 1
88 | dist(1) = 0.d0
89 | ELSEIF (celldata(1,ielt).gt.2900.d0) THEN
90 | bornes(1) = int((2900.d0 - 300.d0)/DT) +1
91 | dist(1) = 0
92 | ELSE
93 | bornes(1) = int((celldata(1,ielt)-300.d0)/DT)+1
94 | dist(1) = (celldata(1,ielt)-300.d0) - ((bornes(1)-1)*1.0)*DT
95 | ENDIF
96 |
97 | IF ((modulo(celldata(1,ielt)-300.d0,DT).eq.0.).or. &
98 | & (celldata(1,ielt).gt.2900.d0)) THEN
99 | bornes(2) = bornes(1)
100 | ELSE
101 | bornes(2) = bornes(1)+1
102 | ENDIF
103 |
104 | ! ------------------------------------------!
105 | ! Test on species if no absorption products !
106 | ! ------------------------------------------!
107 |
108 | IF (celldata(3,ielt).le.DYH) THEN
109 | bornes(3)=1
110 | dist(2)=0.d0
111 | ELSE
112 | bornes(3) = int(celldata(3,ielt)/DYH)+1
113 | dist(2) = (celldata(3,ielt)-((bornes(3)-1)*1.0)*DYH)*(DT/DYH)
114 | ENDIF
115 |
116 | IF (celldata(4,ielt).le.DYC) THEN
117 | bornes(4)=1
118 | dist(3)=0.d0
119 | ELSE
120 | bornes(4) = int(celldata(4,ielt)/DYC)+1
121 | dist(3) = (celldata(4,ielt)-((bornes(4)-1)*1.0)*DYC)*(DT/DYC)
122 | ENDIF
123 |
124 | IF (celldata(5,ielt).le.DYCO) THEN
125 | bornes(5)=1
126 | dist(4)=0.d0
127 | ELSE
128 | bornes(5) = int(celldata(5,ielt)/DYCO)+1
129 | dist(4) =(celldata(5,ielt)-((bornes(5)-1)*1.0)*DYCO)*(DT/DYCO)
130 | ENDIF
131 |
132 | ! bornes(3) = int(celldata(3,ielt)/DYH)+1
133 | ! bornes(4) = int(celldata(4,ielt)/DYC)+1
134 | ! bornes(5) = int(celldata(5,ielt)/DYCO)+1
135 |
136 | IF( modulo(celldata(3,ielt),DYH).eq.0.) THEN
137 | bornes(6) = bornes(3)
138 | ELSE
139 | bornes(6) = bornes(3)+1
140 | ENDIF
141 |
142 | IF( modulo(celldata(4,ielt),DYC).eq.0.) THEN
143 | bornes(7) = bornes(4)
144 | ELSE
145 | bornes(7) = bornes(4)+1
146 | ENDIF
147 |
148 | IF( modulo(celldata(5,ielt),DYCO).eq.0.) THEN
149 | bornes(8) = bornes(5)
150 | ELSE
151 | bornes(8) = bornes(5)+1
152 | ENDIF
153 |
154 | ! ------------------------------------------------!
155 | ! Calculationn of the distances for interpolation !
156 | ! ------------------------------------------------!
157 | ! dist(2) = (celldata(3,ielt) - ((bornes(3)-1)*1.0)*DYH)*(DT/DYH)
158 | ! dist(3) = (celldata(4,ielt) - ((bornes(4)-1)*1.0)*DYC)*(DT/DYC)
159 | ! dist(4) = (celldata(5,ielt)- ((bornes(5)-1)*1.0) &
160 | ! & *DYCO)*(DT/DYCO)
161 |
162 | d(1) = sqrt(dist(1)**2 + dist (2)**2 + &
163 | & dist(3)**2 + 0.04*(dist(4)**2))
164 |
165 | d(2) = sqrt((DT - dist(1))**2 + dist(2)**2 + &
166 | & dist(3)**2 + 0.04*(dist(4)**2))
167 |
168 | d(3) = sqrt(dist(1)**2 + (DYH2 - dist(2))**2 + &
169 | & dist(3)**2 + 0.04*(dist(4)**2))
170 |
171 | d(4) = sqrt(dist(1)**2 + dist(2)**2 + &
172 | & (DYC2 - dist(3))**2 + 0.04*(dist(4)**2))
173 |
174 | d(5) = sqrt(dist(1)**2 + dist(2)**2 + &
175 | & dist(3)**2 + 0.04*(DYCO2 - dist(4))**2)
176 |
177 | d(6) = sqrt((DT - dist(1))**2 + &
178 | & (DYH2 - dist(2))**2 + dist(3)**2 + 0.04*(dist(4)**2))
179 |
180 | d(7) = sqrt((DT - dist(1))**2 + dist(2)**2 + &
181 | & (DYC2 - dist(3))**2 + 0.04*(dist(4)**2))
182 |
183 | d(8) = sqrt((DT - dist(1))**2 + dist(2)**2 + &
184 | & dist(3)**2 + 0.04*(DYCO2 - dist(4))**2)
185 |
186 | d(9) = sqrt(dist(1)**2 + (DYH2 - dist(2))**2 + &
187 | & (DYC2 - dist(3))**2 + 0.04*(dist(4)**2))
188 |
189 | d(10) = sqrt(dist(1)**2 + (DYH2 - dist(2))**2 + &
190 | & dist(3)**2 + 0.04*(DYCO2 - dist(4))**2)
191 |
192 | d(11) = sqrt(dist(1)**2 + dist(2)**2 + &
193 | & (DYC2 - dist(3))**2 + 0.04*(DYCO2 - dist(4))**2)
194 |
195 | d(16) = sqrt((DT - dist(1))**2 + (DYH2- dist(2))**2 + (DYC2 - &
196 | & dist(3))**2 + 0.04*(DYCO2 - dist(4))**2)
197 |
198 | d(12) = sqrt((DT - dist(1))**2 + (DYH2 - dist(2))**2 + &
199 | & (DYC2 - dist(3))**2 + 0.04*(dist(4)**2))
200 |
201 | d(13) = sqrt((DT - dist(1))**2 + (DYH2 - dist(2))**2 + &
202 | & dist(3)**2 + 0.04*(DYCO2 - dist(4))**2)
203 |
204 | d(14) = sqrt((DT - dist(1))**2 + dist(2)**2 + &
205 | & (DYC2 - dist(3))**2 + 0.04*(DYCO2 - dist(4))**2)
206 |
207 | d(15) = sqrt(dist(1)**2 + (DYH2 - dist(2))**2 + &
208 | & (DYC2 - dist(3))**2 + 0.04*(DYCO2 - dist(4))**2)
209 |
210 | ave = SUM(d(:))/16.d0
211 |
212 | ! -------------------------------------------------------!
213 | ! Interpolation of the tabulated absorption coefficients !
214 | ! -------------------------------------------------------!
215 |
216 | DO iq=1,nkabs
217 | local_kabs(iq,ielt) = &
218 | & allkabs(bornes(3),bornes(4),bornes(5), &
219 | & bornes(1),iq)*(ave/d(1)) + &
220 | & allkabs(bornes(3),bornes(4),bornes(5), &
221 | & bornes(2),iq)*(ave/d(2)) + &
222 | & allkabs(bornes(6),bornes(4),bornes(5), &
223 | & bornes(1),iq)*(ave/d(3)) + &
224 | & allkabs(bornes(3),bornes(7),bornes(5), &
225 | & bornes(1),iq)*(ave/d(4)) + &
226 | & allkabs(bornes(3),bornes(4),bornes(8), &
227 | & bornes(1),iq)*(ave/d(5)) + &
228 | & allkabs(bornes(6),bornes(4),bornes(5), &
229 | & bornes(2),iq)*(ave/d(6)) + &
230 | & allkabs(bornes(3),bornes(7),bornes(5), &
231 | & bornes(2),iq)*(ave/d(7)) + &
232 | & allkabs(bornes(3),bornes(4),bornes(8), &
233 | & bornes(2),iq)*(ave/d(8)) + &
234 | & allkabs(bornes(6),bornes(7),bornes(5), &
235 | & bornes(1),iq)*(ave/d(9)) + &
236 | & allkabs(bornes(6),bornes(5),bornes(8), &
237 | & bornes(1),iq)*(ave/d(10)) + &
238 | & allkabs(bornes(3),bornes(7),bornes(8), &
239 | & bornes(1),iq)*(ave/d(11)) + &
240 | & allkabs(bornes(6),bornes(7),bornes(5), &
241 | & bornes(2),iq)*(ave/d(12)) + &
242 | & allkabs(bornes(6),bornes(4),bornes(8), &
243 | & bornes(2),iq)*(ave/d(13)) + &
244 | & allkabs(bornes(3),bornes(7),bornes(8), &
245 | & bornes(2),iq)*(ave/d(14)) + &
246 | & allkabs(bornes(6),bornes(7),bornes(8), &
247 | & bornes(1),iq)*(ave/d(15)) + &
248 | & allkabs(bornes(6),bornes(7),bornes(8), &
249 | & bornes(2),iq)*(ave/d(16))
250 | ENDDO
251 |
252 | IF (celldata(1,ielt).lt.300.d0) THEN
253 | local_kabs(:,ielt) = 0.0d0
254 | ELSE
255 | local_kabs(:,ielt) = local_kabs(:,ielt)/16.d0 + FSK_SOOT(ielt)
256 | ENDIF
257 |
258 | ENDDO
259 |
260 | IF (homosyst.eq.'YES') THEN
261 | DO i=celld+1,cellf
262 | local_kabs(:,i) = local_kabs(:,celld)
263 | ENDDO
264 | ENDIF
265 |
266 | ! ------------------------------------------------!
267 | ! sending all_k_abs....change to a pmm subroutine !
268 | ! ------------------------------------------------!
269 |
270 | CALL MPI_ALLREDUCE(local_kabs, kabs, nkabs*ntcells, &
271 | & MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD,&
272 | & ierr)
273 |
274 | END SUBROUTINE TAB_CASE