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

Last change on this file since 493 was 493, checked in by raasch, 14 years ago

New:
---
Output in NetCDF4-format. New d3par-parameter netcdf_data_format.

(check_open, check_parameters, close_file, data_output_2d, data_output_3d, header, modules, netcdf, parin)

Modules to be loaded for compilation (mbuild) or job execution (mrun)
can be given in the configuration file using variable modules. Example:

%modules ifort/11.0.069:netcdf lcsgih parallel

This method replaces the (undocumented) mpilib-variable.

WARNING: All fixed settings of modules in the scripts mbuild, mrun, and subjob
have been removed! Please set the modules variable appropriately in your
configuration file. (mbuild, mrun, subjob)

Changed:


Parameters netcdf_64bit and netcdf_64bit_3d have been removed. Use
netcdf_data_format = 2 for choosing the classic 64bit-offset format (this is
the default). The offset-format can not be set independently for the
3d-output-data any more.

Parameters netcdf_format_mask, netcdf_format_mask_av, and variables
nc_format_mask, format_parallel_io removed. They are replaced by the new
parameter netcdf_data_format. (check_open, close_file,
data_output_mask, header, init_masks, modules, parin)

Errors:


bugfix in trunk/UTIL/Makefile: forgot to compile for interpret_config

Bugfix: timeseries data have to be collected by PE0 (user_statistics)

  • Property svn:keywords set to Id
