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

Last change on this file since 1585 was 1585, checked in by maronga, 9 years ago

Added support for RRTMG radiation code

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