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

Last change on this file since 1952 was 1852, checked in by hoffmann, 8 years ago

last commit documented

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