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

Last change on this file since 1852 was 1852, checked in by hoffmann, 8 years ago

last commit documented

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