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

Last change on this file since 291 was 291, checked in by raasch, 12 years ago

changes for coupling with independent precursor runs; z_i calculation with Sullivan criterion

  • 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 291 2009-04-16 12:07:26Z 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', 1009 )
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', 1010 )
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.
4093300 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.