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

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

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

  • Property svn:keywords set to Id
File size: 23.7 KB
Line 
1!> @file data_output_mask.f90
2!--------------------------------------------------------------------------------!
3! This file is part of PALM.
4!
5! PALM is free software: you can redistribute it and/or modify it under the terms
6! of the GNU General Public License as published by the Free Software Foundation,
7! either version 3 of the License, or (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
10! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
11! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with
14! PALM. If not, see <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2015 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------!
18!
19! Current revisions:
20! -----------------
21! Added output of radiative heating rates for RRTMG
22!
23! Former revisions:
24! -----------------
25! $Id: data_output_mask.f90 1691 2015-10-26 16:17:44Z maronga $
26!
27! 1682 2015-10-07 23:56:08Z knoop
28! Code annotations made doxygen readable
29!
30! 1585 2015-04-30 07:05:52Z maronga
31! Added support for RRTMG
32!
33! 1438 2014-07-22 14:14:06Z heinze
34! +nr, qc, qr
35!
36! 1359 2014-04-11 17:15:14Z hoffmann
37! New particle structure integrated.
38!
39! 1353 2014-04-08 15:21:23Z heinze
40! REAL constants provided with KIND-attribute
41!
42! 1327 2014-03-21 11:00:16Z raasch
43!
44!
45! 1320 2014-03-20 08:40:49Z raasch
46! ONLY-attribute added to USE-statements,
47! kind-parameters added to all INTEGER and REAL declaration statements,
48! kinds are defined in new module kinds,
49! revision history before 2012 removed,
50! comment fields (!:) to be used for variable explanations added to
51! all variable declaration statements
52!
53! 1318 2014-03-17 13:35:16Z raasch
54! barrier argument removed from cpu_log,
55! module interfaces removed
56!
57! 1092 2013-02-02 11:24:22Z raasch
58! unused variables removed
59!
60! 1036 2012-10-22 13:43:42Z raasch
61! code put under GPL (PALM 3.9)
62!
63! 1031 2012-10-19 14:35:30Z raasch
64! netCDF4 without parallel file support implemented
65!
66! 1007 2012-09-19 14:30:36Z franke
67! Bugfix: calculation of pr must depend on the particle weighting factor,
68! missing calculation of ql_vp added
69!
70! 410 2009-12-04 17:05:40Z letzel
71! Initial version
72!
73! Description:
74! ------------
75!> Masked data output in netCDF format for current mask (current value of mid).
76!------------------------------------------------------------------------------!
77 SUBROUTINE data_output_mask( av )
78
79 
80
81#if defined( __netcdf )
82    USE arrays_3d,                                                             &
83        ONLY:  e, nr, p, pt, q, qc, ql, ql_c, ql_v, qr, rho, sa, tend, u,      &
84               v, vpt, w
85   
86    USE averaging,                                                             &
87        ONLY:  e_av, lpt_av, nr_av, p_av, pc_av, pr_av, pt_av, q_av, qc_av,    &
88               ql_av, ql_c_av, ql_v_av, ql_vp_av, qv_av, qr_av, rho_av, s_av,  &
89               sa_av, u_av, v_av, vpt_av, w_av 
90   
91    USE cloud_parameters,                                                      &
92        ONLY:  l_d_cp, pt_d_t
93   
94    USE control_parameters,                                                    &
95        ONLY:  cloud_physics, domask, domask_no, domask_time_count,            &
96               mask_i, mask_j, mask_k, mask_size, mask_size_l,                 &
97               mask_start_l, max_masks, message_string, mid,                   &
98               netcdf_data_format, nz_do3d, simulated_time
99    USE cpulog,                                                                &
100        ONLY:  cpu_log, log_point
101
102
103   
104    USE indices,                                                               &
105        ONLY:  nbgp, nxl, nxr, nyn, nys, nzb, nzt
106       
107    USE kinds
108   
109    USE netcdf
110   
111    USE netcdf_control
112   
113    USE particle_attributes,                                                   &
114        ONLY:  grid_particles, number_of_particles, particles,                 &
115               particle_advection_start, prt_count
116   
117    USE pegrid
118
119    USE radiation_model_mod,                                                   &
120        ONLY:  rad_lw_in, rad_lw_in_av, rad_lw_out, rad_lw_out_av,             &
121               rad_lw_cs_hr, rad_lw_cs_hr_av, rad_lw_hr, rad_lw_hr_av,         &
122               rad_sw_in, rad_sw_in_av, rad_sw_out, rad_sw_out_av,             &
123               rad_sw_cs_hr, rad_sw_cs_hr_av, rad_sw_hr, rad_sw_hr_av
124
125
126    IMPLICIT NONE
127
128    INTEGER(iwp) ::  av       !<
129    INTEGER(iwp) ::  ngp      !<
130    INTEGER(iwp) ::  i        !<
131    INTEGER(iwp) ::  if       !<
132    INTEGER(iwp) ::  j        !<
133    INTEGER(iwp) ::  k        !<
134    INTEGER(iwp) ::  n        !<
135    INTEGER(iwp) ::  psi      !<
136    INTEGER(iwp) ::  sender   !<
137    INTEGER(iwp) ::  ind(6)   !<
138   
139    LOGICAL ::  found         !<
140    LOGICAL ::  resorted      !<
141   
142    REAL(wp) ::  mean_r       !<
143    REAL(wp) ::  s_r2         !<
144    REAL(wp) ::  s_r3         !<
145   
146    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  local_pf    !<
147#if defined( __parallel )
148    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  total_pf    !<
149#endif
150    REAL(wp), DIMENSION(:,:,:), POINTER ::  to_be_resorted  !<
151
152!
153!-- Return, if nothing to output
154    IF ( domask_no(mid,av) == 0 )  RETURN
155
156    CALL cpu_log (log_point(49),'data_output_mask','start')
157
158!
159!-- Open output file.
160    IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
161       CALL check_open( 200+mid+av*max_masks )
162    ENDIF 
163
164!
165!-- Allocate total and local output arrays.
166#if defined( __parallel )
167    IF ( myid == 0 )  THEN
168       ALLOCATE( total_pf(mask_size(mid,1),mask_size(mid,2),mask_size(mid,3)) )
169    ENDIF
170#endif
171    ALLOCATE( local_pf(mask_size_l(mid,1),mask_size_l(mid,2), &
172                       mask_size_l(mid,3)) )
173
174!
175!-- Update the netCDF time axis.
176    domask_time_count(mid,av) = domask_time_count(mid,av) + 1
177    IF ( myid == 0  .OR.  netcdf_data_format > 4 )  THEN
178       nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_time_mask(mid,av), &
179                               (/ simulated_time /),                          &
180                               start = (/ domask_time_count(mid,av) /),       &
181                               count = (/ 1 /) )
182       CALL handle_netcdf_error( 'data_output_mask', 460 )
183    ENDIF
184
185!
186!-- Loop over all variables to be written.
187    if = 1
188
189    DO  WHILE ( domask(mid,av,if)(1:1) /= ' ' )
190!
191!--    Reallocate local_pf on PE 0 since its shape changes during MPI exchange
192       IF ( netcdf_data_format < 5   .AND.  myid == 0  .AND.  if > 1 )  THEN
193          DEALLOCATE( local_pf )
194          ALLOCATE( local_pf(mask_size_l(mid,1),mask_size_l(mid,2), &
195                             mask_size_l(mid,3)) )
196       ENDIF
197!
198!--    Store the variable chosen.
199       resorted = .FALSE.
200       SELECT CASE ( TRIM( domask(mid,av,if) ) )
201
202          CASE ( 'e' )
203             IF ( av == 0 )  THEN
204                to_be_resorted => e
205             ELSE
206                to_be_resorted => e_av
207             ENDIF
208
209          CASE ( 'lpt' )
210             IF ( av == 0 )  THEN
211                to_be_resorted => pt
212             ELSE
213                to_be_resorted => lpt_av
214             ENDIF
215
216          CASE ( 'nr' )
217             IF ( av == 0 )  THEN
218                to_be_resorted => nr
219             ELSE
220                to_be_resorted => nr_av
221             ENDIF
222
223          CASE ( 'p' )
224             IF ( av == 0 )  THEN
225                to_be_resorted => p
226             ELSE
227                to_be_resorted => p_av
228             ENDIF
229
230          CASE ( 'pc' )  ! particle concentration (requires ghostpoint exchange)
231             IF ( av == 0 )  THEN
232                tend = prt_count
233                CALL exchange_horiz( tend, nbgp )
234                DO  i = 1, mask_size_l(mid,1)
235                   DO  j = 1, mask_size_l(mid,2)
236                      DO  k = 1, mask_size_l(mid,3)
237                         local_pf(i,j,k) =  tend(mask_k(mid,k), &
238                                   mask_j(mid,j),mask_i(mid,i))
239                      ENDDO
240                   ENDDO
241                ENDDO
242                resorted = .TRUE.
243             ELSE
244                CALL exchange_horiz( pc_av, nbgp )
245                to_be_resorted => pc_av
246             ENDIF
247
248          CASE ( 'pr' )  ! mean particle radius (effective radius)
249             IF ( av == 0 )  THEN
250                IF ( simulated_time >= particle_advection_start )  THEN
251                   DO  i = nxl, nxr
252                      DO  j = nys, nyn
253                         DO  k = nzb, nz_do3d
254                            number_of_particles = prt_count(k,j,i)
255                            IF (number_of_particles <= 0)  CYCLE
256                            particles => grid_particles(k,j,i)%particles(1:number_of_particles)
257                            s_r2 = 0.0_wp
258                            s_r3 = 0.0_wp
259                            DO  n = 1, number_of_particles
260                               IF ( particles(n)%particle_mask )  THEN
261                                  s_r2 = s_r2 + grid_particles(k,j,i)%particles(n)%radius**2 * &
262                                         grid_particles(k,j,i)%particles(n)%weight_factor
263                                  s_r3 = s_r3 + grid_particles(k,j,i)%particles(n)%radius**3 * &
264                                         grid_particles(k,j,i)%particles(n)%weight_factor
265                               ENDIF
266                            ENDDO
267                            IF ( s_r2 > 0.0_wp )  THEN
268                               mean_r = s_r3 / s_r2
269                            ELSE
270                               mean_r = 0.0_wp
271                            ENDIF
272                            tend(k,j,i) = mean_r
273                         ENDDO
274                      ENDDO
275                   ENDDO
276                   CALL exchange_horiz( tend, nbgp )
277                ELSE
278                   tend = 0.0_wp
279                ENDIF
280                DO  i = 1, mask_size_l(mid,1)
281                   DO  j = 1, mask_size_l(mid,2)
282                      DO  k = 1, mask_size_l(mid,3)
283                         local_pf(i,j,k) =  tend(mask_k(mid,k), &
284                                   mask_j(mid,j),mask_i(mid,i))
285                      ENDDO
286                   ENDDO
287                ENDDO
288                resorted = .TRUE.
289             ELSE
290                CALL exchange_horiz( pr_av, nbgp )
291                to_be_resorted => pr_av
292             ENDIF
293
294          CASE ( 'pt' )
295             IF ( av == 0 )  THEN
296                IF ( .NOT. cloud_physics ) THEN
297                   to_be_resorted => pt
298                ELSE
299                   DO  i = 1, mask_size_l(mid,1)
300                      DO  j = 1, mask_size_l(mid,2)
301                         DO  k = 1, mask_size_l(mid,3)
302                            local_pf(i,j,k) =  &
303                                 pt(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) &
304                                 + l_d_cp * pt_d_t(mask_k(mid,k)) * &
305                                   ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
306                         ENDDO
307                      ENDDO
308                   ENDDO
309                   resorted = .TRUE.
310                ENDIF
311             ELSE
312                to_be_resorted => pt_av
313             ENDIF
314
315          CASE ( 'q' )
316             IF ( av == 0 )  THEN
317                to_be_resorted => q
318             ELSE
319                to_be_resorted => q_av
320             ENDIF
321
322          CASE ( 'qc' )
323             IF ( av == 0 )  THEN
324                to_be_resorted => qc
325             ELSE
326                to_be_resorted => qc_av
327             ENDIF
328
329          CASE ( 'ql' )
330             IF ( av == 0 )  THEN
331                to_be_resorted => ql
332             ELSE
333                to_be_resorted => ql_av
334             ENDIF
335
336          CASE ( 'ql_c' )
337             IF ( av == 0 )  THEN
338                to_be_resorted => ql_c
339             ELSE
340                to_be_resorted => ql_c_av
341             ENDIF
342
343          CASE ( 'ql_v' )
344             IF ( av == 0 )  THEN
345                to_be_resorted => ql_v
346             ELSE
347                to_be_resorted => ql_v_av
348             ENDIF
349
350          CASE ( 'ql_vp' )
351             IF ( av == 0 )  THEN
352                IF ( simulated_time >= particle_advection_start )  THEN
353                   DO  i = nxl, nxr
354                      DO  j = nys, nyn
355                         DO  k = nzb, nz_do3d
356                            number_of_particles = prt_count(k,j,i)
357                            IF (number_of_particles <= 0)  CYCLE
358                            particles => grid_particles(k,j,i)%particles(1:number_of_particles)
359                            DO  n = 1, number_of_particles
360                               IF ( particles(n)%particle_mask )  THEN
361                                  tend(k,j,i) = tend(k,j,i) + &
362                                          particles(n)%weight_factor / &
363                                          prt_count(k,j,i)
364                               ENDIF
365                            ENDDO
366                         ENDDO
367                      ENDDO
368                   ENDDO
369                   CALL exchange_horiz( tend, nbgp )
370                ELSE
371                   tend = 0.0_wp
372                ENDIF
373                DO  i = 1, mask_size_l(mid,1)
374                   DO  j = 1, mask_size_l(mid,2)
375                      DO  k = 1, mask_size_l(mid,3)
376                         local_pf(i,j,k) =  tend(mask_k(mid,k), &
377                                   mask_j(mid,j),mask_i(mid,i))
378                      ENDDO
379                   ENDDO
380                ENDDO
381                resorted = .TRUE.
382             ELSE
383                CALL exchange_horiz( ql_vp_av, nbgp )
384                to_be_resorted => ql_vp_av
385             ENDIF
386
387          CASE ( 'qv' )
388             IF ( av == 0 )  THEN
389                DO  i = 1, mask_size_l(mid,1)
390                   DO  j = 1, mask_size_l(mid,2)
391                      DO  k = 1, mask_size_l(mid,3)
392                         local_pf(i,j,k) =  &
393                              q(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) -  &
394                              ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
395                      ENDDO
396                   ENDDO
397                ENDDO
398                resorted = .TRUE.
399             ELSE
400                to_be_resorted => qv_av
401             ENDIF
402
403          CASE ( 'qr' )
404             IF ( av == 0 )  THEN
405                to_be_resorted => qr
406             ELSE
407                to_be_resorted => qr_av
408             ENDIF
409
410          CASE ( 'rad_lw_in' )
411             IF ( av == 0 )  THEN
412                to_be_resorted => rad_lw_in
413             ELSE
414                to_be_resorted => rad_lw_in_av
415             ENDIF
416
417          CASE ( 'rad_lw_out' )
418             IF ( av == 0 )  THEN
419                to_be_resorted => rad_lw_out
420             ELSE
421                to_be_resorted => rad_lw_out_av
422             ENDIF
423
424          CASE ( 'rad_lw_cs_hr' )
425             IF ( av == 0 )  THEN
426                to_be_resorted => rad_lw_cs_hr
427             ELSE
428                to_be_resorted => rad_lw_cs_hr_av
429             ENDIF
430
431          CASE ( 'rad_lw_hr' )
432             IF ( av == 0 )  THEN
433                to_be_resorted => rad_lw_hr
434             ELSE
435                to_be_resorted => rad_lw_hr_av
436             ENDIF
437
438          CASE ( 'rad_sw_in' )
439             IF ( av == 0 )  THEN
440                to_be_resorted => rad_sw_in
441             ELSE
442                to_be_resorted => rad_sw_in_av
443             ENDIF
444
445          CASE ( 'rad_sw_out' )
446             IF ( av == 0 )  THEN
447                to_be_resorted => rad_sw_out
448             ELSE
449                to_be_resorted => rad_sw_out_av
450             ENDIF
451
452          CASE ( 'rad_sw_cs_hr' )
453             IF ( av == 0 )  THEN
454                to_be_resorted => rad_sw_cs_hr
455             ELSE
456                to_be_resorted => rad_sw_cs_hr_av
457             ENDIF
458
459          CASE ( 'rad_sw_hr' )
460             IF ( av == 0 )  THEN
461                to_be_resorted => rad_sw_hr
462             ELSE
463                to_be_resorted => rad_sw_hr_av
464             ENDIF
465
466          CASE ( 'rho' )
467             IF ( av == 0 )  THEN
468                to_be_resorted => rho
469             ELSE
470                to_be_resorted => rho_av
471             ENDIF
472
473          CASE ( 's' )
474             IF ( av == 0 )  THEN
475                to_be_resorted => q
476             ELSE
477                to_be_resorted => s_av
478             ENDIF
479
480          CASE ( 'sa' )
481             IF ( av == 0 )  THEN
482                to_be_resorted => sa
483             ELSE
484                to_be_resorted => sa_av
485             ENDIF
486
487          CASE ( 'u' )
488             IF ( av == 0 )  THEN
489                to_be_resorted => u
490             ELSE
491                to_be_resorted => u_av
492             ENDIF
493
494          CASE ( 'v' )
495             IF ( av == 0 )  THEN
496                to_be_resorted => v
497             ELSE
498                to_be_resorted => v_av
499             ENDIF
500
501          CASE ( 'vpt' )
502             IF ( av == 0 )  THEN
503                to_be_resorted => vpt
504             ELSE
505                to_be_resorted => vpt_av
506             ENDIF
507
508          CASE ( 'w' )
509             IF ( av == 0 )  THEN
510                to_be_resorted => w
511             ELSE
512                to_be_resorted => w_av
513             ENDIF
514
515          CASE DEFAULT
516!
517!--          User defined quantity
518             CALL user_data_output_mask(av, domask(mid,av,if), found, local_pf )
519             resorted = .TRUE.
520
521             IF ( .NOT. found )  THEN
522                WRITE ( message_string, * ) 'no output available for: ', &
523                                            TRIM( domask(mid,av,if) )
524                CALL message( 'data_output_mask', 'PA0327', 0, 0, 0, 6, 0 )
525             ENDIF
526
527       END SELECT
528
529!
530!--    Resort the array to be output, if not done above
531       IF ( .NOT. resorted )  THEN
532          DO  i = 1, mask_size_l(mid,1)
533             DO  j = 1, mask_size_l(mid,2)
534                DO  k = 1, mask_size_l(mid,3)
535                   local_pf(i,j,k) =  to_be_resorted(mask_k(mid,k), &
536                                      mask_j(mid,j),mask_i(mid,i))
537                ENDDO
538             ENDDO
539          ENDDO
540       ENDIF
541
542!
543!--    I/O block. I/O methods are implemented
544!--    (1) for parallel execution
545!--     a. with netCDF 4 parallel I/O-enabled library
546!--     b. with netCDF 3 library
547!--    (2) for serial execution.
548!--    The choice of method depends on the correct setting of preprocessor
549!--    directives __parallel and __netcdf4_parallel as well as on the parameter
550!--    netcdf_data_format.
551#if defined( __parallel )
552#if defined( __netcdf4_parallel )
553       IF ( netcdf_data_format > 4 )  THEN
554!
555!--       (1) a. Parallel I/O using netCDF 4 (not yet tested)
556          nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),  &
557               id_var_domask(mid,av,if),  &
558               local_pf,  &
559               start = (/ mask_start_l(mid,1), mask_start_l(mid,2),  &
560                          mask_start_l(mid,3), domask_time_count(mid,av) /),  &
561               count = (/ mask_size_l(mid,1), mask_size_l(mid,2),  &
562                          mask_size_l(mid,3), 1 /) )
563          CALL handle_netcdf_error( 'data_output_mask', 461 )
564       ELSE
565#endif
566!
567!--       (1) b. Conventional I/O only through PE0
568!--       PE0 receives partial arrays from all processors of the respective mask
569!--       and outputs them. Here a barrier has to be set, because otherwise
570!--       "-MPI- FATAL: Remote protocol queue full" may occur.
571          CALL MPI_BARRIER( comm2d, ierr )
572
573          ngp = mask_size_l(mid,1) * mask_size_l(mid,2) * mask_size_l(mid,3)
574          IF ( myid == 0 )  THEN
575!
576!--          Local array can be relocated directly.
577             total_pf( &
578               mask_start_l(mid,1):mask_start_l(mid,1)+mask_size_l(mid,1)-1, &
579               mask_start_l(mid,2):mask_start_l(mid,2)+mask_size_l(mid,2)-1, &
580               mask_start_l(mid,3):mask_start_l(mid,3)+mask_size_l(mid,3)-1 ) &
581               = local_pf
582!
583!--          Receive data from all other PEs.
584             DO  n = 1, numprocs-1
585!
586!--             Receive index limits first, then array.
587!--             Index limits are received in arbitrary order from the PEs.
588                CALL MPI_RECV( ind(1), 6, MPI_INTEGER, MPI_ANY_SOURCE, 0,  &
589                     comm2d, status, ierr )
590!
591!--             Not all PEs have data for the mask
592                IF ( ind(1) /= -9999 )  THEN
593                   ngp = ( ind(2)-ind(1)+1 ) * (ind(4)-ind(3)+1 ) *  &
594                         ( ind(6)-ind(5)+1 )
595                   sender = status(MPI_SOURCE)
596                   DEALLOCATE( local_pf )
597                   ALLOCATE(local_pf(ind(1):ind(2),ind(3):ind(4),ind(5):ind(6)))
598                   CALL MPI_RECV( local_pf(ind(1),ind(3),ind(5)), ngp,  &
599                        MPI_REAL, sender, 1, comm2d, status, ierr )
600                   total_pf(ind(1):ind(2),ind(3):ind(4),ind(5):ind(6)) &
601                        = local_pf
602                ENDIF
603             ENDDO
604
605             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),  &
606                  id_var_domask(mid,av,if), total_pf, &
607                  start = (/ 1, 1, 1, domask_time_count(mid,av) /), &
608                  count = (/ mask_size(mid,1), mask_size(mid,2), &
609                             mask_size(mid,3), 1 /) )
610             CALL handle_netcdf_error( 'data_output_mask', 462 )
611
612          ELSE
613!
614!--          If at least part of the mask resides on the PE, send the index
615!--          limits for the target array, otherwise send -9999 to PE0.
616             IF ( mask_size_l(mid,1) > 0 .AND.  mask_size_l(mid,2) > 0 .AND. &
617                  mask_size_l(mid,3) > 0  ) &
618                  THEN
619                ind(1) = mask_start_l(mid,1)
620                ind(2) = mask_start_l(mid,1) + mask_size_l(mid,1) - 1
621                ind(3) = mask_start_l(mid,2)
622                ind(4) = mask_start_l(mid,2) + mask_size_l(mid,2) - 1
623                ind(5) = mask_start_l(mid,3)
624                ind(6) = mask_start_l(mid,3) + mask_size_l(mid,3) - 1
625             ELSE
626                ind(1) = -9999; ind(2) = -9999
627                ind(3) = -9999; ind(4) = -9999
628                ind(5) = -9999; ind(6) = -9999
629             ENDIF
630             CALL MPI_SEND( ind(1), 6, MPI_INTEGER, 0, 0, comm2d, ierr )
631!
632!--          If applicable, send data to PE0.
633             IF ( ind(1) /= -9999 )  THEN
634                CALL MPI_SEND( local_pf(1,1,1), ngp, MPI_REAL, 0, 1, comm2d, &
635                     ierr )
636             ENDIF
637          ENDIF
638!
639!--       A barrier has to be set, because otherwise some PEs may proceed too
640!--       fast so that PE0 may receive wrong data on tag 0.
641          CALL MPI_BARRIER( comm2d, ierr )
642#if defined( __netcdf4_parallel )
643       ENDIF
644#endif
645#else
646!
647!--    (2) For serial execution of PALM, the single processor (PE0) holds all
648!--    data and writes them directly to file.
649       nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),  &
650            id_var_domask(mid,av,if),       &
651            local_pf, &
652            start = (/ 1, 1, 1, domask_time_count(mid,av) /), &
653            count = (/ mask_size_l(mid,1), mask_size_l(mid,2), &
654                       mask_size_l(mid,3), 1 /) )
655       CALL handle_netcdf_error( 'data_output_mask', 463 )
656#endif
657
658       if = if + 1
659
660    ENDDO
661
662!
663!-- Deallocate temporary arrays.
664    DEALLOCATE( local_pf )
665#if defined( __parallel )
666    IF ( myid == 0 )  THEN
667       DEALLOCATE( total_pf )
668    ENDIF
669#endif
670
671
672    CALL cpu_log( log_point(49), 'data_output_mask', 'stop' )
673#endif
674
675 END SUBROUTINE data_output_mask
Note: See TracBrowser for help on using the repository browser.