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

Last change on this file since 2007 was 2007, checked in by kanani, 5 years ago

changes in the course of urban surface model implementation

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