1 | include(dom.inc)
2 |
3 | SUBROUTINE read_data_slave
4 |
5 | ! ================================================================!
6 | ! !
7 | ! read_data_slave.F : Reads all data from input files and !
8 | ! allocates slave vectors. !
9 | ! !
10 | ! out : Slave-side global vectors with initialized !
11 | ! data obtained from *.in files. !
12 | ! !
13 | ! author : J. AMAYA (January 2009) !
14 | ! !
15 | ! ================================================================!
16 |
17 | USE mod_inout
18 | USE mod_slave
19 | USE mod_pmm
20 |
21 | IMPLICIT NONE
22 |
23 | INCLUDE 'dom_constants.h'
24 |
25 | DOM_INT :: i, j, k, icell
26 | DOM_INT :: n, i_bande, patch
27 |
28 | DOM_REAL :: ddata
29 |
30 | CHARACTER*80 :: c2cfile
31 | CHARACTER*80 :: normfile, volafile, facesfile
32 | CHARACTER*80 :: kextfile, emisfile
33 | CHARACTER*80 :: clpropfile, cldatfile
34 | CHARACTER*80 :: snbwnfile
35 | CHARACTER*80 :: facfile, propfile, progfile
36 | CHARACTER*80 :: wsggfile
37 |
38 | ! -----------------------!
39 | ! Initialize variables !
40 | ! -----------------------!
41 | ! WRITE(*,*) pmm_rank," >> SLAVE: Deallocating vetors"
42 |
43 | IF (ALLOCATED(is_neighs)) DEALLOCATE(is_neighs)
44 | IF (ALLOCATED(is_nfcelt)) DEALLOCATE(is_nfcelt)
45 | IF (ALLOCATED(is_pathway)) DEALLOCATE(is_pathway)
46 | IF (ALLOCATED(is_bcell)) DEALLOCATE(is_bcell)
47 | IF (ALLOCATED(is_bface)) DEALLOCATE(is_bface)
48 |
49 | IF (ALLOCATED(s_KCO)) DEALLOCATE(s_KCO)
50 | IF (ALLOCATED(s_KC)) DEALLOCATE(s_KC)
51 | IF (ALLOCATED(s_KH)) DEALLOCATE(s_KH)
52 | IF (ALLOCATED(s_DCO)) DEALLOCATE(s_DCO)
53 | IF (ALLOCATED(s_DC)) DEALLOCATE(s_DC)
54 | IF (ALLOCATED(s_DH)) DEALLOCATE(s_DH)
55 | IF (ALLOCATED(s_V)) DEALLOCATE(s_V)
56 | IF (ALLOCATED(s_k_scat)) DEALLOCATE(s_k_scat)
57 | IF (ALLOCATED(s_kabs_gray)) DEALLOCATE(s_kabs_gray)
58 | IF (ALLOCATED(s_S)) DEALLOCATE(s_S)
59 | IF (ALLOCATED(s_epsil)) DEALLOCATE(s_epsil)
60 | IF (ALLOCATED(s_Tf)) DEALLOCATE(s_Tf)
61 | IF (ALLOCATED(s_norm)) DEALLOCATE(s_norm)
62 | IF (ALLOCATED(s_celldata)) DEALLOCATE(s_celldata)
63 | IF (ALLOCATED(s_all_WVNB)) DEALLOCATE(s_all_WVNB)
64 | IF (ALLOCATED(s_all_DWVNB)) DEALLOCATE(s_all_DWVNB)
65 |
66 | ! -------------------!
67 | ! Read input files !
68 | ! -------------------!
69 |
70 | ! WRITE(*,*) pmm_rank," >> SLAVE: Seting file names"
71 |
72 | c2cfile = path(1:len_trim(path))//'/Cell2cells.in'
73 | normfile = path(1:len_trim(path))//'/Normals.in'
74 | volafile = path(1:len_trim(path))//'/Volumesareas.in'
75 | emisfile = path(1:len_trim(path))//'/Emissivities.in'
76 | kextfile = path(1:len_trim(path))//'/K_Extinction.in'
77 | clpropfile = path(1:len_trim(path))//'/CLProperties.in'
78 | cldatfile = path(1:len_trim(path))//'/CLdata.in'
79 | propfile = path(1:len_trim(path))//'/Properties.in'
80 | progfile = path(1:len_trim(path))//'/Progress.in'
81 |
82 | ! WRITE(*,*) pmm_rank," >> SLAVE: Opening files"
83 |
84 | OPEN(FILE_C2C , FILE=c2cfile, FORM='UNFORMATTED')
85 | OPEN(FILE_NORM , FILE=normfile , FORM='UNFORMATTED')
86 | OPEN(FILE_VOLA , FILE=volafile , FORM='UNFORMATTED')
87 | OPEN(FILE_EMIS , FILE=emisfile , FORM='UNFORMATTED')
88 | OPEN(FILE_KEXT , FILE=kextfile , FORM='UNFORMATTED')
89 | OPEN(FILE_CLPRO, FILE=clpropfile, FORM='UNFORMATTED')
90 | OPEN(FILE_CLDAT, FILE=cldatfile , FORM='UNFORMATTED')
91 | OPEN(FILE_PROP , FILE=propfile , FORM='UNFORMATTED')
92 | OPEN(FILE_PROG , FILE=progfile , FORM='UNFORMATTED')
93 |
94 | ! ----------------------------------------------!
95 | ! Allocate and set properties for radiating gaz !
96 | ! (to be changed for N gaz radiation) !
97 | ! ----------------------------------------------!
98 |
99 | is_ngaz = 3
100 | ALLOCATE(is_nbandes(is_ngaz))
101 | is_nbandes = 0
102 | is_nbandes(GAZ_CO) = 48
103 | is_nbandes(GAZ_C) = 96
104 | is_nbandes(GAZ_H) = 367
105 |
106 | is_nallbandes = 371
107 |
108 | ! -----------------!
109 | ! Allocate vectors !
110 | ! -----------------!
111 |
112 | ! WRITE(*,*) pmm_rank," >> SLAVE allocating vectors"
113 |
114 | ! print*, " is_ncells : ", is_ncells
115 | ! print*, " is_nfacesmax : ", is_nfacesmax
116 | ! print*, " is_nallbandes: ", is_nallbandes
117 | ! print*, " is_nbandes : ", is_nbandes
118 |
119 | ALLOCATE(is_nfcelt (is_ncells))
120 | ALLOCATE(is_neighs (2*is_nfacesmax,is_ncells))
121 | ALLOCATE(is_pathway (is_ncells,is_ndir))
122 | ALLOCATE(is_bcell (is_nbfaces))
123 | ALLOCATE(is_bface (is_nbfaces))
124 |
125 | ! WRITE(*,*) pmm_rank," >> SLAVE integer vectors allocated!"
126 |
127 | ALLOCATE(s_KCO (14,is_nbandes(GAZ_CO)))
128 | ALLOCATE(s_KC (14,is_nbandes(GAZ_C)))
129 | ALLOCATE(s_KH (14,is_nbandes(GAZ_H)))
130 | ALLOCATE(s_DCO (14,is_nbandes(GAZ_CO)))
131 | ALLOCAte(s_DC (14,is_nbandes(GAZ_C)))
132 | ALLOCATE(s_DH (14,is_nbandes(GAZ_H)))
133 | ALLOCATE(s_V (is_ncells))
134 | ALLOCATE(s_k_scat (is_ncells))
135 | ALLOCATE(s_S (is_nfacesmax,is_ncells))
136 | ALLOCATE(s_epsil (is_nbfaces))
137 | ALLOCATE(s_Tf (is_nbfaces))
138 | ALLOCATE(s_norm (3,is_nfacesmax,is_ncells))
139 | ALLOCATE(s_celldata (8,is_ncells))
140 | ALLOCATE(s_all_WVNB (is_nallbandes))
141 | ALLOCATE(s_all_DWVNB (is_nallbandes))
142 |
143 | ! WRITE(*,*) pmm_rank," >> SLAVE vectors allocated!"
144 |
145 | IF ( mediumtype.eq.'GRAY' ) THEN
146 | ALLOCATE(s_kabs_gray (is_ncells))
147 | ENDIF
148 |
149 | is_neighs = 0
150 |
151 | ! --------------------!
152 | ! Loop over all cells !
153 | ! --------------------!
154 |
155 | ! WRITE(*,*) pmm_rank," >> SLAVE: Reading *.in files"
156 |
157 | DO i=1,is_ncells
158 |
159 | ! print*, pmm_rank," reading cell", i
160 | READ(FILE_C2C) icell, &
161 | & is_nfcelt(icell), &
162 | & (is_neighs(j,icell),j=1,(2*is_nfcelt(icell)))
163 |
164 | READ(FILE_PROP) icell, (s_celldata(j,icell),j=1,8)
165 |
166 | ! READ(FILE_EMIS) icell, &
167 | ! & is_nfcelt(icell), &
168 | ! & (s_epsil(j,icell),j=1,is_nfcelt(icell))
169 |
170 | IF ( mediumtype.eq.'GRAY' ) THEN
171 | READ(FILE_KEXT) icell,s_kabs_gray(icell),s_k_scat(icell)
172 | ELSE
173 | READ(FILE_KEXT) icell,ddata,s_k_scat(icell)
174 | ENDIF
175 |
176 | READ(FILE_CLPRO) icell, &
177 | & is_nfcelt(icell), &
178 | & (ddata,patch,j=1,is_nfcelt(icell))
179 |
180 | READ(FILE_NORM) icell, &
181 | & is_nfcelt(icell), &
182 | & ((s_norm(k,j,icell),k=1,3),j=1,is_nfcelt(icell))
183 |
184 | READ(FILE_VOLA) icell, &
185 | & is_nfcelt(icell), &
186 | & s_V(icell), &
187 | & (s_S(j,icell),j=1,is_nfcelt(icell))
188 |
189 | ENDDO
190 |
191 | ! ----------------------!
192 | ! Reading boundary data !
193 | ! ----------------------!
194 |
195 | DO i = 1, is_nbfaces
196 |
197 | READ(FILE_CLDAT) is_bcell(i), is_bface(i), s_epsil(i), s_Tf(i)
198 |
199 | ENDDO
200 |
201 | ! TEST
202 | ! print*, pmm_rank," TEST: Tf =", s_Tf
203 | ! print*, pmm_rank," TEST: epsil=", s_epsil
204 |
205 | CLOSE(FILE_CLDAT)
206 |
207 | ! ----------------!
208 | ! Reading pathway !
209 | ! ----------------!
210 |
211 | i = 1
212 | j = 1
213 | DO WHILE (i.lt.1000)
214 |
215 | IF ( (i.ge.is_dird).and.(i.le.is_dirf) ) THEN
216 | READ(FILE_PROG) (is_pathway(n,j), n=1, is_ncells)
217 | j = j + 1
218 | ELSE
219 | READ(FILE_PROG)
220 | ENDIF
221 |
222 | IF (i.ge.is_dirf) THEN
223 | i = 2000
224 | ENDIF
225 |
226 | i = i + 1
227 |
228 | ENDDO
229 |
230 | CLOSE(FILE_PROG)
231 |
232 | ! ---------------------------------!
233 | ! Read spectral data for each band !
234 | ! ---------------------------------!
235 |
236 | ! WRITE(*,*) pmm_rank," >> SLAVE: Reading spectral data"
237 |
238 | snbwnfile = pathspec(1:len_trim(pathspec))//'/SNBWN'
239 |
240 | IF (mediumtype.ne.'GRAY') THEN
241 |
242 | OPEN(FILE_SNBWN,FILE=snbwnfile)
243 | i_bande=1
244 |
245 | DO WHILE (i_bande .le. is_nallbandes)
246 |
247 | READ(FILE_SNBWN,*) s_all_WVNB(i_bande),s_all_DWVNB(i_bande)
248 |
249 | IF (s_all_WVNB(i_bande).lt.0.) THEN
250 | i_bande = is_nallbandes + 1 !arret de la boucle
251 | ENDIF
252 |
253 | i_bande=i_bande+1
254 |
255 | ENDDO
256 |
257 | CLOSE(FILE_SNBWN)
258 |
259 | ENDIF
260 |
261 | ! ----------------------------!
262 | ! Read spectral data for WSGG !
263 | ! ----------------------------!
264 |
265 | wsggfile = pathspec(1:len_trim(pathspec))// &
266 | & '/WSGG_Soufiani_Djavdan_H20_CO2'
267 |
268 | IF (mediumtype.eq.'WSGG') THEN
269 |
270 | ALLOCATE(s_alpha (6,is_ngg))
271 | ALLOCATE(s_kwsgg (is_ngg))
272 |
273 | OPEN(UNIT=FILE_Wsgg,FILE=wsggfile,FORM='FORMATTED')
274 | READ(FILE_Wsgg,*)
275 |
276 | DO i=1,is_ngg
277 | READ(FILE_Wsgg,*) s_kwsgg(i),(s_alpha(j,i),j=1,6)
278 | ENDDO
279 |
280 | CLOSE(FILE_Wsgg)
281 |
282 | ENDIF
283 |
284 | ! ------------------!
285 | ! Close all files !
286 | ! ------------------!
287 |
288 | CLOSE(FILE_NODES)
289 | CLOSE(FILE_C2C)
290 | CLOSE(FILE_CFACE)
291 | CLOSE(FILE_C2FAC)
292 | CLOSE(FILE_CCELL)
293 | CLOSE(FILE_CLNOD)
294 | CLOSE(FILE_EXTRN)
295 | CLOSE(FILE_EMIS)
296 | CLOSE(FILE_KSCA)
297 | CLOSE(FILE_CLPRO)
298 | CLOSE(FILE_CLFAC)
299 | CLOSE(FILE_NORM)
300 | CLOSE(FILE_VOLA)
301 | CLOSE(FILE_PROG)
302 | CLOSE(FILE_PROP)
303 |
304 | ! ------------------------------------!
305 | ! Read spectral properties of gases !
306 | ! ------------------------------------!
307 |
308 | ! WRITE(*,*) pmm_rank," >> SLAVE: Reading gas properties"
309 |
310 | CALL PARAM_SLAVE(pathspec)
311 |
312 | END SUBROUTINE read_data_slave