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

Last change on this file since 2233 was 2233, checked in by suehring, 4 years ago

last commit documented

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