source: palm/tags/release-3.9/SOURCE/data_output_3d.f90 @ 4480

Last change on this file since 4480 was 1037, checked in by raasch, 11 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 18.6 KB
Line 
1 SUBROUTINE data_output_3d( av )
2
3!--------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2012  Leibniz University Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: data_output_3d.f90 1037 2012-10-22 14:10:22Z Giersch $
27!
28! 1036 2012-10-22 13:43:42Z raasch
29! code put under GPL (PALM 3.9)
30!
31! 1031 2012-10-19 14:35:30Z raasch
32! netCDF4 without parallel file support implemented
33!
34! 1007 2012-09-19 14:30:36Z franke
35! Bugfix: missing calculation of ql_vp added
36!
37! 790 2011-11-29 03:11:20Z raasch
38! bugfix: calculation of 'pr' must depend on the particle weighting factor,
39! nzt+1 replaced by nz_do3d for 'pr'
40!
41! 771 2011-10-27 10:56:21Z heinze
42! +lpt
43!
44! 759 2011-09-15 13:58:31Z raasch
45! Splitting of parallel I/O
46!
47! 727 2011-04-20 20:05:25Z suehring
48! Exchange ghost layers also for p_av.
49!
50! 725 2011-04-11 09:37:01Z suehring
51! Exchange ghost layers for p regardless of used pressure solver (except SOR).
52!
53! 691 2011-03-04 08:45:30Z maronga
54! Replaced simulated_time by time_since_reference_point
55!
56! 673 2011-01-18 16:19:48Z suehring
57! When using Multigrid or SOR solver an additional CALL exchange_horiz is
58! is needed for pressure output.
59!
60! 667 2010-12-23 12:06:00Z suehring/gryschka
61! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in loops and
62! allocation of arrays.  Calls of exchange_horiz are modified.
63! Skip-value skip_do_avs changed to a dynamic adaption of ghost points.
64!
65! 646 2010-12-15 13:03:52Z raasch
66! bugfix: missing define statements for netcdf added
67!
68! 493 2010-03-01 08:30:24Z raasch
69! netCDF4 support (parallel output)
70!
71! 355 2009-07-17 01:03:01Z letzel
72! simulated_time in netCDF output replaced by time_since_reference_point.
73! Output of netCDF messages with aid of message handling routine.
74! Output of messages replaced by message handling routine.
75! Bugfix: to_be_resorted => s_av for time-averaged scalars
76!
77! 96 2007-06-04 08:07:41Z raasch
78! Output of density and salinity
79!
80! 75 2007-03-22 09:54:05Z raasch
81! 2nd+3rd argument removed from exchange horiz
82!
83! RCS Log replace by Id keyword, revision history cleaned up
84!
85! Revision 1.3  2006/06/02 15:18:59  raasch
86! +argument "found", -argument grid in call of routine user_data_output_3d
87!
88! Revision 1.2  2006/02/23 10:23:07  raasch
89! Former subroutine plot_3d renamed data_output_3d, pl.. renamed do..,
90! .._anz renamed .._n,
91! output extended to (almost) all quantities, output of user-defined quantities
92!
93! Revision 1.1  1997/09/03 06:29:36  raasch
94! Initial revision
95!
96!
97! Description:
98! ------------
99! Output of the 3D-arrays in netCDF and/or AVS format.
100!------------------------------------------------------------------------------!
101
102    USE array_kind
103    USE arrays_3d
104    USE averaging
105    USE cloud_parameters
106    USE control_parameters
107    USE cpulog
108    USE indices
109    USE interfaces
110    USE netcdf_control
111    USE particle_attributes
112    USE pegrid
113
114    IMPLICIT NONE
115
116    CHARACTER (LEN=9) ::  simulated_time_mod
117
118    INTEGER           ::  av, i, if, j, k, n, pos, prec, psi
119
120    LOGICAL           ::  found, resorted
121
122    REAL              ::  mean_r, s_r3, s_r4
123
124    REAL(spk), DIMENSION(:,:,:), ALLOCATABLE  ::  local_pf
125
126    REAL, DIMENSION(:,:,:), POINTER ::  to_be_resorted
127
128!
129!-- Return, if nothing to output
130    IF ( do3d_no(av) == 0 )  RETURN
131
132    CALL cpu_log (log_point(14),'data_output_3d','start')
133
134!
135!-- Open output file.
136!-- Also creates coordinate and fld-file for AVS.
137!-- For classic or 64bit netCDF output or output of other (old) data formats,
138!-- for a run on more than one PE, each PE opens its own file and
139!-- writes the data of its subdomain in binary format (regardless of the format
140!-- the user has requested). After the run, these files are combined to one
141!-- file by combine_plot_fields in the format requested by the user (netcdf
142!-- and/or avs).
143!-- For netCDF4/HDF5 output, data is written in parallel into one file.
144    IF ( netcdf_output )  THEN
145       IF ( netcdf_data_format < 5 )  THEN
146          CALL check_open( 30 )
147          IF ( myid == 0 )  CALL check_open( 106+av*10 )
148       ELSE
149          CALL check_open( 106+av*10 )
150       ENDIF
151    ELSE
152       IF ( avs_output  .OR.  ( numprocs > 1 ) )  CALL check_open( 30 )
153    ENDIF
154
155!
156!-- Allocate a temporary array with the desired output dimensions.
157    ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb:nz_do3d) )
158
159!
160!-- Update the netCDF time axis
161#if defined( __netcdf )
162    IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
163       do3d_time_count(av) = do3d_time_count(av) + 1
164       IF ( netcdf_output )  THEN
165          nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_time_3d(av), &
166                                  (/ time_since_reference_point /),  &
167                                  start = (/ do3d_time_count(av) /), &
168                                  count = (/ 1 /) )
169          CALL handle_netcdf_error( 'data_output_3d', 376 )
170       ENDIF
171    ENDIF
172#endif
173
174!
175!-- Loop over all variables to be written.
176    if = 1
177
178    DO  WHILE ( do3d(av,if)(1:1) /= ' ' )
179!
180!--    Set the precision for data compression.
181       IF ( do3d_compress )  THEN
182          DO  i = 1, 100
183             IF ( plot_3d_precision(i)%variable == do3d(av,if) )  THEN
184                prec = plot_3d_precision(i)%precision
185                EXIT
186             ENDIF
187          ENDDO
188       ENDIF
189
190!
191!--    Store the array chosen on the temporary array.
192       resorted = .FALSE.
193       SELECT CASE ( TRIM( do3d(av,if) ) )
194
195          CASE ( 'e' )
196             IF ( av == 0 )  THEN
197                to_be_resorted => e
198             ELSE
199                to_be_resorted => e_av
200             ENDIF
201
202          CASE ( 'lpt' )
203             IF ( av == 0 )  THEN
204                to_be_resorted => pt
205             ELSE
206                to_be_resorted => lpt_av
207             ENDIF
208
209          CASE ( 'p' )
210             IF ( av == 0 )  THEN
211                IF ( psolver /= 'sor' )  CALL exchange_horiz( p, nbgp )
212                to_be_resorted => p
213             ELSE
214                IF ( psolver /= 'sor' )  CALL exchange_horiz( p_av, nbgp )
215                to_be_resorted => p_av
216             ENDIF
217
218          CASE ( 'pc' )  ! particle concentration (requires ghostpoint exchange)
219             IF ( av == 0 )  THEN
220                tend = prt_count
221                CALL exchange_horiz( tend, nbgp )
222                DO  i = nxlg, nxrg
223                   DO  j = nysg, nyng
224                      DO  k = nzb, nz_do3d
225                         local_pf(i,j,k) = tend(k,j,i)
226                      ENDDO
227                   ENDDO
228                ENDDO
229                resorted = .TRUE.
230             ELSE
231                CALL exchange_horiz( pc_av, nbgp )
232                to_be_resorted => pc_av
233             ENDIF
234
235          CASE ( 'pr' )  ! mean particle radius
236             IF ( av == 0 )  THEN
237                DO  i = nxl, nxr
238                   DO  j = nys, nyn
239                      DO  k = nzb, nz_do3d
240                         psi = prt_start_index(k,j,i)
241                         s_r3 = 0.0
242                         s_r4 = 0.0
243                         DO  n = psi, psi+prt_count(k,j,i)-1
244                         s_r3 = s_r3 + particles(n)%radius**3 * &
245                                       particles(n)%weight_factor
246                         s_r4 = s_r4 + particles(n)%radius**4 * &
247                                       particles(n)%weight_factor
248                         ENDDO
249                         IF ( s_r3 /= 0.0 )  THEN
250                            mean_r = s_r4 / s_r3
251                         ELSE
252                            mean_r = 0.0
253                         ENDIF
254                         tend(k,j,i) = mean_r
255                      ENDDO
256                   ENDDO
257                ENDDO
258                CALL exchange_horiz( tend, nbgp )
259                DO  i = nxlg, nxrg
260                   DO  j = nysg, nyng
261                      DO  k = nzb, nz_do3d
262                         local_pf(i,j,k) = tend(k,j,i)
263                      ENDDO
264                   ENDDO
265                ENDDO
266                resorted = .TRUE.
267             ELSE
268                CALL exchange_horiz( pr_av, nbgp )
269                to_be_resorted => pr_av
270             ENDIF
271
272          CASE ( 'pt' )
273             IF ( av == 0 )  THEN
274                IF ( .NOT. cloud_physics ) THEN
275                   to_be_resorted => pt
276                ELSE
277                   DO  i = nxlg, nxrg
278                      DO  j = nysg, nyng
279                         DO  k = nzb, nz_do3d
280                            local_pf(i,j,k) = pt(k,j,i) + l_d_cp *    &
281                                                          pt_d_t(k) * &
282                                                          ql(k,j,i)
283                         ENDDO
284                      ENDDO
285                   ENDDO
286                   resorted = .TRUE.
287                ENDIF
288             ELSE
289                to_be_resorted => pt_av
290             ENDIF
291
292          CASE ( 'q' )
293             IF ( av == 0 )  THEN
294                to_be_resorted => q
295             ELSE
296                to_be_resorted => q_av
297             ENDIF
298
299          CASE ( 'ql' )
300             IF ( av == 0 )  THEN
301                to_be_resorted => ql
302             ELSE
303                to_be_resorted => ql_av
304             ENDIF
305
306          CASE ( 'ql_c' )
307             IF ( av == 0 )  THEN
308                to_be_resorted => ql_c
309             ELSE
310                to_be_resorted => ql_c_av
311             ENDIF
312
313          CASE ( 'ql_v' )
314             IF ( av == 0 )  THEN
315                to_be_resorted => ql_v
316             ELSE
317                to_be_resorted => ql_v_av
318             ENDIF
319
320          CASE ( 'ql_vp' )
321             IF ( av == 0 )  THEN
322                DO  i = nxl, nxr
323                   DO  j = nys, nyn
324                      DO  k = nzb, nz_do3d
325                         psi = prt_start_index(k,j,i)
326                         DO  n = psi, psi+prt_count(k,j,i)-1
327                            tend(k,j,i) = tend(k,j,i) + &
328                                          particles(n)%weight_factor / &
329                                          prt_count(k,j,i)
330                         ENDDO
331                      ENDDO
332                   ENDDO
333                ENDDO
334                CALL exchange_horiz( tend, nbgp )
335                DO  i = nxlg, nxrg
336                   DO  j = nysg, nyng
337                      DO  k = nzb, nz_do3d
338                         local_pf(i,j,k) = tend(k,j,i)
339                      ENDDO
340                   ENDDO
341                ENDDO
342                resorted = .TRUE.
343             ELSE
344                CALL exchange_horiz( ql_vp_av, nbgp )
345                to_be_resorted => ql_vp_av
346             ENDIF
347
348          CASE ( 'qv' )
349             IF ( av == 0 )  THEN
350                DO  i = nxlg, nxrg
351                   DO  j = nysg, nyng
352                      DO  k = nzb, nz_do3d
353                         local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
354                      ENDDO
355                   ENDDO
356                ENDDO
357                resorted = .TRUE.
358             ELSE
359                to_be_resorted => qv_av
360             ENDIF
361
362          CASE ( 'rho' )
363             IF ( av == 0 )  THEN
364                to_be_resorted => rho
365             ELSE
366                to_be_resorted => rho_av
367             ENDIF
368
369          CASE ( 's' )
370             IF ( av == 0 )  THEN
371                to_be_resorted => q
372             ELSE
373                to_be_resorted => s_av
374             ENDIF
375
376          CASE ( 'sa' )
377             IF ( av == 0 )  THEN
378                to_be_resorted => sa
379             ELSE
380                to_be_resorted => sa_av
381             ENDIF
382
383          CASE ( 'u' )
384             IF ( av == 0 )  THEN
385                to_be_resorted => u
386             ELSE
387                to_be_resorted => u_av
388             ENDIF
389
390          CASE ( 'v' )
391             IF ( av == 0 )  THEN
392                to_be_resorted => v
393             ELSE
394                to_be_resorted => v_av
395             ENDIF
396
397          CASE ( 'vpt' )
398             IF ( av == 0 )  THEN
399                to_be_resorted => vpt
400             ELSE
401                to_be_resorted => vpt_av
402             ENDIF
403
404          CASE ( 'w' )
405             IF ( av == 0 )  THEN
406                to_be_resorted => w
407             ELSE
408                to_be_resorted => w_av
409             ENDIF
410
411          CASE DEFAULT
412!
413!--          User defined quantity
414             CALL user_data_output_3d( av, do3d(av,if), found, local_pf, &
415                                       nz_do3d )
416             resorted = .TRUE.
417
418             IF ( .NOT. found )  THEN
419                message_string =  'no output available for: ' //   &
420                                  TRIM( do3d(av,if) )
421                CALL message( 'data_output_3d', 'PA0182', 0, 0, 0, 6, 0 )
422             ENDIF
423
424       END SELECT
425
426!
427!--    Resort the array to be output, if not done above
428       IF ( .NOT. resorted )  THEN
429          DO  i = nxlg, nxrg
430             DO  j = nysg, nyng
431                DO  k = nzb, nz_do3d
432                   local_pf(i,j,k) = to_be_resorted(k,j,i)
433                ENDDO
434             ENDDO
435          ENDDO
436       ENDIF
437
438!
439!--    Output of the volume data information for the AVS-FLD-file.
440       do3d_avs_n = do3d_avs_n + 1
441       IF ( myid == 0  .AND.  avs_output )  THEN
442!
443!--       AVS-labels must not contain any colons. Hence they must be removed
444!--       from the time character string.
445          simulated_time_mod = simulated_time_chr
446          DO  WHILE ( SCAN( simulated_time_mod, ':' ) /= 0 )
447             pos = SCAN( simulated_time_mod, ':' )
448             simulated_time_mod(pos:pos) = '/'
449          ENDDO
450
451          IF ( av == 0 )  THEN
452             WRITE ( 33, 3300 )  do3d_avs_n, TRIM( avs_data_file ), &
453                                 skip_do_avs, TRIM( do3d(av,if) ), &
454                                 TRIM( simulated_time_mod )
455          ELSE
456             WRITE ( 33, 3300 )  do3d_avs_n, TRIM( avs_data_file ), &
457                                 skip_do_avs, TRIM( do3d(av,if) ) // &
458                                 ' averaged', TRIM( simulated_time_mod )
459          ENDIF
460!
461!--       Determine the Skip-value for the next array. Record end and start
462!--       require 4 byte each.
463          skip_do_avs = skip_do_avs + ( ( ( nx+2*nbgp ) * ( ny+2*nbgp ) * &
464                                          ( nz_do3d+1 ) ) * 4 + 8 )
465       ENDIF
466
467!
468!--    Output of the 3D-array. (compressed/uncompressed)
469       IF ( do3d_compress )  THEN
470!
471!--       Compression, output of compression information on FLD-file and output
472!--       of compressed data.
473          CALL write_compressed( local_pf, 30, 33, myid, nxl, nxr, nyn, nys, &
474                                 nzb, nz_do3d, prec, nbgp )
475       ELSE
476!
477!--       Uncompressed output.
478#if defined( __parallel )
479          IF ( netcdf_output )  THEN
480             IF ( netcdf_data_format < 5 )  THEN
481!
482!--             Non-parallel netCDF output. Data is output in parallel in
483!--             FORTRAN binary format here, and later collected into one file by
484!--             combine_plot_fields
485                IF ( myid == 0 )  THEN
486                   WRITE ( 30 )  time_since_reference_point,                   &
487                                 do3d_time_count(av), av
488                ENDIF
489                DO  i = 0, io_blocks-1
490                   IF ( i == io_group )  THEN
491                      WRITE ( 30 )  nxlg, nxrg, nysg, nyng, nzb, nz_do3d
492                      WRITE ( 30 )  local_pf
493                   ENDIF
494#if defined( __parallel )
495                   CALL MPI_BARRIER( comm2d, ierr )
496#endif
497                ENDDO
498
499             ELSE
500#if defined( __netcdf )
501!
502!--             Parallel output in netCDF4/HDF5 format.
503!--             Do not output redundant ghost point data except for the
504!--             boundaries of the total domain.
505                IF ( nxr == nx  .AND.  nyn /= ny )  THEN
506                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
507                                  local_pf(nxl:nxrg,nys:nyn,nzb:nz_do3d),    &
508                      start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
509                      count = (/ nxr-nxl+1+nbgp, nyn-nys+1, nz_do3d-nzb+1, 1 /) )
510                ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
511                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
512                                  local_pf(nxl:nxr,nys:nyng,nzb:nz_do3d),    &
513                      start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
514                      count = (/ nxr-nxl+1, nyn-nys+1+nbgp, nz_do3d-nzb+1, 1 /) )
515                ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
516                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
517                                  local_pf(nxl:nxrg,nys:nyng,nzb:nz_do3d),  &
518                      start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
519                      count = (/ nxr-nxl+1+nbgp, nyn-nys+1+nbgp, nz_do3d-nzb+1, 1 /) )
520                ELSE
521                   nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
522                                  local_pf(nxl:nxr,nys:nyn,nzb:nz_do3d),      &
523                      start = (/ nxl+1, nys+1, nzb+1, do3d_time_count(av) /), &
524                      count = (/ nxr-nxl+1, nyn-nys+1, nz_do3d-nzb+1, 1 /) )
525                ENDIF
526                CALL handle_netcdf_error( 'data_output_3d', 386 )
527#endif
528             ENDIF
529          ENDIF
530#else
531          IF ( avs_output )  THEN
532             WRITE ( 30 )  local_pf(nxl:nxr+1,nys:nyn+1,:)
533          ENDIF
534#if defined( __netcdf )
535          IF ( netcdf_output )  THEN
536
537             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),    &
538                               local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d),  &
539                               start = (/ 1, 1, 1, do3d_time_count(av) /), &
540                               count = (/ nx+2, ny+2, nz_do3d-nzb+1, 1 /) )
541             CALL handle_netcdf_error( 'data_output_3d', 446 )
542
543          ENDIF
544#endif
545#endif
546       ENDIF
547
548       if = if + 1
549
550    ENDDO
551
552!
553!-- Deallocate temporary array.
554    DEALLOCATE( local_pf )
555
556
557    CALL cpu_log (log_point(14),'data_output_3d','stop','nobarrier')
558
559!
560!-- Formats.
5613300 FORMAT ('variable ',I4,'  file=',A,'  filetype=unformatted  skip=',I12/ &
562             'label = ',A,A)
563
564 END SUBROUTINE data_output_3d
Note: See TracBrowser for help on using the repository browser.