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

Last change on this file since 1784 was 1784, checked in by raasch, 6 years ago

last commit documented

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