1 | include(dom.inc)
2 |
3 | SUBROUTINE read_data_slave
4 | ! ================================================================!
5 | ! !
6 | ! read_data_slave.F : Reads all data from input files and !
7 | ! allocates slave vectors. !
8 | ! !
9 | ! out : Slave-side global vectors with initialized !
10 | ! data obtained from *.in files. !
11 | ! !
12 | ! author : J. AMAYA & D. Poitou !
13 | ! !
14 | ! ================================================================!
15 |
16 | USE mod_inout
17 | USE mod_slave
18 | USE mod_pmm
19 | USE mod_ftn_c
20 |
21 | IMPLICIT NONE
22 |
23 | INCLUDE 'dom_constants.h'
24 | include 'pmm_constants.h'
25 |
26 | DOM_INT :: i, j, k, icell, icoef
27 | DOM_INT :: n, i_bande
28 | DOM_INT :: iface, ios
29 | DOM_INT :: itot, dummy, ilocal, inode, ntot_probes
30 |
31 | DOM_REAL :: ddata, epsilon, Tw
32 | DOM_INT, ALLOCATABLE, DIMENSION(:,:) :: buffer
33 | DOM_REAL, ALLOCATABLE, DIMENSION(:,:) :: dbuffer
34 | DOM_REAL, ALLOCATABLE, DIMENSION(:,:,:) :: dbuffer2
35 |
36 | CHARACTER*80 :: c2cfile
37 | CHARACTER*80 :: normfile, volafile
38 | CHARACTER*80 :: kextfile
39 | CHARACTER*80 :: cldatfile
40 | CHARACTER*80 :: snbwnfile, quadfile
41 | CHARACTER*80 :: propfile, progfile
42 | CHARACTER*80 :: lspecfile , sspecfile
43 | CHARACTER*80 :: wsggfile, trackfile
44 |
45 | ! Tabulation variables
46 | CHARACTER*64 :: tabfile
47 | DOM_REAL :: MH2O, MCO2, MCO
48 |
49 | i_inter = i_dom_inter
50 |
51 | ! --------------------!
52 | ! Loop over all nodes !
53 | ! --------------------!
54 |
55 | kextfile = path(1:len_trim(path))//'/K_Extinction.in'
56 | propfile = path(1:len_trim(path))//'/Properties.in'
57 |
58 | OPEN(FILE_KEXT , FILE=kextfile , FORM='UNFORMATTED')
59 | OPEN(FILE_PROP , FILE=propfile , FORM='UNFORMATTED')
60 |
61 | IF (ALLOCATED(s_celldata)) DEALLOCATE(s_celldata)
62 | IF (ALLOCATED(s_k_scat)) DEALLOCATE(s_k_scat)
63 | IF (ALLOCATED(s_kabs_gray)) DEALLOCATE(s_kabs_gray)
64 |
65 | ALLOCATE(s_celldata (8,is_nnodes))
66 | ALLOCATE(s_k_scat (is_nnodes))
67 | IF ( mediumtype.eq.'GRAY' ) THEN
68 | ALLOCATE(s_kabs_gray (is_nnodes))
69 | ENDIF
70 |
71 | DO itot=1,is_ntot_nodes
72 |
73 | inode = is_golo_nodes(itot)
74 |
75 | IF(inode.eq.0) THEN
76 | READ(FILE_PROP)
77 | READ(FILE_KEXT)
78 | ELSE
79 |
80 | READ(FILE_PROP) dummy, (s_celldata(j,inode),j=1,8)
81 |
82 | IF ( mediumtype.eq.'GRAY' ) THEN
83 | READ(FILE_KEXT) dummy,s_kabs_gray(inode),s_k_scat(inode)
84 | ELSE
85 | READ(FILE_KEXT) dummy,ddata,s_k_scat(inode)
86 | ENDIF
87 |
88 | ENDIF
89 |
90 | ENDDO
91 |
92 | CLOSE(FILE_PROP)
93 | CLOSE(FILE_KEXT)
94 |
95 | #ifndef USEPALM
96 | DEALLOCATE(is_golo_nodes)
97 | #endif
98 |
99 | ! --------------------!
100 | ! Loop over all cells !
101 | ! --------------------!
102 |
103 | c2cfile = path(1:len_trim(path))//'/Cell2cells.in'
104 | normfile = path(1:len_trim(path))//'/Normals.in'
105 | volafile = path(1:len_trim(path))//'/Volumesareas.in'
106 |
107 | OPEN(FILE_C2C , FILE=c2cfile, FORM='UNFORMATTED')
108 | OPEN(FILE_NORM , FILE=normfile , FORM='UNFORMATTED')
109 | OPEN(FILE_VOLA , FILE=volafile , FORM='UNFORMATTED')
110 |
111 | IF (ALLOCATED(is_nfcelt)) DEALLOCATE(is_nfcelt)
112 | IF (ALLOCATED(is_neighs)) DEALLOCATE(is_neighs)
113 | IF (ALLOCATED(s_norm)) DEALLOCATE(s_norm)
114 | IF (ALLOCATED(s_V)) DEALLOCATE(s_V)
115 | IF (ALLOCATED(s_S)) DEALLOCATE(s_S)
116 |
117 | ALLOCATE(is_nfcelt (is_ncells))
118 | ALLOCATE(is_neighs (2*is_nfacesmax,is_ncells))
119 | ALLOCATE(s_norm (3,is_nfacesmax,is_ncells))
120 | ALLOCATE(s_V (is_ncells))
121 | ALLOCATE(s_S (is_nfacesmax,is_ncells))
122 |
123 | is_neighs = 0
124 |
125 | ! WRITE(*,*) pmm_rank," >> SLAVE: Reading *.in files"
126 |
127 | i = 0
128 | DO itot=1,is_ntot_cells
129 |
130 | icell = is_golo_cells(itot)
131 | IF(icell.eq.0) THEN
132 | READ(FILE_C2C)
133 | READ(FILE_NORM)
134 | READ(FILE_VOLA)
135 | ELSE
136 |
137 | ! print*, pmm_rank," reading cell", i
138 |
139 | READ(FILE_C2C) dummy, &
140 | & is_nfcelt(icell), &
141 | & (is_neighs(j,icell),j=1,(2*is_nfcelt(icell)))
142 |
143 | ! Update neighbord cell with the local cell number ilocal
144 |
145 | DO iface = 1, is_nfcelt(icell)
146 |
147 | k = is_neighs(2*iface-1,icell)
148 | IF(k.ne.0) THEN
149 | ilocal = is_golo_cells(k)
150 | is_neighs(2*iface-1,icell) = ilocal
151 | IF(ilocal.eq.0) is_neighs(2*iface-1,icell) = -1 ! Cellule en bord de sous-domaine
152 | ENDIF
153 |
154 | ENDDO
155 |
156 | READ(FILE_NORM) dummy, &
157 | & is_nfcelt(icell), &
158 | & ((s_norm(k,j,icell),k=1,3),j=1,is_nfcelt(icell))
159 |
160 | READ(FILE_VOLA) dummy, &
161 | & is_nfcelt(icell), &
162 | & s_V(icell), &
163 | & (s_S(j,icell),j=1,is_nfcelt(icell))
164 |
165 | ENDIF
166 |
167 | ENDDO
168 |
169 | ! PRINT*, "Cellules en bord de domaine :", i
170 | ! PAUSE
171 | CLOSE(FILE_C2C)
172 | CLOSE(FILE_NORM)
173 | CLOSE(FILE_VOLA)
174 |
175 | ! ----------------------!
176 | ! Reading boundary data !
177 | ! ----------------------!
178 |
179 | cldatfile = path(1:len_trim(path))//'/CLdata.in'
180 | OPEN(FILE_CLDAT, FILE=cldatfile , FORM='UNFORMATTED')
181 |
182 | IF (ALLOCATED(ts_boundary)) DEALLOCATE(ts_boundary)
183 | ALLOCATE(ts_boundary(is_nbfaces))
184 |
185 | i = 1
186 | DO itot = 1, is_ntot_bfaces
187 |
188 | READ(FILE_CLDAT) icell, iface, epsilon, Tw
189 | ilocal = is_golo_cells(icell)
190 |
191 | IF(ilocal.ne.0) THEN
192 | ts_boundary(i)%icell = ilocal
193 | ts_boundary(i)%iface = iface
194 | ts_boundary(i)%logo_cell = itot
195 | ts_boundary(i)%epsil = epsilon
196 | ts_boundary(i)%Tf = Tw
197 | i = i + 1
198 | ENDIF
199 |
200 | ENDDO
201 |
202 | ! Reorder boundary properties on subdomain by increasing order
203 | IF(is_nbfaces.gt.0) CALL qsort_C(ts_boundary(1)%icell, &
204 | & is_nbfaces, sizeof(ts_boundary(1)))
205 |
206 | CLOSE(FILE_CLDAT)
207 |
208 | ! ---------------------------------------!
209 | ! Reading pathway and angular quadrature !
210 | ! ---------------------------------------!
211 |
212 | quadfile = path(1:len_trim(path))//'/Quadrature.in'
213 | progfile = path(1:len_trim(path))//'/Progress.in'
214 |
215 | OPEN(FILE_QUADR, FILE=quadfile , FORM='UNFORMATTED')
216 | OPEN(FILE_PROG , FILE=progfile , FORM='UNFORMATTED')
217 |
218 | IF (ALLOCATED(s_mu)) DEALLOCATE(s_mu)
219 | IF (ALLOCATED(s_eta)) DEALLOCATE(s_eta)
220 | IF (ALLOCATED(s_ksi)) DEALLOCATE(s_ksi)
221 | IF (ALLOCATED(s_w)) DEALLOCATE(s_w)
222 | IF (ALLOCATED(is_pathway)) DEALLOCATE(is_pathway)
223 |
224 | ALLOCATE(s_mu (is_ndir))
225 | ALLOCATE(s_eta (is_ndir))
226 | ALLOCATE(s_ksi (is_ndir))
227 | ALLOCATE(s_w (is_ndir))
228 | ALLOCATE(is_pathway (is_ncells,is_ndir))
229 | ALLOCATE(buffer (is_ntot_cells,is_ndir))
230 |
231 | i = 1
232 | j = 1
233 | DO WHILE (i.lt.1000)
234 |
235 | IF ( (i.ge.is_dird).and.(i.le.is_dirf) ) THEN
236 | READ(FILE_QUADR) s_mu(j), s_eta(j), s_ksi(j), s_w(j)
237 | READ(FILE_PROG) (buffer(n,j), n=1, is_ntot_cells)
238 |
239 | j = j + 1
240 | ELSE
241 | READ(FILE_QUADR)
242 | READ(FILE_PROG)
243 | ENDIF
244 |
245 | IF (i.ge.is_dirf) THEN
246 | i = 2000
247 | ENDIF
248 |
249 | i = i + 1
250 |
251 | ENDDO
252 |
253 | CLOSE(FILE_QUADR)
254 | CLOSE(FILE_PROG)
255 |
256 |
257 | DO j = 1, is_ndir
258 | k = 0
259 |
260 | DO itot = 1, is_ntot_cells
261 | ilocal = is_golo_cells( buffer(itot,j) )
262 |
263 | IF(ilocal.ne.0) THEN
264 | k = k + 1
265 | is_pathway(k,j) = ilocal
266 | ENDIF
267 | ENDDO
268 |
269 | ENDDO
270 | DEALLOCATE(buffer)
271 |
272 | ! -------------------------------------------!
273 | ! Read data for exponential band integration !
274 | ! -------------------------------------------!
275 |
276 | IF (spascheme.eq.'EXPON') THEN
277 | PRINT*, "WARNING: This scheme has not been maintained"
278 | PRINT*, "Fix it in predatas... Then test it!"
279 | STOP
280 |
281 | lspecfile = path(1:len_trim(path))//'/L_SPEC.in'
282 | sspecfile = path(1:len_trim(path))//'/S_SPEC.in'
283 |
284 | OPEN(FILE_LSPEC,FILE=lspecfile,FORM='unformatted')
285 | OPEN(FILE_SSPEC,FILE=sspecfile,FORM='unformatted')
286 |
287 | ALLOCATE(dbuffer (is_ntot_cells,is_ndir))
288 | ALLOCATE(dbuffer2 (is_nfacesmax,is_ntot_cells,is_ndir))
289 |
290 | dbuffer2 = 0.
291 | i = 1
292 | j = 1
293 | DO WHILE (i.lt.1000)
294 |
295 | IF ( (i.ge.is_dird).and.(i.le.is_dirf) ) THEN
296 | READ(FILE_LSPEC) (dbuffer(icell,i), &
297 | & icell=1,is_ntot_cells)
298 | READ(FILE_SSPEC)((dbuffer2(icoef,icell,i), &
299 | & icell=1,is_ntot_cells),icoef=1,4)
300 | j = j + 1
301 | ELSE
302 | READ(FILE_LSPEC)
303 | READ(FILE_SSPEC)
304 | ENDIF
305 |
306 | IF (i.ge.is_dirf) THEN
307 | i = 2000
308 | ENDIF
309 |
310 | i = i + 1
311 |
312 | ENDDO
313 |
314 | CLOSE(FILE_LSPEC)
315 | CLOSE(FILE_SSPEC)
316 |
317 | IF (ALLOCATED(s_maxlen)) DEALLOCATE(s_maxlen)
318 | IF (ALLOCATED(s_ss)) DEALLOCATE(s_ss)
319 | ALLOCATE(s_maxlen (is_ncells,is_ndir))
320 | ALLOCATE(s_ss (is_nfacesmax,is_ncells,is_ndir))
321 | s_ss =0.
322 |
323 | DO itot = 1, is_ntot_cells
324 |
325 | icell = is_golo_cells(itot)
326 | IF(icell.ne.0) THEN
327 | DO j = 1, is_ndir
328 | s_maxlen(icell,j) = dbuffer(itot,j)
329 | s_ss(:,icell,j) = dbuffer2(:,itot,j)
330 | ENDDO
331 | ENDIF
332 |
333 | ENDDO
334 |
335 | DEALLOCATE(dbuffer)
336 | DEALLOCATE(dbuffer2)
337 |
338 | ENDIF
339 |
340 | ! ------------!
341 | ! Read probes !
342 | ! ------------!
343 |
344 | trackfile = path(1:len_trim(path))//'/Track.in'
345 | OPEN(FILE_TRACK, FILE=trackfile , FORM='FORMATTED', IOSTAT =ios,&
346 | & STATUS='old')
347 |
348 | is_nprobes = 0
349 | IF(ios.eq.0) THEN
350 |
351 | IF (ALLOCATED(s_norm_probe)) DEALLOCATE(s_norm_probe)
352 | IF (ALLOCATED(is_norm_probe)) DEALLOCATE(is_norm_probe)
353 | IF (ALLOCATED(is_pcells)) DEALLOCATE(is_pcells)
354 |
355 | READ(FILE_TRACK,*) ntot_probes
356 | ALLOCATE(s_norm_probe(3,ntot_probes))
357 | s_norm_probe(:,:)=0.0
358 | ALLOCATE(is_norm_probe(ntot_probes))
359 | is_norm_probe(:)=0
360 |
361 | ! The 3 first row of s_norm_probe are coordinates
362 | ! the is_norm_probe is the number of the probe cell
363 |
364 | IF(ntot_probes.gt.0) THEN
365 | is_nprobes = 1
366 | DO i=1,is_nprobes
367 |
368 | READ(FILE_TRACK,*) icell,is_norm_probe(is_nprobes), &
369 | & (s_norm_probe(k,is_nprobes) ,k=1,3)
370 |
371 | icell = is_norm_probe(is_nprobes)
372 | ilocal = is_golo_cells(icell)
373 | IF(ilocal.ne.0) THEN
374 | is_norm_probe(is_nprobes) = ilocal
375 | is_nprobes = is_nprobes + 1
376 | ENDIF
377 |
378 | ENDDO
379 |
380 | i=1
381 | ALLOCATE(is_pcells(is_ncells))
382 | is_pcells(:) = 0
383 |
384 | ! The probes must be shorten by incresing order
385 | DO i=1,is_nprobes
386 | DO icell=1,is_ncells
387 | IF(icell.eq.is_norm_probe(i)) THEN
388 | is_pcells(icell) = i
389 | ENDIF
390 | ENDDO
391 | ENDDO
392 |
393 | ENDIF
394 |
395 | ENDIF
396 |
397 | CLOSE(FILE_TRACK)
398 | DEALLOCATE(is_golo_cells)
399 |
400 | ! ---------------------------------!
401 | ! Read spectral data for each band !
402 | ! ---------------------------------!
403 | is_ngaz = 3
404 | ALLOCATE(is_nbandes(is_ngaz))
405 | is_nbandes = 0
406 | is_nbandes(GAZ_CO) = 48
407 | is_nbandes(GAZ_C) = 96
408 | is_nbandes(GAZ_H) = 367
409 |
410 | is_nallbandes = 371
411 |
412 | ! WRITE(*,*) pmm_rank," >> SLAVE: Reading spectral data"
413 |
414 | snbwnfile = pathspec(1:len_trim(pathspec))//'/SNBWN'
415 |
416 | IF (mediumtype.ne.'GRAY') THEN
417 | ! ----------------------------------------------!
418 | ! Allocate and set properties for radiating gaz !
419 | ! (to be changed for N gaz radiation) !
420 | ! ----------------------------------------------!
421 | IF (ALLOCATED(s_KCO)) DEALLOCATE(s_KCO)
422 | IF (ALLOCATED(s_KC)) DEALLOCATE(s_KC)
423 | IF (ALLOCATED(s_KH)) DEALLOCATE(s_KH)
424 | IF (ALLOCATED(s_DCO)) DEALLOCATE(s_DCO)
425 | IF (ALLOCATED(s_DC)) DEALLOCATE(s_DC)
426 | IF (ALLOCATED(s_DH)) DEALLOCATE(s_DH)
427 | ALLOCATE(s_KCO (14,is_nbandes(GAZ_CO)))
428 | ALLOCATE(s_KC (14,is_nbandes(GAZ_C)))
429 | ALLOCATE(s_KH (14,is_nbandes(GAZ_H)))
430 | ALLOCATE(s_DCO (14,is_nbandes(GAZ_CO)))
431 | ALLOCAte(s_DC (14,is_nbandes(GAZ_C)))
432 | ALLOCATE(s_DH (14,is_nbandes(GAZ_H)))
433 |
434 | ! ------------------------------------!
435 | ! Read spectral properties of gases !
436 | ! ------------------------------------!
437 |
438 | ! WRITE(*,*) pmm_rank," >> SLAVE: Reading gas properties"
439 | IF((mediumtype.ne.'GRAY').and.(mediumtype.ne.'WSGG')) THEN
440 | CALL PARAM_SLAVE(pathspec,nb_base)
441 | ENDIF
442 |
443 | IF (ALLOCATED(s_all_WVNB)) DEALLOCATE(s_all_WVNB)
444 | IF (ALLOCATED(s_all_DWVNB)) DEALLOCATE(s_all_DWVNB)
445 | ALLOCATE(s_all_WVNB (is_nallbandes))
446 | ALLOCATE(s_all_DWVNB (is_nallbandes))
447 |
448 | OPEN(FILE_SNBWN,FILE=snbwnfile)
449 | i_bande=1
450 |
451 | DO WHILE (i_bande .le. is_nallbandes)
452 |
453 | READ(FILE_SNBWN,*) s_all_WVNB(i_bande),s_all_DWVNB(i_bande)
454 |
455 | IF (s_all_WVNB(i_bande).lt.0.) THEN
456 | i_bande = is_nallbandes + 1 !arret de la boucle
457 | ENDIF
458 |
459 | i_bande=i_bande+1
460 |
461 | ENDDO
462 |
463 | CLOSE(FILE_SNBWN)
464 |
465 | ENDIF
466 |
467 | ! ----------------------------!
468 | ! Read spectral data for WSGG !
469 | ! ----------------------------!
470 |
471 | wsggfile = pathspec(1:len_trim(pathspec))// &
472 | & '/WSGG_Soufiani_Djavdan_H20_CO2'
473 |
474 | IF (mediumtype.eq.'WSGG') THEN
475 |
476 | ALLOCATE(s_alpha (6,is_ngg))
477 | ALLOCATE(s_kwsgg (is_ngg))
478 |
479 | OPEN(UNIT=FILE_Wsgg,FILE=wsggfile,FORM='FORMATTED')
480 | READ(FILE_Wsgg,*)
481 |
482 | DO i=1,is_ngg
483 | READ(FILE_Wsgg,*) s_kwsgg(i),(s_alpha(j,i),j=1,6)
484 | ENDDO
485 |
486 | CLOSE(FILE_Wsgg)
487 |
488 | ENDIF
489 |
490 | ! -----------------------------!
491 | ! Read data for tabulated FSK !
492 | ! and set the number of points !
493 | ! for the spectral quadrature !
494 | ! -----------------------------!
495 |
496 | IF ((mediumtype.eq.'TFSK').or.(mediumtype.eq.'TFSCK')) THEN
497 | tabfile = pathspec(1:len_trim(pathspec))//'/table.dat'
498 | IF (pmm_rank.eq.PMM_HOST) THEN
499 | PRINT*, " -> Tabulated File : ",trim(tabfile)
500 | ENDIF
501 |
502 | OPEN(FILE_TAB,FILE=tabfile,FORM='FORMATTED')
503 | READ(FILE_TAB,*) is_nkabs
504 | READ(FILE_TAB,*) s_DT
505 | READ(FILE_TAB,*) s_DYH, MH2O
506 | READ(FILE_TAB,*) s_DYC, MCO2
507 | READ(FILE_TAB,*) s_DYCO, MCO
508 | CLOSE(FILE_TAB)
509 |
510 | is_nT = INT((2900-300)/s_DT) + 1
511 | is_nYH = INT((MH2O-0.0)/s_DYH) + 1
512 | is_nYC = INT((MCO2-0.0)/s_DYC) + 1
513 | is_nYCO = INT((MCO-0.0)/s_DYCO) + 1
514 |
515 | ALLOCATE(s_tabkabs(is_nYH,is_nYC,is_nYCO,is_nT,is_nkabs))
516 |
517 | CALL readtab(tabfile,s_tabkabs, is_nYH, is_nYC, is_nYCO, &
518 | & is_nT, is_nkabs, mediumtype, s_dataref)
519 |
520 | IF (pmm_rank.eq.PMM_HOST) THEN
521 | PRINT*, " -> Table for ", trim(mediumtype) ," model readed"
522 | ENDIF
523 |
524 | ELSEIF (mediumtype.eq.'GRAY') THEN
525 | is_nkabs = 1
526 | ELSEIF (mediumtype.eq.'WSGG') THEN
527 | is_nkabs = is_ngg
528 | ELSE
529 | is_nkabs = Nq_kabs
530 | ENDIF
531 |
532 | ! print*, " is_ncells : ", is_ncells
533 | ! print*, " is_nfacesmax : ", is_nfacesmax
534 | ! print*, " is_nallbandes: ", is_nallbandes
535 | ! print*, " is_nbandes : ", is_nbandes
536 |
537 | END SUBROUTINE read_data_slave