File size: 14.8 KB
Line 
1 SUBROUTINE data_output_mask( av )
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: data_output_mask.f90 493 2010-03-01 08:30:24Z raasch $
11!
12! 475 2010-02-04 02:26:16Z raasch
13! Bugfix in serial branch: arguments from array local_pf removed in N90_PUT_VAR
14!
15! 410 2009-12-04 17:05:40Z letzel
16! Initial version
17!
18! Description:
19! ------------
20! Masked data output in NetCDF format for current mask (current value of mid).
21!------------------------------------------------------------------------------!
22
23#if defined( __netcdf )
24    USE arrays_3d
25    USE averaging
26    USE cloud_parameters
27    USE control_parameters
28    USE cpulog
29    USE grid_variables
30    USE indices
31    USE interfaces
32    USE netcdf
33    USE netcdf_control
34    USE particle_attributes
35    USE pegrid
36
37    IMPLICIT NONE
38
39    INTEGER ::  av, ngp, file_id, i, if, is, j, k, l, n, psi, s, sender, &
40                ind(6)
41    LOGICAL ::  found, resorted
42    REAL    ::  mean_r, s_r3, s_r4
43    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  local_pf
44#if defined( __parallel )
45    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  total_pf
46#endif
47    REAL, DIMENSION(:,:,:), POINTER ::  to_be_resorted
48
49!
50!-- Return, if nothing to output
51    IF ( domask_no(mid,av) == 0 )  RETURN
52
53    CALL cpu_log (log_point(49),'data_output_mask','start')
54
55!
56!-- Open output file.
57    IF ( netcdf_output  .AND.  ( myid == 0  .OR.  netcdf_data_format > 2 ) ) &
58    THEN
59       CALL check_open( 120+mid+av*max_masks )
60    ENDIF 
61
62!
63!-- Allocate total and local output arrays.
64#if defined( __parallel )
65    IF ( myid == 0 )  THEN
66       ALLOCATE( total_pf(mask_size(mid,1),mask_size(mid,2),mask_size(mid,3)) )
67    ENDIF
68#endif
69    ALLOCATE( local_pf(mask_size_l(mid,1),mask_size_l(mid,2), &
70                       mask_size_l(mid,3)) )
71
72!
73!-- Update the NetCDF time axis.
74    domask_time_count(mid,av) = domask_time_count(mid,av) + 1
75    IF ( netcdf_output  .AND.  ( myid == 0  .OR.  netcdf_data_format > 2 ) ) &
76    THEN
77       nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_time_mask(mid,av), &
78                               (/ simulated_time /),                          &
79                               start = (/ domask_time_count(mid,av) /),       &
80                               count = (/ 1 /) )
81       CALL handle_netcdf_error( 'data_output_mask', 9998 )
82    ENDIF
83
84!
85!-- Loop over all variables to be written.
86    if = 1
87
88    DO  WHILE ( domask(mid,av,if)(1:1) /= ' ' )
89!
90!--    Reallocate local_pf on PE 0 since its shape changes during MPI exchange
91       IF ( netcdf_data_format < 3   .AND.  myid == 0  .AND.  if > 1 )  THEN
92          DEALLOCATE( local_pf )
93          ALLOCATE( local_pf(mask_size_l(mid,1),mask_size_l(mid,2), &
94                             mask_size_l(mid,3)) )
95       ENDIF
96!
97!--    Store the variable chosen.
98       resorted = .FALSE.
99       SELECT CASE ( TRIM( domask(mid,av,if) ) )
100
101          CASE ( 'e' )
102             IF ( av == 0 )  THEN
103                to_be_resorted => e
104             ELSE
105                to_be_resorted => e_av
106             ENDIF
107
108          CASE ( 'p' )
109             IF ( av == 0 )  THEN
110                to_be_resorted => p
111             ELSE
112                to_be_resorted => p_av
113             ENDIF
114
115          CASE ( 'pc' )  ! particle concentration (requires ghostpoint exchange)
116             IF ( av == 0 )  THEN
117                tend = prt_count
118                CALL exchange_horiz( tend )
119                DO  i = 1, mask_size_l(mid,1)
120                   DO  j = 1, mask_size_l(mid,2)
121                      DO  k = 1, mask_size_l(mid,3)
122                         local_pf(i,j,k) =  tend(mask_k(mid,k), &
123                                   mask_j(mid,j),mask_i(mid,i))
124                      ENDDO
125                   ENDDO
126                ENDDO
127                resorted = .TRUE.
128             ELSE
129                CALL exchange_horiz( pc_av )
130                to_be_resorted => pc_av
131             ENDIF
132
133          CASE ( 'pr' )  ! mean particle radius
134             IF ( av == 0 )  THEN
135                DO  i = nxl, nxr
136                   DO  j = nys, nyn
137                      DO  k = nzb, nzt+1
138                         psi = prt_start_index(k,j,i)
139                         s_r3 = 0.0
140                         s_r4 = 0.0
141                         DO  n = psi, psi+prt_count(k,j,i)-1
142                            s_r3 = s_r3 + particles(n)%radius**3
143                            s_r4 = s_r4 + particles(n)%radius**4
144                         ENDDO
145                         IF ( s_r3 /= 0.0 )  THEN
146                            mean_r = s_r4 / s_r3
147                         ELSE
148                            mean_r = 0.0
149                         ENDIF
150                         tend(k,j,i) = mean_r
151                      ENDDO
152                   ENDDO
153                ENDDO
154                CALL exchange_horiz( tend )
155                DO  i = 1, mask_size_l(mid,1)
156                   DO  j = 1, mask_size_l(mid,2)
157                      DO  k = 1, mask_size_l(mid,3)
158                         local_pf(i,j,k) =  tend(mask_k(mid,k), &
159                                   mask_j(mid,j),mask_i(mid,i))
160                      ENDDO
161                   ENDDO
162                ENDDO
163                resorted = .TRUE.
164             ELSE
165                CALL exchange_horiz( pr_av )
166                to_be_resorted => pr_av
167             ENDIF
168
169          CASE ( 'pt' )
170             IF ( av == 0 )  THEN
171                IF ( .NOT. cloud_physics ) THEN
172                   to_be_resorted => pt
173                ELSE
174                   DO  i = 1, mask_size_l(mid,1)
175                      DO  j = 1, mask_size_l(mid,2)
176                         DO  k = 1, mask_size_l(mid,3)
177                            local_pf(i,j,k) =  &
178                                 pt(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) &
179                                 + l_d_cp * pt_d_t(mask_k(mid,k)) * &
180                                   ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
181                         ENDDO
182                      ENDDO
183                   ENDDO
184                   resorted = .TRUE.
185                ENDIF
186             ELSE
187                to_be_resorted => pt_av
188             ENDIF
189
190          CASE ( 'q' )
191             IF ( av == 0 )  THEN
192                to_be_resorted => q
193             ELSE
194                to_be_resorted => q_av
195             ENDIF
196             
197          CASE ( 'ql' )
198             IF ( av == 0 )  THEN
199                to_be_resorted => ql
200             ELSE
201                to_be_resorted => ql_av
202             ENDIF
203
204          CASE ( 'ql_c' )
205             IF ( av == 0 )  THEN
206                to_be_resorted => ql_c
207             ELSE
208                to_be_resorted => ql_c_av
209             ENDIF
210
211          CASE ( 'ql_v' )
212             IF ( av == 0 )  THEN
213                to_be_resorted => ql_v
214             ELSE
215                to_be_resorted => ql_v_av
216             ENDIF
217
218          CASE ( 'ql_vp' )
219             IF ( av == 0 )  THEN
220                to_be_resorted => ql_vp
221             ELSE
222                to_be_resorted => ql_vp_av
223             ENDIF
224
225          CASE ( 'qv' )
226             IF ( av == 0 )  THEN
227                DO  i = 1, mask_size_l(mid,1)
228                   DO  j = 1, mask_size_l(mid,2)
229                      DO  k = 1, mask_size_l(mid,3)
230                         local_pf(i,j,k) =  &
231                              q(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) -  &
232                              ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i))
233                      ENDDO
234                   ENDDO
235                ENDDO
236                resorted = .TRUE.
237             ELSE
238                to_be_resorted => qv_av
239             ENDIF
240
241          CASE ( 'rho' )
242             IF ( av == 0 )  THEN
243                to_be_resorted => rho
244             ELSE
245                to_be_resorted => rho_av
246             ENDIF
247             
248          CASE ( 's' )
249             IF ( av == 0 )  THEN
250                to_be_resorted => q
251             ELSE
252                to_be_resorted => s_av
253             ENDIF
254             
255          CASE ( 'sa' )
256             IF ( av == 0 )  THEN
257                to_be_resorted => sa
258             ELSE
259                to_be_resorted => sa_av
260             ENDIF
261             
262          CASE ( 'u' )
263             IF ( av == 0 )  THEN
264                to_be_resorted => u
265             ELSE
266                to_be_resorted => u_av
267             ENDIF
268
269          CASE ( 'v' )
270             IF ( av == 0 )  THEN
271                to_be_resorted => v
272             ELSE
273                to_be_resorted => v_av
274             ENDIF
275
276          CASE ( 'vpt' )
277             IF ( av == 0 )  THEN
278                to_be_resorted => vpt
279             ELSE
280                to_be_resorted => vpt_av
281             ENDIF
282
283          CASE ( 'w' )
284             IF ( av == 0 )  THEN
285                to_be_resorted => w
286             ELSE
287                to_be_resorted => w_av
288             ENDIF
289
290          CASE DEFAULT
291!
292!--          User defined quantity
293             CALL user_data_output_mask(av, domask(mid,av,if), found, local_pf )
294             resorted = .TRUE.
295
296             IF ( .NOT. found )  THEN
297                WRITE ( message_string, * ) 'no output available for: ', &
298                                            TRIM( domask(mid,av,if) )
299                CALL message( 'data_output_mask', 'PA9998', 0, 0, 0, 6, 0 )
300             ENDIF
301
302       END SELECT
303
304!
305!--    Resort the array to be output, if not done above
306       IF ( .NOT. resorted )  THEN
307          DO  i = 1, mask_size_l(mid,1)
308             DO  j = 1, mask_size_l(mid,2)
309                DO  k = 1, mask_size_l(mid,3)
310                   local_pf(i,j,k) =  to_be_resorted(mask_k(mid,k), &
311                                      mask_j(mid,j),mask_i(mid,i))
312                ENDDO
313             ENDDO
314          ENDDO
315       ENDIF
316
317!
318!--    I/O block. I/O methods are implemented
319!--    (1) for parallel execution
320!--     a. with NetCDF 4 parallel I/O-enabled library
321!--     b. with NetCDF 3 library
322!--    (2) for serial execution.
323!--    The choice of method depends on the correct setting of preprocessor
324!--    directives __parallel and __netcdf4 as well as on the parameter
325!--    netcdf_data_format.
326#if defined( __parallel )
327#if defined( __netcdf4 )
328       IF ( netcdf_data_format > 2 )  THEN
329!
330!--       (1) a. Parallel I/O using NetCDF 4 (not yet tested)
331          nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),  &
332               id_var_domask(mid,av,if),  &
333               local_pf,  &
334               start = (/ mask_start_l(mid,1), mask_start_l(mid,2),  &
335                          mask_start_l(mid,3), domask_time_count(mid,av) /),  &
336               count = (/ mask_size_l(mid,1), mask_size_l(mid,2),  &
337                          mask_size_l(mid,3), 1 /) )
338          CALL handle_netcdf_error( 'data_output_mask', 9998 )
339       ELSE
340#endif
341!
342!--       (1) b. Conventional I/O only through PE0
343!--       PE0 receives partial arrays from all processors of the respective mask
344!--       and outputs them. Here a barrier has to be set, because otherwise
345!--       "-MPI- FATAL: Remote protocol queue full" may occur.
346          CALL MPI_BARRIER( comm2d, ierr )
347
348          ngp = mask_size_l(mid,1) * mask_size_l(mid,2) * mask_size_l(mid,3)
349          IF ( myid == 0 )  THEN
350!
351!--          Local array can be relocated directly.
352             total_pf( &
353               mask_start_l(mid,1):mask_start_l(mid,1)+mask_size_l(mid,1)-1, &
354               mask_start_l(mid,2):mask_start_l(mid,2)+mask_size_l(mid,2)-1, &
355               mask_start_l(mid,3):mask_start_l(mid,3)+mask_size_l(mid,3)-1 ) &
356               = local_pf
357!
358!--          Receive data from all other PEs.
359             DO  n = 1, numprocs-1
360!
361!--             Receive index limits first, then array.
362!--             Index limits are received in arbitrary order from the PEs.
363                CALL MPI_RECV( ind(1), 6, MPI_INTEGER, MPI_ANY_SOURCE, 0,  &
364                     comm2d, status, ierr )
365!
366!--             Not all PEs have data for the mask
367                IF ( ind(1) /= -9999 )  THEN
368                   ngp = ( ind(2)-ind(1)+1 ) * (ind(4)-ind(3)+1 ) *  &
369                         ( ind(6)-ind(5)+1 )
370                   sender = status(MPI_SOURCE)
371                   DEALLOCATE( local_pf )
372                   ALLOCATE(local_pf(ind(1):ind(2),ind(3):ind(4),ind(5):ind(6)))
373                   CALL MPI_RECV( local_pf(ind(1),ind(3),ind(5)), ngp,  &
374                        MPI_REAL, sender, 1, comm2d, status, ierr )
375                   total_pf(ind(1):ind(2),ind(3):ind(4),ind(5):ind(6)) &
376                        = local_pf
377                ENDIF
378             ENDDO
379
380             nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),  &
381                  id_var_domask(mid,av,if), total_pf, &
382                  start = (/ 1, 1, 1, domask_time_count(mid,av) /), &
383                  count = (/ mask_size(mid,1), mask_size(mid,2), &
384                             mask_size(mid,3), 1 /) )
385             CALL handle_netcdf_error( 'data_output_mask', 9998 )
386
387          ELSE
388!
389!--          If at least part of the mask resides on the PE, send the index
390!--          limits for the target array, otherwise send -9999 to PE0.
391             IF ( mask_size_l(mid,1) > 0 .AND.  mask_size_l(mid,2) > 0 .AND. &
392                  mask_size_l(mid,3) > 0  ) &
393                  THEN
394                ind(1) = mask_start_l(mid,1)
395                ind(2) = mask_start_l(mid,1) + mask_size_l(mid,1) - 1
396                ind(3) = mask_start_l(mid,2)
397                ind(4) = mask_start_l(mid,2) + mask_size_l(mid,2) - 1
398                ind(5) = mask_start_l(mid,3)
399                ind(6) = mask_start_l(mid,3) + mask_size_l(mid,3) - 1
400             ELSE
401                ind(1) = -9999; ind(2) = -9999
402                ind(3) = -9999; ind(4) = -9999
403                ind(5) = -9999; ind(6) = -9999
404             ENDIF
405             CALL MPI_SEND( ind(1), 6, MPI_INTEGER, 0, 0, comm2d, ierr )
406!
407!--          If applicable, send data to PE0.
408             IF ( ind(1) /= -9999 )  THEN
409                CALL MPI_SEND( local_pf(1,1,1), ngp, MPI_REAL, 0, 1, comm2d, &
410                     ierr )
411             ENDIF
412          ENDIF
413!
414!--       A barrier has to be set, because otherwise some PEs may proceed too
415!--       fast so that PE0 may receive wrong data on tag 0.
416          CALL MPI_BARRIER( comm2d, ierr )
417#if defined( __netcdf4 )
418       ENDIF
419#endif
420#else
421!
422!--    (2) For serial execution of PALM, the single processor (PE0) holds all
423!--    data and writes them directly to file.
424       nc_stat = NF90_PUT_VAR( id_set_mask(mid,av),  &
425            id_var_domask(mid,av,if),       &
426            local_pf, &
427            start = (/ 1, 1, 1, domask_time_count(mid,av) /), &
428            count = (/ mask_size_l(mid,1), mask_size_l(mid,2), &
429                       mask_size_l(mid,3), 1 /) )
430       CALL handle_netcdf_error( 'data_output_mask', 9998 )
431#endif
432
433       if = if + 1
434    ENDDO
435
436!
437!-- Deallocate temporary arrays.
438    DEALLOCATE( local_pf )
439#if defined( __parallel )
440    IF ( myid == 0 )  THEN
441       DEALLOCATE( total_pf )
442    ENDIF
443#endif
444
445
446    CALL cpu_log (log_point(49),'data_output_mask','stop','nobarrier')
447#endif
448
449 END SUBROUTINE data_output_mask
Note: See TracBrowser for help on using the repository browser.