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

Last change on this file since 1727 was 1692, checked in by maronga, 9 years ago

last commit documented

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