source: palm/trunk/SOURCE/sum_up_3d_data.f90 @ 1673

Last change on this file since 1673 was 1586, checked in by maronga, 10 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 29.7 KB
Line 
1 SUBROUTINE sum_up_3d_data
2
3!--------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later 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-2014 Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: sum_up_3d_data.f90 1586 2015-04-30 07:11:33Z raasch $
27!
28! 1585 2015-04-30 07:05:52Z maronga
29! Adapted for RRTMG
30!
31! 1555 2015-03-04 17:44:27Z maronga
32! Added output of r_a and r_s
33!
34! 1551 2015-03-03 14:18:16Z maronga
35! Added support for land surface model and radiation model data.
36!
37! 1359 2014-04-11 17:15:14Z hoffmann
38! New particle structure integrated.
39!
40! 1353 2014-04-08 15:21:23Z heinze
41! REAL constants provided with KIND-attribute
42!
43! 1320 2014-03-20 08:40:49Z raasch
44! ONLY-attribute added to USE-statements,
45! kind-parameters added to all INTEGER and REAL declaration statements,
46! kinds are defined in new module kinds,
47! old module precision_kind is removed,
48! revision history before 2012 removed,
49! comment fields (!:) to be used for variable explanations added to
50! all variable declaration statements
51!
52! 1318 2014-03-17 13:35:16Z raasch
53! barrier argument removed from cpu_log,
54! module interfaces removed
55!
56! 1115 2013-03-26 18:16:16Z hoffmann
57! ql is calculated by calc_liquid_water_content
58!
59! 1053 2012-11-13 17:11:03Z hoffmann
60! +nr, prr, qr
61!
62! 1036 2012-10-22 13:43:42Z raasch
63! code put under GPL (PALM 3.9)
64!
65! 1007 2012-09-19 14:30:36Z franke
66! Bugfix in calculation of ql_vp
67!
68! 978 2012-08-09 08:28:32Z fricke
69! +z0h*
70!
71! Revision 1.1  2006/02/23 12:55:23  raasch
72! Initial revision
73!
74!
75! Description:
76! ------------
77! Sum-up the values of 3d-arrays. The real averaging is later done in routine
78! average_3d_data.
79!------------------------------------------------------------------------------!
80
81    USE arrays_3d,                                                             &
82        ONLY:  dzw, e, nr, p, pt, q, qc, ql, ql_c, ql_v, qr, qsws, rho, sa,    &
83               shf, ts, u, us, v, vpt, w, z0, z0h
84
85    USE averaging,                                                             &
86        ONLY:  e_av, lpt_av, lwp_av, nr_av, p_av, pc_av, pr_av, prr_av,        &
87               precipitation_rate_av, pt_av, q_av, qc_av, ql_av, ql_c_av,      &
88               ql_v_av, ql_vp_av, qr_av, qsws_av, qv_av, rho_av, s_av, sa_av,  &
89               shf_av, ts_av, u_av, us_av, v_av, vpt_av, w_av, z0_av, z0h_av
90
91    USE cloud_parameters,                                                      &
92        ONLY:  l_d_cp, precipitation_rate, pt_d_t 
93
94    USE control_parameters,                                                    &
95        ONLY:  average_count_3d, cloud_physics, doav, doav_n
96
97    USE cpulog,                                                                &
98        ONLY:  cpu_log, log_point
99
100    USE indices,                                                               &
101        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt 
102
103    USE kinds
104
105    USE land_surface_model_mod,                                                &
106        ONLY:  c_liq, c_liq_av, c_soil_av, c_veg, c_veg_av, ghf_eb,            &
107               ghf_eb_av, lai, lai_av, m_liq_eb, m_liq_eb_av, m_soil,          &
108               m_soil_av, nzb_soil, nzt_soil, qsws_eb, qsws_eb_av,             &
109               qsws_liq_eb, qsws_liq_eb_av, qsws_soil_eb, qsws_soil_eb_av,     &
110               qsws_veg_eb, qsws_veg_eb_av, shf_eb, shf_eb_av, r_a, r_a_av,    &
111               r_s, r_s_av, t_soil, t_soil_av
112
113    USE particle_attributes,                                                   &
114        ONLY:  grid_particles, number_of_particles, particles, prt_count
115
116    USE radiation_model_mod,                                                   &
117        ONLY:  rad_net, rad_net_av, rad_sw_in, rad_sw_in_av, rad_sw_out,       &
118               rad_sw_out_av, rad_lw_in, rad_lw_in_av, rad_lw_out,             &
119               rad_lw_out_av
120
121    IMPLICIT NONE
122
123    INTEGER(iwp) ::  i   !:
124    INTEGER(iwp) ::  ii  !:
125    INTEGER(iwp) ::  j   !:
126    INTEGER(iwp) ::  k   !:
127    INTEGER(iwp) ::  n   !:
128    INTEGER(iwp) ::  psi !:
129
130    REAL(wp)     ::  mean_r !:
131    REAL(wp)     ::  s_r2   !:
132    REAL(wp)     ::  s_r3   !:
133
134    CALL cpu_log (log_point(34),'sum_up_3d_data','start')
135
136!
137!-- Allocate and initialize the summation arrays if called for the very first
138!-- time or the first time after average_3d_data has been called
139!-- (some or all of the arrays may have been already allocated
140!-- in read_3d_binary)
141    IF ( average_count_3d == 0 )  THEN
142
143       DO  ii = 1, doav_n
144
145          SELECT CASE ( TRIM( doav(ii) ) )
146
147             CASE ( 'c_liq*' )
148                IF ( .NOT. ALLOCATED( c_liq_av ) )  THEN
149                   ALLOCATE( c_liq_av(nysg:nyng,nxlg:nxrg) )
150                ENDIF
151                c_liq_av = 0.0_wp
152
153             CASE ( 'c_soil*' )
154                IF ( .NOT. ALLOCATED( c_soil_av ) )  THEN
155                   ALLOCATE( c_soil_av(nysg:nyng,nxlg:nxrg) )
156                ENDIF
157                c_soil_av = 0.0_wp
158
159             CASE ( 'c_veg*' )
160                IF ( .NOT. ALLOCATED( c_veg_av ) )  THEN
161                   ALLOCATE( c_veg_av(nysg:nyng,nxlg:nxrg) )
162                ENDIF
163                c_veg_av = 0.0_wp
164
165             CASE ( 'e' )
166                IF ( .NOT. ALLOCATED( e_av ) )  THEN
167                   ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
168                ENDIF
169                e_av = 0.0_wp
170
171             CASE ( 'ghf_eb*' )
172                IF ( .NOT. ALLOCATED( ghf_eb_av ) )  THEN
173                   ALLOCATE( ghf_eb_av(nysg:nyng,nxlg:nxrg) )
174                ENDIF
175                ghf_eb_av = 0.0_wp
176
177             CASE ( 'lai*' )
178                IF ( .NOT. ALLOCATED( lai_av ) )  THEN
179                   ALLOCATE( lai_av(nysg:nyng,nxlg:nxrg) )
180                ENDIF
181                lai_av = 0.0_wp
182
183             CASE ( 'lpt' )
184                IF ( .NOT. ALLOCATED( lpt_av ) )  THEN
185                   ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
186                ENDIF
187                lpt_av = 0.0_wp
188
189             CASE ( 'lwp*' )
190                IF ( .NOT. ALLOCATED( lwp_av ) )  THEN
191                   ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
192                ENDIF
193                lwp_av = 0.0_wp
194
195             CASE ( 'm_liq_eb*' )
196                IF ( .NOT. ALLOCATED( m_liq_eb_av ) )  THEN
197                   ALLOCATE( m_liq_eb_av(nysg:nyng,nxlg:nxrg) )
198                ENDIF
199                m_liq_eb_av = 0.0_wp
200
201             CASE ( 'm_soil' )
202                IF ( .NOT. ALLOCATED( m_soil_av ) )  THEN
203                   ALLOCATE( m_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
204                ENDIF
205                m_soil_av = 0.0_wp
206
207             CASE ( 'nr' )
208                IF ( .NOT. ALLOCATED( nr_av ) )  THEN
209                   ALLOCATE( nr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
210                ENDIF
211                nr_av = 0.0_wp
212
213             CASE ( 'p' )
214                IF ( .NOT. ALLOCATED( p_av ) )  THEN
215                   ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
216                ENDIF
217                p_av = 0.0_wp
218
219             CASE ( 'pc' )
220                IF ( .NOT. ALLOCATED( pc_av ) )  THEN
221                   ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
222                ENDIF
223                pc_av = 0.0_wp
224
225             CASE ( 'pr' )
226                IF ( .NOT. ALLOCATED( pr_av ) )  THEN
227                   ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
228                ENDIF
229                pr_av = 0.0_wp
230
231             CASE ( 'prr' )
232                IF ( .NOT. ALLOCATED( prr_av ) )  THEN
233                   ALLOCATE( prr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
234                ENDIF
235                prr_av = 0.0_wp
236
237             CASE ( 'prr*' )
238                IF ( .NOT. ALLOCATED( precipitation_rate_av ) )  THEN
239                   ALLOCATE( precipitation_rate_av(nysg:nyng,nxlg:nxrg) )
240                ENDIF
241                precipitation_rate_av = 0.0_wp
242
243             CASE ( 'pt' )
244                IF ( .NOT. ALLOCATED( pt_av ) )  THEN
245                   ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
246                ENDIF
247                pt_av = 0.0_wp
248
249             CASE ( 'q' )
250                IF ( .NOT. ALLOCATED( q_av ) )  THEN
251                   ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
252                ENDIF
253                q_av = 0.0_wp
254
255             CASE ( 'qc' )
256                IF ( .NOT. ALLOCATED( qc_av ) )  THEN
257                   ALLOCATE( qc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
258                ENDIF
259                qc_av = 0.0_wp
260
261             CASE ( 'ql' )
262                IF ( .NOT. ALLOCATED( ql_av ) )  THEN
263                   ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
264                ENDIF
265                ql_av = 0.0_wp
266
267             CASE ( 'ql_c' )
268                IF ( .NOT. ALLOCATED( ql_c_av ) )  THEN
269                   ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
270                ENDIF
271                ql_c_av = 0.0_wp
272
273             CASE ( 'ql_v' )
274                IF ( .NOT. ALLOCATED( ql_v_av ) )  THEN
275                   ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
276                ENDIF
277                ql_v_av = 0.0_wp
278
279             CASE ( 'ql_vp' )
280                IF ( .NOT. ALLOCATED( ql_vp_av ) )  THEN
281                   ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
282                ENDIF
283                ql_vp_av = 0.0_wp
284
285             CASE ( 'qr' )
286                IF ( .NOT. ALLOCATED( qr_av ) )  THEN
287                   ALLOCATE( qr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
288                ENDIF
289                qr_av = 0.0_wp
290
291             CASE ( 'qsws*' )
292                IF ( .NOT. ALLOCATED( qsws_av ) )  THEN
293                   ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
294                ENDIF
295                qsws_av = 0.0_wp
296
297             CASE ( 'qsws_eb*' )
298                IF ( .NOT. ALLOCATED( qsws_eb_av ) )  THEN
299                   ALLOCATE( qsws_eb_av(nysg:nyng,nxlg:nxrg) )
300                ENDIF
301                qsws_eb_av = 0.0_wp
302
303             CASE ( 'qsws_liq_eb*' )
304                IF ( .NOT. ALLOCATED( qsws_liq_eb_av ) )  THEN
305                   ALLOCATE( qsws_liq_eb_av(nysg:nyng,nxlg:nxrg) )
306                ENDIF
307                qsws_liq_eb_av = 0.0_wp
308
309             CASE ( 'qsws_soil_eb*' )
310                IF ( .NOT. ALLOCATED( qsws_soil_eb_av ) )  THEN
311                   ALLOCATE( qsws_soil_eb_av(nysg:nyng,nxlg:nxrg) )
312                ENDIF
313                qsws_soil_eb_av = 0.0_wp
314
315             CASE ( 'qsws_veg_eb*' )
316                IF ( .NOT. ALLOCATED( qsws_veg_eb_av ) )  THEN
317                   ALLOCATE( qsws_veg_eb_av(nysg:nyng,nxlg:nxrg) )
318                ENDIF
319                qsws_veg_eb_av = 0.0_wp
320
321             CASE ( 'qv' )
322                IF ( .NOT. ALLOCATED( qv_av ) )  THEN
323                   ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
324                ENDIF
325                qv_av = 0.0_wp
326
327             CASE ( 'rad_net*' )
328                IF ( .NOT. ALLOCATED( rad_net_av ) )  THEN
329                   ALLOCATE( rad_net_av(nysg:nyng,nxlg:nxrg) )
330                ENDIF
331                rad_net_av = 0.0_wp
332
333             CASE ( 'rad_lw_in' )
334                IF ( .NOT. ALLOCATED( rad_lw_in_av ) )  THEN
335                   ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
336                ENDIF
337                rad_lw_in_av = 0.0_wp
338
339             CASE ( 'rad_lw_out' )
340                IF ( .NOT. ALLOCATED( rad_lw_out_av ) )  THEN
341                   ALLOCATE( rad_lw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
342                ENDIF
343                rad_lw_out_av = 0.0_wp
344
345             CASE ( 'rad_sw_in' )
346                IF ( .NOT. ALLOCATED( rad_sw_in_av ) )  THEN
347                   ALLOCATE( rad_sw_in_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
348                ENDIF
349                rad_sw_in_av = 0.0_wp
350
351             CASE ( 'rad_sw_out' )
352                IF ( .NOT. ALLOCATED( rad_sw_out_av ) )  THEN
353                   ALLOCATE( rad_sw_out_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
354                ENDIF
355                rad_sw_out_av = 0.0_wp
356
357             CASE ( 'rho' )
358                IF ( .NOT. ALLOCATED( rho_av ) )  THEN
359                   ALLOCATE( rho_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
360                ENDIF
361                rho_av = 0.0_wp
362
363             CASE ( 'r_a*' )
364                IF ( .NOT. ALLOCATED( r_a_av ) )  THEN
365                   ALLOCATE( r_a_av(nysg:nyng,nxlg:nxrg) )
366                ENDIF
367                r_a_av = 0.0_wp
368
369             CASE ( 'r_s*' )
370                IF ( .NOT. ALLOCATED( r_s_av ) )  THEN
371                   ALLOCATE( r_s_av(nysg:nyng,nxlg:nxrg) )
372                ENDIF
373                r_s_av = 0.0_wp
374
375             CASE ( 's' )
376                IF ( .NOT. ALLOCATED( s_av ) )  THEN
377                   ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
378                ENDIF
379                s_av = 0.0_wp
380
381             CASE ( 'sa' )
382                IF ( .NOT. ALLOCATED( sa_av ) )  THEN
383                   ALLOCATE( sa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
384                ENDIF
385                sa_av = 0.0_wp
386
387             CASE ( 'shf*' )
388                IF ( .NOT. ALLOCATED( shf_av ) )  THEN
389                   ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
390                ENDIF
391                shf_av = 0.0_wp
392
393             CASE ( 'shf_eb*' )
394                IF ( .NOT. ALLOCATED( shf_eb_av ) )  THEN
395                   ALLOCATE( shf_eb_av(nysg:nyng,nxlg:nxrg) )
396                ENDIF
397                shf_eb_av = 0.0_wp
398
399             CASE ( 't_soil' )
400                IF ( .NOT. ALLOCATED( t_soil_av ) )  THEN
401                   ALLOCATE( t_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) )
402                ENDIF
403                t_soil_av = 0.0_wp
404
405             CASE ( 't*' )
406                IF ( .NOT. ALLOCATED( ts_av ) )  THEN
407                   ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
408                ENDIF
409                ts_av = 0.0_wp
410
411             CASE ( 'u' )
412                IF ( .NOT. ALLOCATED( u_av ) )  THEN
413                   ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
414                ENDIF
415                u_av = 0.0_wp
416
417             CASE ( 'u*' )
418                IF ( .NOT. ALLOCATED( us_av ) )  THEN
419                   ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
420                ENDIF
421                us_av = 0.0_wp
422
423             CASE ( 'v' )
424                IF ( .NOT. ALLOCATED( v_av ) )  THEN
425                   ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
426                ENDIF
427                v_av = 0.0_wp
428
429             CASE ( 'vpt' )
430                IF ( .NOT. ALLOCATED( vpt_av ) )  THEN
431                   ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
432                ENDIF
433                vpt_av = 0.0_wp
434
435             CASE ( 'w' )
436                IF ( .NOT. ALLOCATED( w_av ) )  THEN
437                   ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
438                ENDIF
439                w_av = 0.0_wp
440
441             CASE ( 'z0*' )
442                IF ( .NOT. ALLOCATED( z0_av ) )  THEN
443                   ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
444                ENDIF
445                z0_av = 0.0_wp
446
447             CASE ( 'z0h*' )
448                IF ( .NOT. ALLOCATED( z0h_av ) )  THEN
449                   ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
450                ENDIF
451                z0h_av = 0.0_wp
452
453             CASE DEFAULT
454!
455!--             User-defined quantity
456                CALL user_3d_data_averaging( 'allocate', doav(ii) )
457
458          END SELECT
459
460       ENDDO
461
462    ENDIF
463
464!
465!-- Loop of all variables to be averaged.
466    DO  ii = 1, doav_n
467
468!
469!--    Store the array chosen on the temporary array.
470       SELECT CASE ( TRIM( doav(ii) ) )
471
472          CASE ( 'c_liq*' )
473             DO  i = nxlg, nxrg
474                DO  j = nysg, nyng
475                   c_liq_av(j,i) = c_liq_av(j,i)
476                ENDDO
477             ENDDO
478
479          CASE ( 'c_soil*' )
480             DO  i = nxlg, nxrg
481                DO  j = nysg, nyng
482                   c_soil_av(j,i) = c_soil_av(j,i) + (1.0_wp - c_veg(j,i))
483                ENDDO
484             ENDDO
485
486          CASE ( 'c_veg*' )
487             DO  i = nxlg, nxrg
488                DO  j = nysg, nyng
489                   c_veg_av(j,i) = c_veg_av(j,i)
490                ENDDO
491             ENDDO
492
493          CASE ( 'e' )
494             DO  i = nxlg, nxrg
495                DO  j = nysg, nyng
496                   DO  k = nzb, nzt+1
497                      e_av(k,j,i) = e_av(k,j,i) + e(k,j,i)
498                   ENDDO
499                ENDDO
500             ENDDO
501
502          CASE ( 'ghf_eb*' )
503             DO  i = nxlg, nxrg
504                DO  j = nysg, nyng
505                   ghf_eb_av(j,i) = ghf_eb_av(j,i) + ghf_eb(j,i)
506                ENDDO
507             ENDDO
508
509          CASE ( 'lai*' )
510             DO  i = nxlg, nxrg
511                DO  j = nysg, nyng
512                   lai_av(j,i) = lai_av(j,i)
513                ENDDO
514             ENDDO
515
516          CASE ( 'lpt' )
517             DO  i = nxlg, nxrg
518                DO  j = nysg, nyng
519                   DO  k = nzb, nzt+1
520                      lpt_av(k,j,i) = lpt_av(k,j,i) + pt(k,j,i)
521                   ENDDO
522                ENDDO
523             ENDDO
524
525          CASE ( 'lwp*' )
526             DO  i = nxlg, nxrg
527                DO  j = nysg, nyng
528                   lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) * &
529                                                    dzw(1:nzt+1) )
530                ENDDO
531             ENDDO
532
533          CASE ( 'm_liq_eb*' )
534             DO  i = nxlg, nxrg
535                DO  j = nysg, nyng
536                   m_liq_eb_av(j,i) = m_liq_eb_av(j,i) + m_liq_eb(j,i)
537                ENDDO
538             ENDDO
539
540          CASE ( 'm_soil' )
541             DO  i = nxlg, nxrg
542                DO  j = nysg, nyng
543                   DO  k = nzb_soil, nzt_soil
544                      m_soil_av(k,j,i) = m_soil_av(k,j,i) + m_soil(k,j,i)
545                   ENDDO
546                ENDDO
547             ENDDO
548
549          CASE ( 'nr' )
550             DO  i = nxlg, nxrg
551                DO  j = nysg, nyng
552                   DO  k = nzb, nzt+1
553                      nr_av(k,j,i) = nr_av(k,j,i) + nr(k,j,i)
554                   ENDDO
555                ENDDO
556             ENDDO
557
558          CASE ( 'p' )
559             DO  i = nxlg, nxrg
560                DO  j = nysg, nyng
561                   DO  k = nzb, nzt+1
562                      p_av(k,j,i) = p_av(k,j,i) + p(k,j,i)
563                   ENDDO
564                ENDDO
565             ENDDO
566
567          CASE ( 'pc' )
568             DO  i = nxl, nxr
569                DO  j = nys, nyn
570                   DO  k = nzb, nzt+1
571                      pc_av(k,j,i) = pc_av(k,j,i) + prt_count(k,j,i)
572                   ENDDO
573                ENDDO
574             ENDDO
575
576          CASE ( 'pr' )
577             DO  i = nxl, nxr
578                DO  j = nys, nyn
579                   DO  k = nzb, nzt+1
580                      number_of_particles = prt_count(k,j,i)
581                      IF ( number_of_particles <= 0 )  CYCLE
582                      particles => grid_particles(k,j,i)%particles(1:number_of_particles)
583                      s_r2 = 0.0_wp
584                      s_r3 = 0.0_wp
585
586                      DO  n = 1, number_of_particles
587                         IF ( particles(n)%particle_mask )  THEN
588                            s_r2 = s_r2 + particles(n)%radius**2 * &
589                                particles(n)%weight_factor
590                            s_r3 = s_r3 + particles(n)%radius**3 * &
591                                particles(n)%weight_factor
592                         ENDIF
593                      ENDDO
594
595                      IF ( s_r2 > 0.0_wp )  THEN
596                         mean_r = s_r3 / s_r2
597                      ELSE
598                         mean_r = 0.0_wp
599                      ENDIF
600                      pr_av(k,j,i) = pr_av(k,j,i) + mean_r
601                   ENDDO
602                ENDDO
603             ENDDO
604
605
606          CASE ( 'pr*' )
607             DO  i = nxlg, nxrg
608                DO  j = nysg, nyng
609                   precipitation_rate_av(j,i) = precipitation_rate_av(j,i) + &
610                                                precipitation_rate(j,i)
611                ENDDO
612             ENDDO
613
614          CASE ( 'pt' )
615             IF ( .NOT. cloud_physics ) THEN
616             DO  i = nxlg, nxrg
617                DO  j = nysg, nyng
618                   DO  k = nzb, nzt+1
619                         pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
620                      ENDDO
621                   ENDDO
622                ENDDO
623             ELSE
624             DO  i = nxlg, nxrg
625                DO  j = nysg, nyng
626                   DO  k = nzb, nzt+1
627                         pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + l_d_cp * &
628                                                       pt_d_t(k) * ql(k,j,i)
629                      ENDDO
630                   ENDDO
631                ENDDO
632             ENDIF
633
634          CASE ( 'q' )
635             DO  i = nxlg, nxrg
636                DO  j = nysg, nyng
637                   DO  k = nzb, nzt+1
638                      q_av(k,j,i) = q_av(k,j,i) + q(k,j,i)
639                   ENDDO
640                ENDDO
641             ENDDO
642
643          CASE ( 'qc' )
644             DO  i = nxlg, nxrg
645                DO  j = nysg, nyng
646                   DO  k = nzb, nzt+1
647                      qc_av(k,j,i) = qc_av(k,j,i) + qc(k,j,i)
648                   ENDDO
649                ENDDO
650             ENDDO
651
652          CASE ( 'ql' )
653             DO  i = nxlg, nxrg
654                DO  j = nysg, nyng
655                   DO  k = nzb, nzt+1
656                      ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i)
657                   ENDDO
658                ENDDO
659             ENDDO
660
661          CASE ( 'ql_c' )
662             DO  i = nxlg, nxrg
663                DO  j = nysg, nyng
664                   DO  k = nzb, nzt+1
665                      ql_c_av(k,j,i) = ql_c_av(k,j,i) + ql_c(k,j,i)
666                   ENDDO
667                ENDDO
668             ENDDO
669
670          CASE ( 'ql_v' )
671             DO  i = nxlg, nxrg
672                DO  j = nysg, nyng
673                   DO  k = nzb, nzt+1
674                      ql_v_av(k,j,i) = ql_v_av(k,j,i) + ql_v(k,j,i)
675                   ENDDO
676                ENDDO
677             ENDDO
678
679          CASE ( 'ql_vp' )
680             DO  i = nxl, nxr
681                DO  j = nys, nyn
682                   DO  k = nzb, nzt+1
683                      number_of_particles = prt_count(k,j,i)
684                      IF ( number_of_particles <= 0 )  CYCLE
685                      particles => grid_particles(k,j,i)%particles(1:number_of_particles)
686                      DO  n = 1, number_of_particles
687                         IF ( particles(n)%particle_mask )  THEN
688                            ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + &
689                                              particles(n)%weight_factor / &
690                                              number_of_particles
691                         ENDIF
692                      ENDDO
693                   ENDDO
694                ENDDO
695             ENDDO
696
697          CASE ( 'qr' )
698             DO  i = nxlg, nxrg
699                DO  j = nysg, nyng
700                   DO  k = nzb, nzt+1
701                      qr_av(k,j,i) = qr_av(k,j,i) + qr(k,j,i)
702                   ENDDO
703                ENDDO
704             ENDDO
705
706          CASE ( 'qsws*' )
707             DO  i = nxlg, nxrg
708                DO  j = nysg, nyng
709                   qsws_av(j,i) = qsws_av(j,i) + qsws(j,i)
710                ENDDO
711             ENDDO
712
713          CASE ( 'qsws_eb*' )
714             DO  i = nxlg, nxrg
715                DO  j = nysg, nyng
716                   qsws_eb_av(j,i) = qsws_eb_av(j,i) + qsws_eb(j,i)
717                ENDDO
718             ENDDO
719
720          CASE ( 'qsws_liq_eb*' )
721             DO  i = nxlg, nxrg
722                DO  j = nysg, nyng
723                   qsws_liq_eb_av(j,i) = qsws_liq_eb_av(j,i) + qsws_liq_eb(j,i)
724                ENDDO
725             ENDDO
726
727          CASE ( 'qsws_soil_eb*' )
728             DO  i = nxlg, nxrg
729                DO  j = nysg, nyng
730                   qsws_soil_eb_av(j,i) = qsws_soil_eb_av(j,i) + qsws_soil_eb(j,i)
731                ENDDO
732             ENDDO
733
734          CASE ( 'qsws_veg_eb*' )
735             DO  i = nxlg, nxrg
736                DO  j = nysg, nyng
737                   qsws_veg_eb_av(j,i) = qsws_veg_eb_av(j,i) + qsws_veg_eb(j,i)
738                ENDDO
739             ENDDO
740
741          CASE ( 'qv' )
742             DO  i = nxlg, nxrg
743                DO  j = nysg, nyng
744                   DO  k = nzb, nzt+1
745                      qv_av(k,j,i) = qv_av(k,j,i) + q(k,j,i) - ql(k,j,i)
746                   ENDDO
747                ENDDO
748             ENDDO
749
750          CASE ( 'rad_net*' )
751             DO  i = nxlg, nxrg
752                DO  j = nysg, nyng
753                   rad_net_av(j,i) = rad_net_av(j,i) + rad_net(j,i)
754                ENDDO
755             ENDDO
756
757          CASE ( 'rad_lw_in' )
758             DO  i = nxlg, nxrg
759                DO  j = nysg, nyng
760                   DO  k = nzb, nzt+1
761                      rad_lw_in_av(k,j,i) = rad_lw_in_av(k,j,i) + rad_lw_in(k,j,i)
762                   ENDDO
763                ENDDO
764             ENDDO
765
766          CASE ( 'rad_lw_out' )
767             DO  i = nxlg, nxrg
768                DO  j = nysg, nyng
769                   DO  k = nzb, nzt+1
770                      rad_lw_out_av(k,j,i) = rad_lw_out_av(k,j,i) + rad_lw_out(k,j,i)
771                   ENDDO
772                ENDDO
773             ENDDO
774
775
776          CASE ( 'rad_sw_in' )
777             DO  i = nxlg, nxrg
778                DO  j = nysg, nyng
779                   DO  k = nzb, nzt+1
780                      rad_sw_in_av(k,j,i) = rad_sw_in_av(k,j,i) + rad_sw_in(k,j,i)
781                   ENDDO
782                ENDDO
783             ENDDO
784
785          CASE ( 'rad_sw_out' )
786             DO  i = nxlg, nxrg
787                DO  j = nysg, nyng
788                   DO  k = nzb, nzt+1
789                      rad_sw_out_av(k,j,i) = rad_sw_out_av(k,j,i) + rad_sw_out(k,j,i)
790                   ENDDO
791                ENDDO
792             ENDDO
793
794          CASE ( 'r_a*' )
795             DO  i = nxlg, nxrg
796                DO  j = nysg, nyng
797                   r_a_av(j,i) = r_a_av(j,i) + r_a(j,i)
798                ENDDO
799             ENDDO
800
801          CASE ( 'r_s*' )
802             DO  i = nxlg, nxrg
803                DO  j = nysg, nyng
804                   r_s_av(j,i) = r_s_av(j,i) + r_s(j,i)
805                ENDDO
806             ENDDO
807
808          CASE ( 'rho' )
809             DO  i = nxlg, nxrg
810                DO  j = nysg, nyng
811                   DO  k = nzb, nzt+1
812                      rho_av(k,j,i) = rho_av(k,j,i) + rho(k,j,i)
813                   ENDDO
814                ENDDO
815             ENDDO
816
817          CASE ( 's' )
818             DO  i = nxlg, nxrg
819                DO  j = nysg, nyng
820                   DO  k = nzb, nzt+1
821                      s_av(k,j,i) = s_av(k,j,i) + q(k,j,i)
822                   ENDDO
823                ENDDO
824             ENDDO
825
826          CASE ( 'sa' )
827             DO  i = nxlg, nxrg
828                DO  j = nysg, nyng
829                   DO  k = nzb, nzt+1
830                      sa_av(k,j,i) = sa_av(k,j,i) + sa(k,j,i)
831                   ENDDO
832                ENDDO
833             ENDDO
834
835          CASE ( 'shf*' )
836             DO  i = nxlg, nxrg
837                DO  j = nysg, nyng
838                   shf_av(j,i) = shf_av(j,i) + shf(j,i)
839                ENDDO
840             ENDDO
841
842          CASE ( 'shf_eb*' )
843             DO  i = nxlg, nxrg
844                DO  j = nysg, nyng
845                   shf_eb_av(j,i) = shf_eb_av(j,i) + shf_eb(j,i)
846                ENDDO
847             ENDDO
848
849          CASE ( 't*' )
850             DO  i = nxlg, nxrg
851                DO  j = nysg, nyng
852                   ts_av(j,i) = ts_av(j,i) + ts(j,i)
853                ENDDO
854             ENDDO
855
856          CASE ( 't_soil' )
857             DO  i = nxlg, nxrg
858                DO  j = nysg, nyng
859                   DO  k = nzb_soil, nzt_soil
860                      t_soil_av(k,j,i) = t_soil_av(k,j,i) + t_soil(k,j,i)
861                   ENDDO
862                ENDDO
863             ENDDO
864
865          CASE ( 'u' )
866             DO  i = nxlg, nxrg
867                DO  j = nysg, nyng
868                   DO  k = nzb, nzt+1
869                      u_av(k,j,i) = u_av(k,j,i) + u(k,j,i)
870                   ENDDO
871                ENDDO
872             ENDDO
873
874          CASE ( 'u*' )
875             DO  i = nxlg, nxrg
876                DO  j = nysg, nyng
877                   us_av(j,i) = us_av(j,i) + us(j,i)
878                ENDDO
879             ENDDO
880
881          CASE ( 'v' )
882             DO  i = nxlg, nxrg
883                DO  j = nysg, nyng
884                   DO  k = nzb, nzt+1
885                      v_av(k,j,i) = v_av(k,j,i) + v(k,j,i)
886                   ENDDO
887                ENDDO
888             ENDDO
889
890          CASE ( 'vpt' )
891             DO  i = nxlg, nxrg
892                DO  j = nysg, nyng
893                   DO  k = nzb, nzt+1
894                      vpt_av(k,j,i) = vpt_av(k,j,i) + vpt(k,j,i)
895                   ENDDO
896                ENDDO
897             ENDDO
898
899          CASE ( 'w' )
900             DO  i = nxlg, nxrg
901                DO  j = nysg, nyng
902                   DO  k = nzb, nzt+1
903                      w_av(k,j,i) = w_av(k,j,i) + w(k,j,i)
904                   ENDDO
905                ENDDO
906             ENDDO
907
908          CASE ( 'z0*' )
909             DO  i = nxlg, nxrg
910                DO  j = nysg, nyng
911                   z0_av(j,i) = z0_av(j,i) + z0(j,i)
912                ENDDO
913             ENDDO
914
915          CASE ( 'z0h*' )
916             DO  i = nxlg, nxrg
917                DO  j = nysg, nyng
918                   z0h_av(j,i) = z0h_av(j,i) + z0h(j,i)
919                ENDDO
920             ENDDO
921
922          CASE DEFAULT
923!
924!--          User-defined quantity
925             CALL user_3d_data_averaging( 'sum', doav(ii) )
926
927       END SELECT
928
929    ENDDO
930
931    CALL cpu_log( log_point(34), 'sum_up_3d_data', 'stop' )
932
933
934 END SUBROUTINE sum_up_3d_data
Note: See TracBrowser for help on using the repository browser.