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

Last change on this file since 2512 was 2512, checked in by raasch, 4 years ago

upper bounds of cross section and 3d output changed from nx+1,ny+1 to nx,ny; no output if redundant ghost layer data to NetCDF files

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