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

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

last commit documented

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