1 | include(dom.inc)
2 |
3 | SUBROUTINE slave
4 |
5 | ! ================================================================!
6 | ! !
7 | ! slave.F : Main control of the slave side of the code. !
8 | ! !
9 | ! out : !
10 | ! !
11 | ! author : J. AMAYA (september 2007) !
12 | ! !
13 | ! ================================================================!
14 |
15 | USE mod_inout
16 | USE mod_pmm
17 | USE mod_slave
18 |
19 | IMPLICIT NONE
20 |
21 | include 'pmm_constants.h'
22 |
23 | ! LOCAL
24 | DOM_INT :: n_k_abs, ib_beg, ib_end, finprog, i, ierr
25 | DOM_INT :: is_dirbeg, is_dirend, i_bande, ngbands
26 | DOM_INT :: ICO,ICO2,IH2O
27 | LOGICAL :: LICO,LICO2,LIH2O
28 | DOM_REAL :: DWVNB_SI, WVNB_SI
29 | DOM_REAL :: DWVNB, WVNB
30 |
31 | DOM_REAL, ALLOCATABLE, DIMENSION(:) :: wkabs
32 | DOM_REAL, ALLOCATABLE, DIMENSION(:) :: k_absmel
33 | DOM_REAL, ALLOCATABLE, DIMENSION(:) :: WVSOOT
34 | DOM_REAL, ALLOCATABLE, DIMENSION(:) :: Lb
35 | DOM_REAL, ALLOCATABLE, DIMENSION(:,:) :: Lo
36 | DOM_REAL, ALLOCATABLE, DIMENSION(:,:) :: all_k_abs
37 |
38 | DOM_REAL, ALLOCATABLE, DIMENSION(:,:) :: Q_rtot
39 | DOM_REAL, ALLOCATABLE, DIMENSION(:) :: Gtot, Lbtot
40 | DOM_REAL, ALLOCATABLE, DIMENSION(:,:) :: Lotot, Htot
41 | DOM_REAL, ALLOCATABLE, DIMENSION(:,:) :: WSGG_W
42 |
43 | ! Speed-up debugging variables
44 | DOM_DBLE :: cic_beg_time, cic_end_time
45 | DOM_DBLE :: lum_beg_time, lum_end_time
46 | DOM_DBLE :: snb_beg_time, snb_end_time
47 | DOM_DBLE :: bint_beg_time, bint_end_time
48 |
49 | DOM_DBLE :: cic_mean_time
50 | DOM_DBLE :: lum_mean_time
51 | DOM_DBLE :: snb_mean_time
52 | DOM_DBLE :: bint_mean_time
53 |
54 | ! Tabulation variables
55 | CHARACTER*64 :: tabfile
56 | DOM_INT :: nYH, nYC, nYCO, nT
57 | DOM_REAL :: DYH, DYC, DYCO, DT
58 | DOM_REAL :: MH2O, MCO2, MCO
59 | DOM_REAL, ALLOCATABLE,DIMENSION(:,:,:,:,:) :: tabkabs
60 |
61 | ! --------------------------------------!
62 | ! Receive vectors from master processor !
63 | ! --------------------------------------!
64 |
65 | IF (pmm_rank.ne.PMM_HOST) THEN
66 | CALL slave_receive
67 | ENDIF
68 |
69 | ! ------------------------!
70 | ! Load runing parammeters !
71 | ! ------------------------!
72 |
73 | CALL read_data_slave
74 |
75 | ! -----------------------------!
76 | ! Read data for tabulated FSCK !
77 | ! -----------------------------!
78 |
79 | IF (mediumtype.eq.'TAB') THEN
80 | tabfile = pathspec(1:len_trim(pathspec))//'/table.dat'
81 | PRINT*, "Tabulated File : ",tabfile
82 |
83 | OPEN(12,FILE=tabfile,FORM='FORMATTED')
84 | READ(12,*) is_nkabs
85 | READ(12,*) DT
86 | READ(12,*) DYH, MH2O
87 | READ(12,*) DYC, MCO2
88 | READ(12,*) DYCO, MCO
89 | CLOSE(12)
90 |
91 | nT=INT((2900-300)/DT)+1
92 | nYH=INT((MH2O-0.0)/DYH)+1
93 | nYC=INT((MCO2-0.0)/DYC)+1
94 | nYCO=INT((MCO-0.0)/DYCO)+1
95 | ALLOCATE(tabkabs(nYH,nYC,nYCO,nT,is_nkabs))
96 | CALL readtab(tabfile,tabkabs,nYH,nYC,nYCO,nT,is_nkabs)
97 | PRINT*, "Table for FS-SNBcK model readed"
98 | ELSE
99 | is_nkabs = Nq_kabs
100 | ENDIF
101 |
102 | ! -----------------!
103 | ! Allocate vactors !
104 | ! -----------------!
105 |
106 | IF (ALLOCATED(wkabs)) DEALLOCATE(wkabs)
107 | IF (ALLOCATED(k_absmel)) DEALLOCATE(k_absmel)
108 | IF (ALLOCATED(WVSOOT)) DEALLOCATE(WVSOOT)
109 | IF (ALLOCATED(all_k_abs)) DEALLOCATE(all_k_abs)
110 | IF (ALLOCATED(Lb)) DEALLOCATE(Lb)
111 | IF (ALLOCATED(Lo)) DEALLOCATE(Lo)
112 | IF (ALLOCATED(Q_rtot)) DEALLOCATE(Q_rtot)
113 | IF (ALLOCATED(Gtot)) DEALLOCATE(Gtot)
114 | IF (ALLOCATED(Lbtot)) DEALLOCATE(Lbtot)
115 | IF (ALLOCATED(Lotot)) DEALLOCATE(Lotot)
116 | IF (ALLOCATED(Htot)) DEALLOCATE(Htot)
117 |
118 | ALLOCATE(wkabs(is_nkabs))
119 | ALLOCATE(k_absmel(is_nkabs))
120 | ALLOCATE(WVSOOT(is_ncells))
121 | ALLOCATE(all_k_abs(is_nkabs,is_ncells))
122 | ALLOCATE(Lb(is_ncells))
123 | ALLOCATE(Lo(is_nfacesmax, is_ncells))
124 | ALLOCATE(Q_rtot(3,is_ncells))
125 | ALLOCATE(Gtot(is_ncells))
126 | ALLOCATE(Lbtot(is_ncells))
127 | ALLOCATE(Lotot(is_nfacesmax,is_ncells))
128 | ALLOCATE(Htot(is_nfacesmax,is_ncells))
129 |
130 | ! --------------------------!
131 | ! Initialize result vectors !
132 | ! --------------------------!
133 |
134 | Gtot = 0.
135 | Htot = 0.
136 | Lotot = 0.
137 | Lbtot = 0.
138 | Q_rtot = 0.
139 |
140 | finprog = 0
141 |
142 | ! ------------------------!
143 | ! Initialize time counter !
144 | ! ------------------------!
145 |
146 | CALL MPI_BARRIER(MPI_COMM_WORLD,ierr)
147 | ! CALL cpu_time(sc_time)
148 | sc_time = MPI_WTIME()
149 |
150 | ! -------------------!
151 | ! GRAY gas tratement !
152 | ! -------------------!
153 | IF (mediumtype.eq.'GRAY') THEN
154 |
155 | WRITE(*,*) " (",pmm_rank,") Gray case calculation"
156 |
157 | CALL GRAY_CASE(mediumtype,homosyst,is_nfcelt,s_celldata, &
158 | & all_k_abs, Lb, s_kabs_gray, Lo, s_epsil, s_Tf, &
159 | & is_ncells, is_nfacesmax, is_nkabs, is_bcell, &
160 | & is_bface, is_nbfaces)
161 |
162 | n_k_abs = 1
163 | wkabs = 1.0
164 | DWVNB_SI = 1.0
165 | is_dirbeg = 1
166 | is_dirend = is_ndir
167 |
168 | CALL BAND_INTEG(is_neighs, is_nfcelt, wkabs, all_k_abs, s_mu, &
169 | & s_eta, s_ksi, s_w, Lb, WSGG_W, s_V, s_k_scat, &
170 | & s_maxlen, Lo, s_S, s_epsil, s_ss, s_norm, &
171 | & n_k_abs, is_ncells, is_nfacesmax, I_SCHEME, &
172 | & is_ndir, DWVNB_SI, alpha, is_nkabs, &
173 | & is_pathway, Gtot, Htot, Lotot, Lbtot, Q_rtot, &
174 | & is_dirbeg, is_dirend, is_ngg, mediumtype, &
175 | & WVNB_SI,critconv,is_bcell,is_bface,is_nbfaces)
176 |
177 | ! ---------------------!
178 | ! WSGG case treatement !
179 | ! ---------------------!
180 | ELSEIF (mediumtype.eq.'WSGG') THEN
181 |
182 | IF (.not.ALLOCATED(WSGG_W)) THEN
183 | ALLOCATE(WSGG_W(is_ngg,is_ncells))
184 | ENDIF
185 |
186 | cic_mean_time = 0
187 | lum_mean_time = 0
188 | snb_mean_time = 0
189 | bint_mean_time = 0
190 |
191 | CALL cpu_time(cic_beg_time)
192 |
193 | ngbands = is_nallbandes
194 | n_k_abs = is_ngg
195 | wkabs = 1.0
196 | DWVNB_SI = 1.0
197 |
198 | CALL cpu_time(lum_beg_time)
199 | CALL EMISSIV(is_nfcelt, s_celldata, Lb, Lo, s_epsil, s_Tf, &
200 | & is_ncells, is_nfacesmax, is_lbcd, is_lbcf, &
201 | & is_bcell, is_bface, is_nbfaces, is_bfbeg, &
202 | & is_bfend)
203 | CALL cpu_time(lum_end_time)
204 | lum_mean_time=lum_mean_time+(lum_end_time-lum_beg_time)
205 |
206 | WRITE(*,*) " (",pmm_rank,") WSGG case calculation"
207 | CALL cpu_time(snb_beg_time)
208 | CALL WSGG_CASE(all_k_abs,WSGG_W,Lb,s_celldata,is_ncells, &
209 | & s_alpha,s_kwsgg,s_all_WVNB,s_all_DWVNB, &
210 | & is_ngg,is_nallbandes,is_lbcd,is_lbcf)
211 | CALL cpu_time(snb_end_time)
212 | snb_mean_time=snb_mean_time+(snb_end_time-snb_beg_time)
213 |
214 | ! ------------------------!
215 | ! Integrate over the band !
216 | ! ------------------------!
217 |
218 | is_dirbeg = 1
219 | is_dirend = is_ndir
220 |
221 | CALL cpu_time(bint_beg_time)
222 | WRITE(*,*) " (",pmm_rank,") ",n_k_abs," point integration"
223 | CALL BAND_INTEG(is_neighs,is_nfcelt,wkabs,all_k_abs,s_mu, &
224 | & s_eta, s_ksi, s_w, Lb, WSGG_W, s_V, s_k_scat, &
225 | & s_maxlen, Lo, s_S, s_epsil, s_ss, s_norm, &
226 | & n_k_abs, is_ncells, is_nfacesmax, I_SCHEME, &
227 | & is_ndir, DWVNB_SI, alpha, is_ngg, &
228 | & is_pathway, Gtot, Htot, Lotot, Lbtot, Q_rtot, &
229 | & is_dirbeg, is_dirend, is_ngg, mediumtype, &
230 | & WVNB_SI, critconv,is_bcell,is_bface,is_nbfaces)
231 | CALL cpu_time(bint_end_time)
232 | bint_mean_time=bint_end_time-bint_beg_time
233 |
234 | CALL cpu_time(cic_end_time)
235 | cic_mean_time = cic_mean_time + (cic_end_time-cic_beg_time)
236 |
237 | ! -------------------------!
238 | ! SNB-FSCK CASE TREATEMENT !
239 | ! -------------------------!
240 |
241 | ELSEIF ((mediumtype.eq.'FSCK').or.(mediumtype.eq.'TAB')) THEN
242 |
243 | cic_mean_time = 0
244 | lum_mean_time = 0
245 | snb_mean_time = 0
246 | bint_mean_time = 0
247 |
248 | CALL cpu_time(cic_beg_time)
249 |
250 | n_k_abs = is_nkabs
251 | DWVNB_SI = 1.0
252 | ngbands = is_nallbandes
253 |
254 | CALL cpu_time(lum_beg_time)
255 | CALL EMISSIV(is_nfcelt, s_celldata, Lb, Lo, s_epsil, s_Tf, &
256 | & is_ncells, is_nfacesmax, is_lbcd, is_lbcf, &
257 | & is_bcell,is_bface,is_nbfaces,is_bfbeg,is_bfend)
258 | CALL cpu_time(lum_end_time)
259 | lum_mean_time=lum_mean_time+(lum_end_time-lum_beg_time)
260 |
261 | IF (mediumtype.eq.'FSCK') THEN
262 | WRITE(*,*) " (",pmm_rank,") FSCK case calculation"
263 | CALL cpu_time(snb_beg_time)
264 | CALL FSCK_CASE(all_k_abs, wkabs, Lb, s_celldata, is_ncells, &
265 | & s_all_WVNB, s_all_DWVNB, s_KCO, s_DCO, s_KC, &
266 | & s_DC, s_KH, s_DH, ngbands, is_nallbandes, &
267 | & is_nkabs, is_lbcd, is_lbcf)
268 | CALL cpu_time(snb_end_time)
269 | snb_mean_time=snb_mean_time+(snb_end_time-snb_beg_time)
270 | ELSEIF (mediumtype.eq.'TAB') THEN
271 | WRITE(*,*) " (",pmm_rank,") FSCK TAB case calculation"
272 | CALL cpu_time(snb_beg_time)
273 | CALL TAB_CASE(s_celldata, all_k_abs, wkabs, tabkabs, DYH, &
274 | & DYC, DYCO, nYH, nYC, nYCO, DT, nT, is_nkabs, &
275 | & is_ncells, is_nallbandes, s_all_WVNB, &
276 | & s_all_DWVNB, Lb, is_lbcd, is_lbcf)
277 |
278 | CALL cpu_time(snb_end_time)
279 | snb_mean_time=snb_mean_time+(snb_end_time-snb_beg_time)
280 | ENDIF
281 |
282 | ! ------------------------!
283 | ! Integrate over the band !
284 | ! ------------------------!
285 |
286 | is_dirbeg = 1
287 | is_dirend = is_ndir
288 |
289 | CALL cpu_time(bint_beg_time)
290 |
291 | WRITE(*,*) " (",pmm_rank,") ",n_k_abs," point integration"
292 | CALL BAND_INTEG(is_neighs,is_nfcelt,wkabs,all_k_abs,s_mu, &
293 | & s_eta, s_ksi, s_w, Lb, WSGG_W, s_V, s_k_scat, &
294 | & s_maxlen, Lo, s_S, s_epsil, s_ss, s_norm, &
295 | & n_k_abs, is_ncells, is_nfacesmax, I_SCHEME, &
296 | & is_ndir, DWVNB_SI, alpha, is_nkabs, &
297 | & is_pathway, Gtot, Htot, Lotot, Lbtot, Q_rtot, &
298 | & is_dirbeg, is_dirend, is_ngg, mediumtype, &
299 | & WVNB_SI, critconv,is_bcell,is_bface,is_nbfaces)
300 |
301 | CALL cpu_time(bint_end_time)
302 | bint_mean_time=bint_end_time-bint_beg_time
303 |
304 | CALL cpu_time(cic_end_time)
305 | cic_mean_time = cic_mean_time + (cic_end_time-cic_beg_time)
306 |
307 | ! -----------------------!
308 | ! SNB-CK case treatement !
309 | ! -----------------------!
310 |
311 | ELSEIF (mediumtype.eq.'SNB-CK') THEN
312 |
313 | cic_mean_time = 0
314 | lum_mean_time = 0
315 | snb_mean_time = 0
316 | bint_mean_time = 0
317 |
318 | WRITE(*,*) " (",pmm_rank,") SNB-CK case calculation"
319 |
320 | ! ----------------------------!
321 | ! Calculate spectral interval !
322 | ! ----------------------------!
323 |
324 | ib_beg = 1
325 | ib_end = is_nallbandes
326 | ! IF (is_ndir.eq.1) THEN
327 | ! ib_beg = is_cd
328 | ! ib_end = is_cf
329 | ! ENDIF
330 |
331 | ! --------------------!
332 | ! Loop over all bands !
333 | ! --------------------!
334 |
335 | ! print*, " (",pmm_rank,") ibeg-iend:", ib_beg, ib_end
336 | DO i_bande = ib_beg, ib_end
337 |
338 | CALL cpu_time(cic_beg_time)
339 |
340 | ! ------------------!
341 | ! Set partitionning !
342 | ! ------------------!
343 |
344 | is_dirbeg = 2
345 | IF (i_bande.ge.is_cd) is_dirbeg = 1
346 |
347 | is_dirend = is_ndir - 1
348 | IF (i_bande.le.is_cf) is_dirend = is_ndir
349 |
350 | ! print*, " (",pmm_rank,") d_beg, d_end:",is_dirbeg,is_dirend
351 |
352 | ! -----------!
353 | ! Initialize !
354 | ! -----------!
355 |
356 | WVNB = s_all_WVNB(i_bande)
357 | DWVNB = s_all_DWVNB(i_bande)
358 | WVNB_SI = 100.*WVNB
359 | DWVNB_SI = 100.*DWVNB
360 |
361 | n_k_abs = is_nkabs
362 | ngbands = 1
363 |
364 | CALL cpu_time(lum_beg_time)
365 | CALL EMISSIV_SNB(is_nfcelt, s_celldata, Lb, Lo, s_epsil, &
366 | & s_Tf, WVNB_SI, is_ncells, is_nfacesmax, &
367 | & is_lbcd, is_lbcf, is_bcell, is_bface, &
368 | & is_nbfaces)
369 | CALL cpu_time(lum_end_time)
370 | lum_mean_time=lum_mean_time+(lum_end_time-lum_beg_time)
371 |
372 | CALL cpu_time(snb_beg_time)
373 |
374 | CALL SNB_CASE(all_k_abs, wkabs, Lb, s_celldata, is_ncells, &
375 | & s_all_WVNB, s_all_DWVNB, s_KCO, s_DCO, s_KC, &
376 | & s_DC, s_KH, s_DH, ngbands, i_bande, &
377 | & is_nallbandes, is_nkabs, is_lbcd, is_lbcf)
378 |
379 | CALL cpu_time(snb_end_time)
380 | snb_mean_time=snb_mean_time+(snb_end_time-snb_beg_time)
381 |
382 | ! ------------------------!
383 | ! Integrate over the band !
384 | ! ------------------------!
385 |
386 | CALL cpu_time(bint_beg_time)
387 |
388 | IF (pmm_rank.eq.PMM_HOST) THEN
389 | WRITE(*,*) " Band: ", i_bande,"/", ib_end
390 | ENDIF
391 |
392 | CALL BAND_INTEG(is_neighs,is_nfcelt,wkabs,all_k_abs,s_mu, &
393 | & s_eta, s_ksi, s_w, Lb, WSGG_W, s_V, s_k_scat, &
394 | & s_maxlen, Lo, s_S, s_epsil, s_ss, s_norm, &
395 | & n_k_abs, is_ncells, is_nfacesmax, I_SCHEME, &
396 | & is_ndir, DWVNB_SI, alpha, is_nkabs, &
397 | & is_pathway, Gtot, Htot, Lotot, Lbtot, Q_rtot, &
398 | & is_dirbeg, is_dirend, is_ngg, mediumtype, &
399 | & WVNB_SI, critconv, is_bcell, is_bface, &
400 | & is_nbfaces)
401 |
402 | CALL cpu_time(bint_end_time)
403 | bint_mean_time=bint_mean_time+(bint_end_time-bint_beg_time)
404 |
405 |
406 | ! --------------------!
407 | ! Testing the results !
408 | ! --------------------!
409 | ! IF (i_bande.eq.1) THEN
410 | ! DO i=1,is_ncells
411 | ! print*, "Lb(",i,")=",Lbtot(i)
412 | ! ENDDO
413 | ! ENDIF
414 |
415 | CALL cpu_time(cic_end_time)
416 | cic_mean_time = cic_mean_time + (cic_end_time-cic_beg_time)
417 |
418 | ! WRITE(69,*) i_bande, (cic_end_time-cic_beg_time)
419 |
420 | ENDDO
421 |
422 | ! ---------------------------------------------------!
423 | ! Stop computation time counter and reduce to master !
424 | ! ---------------------------------------------------!
425 |
426 | ec_time = MPI_WTIME()
427 | ! CALL cpu_time(ec_time)
428 | CALL MPI_REDUCE(ec_time-sc_time,c_time,1,MPI_DOUBLE_PRECISION,&
429 | & MPI_MAX, PMM_HOST, MPI_COMM_WORLD, ierr)
430 |
431 | cic_mean_time=cic_mean_time/(ib_end-ib_beg)
432 | bint_mean_time=bint_mean_time/(ib_end-ib_beg)
433 | snb_mean_time=snb_mean_time/(ib_end-ib_beg)
434 | lum_mean_time=lum_mean_time/(ib_end-ib_beg)
435 |
436 | ELSE
437 | finprog=1
438 | ENDIF
439 |
440 | IF (pmm_rank.eq.0) THEN
441 | print*, " Mean time per band :",cic_mean_time,"sec."
442 | print*, " + Planck luminance:",lum_mean_time,"sec."
443 | print*, " + Kabs model :",snb_mean_time,"sec."
444 | print*, " + Band integration:",bint_mean_time,"sec."
445 | ENDIF
446 |
447 | ! ---------------------------!
448 | ! Send results to the master !
449 | ! ---------------------------!
450 |
451 | IF (finprog .ne. 1) THEN
452 | WRITE(*,*) " (",pmm_rank,") Send results to the master"
453 | CALL slave_return(Gtot, Htot, Lotot, Lbtot, Q_rtot, &
454 | & is_ncells, is_nfacesmax)
455 |
456 | IF (pmm_rank.eq.PMM_HOST) THEN
457 | CALL master_control(MASTER_OUTPROC)
458 | ENDIF
459 |
460 | ELSE
461 | WRITE(*,*) " Fatal error: unknown spectral type ",mediumtype
462 | ENDIF
463 |
464 | END SUBROUTINE slave
slave.F could be called by: