Home

Context Navigation

source: palm/trunk/SOURCE/data_output_mask.f90 @ 449

Last change on this file since 449 was 449, checked in by raasch, 15 years ago
branch revision comments from Marcus (rev 410) replaced by normal revision comments
Property svn:keywords set to `Id`
File size: 15.3 KB

Line
1	SUBROUTINE data_output_mask( av )
2
3	!------------------------------------------------------------------------------!
4	! Actual revisions:
5	! -----------------
6	!
7	!
8	! Former revisions:
9	! -----------------
10	! $Id: data_output_mask.f90 449 2010-02-02 11:23:59Z raasch $
11	!
12	! 410 2009-12-04 17:05:40Z letzel
13	! Initial version
14	!
15	! Description:
16	! ------------
17	! Masked data output in NetCDF format for current mask (current value of mid).
18	!------------------------------------------------------------------------------!
19
20	#if defined( __netcdf )
21	USE arrays_3d
22	USE averaging
23	USE cloud_parameters
24	USE control_parameters
25	USE cpulog
26	USE grid_variables
27	USE indices
28	USE interfaces
29	USE netcdf
30	USE netcdf_control
31	USE particle_attributes
32	USE pegrid
33
34	IMPLICIT NONE
35
36	INTEGER :: av, ngp, file_id, i, if, is, j, k, l, n, psi, s, sender, &
37	ind(6)
38	LOGICAL :: found, resorted
39	REAL :: mean_r, s_r3, s_r4
40	REAL, DIMENSION(:,:,:), ALLOCATABLE :: local_pf
41	#if defined( __parallel )
42	REAL, DIMENSION(:,:,:), ALLOCATABLE :: total_pf
43	#endif
44	REAL, DIMENSION(:,:,:), POINTER :: to_be_resorted
45
46	!
47	!-- Return, if nothing to output
48	IF ( domask_no(mid,av) == 0 ) RETURN
49
50	CALL cpu_log (log_point(49),'data_output_mask','start')
51
52	!!
53	!-- Open output file.
54	IF ( format_parallel_io .AND. netcdf_output ) THEN
55	CALL check_open( 120+mid+av*max_masks )
56	ELSEIF (myid == 0 .AND. netcdf_output ) THEN
57	CALL check_open( 120+mid+av*max_masks )
58	ENDIF
59
60	!
61	!-- Allocate total and local output arrays.
62	#if defined( __parallel )
63	IF ( myid == 0 ) THEN
64	ALLOCATE( total_pf(mask_size(mid,1),mask_size(mid,2),mask_size(mid,3)) )
65	ENDIF
66	#endif
67	ALLOCATE( local_pf(mask_size_l(mid,1),mask_size_l(mid,2), &
68	mask_size_l(mid,3)) )
69
70	!
71	!-- Update the NetCDF time axis.
72	domask_time_count(mid,av) = domask_time_count(mid,av) + 1
73	IF ( format_parallel_io .AND. netcdf_output ) THEN
74	nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_time_mask(mid,av), &
75	(/ simulated_time /), &
76	start = (/ domask_time_count(mid,av) /), &
77	count = (/ 1 /) )
78	CALL handle_netcdf_error( 'data_output_mask', 9998 )
79	ELSEIF ( myid == 0 .AND. netcdf_output ) THEN
80	nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_time_mask(mid,av), &
81	(/ simulated_time /), &
82	start = (/ domask_time_count(mid,av) /), &
83	count = (/ 1 /) )
84	CALL handle_netcdf_error( 'data_output_mask', 9998 )
85	ENDIF
86
87	!
88	!-- Loop over all variables to be written.
89	if = 1
90
91	DO WHILE ( domask(mid,av,if)(1:1) /= ' ' )
92	!
93	!-- Reallocate local_pf on PE 0 since its shape changes during MPI exchange
94	IF ( .NOT. format_parallel_io .AND. myid == 0 .AND. if > 1 ) THEN
95	DEALLOCATE( local_pf )
96	ALLOCATE( local_pf(mask_size_l(mid,1),mask_size_l(mid,2), &
97	mask_size_l(mid,3)) )
98	ENDIF
99	!
100	!-- Store the variable chosen.
101	resorted = .FALSE.
102	SELECT CASE ( TRIM( domask(mid,av,if) ) )
103
104	CASE ( 'e' )
105	IF ( av == 0 ) THEN
106	to_be_resorted => e
107	ELSE
108	to_be_resorted => e_av
109	ENDIF
110
111	CASE ( 'p' )
112	IF ( av == 0 ) THEN
113	to_be_resorted => p
114	ELSE
115	to_be_resorted => p_av
116	ENDIF
117
118	CASE ( 'pc' ) ! particle concentration (requires ghostpoint exchange)
119	IF ( av == 0 ) THEN
120	tend = prt_count
121	CALL exchange_horiz( tend )
122	DO i = 1, mask_size_l(mid,1)
123	DO j = 1, mask_size_l(mid,2)
124	DO k = 1, mask_size_l(mid,3)
125	local_pf(i,j,k) = tend(mask_k(mid,k), &
126	mask_j(mid,j),mask_i(mid,i))
127	ENDDO
128	ENDDO
129	ENDDO
130	resorted = .TRUE.
131	ELSE
132	CALL exchange_horiz( pc_av )
133	to_be_resorted => pc_av
134	ENDIF
135
136	CASE ( 'pr' ) ! mean particle radius
137	IF ( av == 0 ) THEN
138	DO i = nxl, nxr
139	DO j = nys, nyn
140	DO k = nzb, nzt+1
141	psi = prt_start_index(k,j,i)
142	s_r3 = 0.0
143	s_r4 = 0.0
144	DO n = psi, psi+prt_count(k,j,i)-1
145	s_r3 = s_r3 + particles(n)%radius**3
146	s_r4 = s_r4 + particles(n)%radius**4
147	ENDDO
148	IF ( s_r3 /= 0.0 ) THEN
149	mean_r = s_r4 / s_r3
150	ELSE
151	mean_r = 0.0
152	ENDIF
153	tend(k,j,i) = mean_r
154	ENDDO
155	ENDDO
156	ENDDO
157	CALL exchange_horiz( tend )
158	DO i = 1, mask_size_l(mid,1)
159	DO j = 1, mask_size_l(mid,2)
160	DO k = 1, mask_size_l(mid,3)
161	local_pf(i,j,k) = tend(mask_k(mid,k), &
162	mask_j(mid,j),mask_i(mid,i))
163	ENDDO
164	ENDDO
165	ENDDO
166	resorted = .TRUE.
167	ELSE
168	CALL exchange_horiz( pr_av )
169	to_be_resorted => pr_av
170	ENDIF
171
172	CASE ( 'pt' )
173	IF ( av == 0 ) THEN
174	IF ( .NOT. cloud_physics ) THEN
175	to_be_resorted => pt
176	ELSE
177	DO i = 1, mask_size_l(mid,1)
178	DO j = 1, mask_size_l(mid,2)
179	DO k = 1, mask_size_l(mid,3)
180	local_pf(i,j,k) = &
181	pt(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) &
182	+ l_d_cp * pt_d_t(mask_k(mid,k)) * &
183	ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
184	ENDDO
185	ENDDO
186	ENDDO
187	resorted = .TRUE.
188	ENDIF
189	ELSE
190	to_be_resorted => pt_av
191	ENDIF
192
193	CASE ( 'q' )
194	IF ( av == 0 ) THEN
195	to_be_resorted => q
196	ELSE
197	to_be_resorted => q_av
198	ENDIF
199
200	CASE ( 'ql' )
201	IF ( av == 0 ) THEN
202	to_be_resorted => ql
203	ELSE
204	to_be_resorted => ql_av
205	ENDIF
206
207	CASE ( 'ql_c' )
208	IF ( av == 0 ) THEN
209	to_be_resorted => ql_c
210	ELSE
211	to_be_resorted => ql_c_av
212	ENDIF
213
214	CASE ( 'ql_v' )
215	IF ( av == 0 ) THEN
216	to_be_resorted => ql_v
217	ELSE
218	to_be_resorted => ql_v_av
219	ENDIF
220
221	CASE ( 'ql_vp' )
222	IF ( av == 0 ) THEN
223	to_be_resorted => ql_vp
224	ELSE
225	to_be_resorted => ql_vp_av
226	ENDIF
227
228	CASE ( 'qv' )
229	IF ( av == 0 ) THEN
230	DO i = 1, mask_size_l(mid,1)
231	DO j = 1, mask_size_l(mid,2)
232	DO k = 1, mask_size_l(mid,3)
233	local_pf(i,j,k) = &
234	q(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) - &
235	ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
236	ENDDO
237	ENDDO
238	ENDDO
239	resorted = .TRUE.
240	ELSE
241	to_be_resorted => qv_av
242	ENDIF
243
244	CASE ( 'rho' )
245	IF ( av == 0 ) THEN
246	to_be_resorted => rho
247	ELSE
248	to_be_resorted => rho_av
249	ENDIF
250
251	CASE ( 's' )
252	IF ( av == 0 ) THEN
253	to_be_resorted => q
254	ELSE
255	to_be_resorted => s_av
256	ENDIF
257
258	CASE ( 'sa' )
259	IF ( av == 0 ) THEN
260	to_be_resorted => sa
261	ELSE
262	to_be_resorted => sa_av
263	ENDIF
264
265	CASE ( 'u' )
266	IF ( av == 0 ) THEN
267	to_be_resorted => u
268	ELSE
269	to_be_resorted => u_av
270	ENDIF
271
272	CASE ( 'v' )
273	IF ( av == 0 ) THEN
274	to_be_resorted => v
275	ELSE
276	to_be_resorted => v_av
277	ENDIF
278
279	CASE ( 'vpt' )
280	IF ( av == 0 ) THEN
281	to_be_resorted => vpt
282	ELSE
283	to_be_resorted => vpt_av
284	ENDIF
285
286	CASE ( 'w' )
287	IF ( av == 0 ) THEN
288	to_be_resorted => w
289	ELSE
290	to_be_resorted => w_av
291	ENDIF
292
293	CASE DEFAULT
294	!
295	!-- User defined quantity
296	CALL user_data_output_mask(av, domask(mid,av,if), found, local_pf )
297	resorted = .TRUE.
298
299	IF ( .NOT. found ) THEN
300	WRITE ( message_string, * ) 'no output available for: ', &
301	TRIM( domask(mid,av,if) )
302	CALL message( 'data_output_mask', 'PA9998', 0, 0, 0, 6, 0 )
303	ENDIF
304
305	END SELECT
306
307	!
308	!-- Resort the array to be output, if not done above
309	IF ( .NOT. resorted ) THEN
310	DO i = 1, mask_size_l(mid,1)
311	DO j = 1, mask_size_l(mid,2)
312	DO k = 1, mask_size_l(mid,3)
313	local_pf(i,j,k) = to_be_resorted(mask_k(mid,k), &
314	mask_j(mid,j),mask_i(mid,i))
315	ENDDO
316	ENDDO
317	ENDDO
318	ENDIF
319
320	!
321	!-- I/O block. I/O methods are implemented
322	!-- (1) for parallel execution
323	!-- a. with NetCDF 4 parallel I/O-enabled library
324	!-- b. with NetCDF 3 library
325	!-- (2) for serial execution.
326	!-- The choice of method depends on the correct setting of preprocessor
327	!-- directives __parallel and __netcdf4 as well as on the parameter
328	!-- nc_format_mask(mid,av).
329	#if defined( __parallel )
330	#if defined( __netcdf4 )
331	IF ( nc_format_mask(mid,av) == 3 .OR. nc_format_mask(mid,av) == 4 ) THEN
332	!
333	!-- (1) a. Parallel I/O using NetCDF 4 (not yet tested)
334	nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &
335	id_var_domask(mid,av,if), &
336	local_pf, &
337	start = (/ mask_start_l(mid,1), mask_start_l(mid,2), &
338	mask_start_l(mid,3), domask_time_count(mid,av) /), &
339	count = (/ mask_size_l(mid,1), mask_size_l(mid,2), &
340	mask_size_l(mid,3), 1 /) )
341	CALL handle_netcdf_error( 'data_output_mask', 9998 )
342	ELSE
343	#endif
344	!
345	!-- (1) b. Conventional I/O only through PE0
346	!-- PE0 receives partial arrays from all processors of the respective mask
347	!-- and outputs them. Here a barrier has to be set, because otherwise
348	!-- "-MPI- FATAL: Remote protocol queue full" may occur.
349	CALL MPI_BARRIER( comm2d, ierr )
350
351	ngp = mask_size_l(mid,1) * mask_size_l(mid,2) * mask_size_l(mid,3)
352	IF ( myid == 0 ) THEN
353	!
354	!-- Local array can be relocated directly.
355	total_pf( &
356	mask_start_l(mid,1):mask_start_l(mid,1)+mask_size_l(mid,1)-1, &
357	mask_start_l(mid,2):mask_start_l(mid,2)+mask_size_l(mid,2)-1, &
358	mask_start_l(mid,3):mask_start_l(mid,3)+mask_size_l(mid,3)-1 ) &
359	= local_pf
360	!
361	!-- Receive data from all other PEs.
362	DO n = 1, numprocs-1
363	!
364	!-- Receive index limits first, then array.
365	!-- Index limits are received in arbitrary order from the PEs.
366	CALL MPI_RECV( ind(1), 6, MPI_INTEGER, MPI_ANY_SOURCE, 0, &
367	comm2d, status, ierr )
368	!
369	!-- Not all PEs have data for the mask
370	IF ( ind(1) /= -9999 ) THEN
371	ngp = ( ind(2)-ind(1)+1 ) * (ind(4)-ind(3)+1 ) * &
372	( ind(6)-ind(5)+1 )
373	sender = status(MPI_SOURCE)
374	DEALLOCATE( local_pf )
375	ALLOCATE(local_pf(ind(1):ind(2),ind(3):ind(4),ind(5):ind(6)))
376	CALL MPI_RECV( local_pf(ind(1),ind(3),ind(5)), ngp, &
377	MPI_REAL, sender, 1, comm2d, status, ierr )
378	total_pf(ind(1):ind(2),ind(3):ind(4),ind(5):ind(6)) &
379	= local_pf
380	ENDIF
381	ENDDO
382
383	nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &
384	id_var_domask(mid,av,if), total_pf, &
385	start = (/ 1, 1, 1, domask_time_count(mid,av) /), &
386	count = (/ mask_size(mid,1), mask_size(mid,2), &
387	mask_size(mid,3), 1 /) )
388	CALL handle_netcdf_error( 'data_output_mask', 9998 )
389
390	ELSE
391	!
392	!-- If at least part of the mask resides on the PE, send the index
393	!-- limits for the target array, otherwise send -9999 to PE0.
394	IF ( mask_size_l(mid,1) > 0 .AND. mask_size_l(mid,2) > 0 .AND. &
395	mask_size_l(mid,3) > 0 ) &
396	THEN
397	ind(1) = mask_start_l(mid,1)
398	ind(2) = mask_start_l(mid,1) + mask_size_l(mid,1) - 1
399	ind(3) = mask_start_l(mid,2)
400	ind(4) = mask_start_l(mid,2) + mask_size_l(mid,2) - 1
401	ind(5) = mask_start_l(mid,3)
402	ind(6) = mask_start_l(mid,3) + mask_size_l(mid,3) - 1
403	ELSE
404	ind(1) = -9999; ind(2) = -9999
405	ind(3) = -9999; ind(4) = -9999
406	ind(5) = -9999; ind(6) = -9999
407	ENDIF
408	CALL MPI_SEND( ind(1), 6, MPI_INTEGER, 0, 0, comm2d, ierr )
409	!
410	!-- If applicable, send data to PE0.
411	IF ( ind(1) /= -9999 ) THEN
412	CALL MPI_SEND( local_pf(1,1,1), ngp, MPI_REAL, 0, 1, comm2d, &
413	ierr )
414	ENDIF
415	ENDIF
416	!
417	!-- A barrier has to be set, because otherwise some PEs may proceed too
418	!-- fast so that PE0 may receive wrong data on tag 0.
419	CALL MPI_BARRIER( comm2d, ierr )
420	#if defined( __netcdf4 )
421	ENDIF
422	#endif
423	#else
424	!
425	!-- (2) For serial execution of PALM, the single processor (PE0) holds all
426	!-- data and writes them directly to file.
427	nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &
428	id_var_domask(mid,av,if), &
429	local_pf(mask_size_l(mid,1),mask_size_l(mid,2), &
430	mask_size_l(mid,3)),&
431	start = (/ 1, 1, 1, domask_time_count(mid,av) /), &
432	count = (/ mask_size_l(mid,1), mask_size_l(mid,2), &
433	mask_size_l(mid,3), 1 /) )
434	CALL handle_netcdf_error( 'data_output_mask', 9998 )
435	#endif
436
437	if = if + 1
438	ENDDO
439
440	!
441	!-- Deallocate temporary arrays.
442	DEALLOCATE( local_pf )
443	#if defined( __parallel )
444	IF ( myid == 0 ) THEN
445	DEALLOCATE( total_pf )
446	ENDIF
447	#endif
448
449
450	CALL cpu_log (log_point(49),'data_output_mask','stop','nobarrier')
451	#endif
452
453	END SUBROUTINE data_output_mask

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |