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

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

last commit documented

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