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

Last change on this file since 276 was 274, checked in by heinze, 15 years ago

Indentation of the message calls corrected

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