source: palm/tags/release-3.4/SOURCE/data_output_3d.f90 @ 3884

Last change on this file since 3884 was 98, checked in by raasch, 17 years ago

updating comments and rc-file

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