1 | include(dom.inc)
2 |
3 | SUBROUTINE TFSCK_CASE(celldata, nelmts, all_WVNB, &
4 | & all_DWVNB, ngbands, &
5 | & nallbandes, nkabs, data_ref, WSGG_W, &
6 | & ieltd, ieltf, WSGG_Wb, Tf, nbfaces)
7 | ! ================================================================!
8 | ! !
9 | ! tfsck_case.F : tabulated fsck model !
10 | ! !
11 | ! author : D. Poitou !
12 | ! !
13 | ! ================================================================!
14 |
15 | USE mod_inout
16 | USE mod_pmm
17 | #ifdef USEPALM
18 | USE palmlib
19 | #endif
20 | USE mod_slave
21 |
22 | IMPLICIT NONE
23 |
24 | include 'dom_constants.h'
25 |
26 | ! IN
27 | DOM_INT :: nallbandes
28 | DOM_INT :: nbfaces, ibnd
29 | DOM_INT :: nkabs, ieltd, ieltf
30 | DOM_INT :: nelmts, ngbands
31 | DOM_REAL,DIMENSION(nallbandes) :: all_WVNB,all_DWVNB
32 | DOM_REAL,DIMENSION(8,nelmts) :: celldata
33 | DOM_REAL,DIMENSION(8) :: data_ref
34 | DOM_REAL, DIMENSION(nbfaces) :: Tf
35 |
36 | ! OUT
37 | DOM_REAL,DIMENSION(nkabs,nelmts) :: WSGG_W
38 | DOM_REAL,DIMENSION(nkabs,nbfaces):: WSGG_Wb
39 |
40 | ! LOCAL
41 | DOM_REAL,DIMENSION(nkabs,nelmts) :: local_WSGG_W
42 | DOM_REAL,DIMENSION(ngbands,2) :: gasdata
43 | DOM_REAL,DIMENSION(ngbands) :: F
44 | DOM_REAL :: blae
45 | DOM_REAL :: WVNB,DWVNB,WVNB_SI,DWVNB_SI
46 | DOM_INT :: ielt, i, ierr, j
47 | DOM_INT :: i_bande, n_cl
48 | DOM_INT :: ICO,ICO2,IH2O
49 | LOGICAL :: LICO,LICO2,LIH2O
50 |
51 | DOM_REAL,DIMENSION(ngbands,2) :: gasdata_ref
52 | DOM_REAL,DIMENSION(nkabs) :: k_ref, fdek, fdek_ref, w
53 | DOM_REAL :: fdek_i, Tp
54 |
55 | ! --------------------------------------------!
56 | ! STEP 1 : Calculation of the reference state !
57 | ! k_ref and fdek_ref !
58 | ! --------------------------------------------!
59 |
60 | F = 0.
61 | gasdata_ref = 0.
62 | fdek_ref = 0.
63 |
64 | Tp = s_Tp
65 |
66 | DO i_bande=1,ngbands
67 | WVNB = all_WVNB(i_bande)
68 | DWVNB = all_DWVNB(i_bande)
69 | WVNB_SI = 100.*WVNB
70 | DWVNB_SI= 100.*DWVNB
71 |
72 | IF (WVNB.le.9300.0) THEN
73 | CALL FINDI(LICO,LICO2,LIH2O,ICO,ICO2,IH2O,WVNB)
74 |
75 | CALL KBARANDPHI(data_ref(:),LICO,LICO2,LIH2O,ICO, &
76 | & ICO2,IH2O,gasdata_ref(i_bande,1:2))
77 | ENDIF
78 |
79 | IF (s_Tp.eq.0) Tp = data_ref(1)
80 | F(i_bande) = blae(WVNB_SI, Tp)*DWVNB_SI
81 |
82 | ENDDO
83 |
84 | F = F / SUM (F)
85 |
86 | CALL k_distributeur(F, ngbands, gasdata_ref, nkabs, k_ref,w)
87 |
88 | DO j = 1, nkabs
89 | DO i_bande=1,ngbands
90 |
91 | CALL pdf(gasdata_ref(i_bande,2), gasdata_ref(i_bande,1), &
92 | & k_ref(j),fdek_i)
93 |
94 | fdek_ref(j) = fdek_ref(j) + F(i_bande)*fdek_i
95 |
96 | ENDDO
97 | ENDDO
98 |
99 | IF (pmm_rank.eq.0) THEN
100 | PRINT*, " DATA_REF : T = ",data_ref(1)
101 | PRINT*, " P = ",data_ref(2)
102 | PRINT*, " XH2O = ",data_ref(3)
103 | PRINT*, " XCO2 = ", data_ref(4)
104 | PRINT*, " XCO = ", data_ref(5)
105 | PRINT*
106 | ! PRINT*, "K_ref :", k_ref
107 | ! PRINT*, "fdek_ref :", fdek_ref
108 | ENDIF
109 |
110 | ! ----------------------------------------------------------!
111 | ! Calculation of the absorption coefficient over the domain !
112 | ! ----------------------------------------------------------!
113 |
114 | local_WSGG_W = 0.
115 | WSGG_W = 0.
116 |
117 | ! ---------------------------------------------!
118 | ! Non-homogeneous system or homogeneous system !
119 | ! ---------------------------------------------!
120 | IF (homosyst.eq.'NO') THEN
121 | n_cl=ieltf
122 | ELSEIF (homosyst.eq.'YES') THEN
123 | n_cl=ieltd
124 | ENDIF
125 |
126 | !$OMP PARALLEL DO &
127 | !$OMP& PRIVATE(gasdata, F, WVNB, DWVNB, WVNB_SI, DWVNB_SI, &
128 | !$OMP& i, j, i_bande, ICO,ICO2,IH2O,LICO,LICO2,LIH2O, &
129 | !$OMP& fdek, fdek_i, Tp) &
130 | !$OMP& SHARED(local_WSGG_W)
131 |
132 | DO ielt=ieltd,n_cl
133 |
134 | gasdata = 0.
135 | F = 0.
136 |
137 | ! ------------------------------------!
138 | ! Setting spectral data for each band !
139 | ! ------------------------------------!
140 |
141 | DO i_bande=1,ngbands
142 |
143 | WVNB = all_WVNB(i_bande)
144 | DWVNB = all_DWVNB(i_bande)
145 | WVNB_SI = 100.*WVNB
146 | DWVNB_SI= 100.*DWVNB
147 |
148 | ! ----------------------------------------!
149 | ! Spectral index lecture for each species !
150 | ! ----------------------------------------!
151 | IF (WVNB.le.9300.0) THEN
152 |
153 | CALL FINDI(LICO,LICO2,LIH2O,ICO,ICO2,IH2O,WVNB,DWVNB)
154 |
155 | CALL KBARANDPHI(celldata(:,ielt),LICO,LICO2,LIH2O,ICO, &
156 | & ICO2,IH2O,gasdata(i_bande,1:2))
157 |
158 | ENDIF
159 |
160 | ! -------------------------------------!
161 | ! Band groupment multiplicative factor !
162 | ! -------------------------------------!
163 |
164 | IF (s_Tp.eq.0) Tp = celldata(1,ielt)
165 | F(i_bande) = blae(WVNB_SI,Tp)*DWVNB_SI
166 |
167 | ENDDO
168 |
169 | F = F / SUM(F)
170 |
171 | ! --------------------------------------!
172 | ! STEP 2 : Calculate f(T,phi_ref,k_ref) !
173 | ! --------------------------------------!
174 |
175 | fdek = 0.
176 |
177 | DO j = 1, nkabs
178 | DO i_bande=1,ngbands
179 |
180 | CALL pdf(gasdata_ref(i_bande,2), gasdata_ref(i_bande:,1), &
181 | & k_ref(j), fdek_i)
182 |
183 | fdek(j) = fdek(j) + F(i_bande)*fdek_i
184 |
185 | ENDDO
186 | ENDDO
187 |
188 | ! ----------------------------------------------------------------!
189 | ! STEP 4 : Calculation of the weight function !
190 | ! a(T,T_ref,g_ref)= fdek(T,phi_ref)/fdek_(T_ref,phi_ref) !
191 | ! ----------------------------------------------------------------!
192 |
193 | DO i = 1, nkabs
194 | IF(fdek_ref(i).ne.0) THEN
195 | local_WSGG_W(i,ielt) = fdek(i)/fdek_ref(i)
196 | ELSE
197 | local_WSGG_W(i,ielt) = 1.
198 | ENDIF
199 | ENDDO
200 |
201 | IF ((MOD(ielt,100).eq.0).and.(pmm_rank.eq.0)) THEN
202 | ! print*, ">> Node:",ielt-ieltd,"/",n_cl-ieltd
203 | ENDIF
204 |
205 | ENDDO
206 | !$OMP END PARALLEL DO
207 |
208 | IF (homosyst.eq.'YES') THEN
209 | DO i=ieltd+1,ieltf
210 | local_WSGG_W(:,i) = local_WSGG_W(:,ieltd)
211 | ENDDO
212 | ENDIF
213 |
214 | ! ------------------------------------------------------------------!
215 | ! STEP 5 : Calculation of the weight function at walls !
216 | ! a(Tw,T_ref,g_ref)= fdek(Tw,phi_ref)/fdek_(T_ref,phi_ref) !
217 | ! ------------------------------------------------------------------!
218 |
219 | WSGG_Wb = 0.
220 |
221 | DO ibnd=1,nbfaces
222 |
223 | fdek = 0.
224 |
225 | DO i_bande=1,ngbands
226 | DWVNB = all_DWVNB(i_bande)
227 | DWVNB_SI= 100.*DWVNB
228 |
229 | IF(s_TP.eq.0) Tp = Tf(ibnd)
230 | F(i_bande) = blae(WVNB_SI,Tp)*DWVNB_SI
231 |
232 | ENDDO
233 |
234 | F = F / SUM (F)
235 |
236 | DO j = 1, nkabs
237 | DO i_bande=1,ngbands
238 |
239 | CALL pdf(gasdata_ref(i_bande,2), gasdata_ref(i_bande:,1), &
240 | & k_ref(j),fdek_i)
241 |
242 | fdek(j) = fdek(j) + F(i_bande)*fdek_i
243 |
244 | ENDDO
245 |
246 | IF(fdek_ref(j).ne.0) THEN
247 | WSGG_Wb(j,ibnd) = fdek(j)/fdek_ref(j)
248 | ELSE
249 | WSGG_Wb(j,ibnd) = 1.
250 | ENDIF
251 |
252 | ENDDO
253 | ENDDO
254 |
255 | ! ------------------------------------------------!
256 | ! sending all_k_abs....change to a pmm subroutine !
257 | ! ------------------------------------------------!
258 |
259 | IF(is_ntask.gt.1) THEN
260 | CALL MPI_ALLREDUCE(local_WSGG_W, WSGG_W, nkabs*nelmts, &
261 | & MPI_DOUBLE_PRECISION, MPI_SUM, SUB_COMM , &
262 | & ierr)
263 | ELSE
264 | WSGG_W =local_WSGG_W
265 | ENDIF
266 |
267 |
268 | END SUBROUTINE TFSCK_CASE
tfsck_case.F could be called by: