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

Last change on this file since 2209 was 2209, checked in by kanani, 4 years ago

small bugfix, formatting and new PCM output

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