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

Last change on this file since 1745 was 1745, checked in by gronemeier, 9 years ago

Bugfix:calculation of time levels for parallel NetCDF output

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