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

Last change on this file since 1691 was 1691, checked in by maronga, 8 years ago

various bugfixes and modifications of the atmosphere-land-surface-radiation interaction. Completely re-written routine to calculate surface fluxes (surface_layer_fluxes.f90) that replaces prandtl_fluxes. Minor formatting corrections and renamings

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