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

Last change on this file since 1171 was 1116, checked in by hoffmann, 12 years ago

last commit documented

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