Home

Context Navigation

source: palm/trunk/SOURCE/data_output_3d.f90 @ 331

Last change on this file since 331 was 314, checked in by heinze, 16 years ago
Change of 2 NetCDF error numbers. appendix_a.html contains the complete content of message_identfiers, so message_identfiers is obsolete.
Property svn:keywords set to `Id`
File size: 12.4 KB

Line
1	SUBROUTINE data_output_3d( av )
2
3	!------------------------------------------------------------------------------!
4	! Current revisions:
5	! -----------------
6	! simulated_time in NetCDF output replaced by time_since_reference_point.
7	! Output of NetCDF messages with aid of message handling routine.
8	! Output of messages replaced by message handling routine.
9	!
10	!
11	! Former revisions:
12	! -----------------
13	! $Id: data_output_3d.f90 314 2009-05-13 07:04:28Z raasch $
14	!
15	! 96 2007-06-04 08:07:41Z raasch
16	! Output of density and salinity
17	!
18	! 75 2007-03-22 09:54:05Z raasch
19	! 2nd+3rd argument removed from exchange horiz
20	!
21	! RCS Log replace by Id keyword, revision history cleaned up
22	!
23	! Revision 1.3 2006/06/02 15:18:59 raasch
24	! +argument "found", -argument grid in call of routine user_data_output_3d
25	!
26	! Revision 1.2 2006/02/23 10:23:07 raasch
27	! Former subroutine plot_3d renamed data_output_3d, pl.. renamed do..,
28	! .._anz renamed .._n,
29	! output extended to (almost) all quantities, output of user-defined quantities
30	!
31	! Revision 1.1 1997/09/03 06:29:36 raasch
32	! Initial revision
33	!
34	!
35	! Description:
36	! ------------
37	! Output of the 3D-arrays in NetCDF and/or AVS format.
38	!------------------------------------------------------------------------------!
39
40	USE array_kind
41	USE arrays_3d
42	USE averaging
43	USE cloud_parameters
44	USE control_parameters
45	USE cpulog
46	USE indices
47	USE interfaces
48	USE netcdf_control
49	USE particle_attributes
50	USE pegrid
51
52	IMPLICIT NONE
53
54	CHARACTER (LEN=9) :: simulated_time_mod
55
56	INTEGER :: av, i, if, j, k, n, pos, prec, psi
57
58	LOGICAL :: found, resorted
59
60	REAL :: mean_r, s_r3, s_r4
61
62	REAL(spk), DIMENSION(:,:,:), ALLOCATABLE :: local_pf
63
64	REAL, DIMENSION(:,:,:), POINTER :: to_be_resorted
65
66	!
67	!-- Return, if nothing to output
68	IF ( do3d_no(av) == 0 ) RETURN
69
70	CALL cpu_log (log_point(14),'data_output_3d','start')
71
72	!
73	!-- Open output file.
74	!-- Also creates coordinate and fld-file for AVS.
75	!-- In case of a run on more than one PE, each PE opens its own file and
76	!-- writes the data of its subdomain in binary format (regardless of the format
77	!-- the user has requested). After the run, these files are combined to one
78	!-- file by combine_plot_fields in the format requested by the user (netcdf
79	!-- and/or avs).
80	IF ( avs_output .OR. ( numprocs > 1 ) ) CALL check_open( 30 )
81
82	#if defined( __netcdf )
83	IF ( myid == 0 .AND. netcdf_output ) CALL check_open( 106+av*10 )
84	#endif
85
86	!
87	!-- Allocate a temporary array with the desired output dimensions.
88	ALLOCATE( local_pf(nxl-1:nxr+1,nys-1:nyn+1,nzb:nz_do3d) )
89
90	!
91	!-- Update the NetCDF time axis
92	#if defined( __netcdf )
93	do3d_time_count(av) = do3d_time_count(av) + 1
94	IF ( myid == 0 .AND. netcdf_output ) THEN
95	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_time_3d(av), &
96	(/ time_since_reference_point /), &
97	start = (/ do3d_time_count(av) /), &
98	count = (/ 1 /) )
99	CALL handle_netcdf_error( 'data_output_3d', 376 )
100	ENDIF
101	#endif
102
103	!
104	!-- Loop over all variables to be written.
105	if = 1
106
107	DO WHILE ( do3d(av,if)(1:1) /= ' ' )
108	!
109	!-- Set the precision for data compression.
110	IF ( do3d_compress ) THEN
111	DO i = 1, 100
112	IF ( plot_3d_precision(i)%variable == do3d(av,if) ) THEN
113	prec = plot_3d_precision(i)%precision
114	EXIT
115	ENDIF
116	ENDDO
117	ENDIF
118
119	!
120	!-- Store the array chosen on the temporary array.
121	resorted = .FALSE.
122	SELECT CASE ( TRIM( do3d(av,if) ) )
123
124	CASE ( 'e' )
125	IF ( av == 0 ) THEN
126	to_be_resorted => e
127	ELSE
128	to_be_resorted => e_av
129	ENDIF
130
131	CASE ( 'p' )
132	IF ( av == 0 ) THEN
133	to_be_resorted => p
134	ELSE
135	to_be_resorted => p_av
136	ENDIF
137
138	CASE ( 'pc' ) ! particle concentration (requires ghostpoint exchange)
139	IF ( av == 0 ) THEN
140	tend = prt_count
141	CALL exchange_horiz( tend )
142	DO i = nxl-1, nxr+1
143	DO j = nys-1, nyn+1
144	DO k = nzb, nz_do3d
145	local_pf(i,j,k) = tend(k,j,i)
146	ENDDO
147	ENDDO
148	ENDDO
149	resorted = .TRUE.
150	ELSE
151	CALL exchange_horiz( pc_av )
152	to_be_resorted => pc_av
153	ENDIF
154
155	CASE ( 'pr' ) ! mean particle radius
156	IF ( av == 0 ) THEN
157	DO i = nxl, nxr
158	DO j = nys, nyn
159	DO k = nzb, nzt+1
160	psi = prt_start_index(k,j,i)
161	s_r3 = 0.0
162	s_r4 = 0.0
163	DO n = psi, psi+prt_count(k,j,i)-1
164	s_r3 = s_r3 + particles(n)%radius**3
165	s_r4 = s_r4 + particles(n)%radius**4
166	ENDDO
167	IF ( s_r3 /= 0.0 ) THEN
168	mean_r = s_r4 / s_r3
169	ELSE
170	mean_r = 0.0
171	ENDIF
172	tend(k,j,i) = mean_r
173	ENDDO
174	ENDDO
175	ENDDO
176	CALL exchange_horiz( tend )
177	DO i = nxl-1, nxr+1
178	DO j = nys-1, nyn+1
179	DO k = nzb, nzt+1
180	local_pf(i,j,k) = tend(k,j,i)
181	ENDDO
182	ENDDO
183	ENDDO
184	resorted = .TRUE.
185	ELSE
186	CALL exchange_horiz( pr_av )
187	to_be_resorted => pr_av
188	ENDIF
189
190	CASE ( 'pt' )
191	IF ( av == 0 ) THEN
192	IF ( .NOT. cloud_physics ) THEN
193	to_be_resorted => pt
194	ELSE
195	DO i = nxl-1, nxr+1
196	DO j = nys-1, nyn+1
197	DO k = nzb, nz_do3d
198	local_pf(i,j,k) = pt(k,j,i) + l_d_cp * &
199	pt_d_t(k) * &
200	ql(k,j,i)
201	ENDDO
202	ENDDO
203	ENDDO
204	resorted = .TRUE.
205	ENDIF
206	ELSE
207	to_be_resorted => pt_av
208	ENDIF
209
210	CASE ( 'q' )
211	IF ( av == 0 ) THEN
212	to_be_resorted => q
213	ELSE
214	to_be_resorted => q_av
215	ENDIF
216
217	CASE ( 'ql' )
218	IF ( av == 0 ) THEN
219	to_be_resorted => ql
220	ELSE
221	to_be_resorted => ql_av
222	ENDIF
223
224	CASE ( 'ql_c' )
225	IF ( av == 0 ) THEN
226	to_be_resorted => ql_c
227	ELSE
228	to_be_resorted => ql_c_av
229	ENDIF
230
231	CASE ( 'ql_v' )
232	IF ( av == 0 ) THEN
233	to_be_resorted => ql_v
234	ELSE
235	to_be_resorted => ql_v_av
236	ENDIF
237
238	CASE ( 'ql_vp' )
239	IF ( av == 0 ) THEN
240	to_be_resorted => ql_vp
241	ELSE
242	to_be_resorted => ql_vp_av
243	ENDIF
244
245	CASE ( 'qv' )
246	IF ( av == 0 ) THEN
247	DO i = nxl-1, nxr+1
248	DO j = nys-1, nyn+1
249	DO k = nzb, nz_do3d
250	local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
251	ENDDO
252	ENDDO
253	ENDDO
254	resorted = .TRUE.
255	ELSE
256	to_be_resorted => qv_av
257	ENDIF
258
259	CASE ( 'rho' )
260	IF ( av == 0 ) THEN
261	to_be_resorted => rho
262	ELSE
263	to_be_resorted => rho_av
264	ENDIF
265
266	CASE ( 's' )
267	IF ( av == 0 ) THEN
268	to_be_resorted => q
269	ELSE
270	to_be_resorted => q_av
271	ENDIF
272
273	CASE ( 'sa' )
274	IF ( av == 0 ) THEN
275	to_be_resorted => sa
276	ELSE
277	to_be_resorted => sa_av
278	ENDIF
279
280	CASE ( 'u' )
281	IF ( av == 0 ) THEN
282	to_be_resorted => u
283	ELSE
284	to_be_resorted => u_av
285	ENDIF
286
287	CASE ( 'v' )
288	IF ( av == 0 ) THEN
289	to_be_resorted => v
290	ELSE
291	to_be_resorted => v_av
292	ENDIF
293
294	CASE ( 'vpt' )
295	IF ( av == 0 ) THEN
296	to_be_resorted => vpt
297	ELSE
298	to_be_resorted => vpt_av
299	ENDIF
300
301	CASE ( 'w' )
302	IF ( av == 0 ) THEN
303	to_be_resorted => w
304	ELSE
305	to_be_resorted => w_av
306	ENDIF
307
308	CASE DEFAULT
309	!
310	!-- User defined quantity
311	CALL user_data_output_3d( av, do3d(av,if), found, local_pf, &
312	nz_do3d )
313	resorted = .TRUE.
314
315	IF ( .NOT. found ) THEN
316	message_string = 'no output available for: ' // &
317	TRIM( do3d(av,if) )
318	CALL message( 'data_output_3d', 'PA0182', 0, 0, 0, 6, 0 )
319	ENDIF
320
321	END SELECT
322
323	!
324	!-- Resort the array to be output, if not done above
325	IF ( .NOT. resorted ) THEN
326	DO i = nxl-1, nxr+1
327	DO j = nys-1, nyn+1
328	DO k = nzb, nz_do3d
329	local_pf(i,j,k) = to_be_resorted(k,j,i)
330	ENDDO
331	ENDDO
332	ENDDO
333	ENDIF
334
335	!
336	!-- Output of the volume data information for the AVS-FLD-file.
337	do3d_avs_n = do3d_avs_n + 1
338	IF ( myid == 0 .AND. avs_output ) THEN
339	!
340	!-- AVS-labels must not contain any colons. Hence they must be removed
341	!-- from the time character string.
342	simulated_time_mod = simulated_time_chr
343	DO WHILE ( SCAN( simulated_time_mod, ':' ) /= 0 )
344	pos = SCAN( simulated_time_mod, ':' )
345	simulated_time_mod(pos:pos) = '/'
346	ENDDO
347
348	IF ( av == 0 ) THEN
349	WRITE ( 33, 3300 ) do3d_avs_n, TRIM( avs_data_file ), &
350	skip_do_avs, TRIM( do3d(av,if) ), &
351	TRIM( simulated_time_mod )
352	ELSE
353	WRITE ( 33, 3300 ) do3d_avs_n, TRIM( avs_data_file ), &
354	skip_do_avs, TRIM( do3d(av,if) ) // &
355	' averaged', TRIM( simulated_time_mod )
356	ENDIF
357	!
358	!-- Determine the Skip-value for the next array. Record end and start
359	!-- require 4 byte each.
360	skip_do_avs = skip_do_avs + ( ((nx+2)(ny+2)(nz_do3d+1)) * 4 + 8 )
361	ENDIF
362
363	!
364	!-- Output of the 3D-array. (compressed/uncompressed)
365	IF ( do3d_compress ) THEN
366	!
367	!-- Compression, output of compression information on FLD-file and output
368	!-- of compressed data.
369	CALL write_compressed( local_pf, 30, 33, myid, nxl, nxr, nyn, nys, &
370	nzb, nz_do3d, prec )
371	ELSE
372	!
373	!-- Uncompressed output.
374	#if defined( __parallel )
375	IF ( netcdf_output .AND. myid == 0 ) THEN
376	WRITE ( 30 ) simulated_time, do3d_time_count(av), av
377	ENDIF
378	WRITE ( 30 ) nxl-1, nxr+1, nys-1, nyn+1, nzb, nz_do3d
379	WRITE ( 30 ) local_pf
380	#else
381	IF ( avs_output ) THEN
382	WRITE ( 30 ) local_pf(nxl:nxr+1,nys:nyn+1,:)
383	ENDIF
384	#if defined( __netcdf )
385	IF ( netcdf_output ) THEN
386	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
387	local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d), &
388	start = (/ 1, 1, 1, do3d_time_count(av) /), &
389	count = (/ nx+2, ny+2, nz_do3d-nzb+1, 1 /) )
390	CALL handle_netcdf_error( 'data_output_3d', 386 )
391	ENDIF
392	#endif
393	#endif
394	ENDIF
395
396	if = if + 1
397
398	ENDDO
399
400	!
401	!-- Deallocate temporary array.
402	DEALLOCATE( local_pf )
403
404
405	CALL cpu_log (log_point(14),'data_output_3d','stop','nobarrier')
406
407	!
408	!-- Formats.
409	3300 FORMAT ('variable ',I4,' file=',A,' filetype=unformatted skip=',I12/ &
410	'label = ',A,A)
411
412	END SUBROUTINE data_output_3d

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |