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

Last change on this file since 2345 was 2292, checked in by schwenkel, 7 years ago

implementation of new bulk microphysics scheme

  • Property svn:keywords set to Id
File size: 25.8 KB
Line 
1!> @file data_output_3d.f90
2!------------------------------------------------------------------------------!
3! This file is part of PALM.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! 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-2017 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: data_output_3d.f90 2292 2017-06-20 09:51:42Z Giersch $
27! Implementation of new microphysic scheme: cloud_scheme = 'morrison'
28! includes two more prognostic equations for cloud drop concentration (nc) 
29! and cloud water content (qc).
30!
31! 2233 2017-05-30 18:08:54Z suehring
32!
33! 2232 2017-05-30 17:47:52Z suehring
34! Adjustments to new topography concept
35!
36! 2209 2017-04-19 09:34:46Z kanani
37! Added plant canopy model output
38!
39! 2031 2016-10-21 15:11:58Z knoop
40! renamed variable rho to rho_ocean and rho_av to rho_ocean_av
41!
42! 2011 2016-09-19 17:29:57Z kanani
43! Flag urban_surface is now defined in module control_parameters,
44! changed prefix for urban surface model output to "usm_",
45! introduced control parameter varnamelength for LEN of trimvar.
46!
47! 2007 2016-08-24 15:47:17Z kanani
48! Added support for new urban surface model (temporary modifications of
49! SELECT CASE ( ) necessary, see variable trimvar)
50!
51! 2000 2016-08-20 18:09:15Z knoop
52! Forced header and separation lines into 80 columns
53!
54! 1980 2016-07-29 15:51:57Z suehring
55! Bugfix, in order to steer user-defined output, setting flag found explicitly
56! to .F.
57!
58! 1976 2016-07-27 13:28:04Z maronga
59! Output of radiation quantities is now done directly in the respective module
60!
61! 1972 2016-07-26 07:52:02Z maronga
62! Output of land surface quantities is now done directly in the respective module.
63! Unnecessary directive __parallel removed.
64!
65! 1960 2016-07-12 16:34:24Z suehring
66! Scalar surface flux added
67!
68! 1849 2016-04-08 11:33:18Z hoffmann
69! prr moved to arrays_3d
70!
71! 1822 2016-04-07 07:49:42Z hoffmann
72! prr vertical dimensions set to nzb_do to nzt_do. Unused variables deleted.
73!
74! 1808 2016-04-05 19:44:00Z raasch
75! test output removed
76!
77! 1783 2016-03-06 18:36:17Z raasch
78! name change of netcdf routines and module + related changes
79!
80! 1745 2016-02-05 13:06:51Z gronemeier
81! Bugfix: test if time axis limit exceeds moved to point after call of check_open
82!
83! 1691 2015-10-26 16:17:44Z maronga
84! Added output of radiative heating rates for RRTMG
85!
86! 1682 2015-10-07 23:56:08Z knoop
87! Code annotations made doxygen readable
88!
89! 1585 2015-04-30 07:05:52Z maronga
90! Added support for RRTMG
91!
92! 1551 2015-03-03 14:18:16Z maronga
93! Added suppport for land surface model and radiation model output. In the course
94! of this action, the limits for vertical loops have been changed (from nzb and
95! nzt+1 to nzb_do and nzt_do, respectively in order to allow soil model output).
96! Moreover, a new vertical grid zs was introduced.
97!
98! 1359 2014-04-11 17:15:14Z hoffmann
99! New particle structure integrated.
100!
101! 1353 2014-04-08 15:21:23Z heinze
102! REAL constants provided with KIND-attribute
103!
104! 1327 2014-03-21 11:00:16Z raasch
105! parts concerning avs output removed,
106! -netcdf output queries
107!
108! 1320 2014-03-20 08:40:49Z raasch
109! ONLY-attribute added to USE-statements,
110! kind-parameters added to all INTEGER and REAL declaration statements,
111! kinds are defined in new module kinds,
112! old module precision_kind is removed,
113! revision history before 2012 removed,
114! comment fields (!:) to be used for variable explanations added to
115! all variable declaration statements
116!
117! 1318 2014-03-17 13:35:16Z raasch
118! barrier argument removed from cpu_log,
119! module interfaces removed
120!
121! 1308 2014-03-13 14:58:42Z fricke
122! Check, if the limit of the time dimension is exceeded for parallel output
123! To increase the performance for parallel output, the following is done:
124! - Update of time axis is only done by PE0
125!
126! 1244 2013-10-31 08:16:56Z raasch
127! Bugfix for index bounds in case of 3d-parallel output
128!
129! 1115 2013-03-26 18:16:16Z hoffmann
130! ql is calculated by calc_liquid_water_content
131!
132! 1106 2013-03-04 05:31:38Z raasch
133! array_kind renamed precision_kind
134!
135! 1076 2012-12-05 08:30:18Z hoffmann
136! Bugfix in output of ql
137!
138! 1053 2012-11-13 17:11:03Z hoffmann
139! +nr, qr, prr, qc and averaged quantities
140!
141! 1036 2012-10-22 13:43:42Z raasch
142! code put under GPL (PALM 3.9)
143!
144! 1031 2012-10-19 14:35:30Z raasch
145! netCDF4 without parallel file support implemented
146!
147! 1007 2012-09-19 14:30:36Z franke
148! Bugfix: missing calculation of ql_vp added
149!
150! Revision 1.1  1997/09/03 06:29:36  raasch
151! Initial revision
152!
153!
154! Description:
155! ------------
156!> Output of the 3D-arrays in netCDF and/or AVS format.
157!------------------------------------------------------------------------------!
158 SUBROUTINE data_output_3d( av )
159 
160
161    USE arrays_3d,                                                             &
162        ONLY:  e, nc, nr, p, pt, prr, q, qc, ql, ql_c, ql_v, qr, rho_ocean, s, &
163               sa, tend, u, v, vpt, w
164       
165    USE averaging
166       
167    USE cloud_parameters,                                                      &
168        ONLY:  l_d_cp, pt_d_t
169       
170    USE control_parameters,                                                    &
171        ONLY:  cloud_physics, do3d, do3d_no, do3d_time_count, io_blocks,       &
172               io_group, land_surface, message_string, ntdim_3d, nz_do3d,      &
173               psolver, simulated_time, time_since_reference_point,            &
174               urban_surface, varnamelength
175       
176    USE cpulog,                                                                &
177        ONLY:  log_point, cpu_log
178       
179    USE indices,                                                               &
180        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb
181       
182    USE kinds
183   
184    USE land_surface_model_mod,                                                &
185        ONLY: lsm_data_output_3d, nzb_soil, nzt_soil
186
187#if defined( __netcdf )
188    USE NETCDF
189#endif
190
191    USE netcdf_interface,                                                      &
192        ONLY:  id_set_3d, id_var_do3d, id_var_time_3d, nc_stat,                &
193               netcdf_data_format, netcdf_handle_error
194       
195    USE particle_attributes,                                                   &
196        ONLY:  grid_particles, number_of_particles, particles,                 &
197               particle_advection_start, prt_count
198       
199    USE pegrid
200
201    USE plant_canopy_model_mod,                                                &
202        ONLY:  pcm_data_output_3d, plant_canopy
203       
204    USE radiation_model_mod,                                                   &
205        ONLY:  radiation, radiation_data_output_3d
206
207    USE urban_surface_mod,                                                     &
208        ONLY:  nzub, nzut, usm_data_output_3d
209
210
211    IMPLICIT NONE
212
213    INTEGER(iwp) ::  av        !<
214    INTEGER(iwp) ::  i         !<
215    INTEGER(iwp) ::  if        !<
216    INTEGER(iwp) ::  j         !<
217    INTEGER(iwp) ::  k         !<
218    INTEGER(iwp) ::  n         !<
219    INTEGER(iwp) ::  nzb_do    !< vertical lower limit for data output
220    INTEGER(iwp) ::  nzt_do    !< vertical upper limit for data output
221
222    LOGICAL      ::  found     !<
223    LOGICAL      ::  resorted  !<
224
225    REAL(wp)     ::  mean_r    !<
226    REAL(wp)     ::  s_r2      !<
227    REAL(wp)     ::  s_r3      !<
228
229    REAL(sp), DIMENSION(:,:,:), ALLOCATABLE ::  local_pf  !<
230
231    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !<
232
233    CHARACTER (LEN=varnamelength) ::  trimvar  !< TRIM of output-variable string
234
235!
236!-- Return, if nothing to output
237    IF ( do3d_no(av) == 0 )  RETURN
238
239    CALL cpu_log (log_point(14),'data_output_3d','start')
240
241!
242!-- Open output file.
243!-- Also creates coordinate and fld-file for AVS.
244!-- For classic or 64bit netCDF output or output of other (old) data formats,
245!-- for a run on more than one PE, each PE opens its own file and
246!-- writes the data of its subdomain in binary format (regardless of the format
247!-- the user has requested). After the run, these files are combined to one
248!-- file by combine_plot_fields in the format requested by the user (netcdf
249!-- and/or avs).
250!-- For netCDF4/HDF5 output, data is written in parallel into one file.
251    IF ( netcdf_data_format < 5 )  THEN
252       CALL check_open( 30 )
253       IF ( myid == 0 )  CALL check_open( 106+av*10 )
254    ELSE
255       CALL check_open( 106+av*10 )
256    ENDIF
257
258!
259!-- For parallel netcdf output the time axis must be limited. Return, if this
260!-- limit is exceeded. This could be the case, if the simulated time exceeds
261!-- the given end time by the length of the given output interval.
262    IF ( netcdf_data_format > 4 )  THEN
263       IF ( do3d_time_count(av) + 1 > ntdim_3d(av) )  THEN
264          WRITE ( message_string, * ) 'Output of 3d data is not given at t=',  &
265                                      simulated_time, '&because the maximum ', & 
266                                      'number of output time levels is ',      &
267                                      'exceeded.'
268          CALL message( 'data_output_3d', 'PA0387', 0, 1, 0, 6, 0 )
269          CALL cpu_log( log_point(14), 'data_output_3d', 'stop' )
270          RETURN
271       ENDIF
272    ENDIF
273
274!
275!-- Update the netCDF time axis
276!-- In case of parallel output, this is only done by PE0 to increase the
277!-- performance.
278#if defined( __netcdf )
279    do3d_time_count(av) = do3d_time_count(av) + 1
280    IF ( myid == 0 )  THEN
281       nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_time_3d(av),           &
282                               (/ time_since_reference_point /),            &
283                               start = (/ do3d_time_count(av) /),           &
284                               count = (/ 1 /) )
285       CALL netcdf_handle_error( 'data_output_3d', 376 )
286    ENDIF
287#endif
288
289!
290!-- Loop over all variables to be written.
291    if = 1
292
293    DO  WHILE ( do3d(av,if)(1:1) /= ' ' )
294
295!
296!--    Temporary solution to account for data output within the new urban
297!--    surface model (urban_surface_mod.f90), see also SELECT CASE ( trimvar ).
298!--    Store the array chosen on the temporary array.
299       trimvar = TRIM( do3d(av,if) )
300       IF ( urban_surface  .AND.  trimvar(1:4) == 'usm_' )  THEN
301          trimvar = 'usm_output'
302          resorted = .TRUE.
303          nzb_do   = nzub
304          nzt_do   = nzut
305       ELSE
306          resorted = .FALSE.
307          nzb_do   = nzb
308          nzt_do   = nz_do3d
309       ENDIF
310!
311!--    Set flag to steer output of radiation, land-surface, or user-defined
312!--    quantities
313       found = .FALSE.
314!
315!--    Allocate a temporary array with the desired output dimensions.
316       ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb_do:nzt_do) )
317
318       SELECT CASE ( trimvar )
319
320          CASE ( 'e' )
321             IF ( av == 0 )  THEN
322                to_be_resorted => e
323             ELSE
324                to_be_resorted => e_av
325             ENDIF
326
327          CASE ( 'lpt' )
328             IF ( av == 0 )  THEN
329                to_be_resorted => pt
330             ELSE
331                to_be_resorted => lpt_av
332             ENDIF
333
334          CASE ( 'nc' )
335             IF ( av == 0 )  THEN
336                to_be_resorted => nc
337             ELSE
338                to_be_resorted => nc_av
339             ENDIF
340
341          CASE ( 'nr' )
342             IF ( av == 0 )  THEN
343                to_be_resorted => nr
344             ELSE
345                to_be_resorted => nr_av
346             ENDIF
347
348          CASE ( 'p' )
349             IF ( av == 0 )  THEN
350                IF ( psolver /= 'sor' )  CALL exchange_horiz( p, nbgp )
351                to_be_resorted => p
352             ELSE
353                IF ( psolver /= 'sor' )  CALL exchange_horiz( p_av, nbgp )
354                to_be_resorted => p_av
355             ENDIF
356
357          CASE ( 'pc' )  ! particle concentration (requires ghostpoint exchange)
358             IF ( av == 0 )  THEN
359                IF ( simulated_time >= particle_advection_start )  THEN
360                   tend = prt_count
361                   CALL exchange_horiz( tend, nbgp )
362                ELSE
363                   tend = 0.0_wp
364                ENDIF
365                DO  i = nxlg, nxrg
366                   DO  j = nysg, nyng
367                      DO  k = nzb_do, nzt_do
368                         local_pf(i,j,k) = tend(k,j,i)
369                      ENDDO
370                   ENDDO
371                ENDDO
372                resorted = .TRUE.
373             ELSE
374                CALL exchange_horiz( pc_av, nbgp )
375                to_be_resorted => pc_av
376             ENDIF
377
378          CASE ( 'pr' )  ! mean particle radius (effective radius)
379             IF ( av == 0 )  THEN
380                IF ( simulated_time >= particle_advection_start )  THEN
381                   DO  i = nxl, nxr
382                      DO  j = nys, nyn
383                         DO  k = nzb_do, nzt_do
384                            number_of_particles = prt_count(k,j,i)
385                            IF (number_of_particles <= 0)  CYCLE
386                            particles => grid_particles(k,j,i)%particles(1:number_of_particles)
387                            s_r2 = 0.0_wp
388                            s_r3 = 0.0_wp
389                            DO  n = 1, number_of_particles
390                               IF ( particles(n)%particle_mask )  THEN
391                                  s_r2 = s_r2 + particles(n)%radius**2 * &
392                                         particles(n)%weight_factor
393                                  s_r3 = s_r3 + particles(n)%radius**3 * &
394                                         particles(n)%weight_factor
395                               ENDIF
396                            ENDDO
397                            IF ( s_r2 > 0.0_wp )  THEN
398                               mean_r = s_r3 / s_r2
399                            ELSE
400                               mean_r = 0.0_wp
401                            ENDIF
402                            tend(k,j,i) = mean_r
403                         ENDDO
404                      ENDDO
405                   ENDDO
406                   CALL exchange_horiz( tend, nbgp )
407                ELSE
408                   tend = 0.0_wp
409                ENDIF
410                DO  i = nxlg, nxrg
411                   DO  j = nysg, nyng
412                      DO  k = nzb_do, nzt_do
413                         local_pf(i,j,k) = tend(k,j,i)
414                      ENDDO
415                   ENDDO
416                ENDDO
417                resorted = .TRUE.
418             ELSE
419                CALL exchange_horiz( pr_av, nbgp )
420                to_be_resorted => pr_av
421             ENDIF
422
423          CASE ( 'prr' )
424             IF ( av == 0 )  THEN
425                CALL exchange_horiz( prr, nbgp )
426                DO  i = nxlg, nxrg
427                   DO  j = nysg, nyng
428                      DO  k = nzb_do, nzt_do
429                         local_pf(i,j,k) = prr(k,j,i)
430                      ENDDO
431                   ENDDO
432                ENDDO
433             ELSE
434                CALL exchange_horiz( prr_av, nbgp )
435                DO  i = nxlg, nxrg
436                   DO  j = nysg, nyng
437                      DO  k = nzb_do, nzt_do
438                         local_pf(i,j,k) = prr_av(k,j,i)
439                      ENDDO
440                   ENDDO
441                ENDDO
442             ENDIF
443             resorted = .TRUE.
444
445          CASE ( 'pt' )
446             IF ( av == 0 )  THEN
447                IF ( .NOT. cloud_physics ) THEN
448                   to_be_resorted => pt
449                ELSE
450                   DO  i = nxlg, nxrg
451                      DO  j = nysg, nyng
452                         DO  k = nzb_do, nzt_do
453                            local_pf(i,j,k) = pt(k,j,i) + l_d_cp *             &
454                                                          pt_d_t(k) *          &
455                                                          ql(k,j,i)
456                         ENDDO
457                      ENDDO
458                   ENDDO
459                   resorted = .TRUE.
460                ENDIF
461             ELSE
462                to_be_resorted => pt_av
463             ENDIF
464
465          CASE ( 'q' )
466             IF ( av == 0 )  THEN
467                to_be_resorted => q
468             ELSE
469                to_be_resorted => q_av
470             ENDIF
471
472          CASE ( 'qc' )
473             IF ( av == 0 )  THEN
474                to_be_resorted => qc
475             ELSE
476                to_be_resorted => qc_av
477             ENDIF
478
479          CASE ( 'ql' )
480             IF ( av == 0 )  THEN
481                to_be_resorted => ql
482             ELSE
483                to_be_resorted => ql_av
484             ENDIF
485
486          CASE ( 'ql_c' )
487             IF ( av == 0 )  THEN
488                to_be_resorted => ql_c
489             ELSE
490                to_be_resorted => ql_c_av
491             ENDIF
492
493          CASE ( 'ql_v' )
494             IF ( av == 0 )  THEN
495                to_be_resorted => ql_v
496             ELSE
497                to_be_resorted => ql_v_av
498             ENDIF
499
500          CASE ( 'ql_vp' )
501             IF ( av == 0 )  THEN
502                IF ( simulated_time >= particle_advection_start )  THEN
503                   DO  i = nxl, nxr
504                      DO  j = nys, nyn
505                         DO  k = nzb_do, nzt_do
506                            number_of_particles = prt_count(k,j,i)
507                            IF (number_of_particles <= 0)  CYCLE
508                            particles => grid_particles(k,j,i)%particles(1:number_of_particles)
509                            DO  n = 1, number_of_particles
510                               IF ( particles(n)%particle_mask )  THEN
511                                  tend(k,j,i) =  tend(k,j,i) +                 &
512                                                 particles(n)%weight_factor /  &
513                                                 prt_count(k,j,i)
514                               ENDIF
515                            ENDDO
516                         ENDDO
517                      ENDDO
518                   ENDDO
519                   CALL exchange_horiz( tend, nbgp )
520                ELSE
521                   tend = 0.0_wp
522                ENDIF
523                DO  i = nxlg, nxrg
524                   DO  j = nysg, nyng
525                      DO  k = nzb_do, nzt_do
526                         local_pf(i,j,k) = tend(k,j,i)
527                      ENDDO
528                   ENDDO
529                ENDDO
530                resorted = .TRUE.
531             ELSE
532                CALL exchange_horiz( ql_vp_av, nbgp )
533                to_be_resorted => ql_vp_av
534             ENDIF
535
536          CASE ( 'qr' )
537             IF ( av == 0 )  THEN
538                to_be_resorted => qr
539             ELSE
540                to_be_resorted => qr_av
541             ENDIF
542
543          CASE ( 'qv' )
544             IF ( av == 0 )  THEN
545                DO  i = nxlg, nxrg
546                   DO  j = nysg, nyng
547                      DO  k = nzb_do, nzt_do
548                         local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
549                      ENDDO
550                   ENDDO
551                ENDDO
552                resorted = .TRUE.
553             ELSE
554                to_be_resorted => qv_av
555             ENDIF
556
557          CASE ( 'rho_ocean' )
558             IF ( av == 0 )  THEN
559                to_be_resorted => rho_ocean
560             ELSE
561                to_be_resorted => rho_ocean_av
562             ENDIF
563
564          CASE ( 's' )
565             IF ( av == 0 )  THEN
566                to_be_resorted => s
567             ELSE
568                to_be_resorted => s_av
569             ENDIF
570
571          CASE ( 'sa' )
572             IF ( av == 0 )  THEN
573                to_be_resorted => sa
574             ELSE
575                to_be_resorted => sa_av
576             ENDIF
577
578          CASE ( 'u' )
579             IF ( av == 0 )  THEN
580                to_be_resorted => u
581             ELSE
582                to_be_resorted => u_av
583             ENDIF
584
585          CASE ( 'v' )
586             IF ( av == 0 )  THEN
587                to_be_resorted => v
588             ELSE
589                to_be_resorted => v_av
590             ENDIF
591
592          CASE ( 'vpt' )
593             IF ( av == 0 )  THEN
594                to_be_resorted => vpt
595             ELSE
596                to_be_resorted => vpt_av
597             ENDIF
598
599          CASE ( 'w' )
600             IF ( av == 0 )  THEN
601                to_be_resorted => w
602             ELSE
603                to_be_resorted => w_av
604             ENDIF
605!             
606!--       Block of urban surface model outputs   
607          CASE ( 'usm_output' )
608             CALL usm_data_output_3d( av, do3d(av,if), found, local_pf,     &
609                                         nzb_do, nzt_do )
610
611          CASE DEFAULT
612
613!
614!--          Land surface quantity
615             IF ( land_surface )  THEN
616!
617!--             For soil model quantities, it is required to re-allocate local_pf
618                nzb_do = nzb_soil
619                nzt_do = nzt_soil
620
621                DEALLOCATE ( local_pf )
622                ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb_do:nzt_do) )
623
624                CALL lsm_data_output_3d( av, do3d(av,if), found, local_pf )
625                resorted = .TRUE.
626
627!
628!--             If no soil model variable was found, re-allocate local_pf
629                IF ( .NOT. found )  THEN
630                   nzb_do = nzb
631                   nzt_do = nz_do3d
632
633                   DEALLOCATE ( local_pf )
634                   ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb_do:nzt_do) )                 
635                ENDIF
636
637             ENDIF
638
639!
640!--          Radiation quantity
641             IF ( .NOT. found  .AND.  radiation )  THEN
642                CALL radiation_data_output_3d( av, do3d(av,if), found,         &
643                                               local_pf )
644                resorted = .TRUE.
645             ENDIF
646
647!
648!--          Plant canopy model output
649             IF ( .NOT. found  .AND.  plant_canopy )  THEN
650                CALL pcm_data_output_3d( av, do3d(av,if), found,         &
651                                               local_pf )
652                resorted = .TRUE.
653             ENDIF
654
655!
656!--          User defined quantity
657             IF ( .NOT. found )  THEN
658                CALL user_data_output_3d( av, do3d(av,if), found, local_pf,    &
659                                          nzb_do, nzt_do )
660                resorted = .TRUE.
661             ENDIF
662
663             IF ( .NOT. found )  THEN
664                message_string =  'no output available for: ' //               &
665                                  TRIM( do3d(av,if) )
666                CALL message( 'data_output_3d', 'PA0182', 0, 0, 0, 6, 0 )
667             ENDIF
668
669       END SELECT
670
671!
672!--    Resort the array to be output, if not done above
673       IF ( .NOT. resorted )  THEN
674          DO  i = nxlg, nxrg
675             DO  j = nysg, nyng
676                DO  k = nzb_do, nzt_do
677                   local_pf(i,j,k) = to_be_resorted(k,j,i)
678                ENDDO
679             ENDDO
680          ENDDO
681       ENDIF
682
683!
684!--    Output of the 3D-array
685#if defined( __parallel )
686       IF ( netcdf_data_format < 5 )  THEN
687!
688!--       Non-parallel netCDF output. Data is output in parallel in
689!--       FORTRAN binary format here, and later collected into one file by
690!--       combine_plot_fields
691          IF ( myid == 0 )  THEN
692             WRITE ( 30 )  time_since_reference_point,                   &
693                           do3d_time_count(av), av
694          ENDIF
695          DO  i = 0, io_blocks-1
696             IF ( i == io_group )  THEN
697                WRITE ( 30 )  nxlg, nxrg, nysg, nyng, nzb_do, nzt_do
698                WRITE ( 30 )  local_pf(:,:,nzb_do:nzt_do)
699             ENDIF
700
701             CALL MPI_BARRIER( comm2d, ierr )
702
703          ENDDO
704
705       ELSE
706#if defined( __netcdf )
707!
708!--       Parallel output in netCDF4/HDF5 format.
709!--       Do not output redundant ghost point data except for the
710!--       boundaries of the total domain.
711          IF ( nxr == nx  .AND.  nyn /= ny )  THEN
712             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),  &
713                               local_pf(nxl:nxr+1,nys:nyn,nzb_do:nzt_do),    &
714                start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /),  &
715                count = (/ nxr-nxl+2, nyn-nys+1, nzt_do-nzb_do+1, 1 /) )
716          ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
717             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),  &
718                               local_pf(nxl:nxr,nys:nyn+1,nzb_do:nzt_do),    &
719                start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /),  &
720                count = (/ nxr-nxl+1, nyn-nys+2, nzt_do-nzb_do+1, 1 /) )
721          ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
722             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),  &
723                             local_pf(nxl:nxr+1,nys:nyn+1,nzb_do:nzt_do  ),  &
724                start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /),  &
725                count = (/ nxr-nxl+2, nyn-nys+2, nzt_do-nzb_do+1, 1 /) )
726          ELSE
727             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),  &
728                                 local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do),    &
729                start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /),  &
730                count = (/ nxr-nxl+1, nyn-nys+1, nzt_do-nzb_do+1, 1 /) )
731          ENDIF
732          CALL netcdf_handle_error( 'data_output_3d', 386 )
733#endif
734       ENDIF
735#else
736#if defined( __netcdf )
737       nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),        &
738                         local_pf(nxl:nxr+1,nys:nyn+1,nzb_do:nzt_do),        &
739                         start = (/ 1, 1, 1, do3d_time_count(av) /),     &
740                         count = (/ nx+2, ny+2, nzt_do-nzb_do+1, 1 /) )
741       CALL netcdf_handle_error( 'data_output_3d', 446 )
742#endif
743#endif
744
745       if = if + 1
746
747!
748!--    Deallocate temporary array
749       DEALLOCATE ( local_pf )
750
751    ENDDO
752
753    CALL cpu_log( log_point(14), 'data_output_3d', 'stop' )
754
755!
756!-- Formats.
7573300 FORMAT ('variable ',I4,'  file=',A,'  filetype=unformatted  skip=',I12/   &
758             'label = ',A,A)
759
760 END SUBROUTINE data_output_3d
Note: See TracBrowser for help on using the repository browser.