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

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

last commit documented

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