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

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