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

Last change on this file since 2184 was 2101, checked in by suehring, 8 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 24.9 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 2101 2017-01-05 16:42:31Z raasch $
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 radiation_model_mod,                                                   &
191        ONLY:  radiation, radiation_data_output_3d
192
193    USE urban_surface_mod,                                                     &
194        ONLY:  nzub, nzut, usm_data_output_3d
195
196
197    IMPLICIT NONE
198
199    INTEGER(iwp) ::  av        !<
200    INTEGER(iwp) ::  i         !<
201    INTEGER(iwp) ::  if        !<
202    INTEGER(iwp) ::  j         !<
203    INTEGER(iwp) ::  k         !<
204    INTEGER(iwp) ::  n         !<
205    INTEGER(iwp) ::  nzb_do    !< vertical lower limit for data output
206    INTEGER(iwp) ::  nzt_do    !< vertical upper limit for data output
207
208    LOGICAL      ::  found     !<
209    LOGICAL      ::  resorted  !<
210
211    REAL(wp)     ::  mean_r    !<
212    REAL(wp)     ::  s_r2      !<
213    REAL(wp)     ::  s_r3      !<
214
215    REAL(sp), DIMENSION(:,:,:), ALLOCATABLE ::  local_pf  !<
216
217    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !<
218
219    CHARACTER (LEN=varnamelength) ::  trimvar  !< TRIM of output-variable string
220
221!
222!-- Return, if nothing to output
223    IF ( do3d_no(av) == 0 )  RETURN
224
225    CALL cpu_log (log_point(14),'data_output_3d','start')
226
227!
228!-- Open output file.
229!-- Also creates coordinate and fld-file for AVS.
230!-- For classic or 64bit netCDF output or output of other (old) data formats,
231!-- for a run on more than one PE, each PE opens its own file and
232!-- writes the data of its subdomain in binary format (regardless of the format
233!-- the user has requested). After the run, these files are combined to one
234!-- file by combine_plot_fields in the format requested by the user (netcdf
235!-- and/or avs).
236!-- For netCDF4/HDF5 output, data is written in parallel into one file.
237    IF ( netcdf_data_format < 5 )  THEN
238       CALL check_open( 30 )
239       IF ( myid == 0 )  CALL check_open( 106+av*10 )
240    ELSE
241       CALL check_open( 106+av*10 )
242    ENDIF
243
244!
245!-- For parallel netcdf output the time axis must be limited. Return, if this
246!-- limit is exceeded. This could be the case, if the simulated time exceeds
247!-- the given end time by the length of the given output interval.
248    IF ( netcdf_data_format > 4 )  THEN
249       IF ( do3d_time_count(av) + 1 > ntdim_3d(av) )  THEN
250          WRITE ( message_string, * ) 'Output of 3d data is not given at t=',  &
251                                      simulated_time, '&because the maximum ', & 
252                                      'number of output time levels is ',      &
253                                      'exceeded.'
254          CALL message( 'data_output_3d', 'PA0387', 0, 1, 0, 6, 0 )
255          CALL cpu_log( log_point(14), 'data_output_3d', 'stop' )
256          RETURN
257       ENDIF
258    ENDIF
259
260!
261!-- Update the netCDF time axis
262!-- In case of parallel output, this is only done by PE0 to increase the
263!-- performance.
264#if defined( __netcdf )
265    do3d_time_count(av) = do3d_time_count(av) + 1
266    IF ( myid == 0 )  THEN
267       nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_time_3d(av),           &
268                               (/ time_since_reference_point /),            &
269                               start = (/ do3d_time_count(av) /),           &
270                               count = (/ 1 /) )
271       CALL netcdf_handle_error( 'data_output_3d', 376 )
272    ENDIF
273#endif
274
275!
276!-- Loop over all variables to be written.
277    if = 1
278
279    DO  WHILE ( do3d(av,if)(1:1) /= ' ' )
280
281!
282!--    Temporary solution to account for data output within the new urban
283!--    surface model (urban_surface_mod.f90), see also SELECT CASE ( trimvar ).
284!--    Store the array chosen on the temporary array.
285       trimvar = TRIM( do3d(av,if) )
286       IF ( urban_surface  .AND.  trimvar(1:4) == 'usm_' )  THEN
287          trimvar = 'usm_output'
288          resorted = .TRUE.
289          nzb_do   = nzub
290          nzt_do   = nzut
291       ELSE
292          resorted = .FALSE.
293          nzb_do   = nzb
294          nzt_do   = nz_do3d
295       ENDIF
296!
297!--    Set flag to steer output of radiation, land-surface, or user-defined
298!--    quantities
299       found = .FALSE.
300!
301!--    Allocate a temporary array with the desired output dimensions.
302       ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb_do:nzt_do) )
303
304       SELECT CASE ( trimvar )
305
306          CASE ( 'e' )
307             IF ( av == 0 )  THEN
308                to_be_resorted => e
309             ELSE
310                to_be_resorted => e_av
311             ENDIF
312
313          CASE ( 'lpt' )
314             IF ( av == 0 )  THEN
315                to_be_resorted => pt
316             ELSE
317                to_be_resorted => lpt_av
318             ENDIF
319
320          CASE ( 'nr' )
321             IF ( av == 0 )  THEN
322                to_be_resorted => nr
323             ELSE
324                to_be_resorted => nr_av
325             ENDIF
326
327          CASE ( 'p' )
328             IF ( av == 0 )  THEN
329                IF ( psolver /= 'sor' )  CALL exchange_horiz( p, nbgp )
330                to_be_resorted => p
331             ELSE
332                IF ( psolver /= 'sor' )  CALL exchange_horiz( p_av, nbgp )
333                to_be_resorted => p_av
334             ENDIF
335
336          CASE ( 'pc' )  ! particle concentration (requires ghostpoint exchange)
337             IF ( av == 0 )  THEN
338                IF ( simulated_time >= particle_advection_start )  THEN
339                   tend = prt_count
340                   CALL exchange_horiz( tend, nbgp )
341                ELSE
342                   tend = 0.0_wp
343                ENDIF
344                DO  i = nxlg, nxrg
345                   DO  j = nysg, nyng
346                      DO  k = nzb_do, nzt_do
347                         local_pf(i,j,k) = tend(k,j,i)
348                      ENDDO
349                   ENDDO
350                ENDDO
351                resorted = .TRUE.
352             ELSE
353                CALL exchange_horiz( pc_av, nbgp )
354                to_be_resorted => pc_av
355             ENDIF
356
357          CASE ( 'pr' )  ! mean particle radius (effective radius)
358             IF ( av == 0 )  THEN
359                IF ( simulated_time >= particle_advection_start )  THEN
360                   DO  i = nxl, nxr
361                      DO  j = nys, nyn
362                         DO  k = nzb_do, nzt_do
363                            number_of_particles = prt_count(k,j,i)
364                            IF (number_of_particles <= 0)  CYCLE
365                            particles => grid_particles(k,j,i)%particles(1:number_of_particles)
366                            s_r2 = 0.0_wp
367                            s_r3 = 0.0_wp
368                            DO  n = 1, number_of_particles
369                               IF ( particles(n)%particle_mask )  THEN
370                                  s_r2 = s_r2 + particles(n)%radius**2 * &
371                                         particles(n)%weight_factor
372                                  s_r3 = s_r3 + particles(n)%radius**3 * &
373                                         particles(n)%weight_factor
374                               ENDIF
375                            ENDDO
376                            IF ( s_r2 > 0.0_wp )  THEN
377                               mean_r = s_r3 / s_r2
378                            ELSE
379                               mean_r = 0.0_wp
380                            ENDIF
381                            tend(k,j,i) = mean_r
382                         ENDDO
383                      ENDDO
384                   ENDDO
385                   CALL exchange_horiz( tend, nbgp )
386                ELSE
387                   tend = 0.0_wp
388                ENDIF
389                DO  i = nxlg, nxrg
390                   DO  j = nysg, nyng
391                      DO  k = nzb_do, nzt_do
392                         local_pf(i,j,k) = tend(k,j,i)
393                      ENDDO
394                   ENDDO
395                ENDDO
396                resorted = .TRUE.
397             ELSE
398                CALL exchange_horiz( pr_av, nbgp )
399                to_be_resorted => pr_av
400             ENDIF
401
402          CASE ( 'prr' )
403             IF ( av == 0 )  THEN
404                CALL exchange_horiz( prr, nbgp )
405                DO  i = nxlg, nxrg
406                   DO  j = nysg, nyng
407                      DO  k = nzb_do, nzt_do
408                         local_pf(i,j,k) = prr(k,j,i)
409                      ENDDO
410                   ENDDO
411                ENDDO
412             ELSE
413                CALL exchange_horiz( prr_av, 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_av(k,j,i)
418                      ENDDO
419                   ENDDO
420                ENDDO
421             ENDIF
422             resorted = .TRUE.
423
424          CASE ( 'pt' )
425             IF ( av == 0 )  THEN
426                IF ( .NOT. cloud_physics ) THEN
427                   to_be_resorted => pt
428                ELSE
429                   DO  i = nxlg, nxrg
430                      DO  j = nysg, nyng
431                         DO  k = nzb_do, nzt_do
432                            local_pf(i,j,k) = pt(k,j,i) + l_d_cp *             &
433                                                          pt_d_t(k) *          &
434                                                          ql(k,j,i)
435                         ENDDO
436                      ENDDO
437                   ENDDO
438                   resorted = .TRUE.
439                ENDIF
440             ELSE
441                to_be_resorted => pt_av
442             ENDIF
443
444          CASE ( 'q' )
445             IF ( av == 0 )  THEN
446                to_be_resorted => q
447             ELSE
448                to_be_resorted => q_av
449             ENDIF
450
451          CASE ( 'qc' )
452             IF ( av == 0 )  THEN
453                to_be_resorted => qc
454             ELSE
455                to_be_resorted => qc_av
456             ENDIF
457
458          CASE ( 'ql' )
459             IF ( av == 0 )  THEN
460                to_be_resorted => ql
461             ELSE
462                to_be_resorted => ql_av
463             ENDIF
464
465          CASE ( 'ql_c' )
466             IF ( av == 0 )  THEN
467                to_be_resorted => ql_c
468             ELSE
469                to_be_resorted => ql_c_av
470             ENDIF
471
472          CASE ( 'ql_v' )
473             IF ( av == 0 )  THEN
474                to_be_resorted => ql_v
475             ELSE
476                to_be_resorted => ql_v_av
477             ENDIF
478
479          CASE ( 'ql_vp' )
480             IF ( av == 0 )  THEN
481                IF ( simulated_time >= particle_advection_start )  THEN
482                   DO  i = nxl, nxr
483                      DO  j = nys, nyn
484                         DO  k = nzb_do, nzt_do
485                            number_of_particles = prt_count(k,j,i)
486                            IF (number_of_particles <= 0)  CYCLE
487                            particles => grid_particles(k,j,i)%particles(1:number_of_particles)
488                            DO  n = 1, number_of_particles
489                               IF ( particles(n)%particle_mask )  THEN
490                                  tend(k,j,i) =  tend(k,j,i) +                 &
491                                                 particles(n)%weight_factor /  &
492                                                 prt_count(k,j,i)
493                               ENDIF
494                            ENDDO
495                         ENDDO
496                      ENDDO
497                   ENDDO
498                   CALL exchange_horiz( tend, nbgp )
499                ELSE
500                   tend = 0.0_wp
501                ENDIF
502                DO  i = nxlg, nxrg
503                   DO  j = nysg, nyng
504                      DO  k = nzb_do, nzt_do
505                         local_pf(i,j,k) = tend(k,j,i)
506                      ENDDO
507                   ENDDO
508                ENDDO
509                resorted = .TRUE.
510             ELSE
511                CALL exchange_horiz( ql_vp_av, nbgp )
512                to_be_resorted => ql_vp_av
513             ENDIF
514
515          CASE ( 'qr' )
516             IF ( av == 0 )  THEN
517                to_be_resorted => qr
518             ELSE
519                to_be_resorted => qr_av
520             ENDIF
521
522          CASE ( 'qv' )
523             IF ( av == 0 )  THEN
524                DO  i = nxlg, nxrg
525                   DO  j = nysg, nyng
526                      DO  k = nzb_do, nzt_do
527                         local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
528                      ENDDO
529                   ENDDO
530                ENDDO
531                resorted = .TRUE.
532             ELSE
533                to_be_resorted => qv_av
534             ENDIF
535
536          CASE ( 'rho_ocean' )
537             IF ( av == 0 )  THEN
538                to_be_resorted => rho_ocean
539             ELSE
540                to_be_resorted => rho_ocean_av
541             ENDIF
542
543          CASE ( 's' )
544             IF ( av == 0 )  THEN
545                to_be_resorted => s
546             ELSE
547                to_be_resorted => s_av
548             ENDIF
549
550          CASE ( 'sa' )
551             IF ( av == 0 )  THEN
552                to_be_resorted => sa
553             ELSE
554                to_be_resorted => sa_av
555             ENDIF
556
557          CASE ( 'u' )
558             IF ( av == 0 )  THEN
559                to_be_resorted => u
560             ELSE
561                to_be_resorted => u_av
562             ENDIF
563
564          CASE ( 'v' )
565             IF ( av == 0 )  THEN
566                to_be_resorted => v
567             ELSE
568                to_be_resorted => v_av
569             ENDIF
570
571          CASE ( 'vpt' )
572             IF ( av == 0 )  THEN
573                to_be_resorted => vpt
574             ELSE
575                to_be_resorted => vpt_av
576             ENDIF
577
578          CASE ( 'w' )
579             IF ( av == 0 )  THEN
580                to_be_resorted => w
581             ELSE
582                to_be_resorted => w_av
583             ENDIF
584!             
585!--       Block of urban surface model outputs   
586          CASE ( 'usm_output' )
587             CALL usm_data_output_3d( av, do3d(av,if), found, local_pf,     &
588                                         nzb_do, nzt_do )
589
590          CASE DEFAULT
591
592!
593!--          Land surface quantity
594             IF ( land_surface )  THEN
595!
596!--             For soil model quantities, it is required to re-allocate local_pf
597                nzb_do = nzb_soil
598                nzt_do = nzt_soil
599
600                DEALLOCATE ( local_pf )
601                ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb_do:nzt_do) )
602
603                CALL lsm_data_output_3d( av, do3d(av,if), found, local_pf )
604                resorted = .TRUE.
605
606!
607!--             If no soil model variable was found, re-allocate local_pf
608                IF ( .NOT. found )  THEN
609                   nzb_do = nzb
610                   nzt_do = nz_do3d
611
612                   DEALLOCATE ( local_pf )
613                   ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb_do:nzt_do) )                 
614                ENDIF
615
616             ENDIF
617
618!
619!--          Radiation quantity
620             IF ( .NOT. found  .AND.  radiation )  THEN
621                CALL radiation_data_output_3d( av, do3d(av,if), found,         &
622                                               local_pf )
623                resorted = .TRUE.
624             ENDIF
625
626!
627!--          User defined quantity
628             IF ( .NOT. found )  THEN
629                CALL user_data_output_3d( av, do3d(av,if), found, local_pf,    &
630                                          nzb_do, nzt_do )
631                resorted = .TRUE.
632             ENDIF
633
634             IF ( .NOT. found )  THEN
635                message_string =  'no output available for: ' //               &
636                                  TRIM( do3d(av,if) )
637                CALL message( 'data_output_3d', 'PA0182', 0, 0, 0, 6, 0 )
638             ENDIF
639
640       END SELECT
641
642!
643!--    Resort the array to be output, if not done above
644       IF ( .NOT. resorted )  THEN
645          DO  i = nxlg, nxrg
646             DO  j = nysg, nyng
647                DO  k = nzb_do, nzt_do
648                   local_pf(i,j,k) = to_be_resorted(k,j,i)
649                ENDDO
650             ENDDO
651          ENDDO
652       ENDIF
653
654!
655!--    Output of the 3D-array
656#if defined( __parallel )
657       IF ( netcdf_data_format < 5 )  THEN
658!
659!--       Non-parallel netCDF output. Data is output in parallel in
660!--       FORTRAN binary format here, and later collected into one file by
661!--       combine_plot_fields
662          IF ( myid == 0 )  THEN
663             WRITE ( 30 )  time_since_reference_point,                   &
664                           do3d_time_count(av), av
665          ENDIF
666          DO  i = 0, io_blocks-1
667             IF ( i == io_group )  THEN
668                WRITE ( 30 )  nxlg, nxrg, nysg, nyng, nzb_do, nzt_do
669                WRITE ( 30 )  local_pf(:,:,nzb_do:nzt_do)
670             ENDIF
671
672             CALL MPI_BARRIER( comm2d, ierr )
673
674          ENDDO
675
676       ELSE
677#if defined( __netcdf )
678!
679!--       Parallel output in netCDF4/HDF5 format.
680!--       Do not output redundant ghost point data except for the
681!--       boundaries of the total domain.
682          IF ( nxr == nx  .AND.  nyn /= ny )  THEN
683             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),  &
684                               local_pf(nxl:nxr+1,nys:nyn,nzb_do:nzt_do),    &
685                start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /),  &
686                count = (/ nxr-nxl+2, nyn-nys+1, nzt_do-nzb_do+1, 1 /) )
687          ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
688             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),  &
689                               local_pf(nxl:nxr,nys:nyn+1,nzb_do:nzt_do),    &
690                start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /),  &
691                count = (/ nxr-nxl+1, nyn-nys+2, nzt_do-nzb_do+1, 1 /) )
692          ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
693             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),  &
694                             local_pf(nxl:nxr+1,nys:nyn+1,nzb_do:nzt_do  ),  &
695                start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /),  &
696                count = (/ nxr-nxl+2, nyn-nys+2, nzt_do-nzb_do+1, 1 /) )
697          ELSE
698             nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),  &
699                                 local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do),    &
700                start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /),  &
701                count = (/ nxr-nxl+1, nyn-nys+1, nzt_do-nzb_do+1, 1 /) )
702          ENDIF
703          CALL netcdf_handle_error( 'data_output_3d', 386 )
704#endif
705       ENDIF
706#else
707#if defined( __netcdf )
708       nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if),        &
709                         local_pf(nxl:nxr+1,nys:nyn+1,nzb_do:nzt_do),        &
710                         start = (/ 1, 1, 1, do3d_time_count(av) /),     &
711                         count = (/ nx+2, ny+2, nzt_do-nzb_do+1, 1 /) )
712       CALL netcdf_handle_error( 'data_output_3d', 446 )
713#endif
714#endif
715
716       if = if + 1
717
718!
719!--    Deallocate temporary array
720       DEALLOCATE ( local_pf )
721
722    ENDDO
723
724    CALL cpu_log( log_point(14), 'data_output_3d', 'stop' )
725
726!
727!-- Formats.
7283300 FORMAT ('variable ',I4,'  file=',A,'  filetype=unformatted  skip=',I12/   &
729             'label = ',A,A)
730
731 END SUBROUTINE data_output_3d
Note: See TracBrowser for help on using the repository browser.