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

Last change on this file since 4281 was 4182, checked in by scharf, 22 months ago
  • corrected "Former revisions" section
  • minor formatting in "Former revisions" section
  • added "Author" section
  • Property svn:keywords set to Id
File size: 39.7 KB
RevLine 
[1682]1!> @file sum_up_3d_data.f90
[2000]2!------------------------------------------------------------------------------!
[2696]3! This file is part of the PALM model system.
[1036]4!
[2000]5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
[1036]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!
[3655]17! Copyright 1997-2019 Leibniz Universitaet Hannover
[2000]18!------------------------------------------------------------------------------!
[1036]19!
[484]20! Current revisions:
[3569]21! ------------------
[1360]22!
[3589]23!
[1321]24! Former revisions:
25! -----------------
26! $Id: sum_up_3d_data.f90 4182 2019-08-22 15:20:23Z schwenkel $
[4182]27! Corrected "Former revisions" section
28!
29! 4048 2019-06-21 21:00:21Z knoop
[4048]30! Moved tcm_3d_data_averaging to module_interface
31!
32! 4039 2019-06-18 10:32:41Z suehring
[4039]33! Modularize diagnostic output
34!
35! 3994 2019-05-22 18:08:09Z suehring
[3994]36! output of turbulence intensity added
37!
38! 3943 2019-05-02 09:50:41Z maronga
[3943]39! Added output of qsws_av for green roofs.
40!
41! 3933 2019-04-25 12:33:20Z kanani
[3933]42! Formatting
43!
44! 3773 2019-03-01 08:56:57Z maronga
[3773]45! Added output of theta_2m*_xy_av
46!
47! 3761 2019-02-25 15:31:42Z raasch
[3761]48! unused variables removed
49!
50! 3655 2019-01-07 16:51:22Z knoop
[3637]51! Implementation of the PALM module interface
[3582]52!
[4182]53! Revision 1.1  2006/02/23 12:55:23  raasch
54! Initial revision
55!
56!
[1]57! Description:
58! ------------
[1682]59!> Sum-up the values of 3d-arrays. The real averaging is later done in routine
60!> average_3d_data.
[1]61!------------------------------------------------------------------------------!
[1682]62 SUBROUTINE sum_up_3d_data
63 
[1]64
[1320]65    USE arrays_3d,                                                             &
[3761]66        ONLY:  dzw, d_exner, e, heatflux_output_conversion, p,    &
67               pt, q, ql, ql_c, ql_v, s, u, v, vpt, w,                 &
[3294]68               waterflux_output_conversion
[1]69
[1320]70    USE averaging,                                                             &
[3294]71        ONLY:  e_av, ghf_av, lpt_av, lwp_av, ol_av, p_av, pc_av, pr_av, pt_av, &
[3597]72               pt_2m_av, q_av, ql_av, ql_c_av, ql_v_av, ql_vp_av, qsws_av,     &
73               qv_av, r_a_av, s_av, shf_av, ssws_av, ts_av, tsurf_av, u_av,    &
74               us_av, v_av, vpt_av, w_av, z0_av, z0h_av, z0q_av
[3241]75
[3274]76    USE basic_constants_and_equations_mod,                                     &
77        ONLY:  c_p, lv_d_cp, l_v
78
79    USE bulk_cloud_model_mod,                                                  &
[3637]80        ONLY:  bulk_cloud_model
[3274]81
[1320]82    USE control_parameters,                                                    &
[3637]83        ONLY:  average_count_3d, doav, doav_n, rho_surface, urban_surface,     &
[3569]84               varnamelength
[1320]85
86    USE cpulog,                                                                &
87        ONLY:  cpu_log, log_point
88
89    USE indices,                                                               &
90        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
91
92    USE kinds
93
[3637]94    USE module_interface,                                                      &
95        ONLY:  module_interface_3d_data_averaging
[1551]96
[1320]97    USE particle_attributes,                                                   &
[1359]98        ONLY:  grid_particles, number_of_particles, particles, prt_count
[1320]99
[2232]100    USE surface_mod,                                                           &
[2963]101        ONLY:  ind_pav_green, ind_veg_wall, ind_wat_win,                       &
102               surf_def_h, surf_lsm_h, surf_usm_h
[2232]103
[2007]104    USE urban_surface_mod,                                                     &
[3637]105        ONLY:  usm_3d_data_averaging
[1691]106
[2007]107
[1]108    IMPLICIT NONE
109
[3170]110    LOGICAL      ::  match_def !< flag indicating default-type surface
111    LOGICAL      ::  match_lsm !< flag indicating natural-type surface
112    LOGICAL      ::  match_usm !< flag indicating urban-type surface
113   
[2232]114    INTEGER(iwp) ::  i   !< grid index x direction
[2007]115    INTEGER(iwp) ::  ii  !< running index
[2232]116    INTEGER(iwp) ::  j   !< grid index y direction
117    INTEGER(iwp) ::  k   !< grid index x direction
[3552]118    INTEGER(iwp) ::  m   !< running index over surfacle elements
119    INTEGER(iwp) ::  n   !< running index over number of particles per grid box
[1]120
[3552]121    REAL(wp)     ::  mean_r !< mean-particle radius witin grid box
122    REAL(wp)     ::  s_r2   !< mean-particle radius witin grid box to the power of two
123    REAL(wp)     ::  s_r3   !< mean-particle radius witin grid box to the power of three
[1]124
[2011]125    CHARACTER (LEN=varnamelength) ::  trimvar  !< TRIM of output-variable string
[2007]126
127
[1]128    CALL cpu_log (log_point(34),'sum_up_3d_data','start')
129
130!
131!-- Allocate and initialize the summation arrays if called for the very first
132!-- time or the first time after average_3d_data has been called
133!-- (some or all of the arrays may have been already allocated
[2894]134!-- in rrd_local)
[1]135    IF ( average_count_3d == 0 )  THEN
136
137       DO  ii = 1, doav_n
[3337]138
[2007]139          trimvar = TRIM( doav(ii) )
[3337]140
[2007]141          SELECT CASE ( trimvar )
[1]142
[2797]143             CASE ( 'ghf*' )
144                IF ( .NOT. ALLOCATED( ghf_av ) )  THEN
145                   ALLOCATE( ghf_av(nysg:nyng,nxlg:nxrg) )
146                ENDIF
147                ghf_av = 0.0_wp
148
[1]149             CASE ( 'e' )
150                IF ( .NOT. ALLOCATED( e_av ) )  THEN
[667]151                   ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]152                ENDIF
[1353]153                e_av = 0.0_wp
[1]154
[3421]155             CASE ( 'thetal' )
[771]156                IF ( .NOT. ALLOCATED( lpt_av ) )  THEN
157                   ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
158                ENDIF
[1353]159                lpt_av = 0.0_wp
[771]160
[1]161             CASE ( 'lwp*' )
162                IF ( .NOT. ALLOCATED( lwp_av ) )  THEN
[667]163                   ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
[1]164                ENDIF
[1353]165                lwp_av = 0.0_wp
[1]166
[1691]167             CASE ( 'ol*' )
168                IF ( .NOT. ALLOCATED( ol_av ) )  THEN
169                   ALLOCATE( ol_av(nysg:nyng,nxlg:nxrg) )
170                ENDIF
171                ol_av = 0.0_wp
172
[1]173             CASE ( 'p' )
174                IF ( .NOT. ALLOCATED( p_av ) )  THEN
[667]175                   ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]176                ENDIF
[1353]177                p_av = 0.0_wp
[1]178
179             CASE ( 'pc' )
180                IF ( .NOT. ALLOCATED( pc_av ) )  THEN
[667]181                   ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]182                ENDIF
[1353]183                pc_av = 0.0_wp
[1]184
185             CASE ( 'pr' )
186                IF ( .NOT. ALLOCATED( pr_av ) )  THEN
[667]187                   ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]188                ENDIF
[1353]189                pr_av = 0.0_wp
[1]190
[3421]191             CASE ( 'theta' )
[1]192                IF ( .NOT. ALLOCATED( pt_av ) )  THEN
[667]193                   ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]194                ENDIF
[1353]195                pt_av = 0.0_wp
[1]196
197             CASE ( 'q' )
198                IF ( .NOT. ALLOCATED( q_av ) )  THEN
[667]199                   ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]200                ENDIF
[1353]201                q_av = 0.0_wp
[1]202
203             CASE ( 'ql' )
204                IF ( .NOT. ALLOCATED( ql_av ) )  THEN
[667]205                   ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]206                ENDIF
[1353]207                ql_av = 0.0_wp
[1]208
209             CASE ( 'ql_c' )
210                IF ( .NOT. ALLOCATED( ql_c_av ) )  THEN
[667]211                   ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]212                ENDIF
[1353]213                ql_c_av = 0.0_wp
[1]214
215             CASE ( 'ql_v' )
216                IF ( .NOT. ALLOCATED( ql_v_av ) )  THEN
[667]217                   ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]218                ENDIF
[1353]219                ql_v_av = 0.0_wp
[1]220
221             CASE ( 'ql_vp' )
222                IF ( .NOT. ALLOCATED( ql_vp_av ) )  THEN
[667]223                   ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]224                ENDIF
[1353]225                ql_vp_av = 0.0_wp
[1]226
[354]227             CASE ( 'qsws*' )
228                IF ( .NOT. ALLOCATED( qsws_av ) )  THEN
[667]229                   ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
[354]230                ENDIF
[1353]231                qsws_av = 0.0_wp
[354]232
[1]233             CASE ( 'qv' )
234                IF ( .NOT. ALLOCATED( qv_av ) )  THEN
[667]235                   ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]236                ENDIF
[1353]237                qv_av = 0.0_wp
[1]238
[2735]239             CASE ( 'r_a*' )
240                IF ( .NOT. ALLOCATED( r_a_av ) )  THEN
241                   ALLOCATE( r_a_av(nysg:nyng,nxlg:nxrg) )
242                ENDIF
243                r_a_av = 0.0_wp
244
[1]245             CASE ( 's' )
246                IF ( .NOT. ALLOCATED( s_av ) )  THEN
[667]247                   ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]248                ENDIF
[1353]249                s_av = 0.0_wp
[1]250
[354]251             CASE ( 'shf*' )
252                IF ( .NOT. ALLOCATED( shf_av ) )  THEN
[667]253                   ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
[354]254                ENDIF
[1353]255                shf_av = 0.0_wp
[2024]256               
257             CASE ( 'ssws*' )
258                IF ( .NOT. ALLOCATED( ssws_av ) )  THEN
259                   ALLOCATE( ssws_av(nysg:nyng,nxlg:nxrg) )
260                ENDIF
261                ssws_av = 0.0_wp               
[354]262
[1]263             CASE ( 't*' )
264                IF ( .NOT. ALLOCATED( ts_av ) )  THEN
[667]265                   ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
[1]266                ENDIF
[1353]267                ts_av = 0.0_wp
[1]268
[2742]269             CASE ( 'tsurf*' )
270                IF ( .NOT. ALLOCATED( tsurf_av ) )  THEN
271                   ALLOCATE( tsurf_av(nysg:nyng,nxlg:nxrg) )
272                ENDIF
273                tsurf_av = 0.0_wp
274
[1]275             CASE ( 'u' )
276                IF ( .NOT. ALLOCATED( u_av ) )  THEN
[667]277                   ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]278                ENDIF
[1353]279                u_av = 0.0_wp
[1]280
[3421]281             CASE ( 'us*' )
[1]282                IF ( .NOT. ALLOCATED( us_av ) )  THEN
[667]283                   ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
[1]284                ENDIF
[1353]285                us_av = 0.0_wp
[1]286
287             CASE ( 'v' )
288                IF ( .NOT. ALLOCATED( v_av ) )  THEN
[667]289                   ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]290                ENDIF
[1353]291                v_av = 0.0_wp
[1]292
[3421]293             CASE ( 'thetav' )
[1]294                IF ( .NOT. ALLOCATED( vpt_av ) )  THEN
[667]295                   ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]296                ENDIF
[1353]297                vpt_av = 0.0_wp
[1]298
[3597]299             CASE ( 'theta_2m*' )
300                IF ( .NOT. ALLOCATED( pt_2m_av ) )  THEN
301                   ALLOCATE( pt_2m_av(nysg:nyng,nxlg:nxrg) )
302                ENDIF
303                pt_2m_av = 0.0_wp
304
[1]305             CASE ( 'w' )
306                IF ( .NOT. ALLOCATED( w_av ) )  THEN
[667]307                   ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
[1]308                ENDIF
[1353]309                w_av = 0.0_wp
[1]310
[72]311             CASE ( 'z0*' )
312                IF ( .NOT. ALLOCATED( z0_av ) )  THEN
[667]313                   ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
[72]314                ENDIF
[1353]315                z0_av = 0.0_wp
[72]316
[978]317             CASE ( 'z0h*' )
318                IF ( .NOT. ALLOCATED( z0h_av ) )  THEN
319                   ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
320                ENDIF
[1353]321                z0h_av = 0.0_wp
[978]322
[1788]323             CASE ( 'z0q*' )
324                IF ( .NOT. ALLOCATED( z0q_av ) )  THEN
325                   ALLOCATE( z0q_av(nysg:nyng,nxlg:nxrg) )
326                ENDIF
327                z0q_av = 0.0_wp
[3294]328
[2007]329
[1]330             CASE DEFAULT
[1972]331
[1]332!
[3637]333!--             Allocating and initializing data arrays for all other modules
334                CALL module_interface_3d_data_averaging( 'allocate', trimvar )
[3337]335
[3274]336
[1]337          END SELECT
338
339       ENDDO
340
341    ENDIF
342
343!
344!-- Loop of all variables to be averaged.
345    DO  ii = 1, doav_n
[3337]346
347       trimvar = TRIM( doav(ii) )
[1]348!
349!--    Store the array chosen on the temporary array.
[2007]350       SELECT CASE ( trimvar )
[1]351
[2797]352          CASE ( 'ghf*' )
[3004]353             IF ( ALLOCATED( ghf_av ) ) THEN
[3170]354                DO  i = nxl, nxr
355                   DO  j = nys, nyn
356!
357!--                   Check whether grid point is a natural- or urban-type
358!--                   surface.
359                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
360                                  surf_lsm_h%end_index(j,i)
361                      match_usm = surf_usm_h%start_index(j,i) <=               &
362                                  surf_usm_h%end_index(j,i)
363!
364!--                   In order to avoid double-counting of surface properties,
365!--                   always assume that natural-type surfaces are below urban-
366!--                   type surfaces, e.g. in case of bridges.
367!--                   Further, take only the last suface element, i.e. the
368!--                   uppermost surface which would be visible from above
369                      IF ( match_lsm  .AND.  .NOT. match_usm )  THEN
370                         m = surf_lsm_h%end_index(j,i)
[3173]371                         ghf_av(j,i) = ghf_av(j,i) +                           &
[3170]372                                         surf_lsm_h%ghf(m)
373                      ELSEIF ( match_usm )  THEN
374                         m = surf_usm_h%end_index(j,i)
[3173]375                         ghf_av(j,i) = ghf_av(j,i) +                           &
[3170]376                                         surf_usm_h%frac(ind_veg_wall,m)  *    &
377                                         surf_usm_h%wghf_eb(m)        +        &
378                                         surf_usm_h%frac(ind_pav_green,m) *    &
379                                         surf_usm_h%wghf_eb_green(m)  +        &
380                                         surf_usm_h%frac(ind_wat_win,m)   *    &
381                                         surf_usm_h%wghf_eb_window(m)
382                      ENDIF
383                   ENDDO
[3004]384                ENDDO
385             ENDIF
[2797]386
[1]387          CASE ( 'e' )
[3004]388             IF ( ALLOCATED( e_av ) ) THEN
389                DO  i = nxlg, nxrg
390                   DO  j = nysg, nyng
391                      DO  k = nzb, nzt+1
392                         e_av(k,j,i) = e_av(k,j,i) + e(k,j,i)
393                      ENDDO
[1]394                   ENDDO
395                ENDDO
[3004]396             ENDIF
[1]397
[3421]398          CASE ( 'thetal' )
[3004]399             IF ( ALLOCATED( lpt_av ) ) THEN
400                DO  i = nxlg, nxrg
401                   DO  j = nysg, nyng
402                      DO  k = nzb, nzt+1
403                         lpt_av(k,j,i) = lpt_av(k,j,i) + pt(k,j,i)
404                      ENDDO
[771]405                   ENDDO
406                ENDDO
[3004]407             ENDIF
[771]408
[1]409          CASE ( 'lwp*' )
[3004]410             IF ( ALLOCATED( lwp_av ) ) THEN
411                DO  i = nxlg, nxrg
412                   DO  j = nysg, nyng
413                      lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i)            &
414                                                  * dzw(1:nzt+1) ) * rho_surface
415                   ENDDO
[1]416                ENDDO
[3004]417             ENDIF
[1]418
[1691]419          CASE ( 'ol*' )
[3004]420             IF ( ALLOCATED( ol_av ) ) THEN
[3170]421                DO  i = nxl, nxr
422                   DO  j = nys, nyn
423                      match_def = surf_def_h(0)%start_index(j,i) <=            &
424                                  surf_def_h(0)%end_index(j,i)
425                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
426                                  surf_lsm_h%end_index(j,i)
427                      match_usm = surf_usm_h%start_index(j,i) <=               &
428                                  surf_usm_h%end_index(j,i)
429
430                      IF ( match_def )  THEN
431                         m = surf_def_h(0)%end_index(j,i)
[3173]432                         ol_av(j,i) = ol_av(j,i) +                             &
[3170]433                                         surf_def_h(0)%ol(m)
434                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
435                         m = surf_lsm_h%end_index(j,i)
[3173]436                         ol_av(j,i) = ol_av(j,i) +                             &
[3170]437                                         surf_lsm_h%ol(m)
438                      ELSEIF ( match_usm )  THEN
439                         m = surf_usm_h%end_index(j,i)
[3173]440                         ol_av(j,i) = ol_av(j,i) +                             &
[3170]441                                         surf_usm_h%ol(m)
442                      ENDIF
443                   ENDDO
[3004]444                ENDDO
445             ENDIF
[1691]446
[1]447          CASE ( 'p' )
[3004]448             IF ( ALLOCATED( p_av ) ) THEN
449                DO  i = nxlg, nxrg
450                   DO  j = nysg, nyng
451                      DO  k = nzb, nzt+1
452                         p_av(k,j,i) = p_av(k,j,i) + p(k,j,i)
453                      ENDDO
[1]454                   ENDDO
455                ENDDO
[3004]456             ENDIF
[1]457
458          CASE ( 'pc' )
[3004]459             IF ( ALLOCATED( pc_av ) ) THEN
460                DO  i = nxl, nxr
461                   DO  j = nys, nyn
462                      DO  k = nzb, nzt+1
463                         pc_av(k,j,i) = pc_av(k,j,i) + prt_count(k,j,i)
464                      ENDDO
[1]465                   ENDDO
466                ENDDO
[3004]467             ENDIF
[1]468
469          CASE ( 'pr' )
[3004]470             IF ( ALLOCATED( pr_av ) ) THEN
471                DO  i = nxl, nxr
472                   DO  j = nys, nyn
473                      DO  k = nzb, nzt+1
474                         number_of_particles = prt_count(k,j,i)
475                         IF ( number_of_particles <= 0 )  CYCLE
476                         particles =>                                          &
477                         grid_particles(k,j,i)%particles(1:number_of_particles)
478                         s_r2 = 0.0_wp
479                         s_r3 = 0.0_wp
[1359]480
[3004]481                         DO  n = 1, number_of_particles
482                            IF ( particles(n)%particle_mask )  THEN
483                               s_r2 = s_r2 + particles(n)%radius**2 *          &
484                                   particles(n)%weight_factor
485                               s_r3 = s_r3 + particles(n)%radius**3 *          &
486                                   particles(n)%weight_factor
487                            ENDIF
488                         ENDDO
489
490                         IF ( s_r2 > 0.0_wp )  THEN
491                            mean_r = s_r3 / s_r2
492                         ELSE
493                            mean_r = 0.0_wp
[1359]494                         ENDIF
[3004]495                         pr_av(k,j,i) = pr_av(k,j,i) + mean_r
[1]496                      ENDDO
497                   ENDDO
498                ENDDO
[3004]499             ENDIF
[1]500
[3421]501          CASE ( 'theta' )
[3004]502             IF ( ALLOCATED( pt_av ) ) THEN
[3274]503                IF ( .NOT. bulk_cloud_model ) THEN
[3004]504                DO  i = nxlg, nxrg
505                   DO  j = nysg, nyng
506                      DO  k = nzb, nzt+1
507                            pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
508                         ENDDO
[1]509                      ENDDO
510                   ENDDO
[3004]511                ELSE
512                DO  i = nxlg, nxrg
513                   DO  j = nysg, nyng
514                      DO  k = nzb, nzt+1
[3274]515                            pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + lv_d_cp * &
516                                                          d_exner(k) * ql(k,j,i)
[3004]517                         ENDDO
[1]518                      ENDDO
519                   ENDDO
[3004]520                ENDIF
[1]521             ENDIF
522
523          CASE ( 'q' )
[3004]524             IF ( ALLOCATED( q_av ) ) THEN
525                DO  i = nxlg, nxrg
526                   DO  j = nysg, nyng
527                      DO  k = nzb, nzt+1
528                         q_av(k,j,i) = q_av(k,j,i) + q(k,j,i)
529                      ENDDO
[1]530                   ENDDO
531                ENDDO
[3004]532             ENDIF
[402]533
[1]534          CASE ( 'ql' )
[3004]535             IF ( ALLOCATED( ql_av ) ) THEN
536                DO  i = nxlg, nxrg
537                   DO  j = nysg, nyng
538                      DO  k = nzb, nzt+1
539                         ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i)
540                      ENDDO
[1]541                   ENDDO
542                ENDDO
[3004]543             ENDIF
[1]544
545          CASE ( 'ql_c' )
[3004]546             IF ( ALLOCATED( ql_c_av ) ) THEN
547                DO  i = nxlg, nxrg
548                   DO  j = nysg, nyng
549                      DO  k = nzb, nzt+1
550                         ql_c_av(k,j,i) = ql_c_av(k,j,i) + ql_c(k,j,i)
551                      ENDDO
[1]552                   ENDDO
553                ENDDO
[3004]554             ENDIF
[1]555
556          CASE ( 'ql_v' )
[3004]557             IF ( ALLOCATED( ql_v_av ) ) THEN
558                DO  i = nxlg, nxrg
559                   DO  j = nysg, nyng
560                      DO  k = nzb, nzt+1
561                         ql_v_av(k,j,i) = ql_v_av(k,j,i) + ql_v(k,j,i)
562                      ENDDO
[1]563                   ENDDO
564                ENDDO
[3004]565             ENDIF
[1]566
567          CASE ( 'ql_vp' )
[3004]568             IF ( ALLOCATED( ql_vp_av ) ) THEN
569                DO  i = nxl, nxr
570                   DO  j = nys, nyn
571                      DO  k = nzb, nzt+1
572                         number_of_particles = prt_count(k,j,i)
573                         IF ( number_of_particles <= 0 )  CYCLE
574                         particles =>                                          & 
575                         grid_particles(k,j,i)%particles(1:number_of_particles)
576                         DO  n = 1, number_of_particles
577                            IF ( particles(n)%particle_mask )  THEN
578                               ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + &
579                                                 particles(n)%weight_factor /  &
580                                                 number_of_particles
581                            ENDIF
582                         ENDDO
[1007]583                      ENDDO
[1]584                   ENDDO
585                ENDDO
[3004]586             ENDIF
[1]587
[402]588          CASE ( 'qsws*' )
[2743]589!
590!--          In case of default surfaces, clean-up flux by density.
591!--          In case of land- and urban-surfaces, convert fluxes into
592!--          dynamic units.
[3943]593!--          Question (maronga): are the .NOT. statements really required?
[3004]594             IF ( ALLOCATED( qsws_av ) ) THEN
[3170]595                DO  i = nxl, nxr
596                   DO  j = nys, nyn
597                      match_def = surf_def_h(0)%start_index(j,i) <=            &
598                                  surf_def_h(0)%end_index(j,i)
599                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
600                                  surf_lsm_h%end_index(j,i)
601                      match_usm = surf_usm_h%start_index(j,i) <=               &
602                                  surf_usm_h%end_index(j,i)
603
604                      IF ( match_def )  THEN
605                         m = surf_def_h(0)%end_index(j,i)
[3173]606                         qsws_av(j,i) = qsws_av(j,i) +                         &
[3170]607                                         surf_def_h(0)%qsws(m) *               &
[3285]608                                         waterflux_output_conversion(nzb)
[3170]609                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
610                         m = surf_lsm_h%end_index(j,i)
[3173]611                         qsws_av(j,i) = qsws_av(j,i) +                         &
[3170]612                                         surf_lsm_h%qsws(m) * l_v
[3943]613                      ELSEIF ( match_usm  .AND.  .NOT. match_lsm )  THEN
614                         m = surf_usm_h%end_index(j,i)
615                         qsws_av(j,i) = qsws_av(j,i) +                         &
616                                         surf_usm_h%qsws(m) * l_v
[3170]617                      ENDIF
618                   ENDDO
[3004]619                ENDDO
620             ENDIF
[402]621
[1]622          CASE ( 'qv' )
[3004]623             IF ( ALLOCATED( qv_av ) ) THEN
624                DO  i = nxlg, nxrg
625                   DO  j = nysg, nyng
626                      DO  k = nzb, nzt+1
627                         qv_av(k,j,i) = qv_av(k,j,i) + q(k,j,i) - ql(k,j,i)
628                      ENDDO
[1]629                   ENDDO
630                ENDDO
[3004]631             ENDIF
[1]632
[2735]633          CASE ( 'r_a*' )
[3004]634             IF ( ALLOCATED( r_a_av ) ) THEN
[3170]635                DO  i = nxl, nxr
636                   DO  j = nys, nyn
637                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
638                                  surf_lsm_h%end_index(j,i)
639                      match_usm = surf_usm_h%start_index(j,i) <=               &
640                                  surf_usm_h%end_index(j,i)
641
642                      IF ( match_lsm  .AND.  .NOT. match_usm )  THEN
643                         m = surf_lsm_h%end_index(j,i)
[3173]644                         r_a_av(j,i) = r_a_av(j,i) +                           &
[3170]645                                         surf_lsm_h%r_a(m)
646                      ELSEIF ( match_usm )  THEN
647                         m = surf_usm_h%end_index(j,i)
[3173]648                         r_a_av(j,i) = r_a_av(j,i) +                           &
[3170]649                                         surf_usm_h%frac(ind_veg_wall,m)  *    &
650                                         surf_usm_h%r_a(m)       +             & 
651                                         surf_usm_h%frac(ind_pav_green,m) *    &
652                                         surf_usm_h%r_a_green(m) +             & 
653                                         surf_usm_h%frac(ind_wat_win,m)   *    &
654                                         surf_usm_h%r_a_window(m)
655                      ENDIF
656                   ENDDO
[3004]657                ENDDO
658             ENDIF
[2735]659
[1]660          CASE ( 's' )
[3004]661             IF ( ALLOCATED( s_av ) ) THEN
662                DO  i = nxlg, nxrg
663                   DO  j = nysg, nyng
664                      DO  k = nzb, nzt+1
665                         s_av(k,j,i) = s_av(k,j,i) + s(k,j,i)
666                      ENDDO
[1]667                   ENDDO
668                ENDDO
[3004]669             ENDIF
[402]670
671          CASE ( 'shf*' )
[2743]672!
673!--          In case of default surfaces, clean-up flux by density.
674!--          In case of land- and urban-surfaces, convert fluxes into
675!--          dynamic units.
[3004]676             IF ( ALLOCATED( shf_av ) ) THEN
[3170]677                DO  i = nxl, nxr
678                   DO  j = nys, nyn
679                      match_def = surf_def_h(0)%start_index(j,i) <=            &
680                                  surf_def_h(0)%end_index(j,i)
681                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
682                                  surf_lsm_h%end_index(j,i)
683                      match_usm = surf_usm_h%start_index(j,i) <=               &
684                                  surf_usm_h%end_index(j,i)
685
686                      IF ( match_def )  THEN
687                         m = surf_def_h(0)%end_index(j,i)
[3173]688                         shf_av(j,i) = shf_av(j,i) +                           &
[3170]689                                         surf_def_h(0)%shf(m)  *               &
[3285]690                                         heatflux_output_conversion(nzb)
[3170]691                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
692                         m = surf_lsm_h%end_index(j,i)
[3173]693                         shf_av(j,i) = shf_av(j,i) +                           &
[3274]694                                         surf_lsm_h%shf(m) * c_p
[3170]695                      ELSEIF ( match_usm )  THEN
696                         m = surf_usm_h%end_index(j,i)
[3173]697                         shf_av(j,i) = shf_av(j,i) +                           &
[3274]698                                         surf_usm_h%shf(m) * c_p
[3170]699                      ENDIF
700                   ENDDO
[3004]701                ENDDO
702             ENDIF
[402]703
[1960]704          CASE ( 'ssws*' )
[3004]705             IF ( ALLOCATED( ssws_av ) ) THEN
[3170]706                DO  i = nxl, nxr
707                   DO  j = nys, nyn
708                      match_def = surf_def_h(0)%start_index(j,i) <=            &
709                                  surf_def_h(0)%end_index(j,i)
710                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
711                                  surf_lsm_h%end_index(j,i)
712                      match_usm = surf_usm_h%start_index(j,i) <=               &
713                                  surf_usm_h%end_index(j,i)
714
715                      IF ( match_def )  THEN
716                         m = surf_def_h(0)%end_index(j,i)
[3173]717                         ssws_av(j,i) = ssws_av(j,i) +                         &
[3170]718                                         surf_def_h(0)%ssws(m)
719                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
720                         m = surf_lsm_h%end_index(j,i)
[3173]721                         ssws_av(j,i) = ssws_av(j,i) +                         &
[3170]722                                         surf_lsm_h%ssws(m)
723                      ELSEIF ( match_usm )  THEN
724                         m = surf_usm_h%end_index(j,i)
[3173]725                         ssws_av(j,i) = ssws_av(j,i) +                         &
[3170]726                                         surf_usm_h%ssws(m)
727                      ENDIF
728                   ENDDO
[3004]729                ENDDO
730             ENDIF
[1960]731
[3773]732          CASE ( 'theta_2m*' )
733             IF ( ALLOCATED( pt_2m_av ) ) THEN   
734                DO  i = nxl, nxr
735                   DO  j = nys, nyn
736                      match_def = surf_def_h(0)%start_index(j,i) <=            &
737                                  surf_def_h(0)%end_index(j,i)
738                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
739                                  surf_lsm_h%end_index(j,i)
740                      match_usm = surf_usm_h%start_index(j,i) <=               &
741                                  surf_usm_h%end_index(j,i)
742
743                      IF ( match_def )  THEN
744                         m = surf_def_h(0)%end_index(j,i)
745                         pt_2m_av(j,i) = pt_2m_av(j,i) +                       &
746                                         surf_def_h(0)%pt_2m(m)
747                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
748                         m = surf_lsm_h%end_index(j,i)
[3933]749                         pt_2m_av(j,i) = pt_2m_av(j,i) +                       &
[3773]750                                         surf_lsm_h%pt_2m(m)
751                      ELSEIF ( match_usm )  THEN
752                         m = surf_usm_h%end_index(j,i)
753                         pt_2m_av(j,i) = pt_2m_av(j,i) +                       &
754                                         surf_usm_h%pt_2m(m)
755                      ENDIF
756                   ENDDO
757                ENDDO
758             ENDIF
759             
760             
[1]761          CASE ( 't*' )
[3004]762             IF ( ALLOCATED( ts_av ) ) THEN
[3170]763                DO  i = nxl, nxr
764                   DO  j = nys, nyn
765                      match_def = surf_def_h(0)%start_index(j,i) <=            &
766                                  surf_def_h(0)%end_index(j,i)
767                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
768                                  surf_lsm_h%end_index(j,i)
769                      match_usm = surf_usm_h%start_index(j,i) <=               &
770                                  surf_usm_h%end_index(j,i)
771
772                      IF ( match_def )  THEN
773                         m = surf_def_h(0)%end_index(j,i)
[3173]774                         ts_av(j,i) = ts_av(j,i) +                             &
[3170]775                                         surf_def_h(0)%ts(m)
776                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
777                         m = surf_lsm_h%end_index(j,i)
[3173]778                         ts_av(j,i) = ts_av(j,i) +                             &
[3170]779                                         surf_lsm_h%ts(m)
780                      ELSEIF ( match_usm )  THEN
781                         m = surf_usm_h%end_index(j,i)
[3173]782                         ts_av(j,i) = ts_av(j,i) +                             &
[3170]783                                         surf_usm_h%ts(m)
784                      ENDIF
785                   ENDDO
[3004]786                ENDDO
787             ENDIF
[1]788
[2742]789          CASE ( 'tsurf*' )
[3170]790             IF ( ALLOCATED( tsurf_av ) ) THEN   
791                DO  i = nxl, nxr
792                   DO  j = nys, nyn
793                      match_def = surf_def_h(0)%start_index(j,i) <=            &
794                                  surf_def_h(0)%end_index(j,i)
795                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
796                                  surf_lsm_h%end_index(j,i)
797                      match_usm = surf_usm_h%start_index(j,i) <=               &
798                                  surf_usm_h%end_index(j,i)
[2798]799
[3170]800                      IF ( match_def )  THEN
801                         m = surf_def_h(0)%end_index(j,i)
802                         tsurf_av(j,i) = tsurf_av(j,i) +                       &
803                                         surf_def_h(0)%pt_surface(m)
804                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
805                         m = surf_lsm_h%end_index(j,i)
806                         tsurf_av(j,i) = tsurf_av(j,i) +                       &
807                                         surf_lsm_h%pt_surface(m)
808                      ELSEIF ( match_usm )  THEN
809                         m = surf_usm_h%end_index(j,i)
810                         tsurf_av(j,i) = tsurf_av(j,i) +                       &
811                                         surf_usm_h%pt_surface(m)
812                      ENDIF
813                   ENDDO
[3004]814                ENDDO
815             ENDIF
[2742]816
[1]817          CASE ( 'u' )
[3004]818             IF ( ALLOCATED( u_av ) ) THEN
819                DO  i = nxlg, nxrg
820                   DO  j = nysg, nyng
821                      DO  k = nzb, nzt+1
822                         u_av(k,j,i) = u_av(k,j,i) + u(k,j,i)
823                      ENDDO
[1]824                   ENDDO
825                ENDDO
[3004]826             ENDIF
[1]827
[3421]828          CASE ( 'us*' )
[3004]829             IF ( ALLOCATED( us_av ) ) THEN   
[3170]830                DO  i = nxl, nxr
831                   DO  j = nys, nyn
832                      match_def = surf_def_h(0)%start_index(j,i) <=            &
833                                  surf_def_h(0)%end_index(j,i)
834                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
835                                  surf_lsm_h%end_index(j,i)
836                      match_usm = surf_usm_h%start_index(j,i) <=               &
837                                  surf_usm_h%end_index(j,i)
838
839                      IF ( match_def )  THEN
840                         m = surf_def_h(0)%end_index(j,i)
[3173]841                         us_av(j,i) = us_av(j,i) +                             &
[3170]842                                         surf_def_h(0)%us(m)
843                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
844                         m = surf_lsm_h%end_index(j,i)
[3173]845                         us_av(j,i) = us_av(j,i) +                             &
[3170]846                                         surf_lsm_h%us(m)
847                      ELSEIF ( match_usm )  THEN
848                         m = surf_usm_h%end_index(j,i)
[3173]849                         us_av(j,i) = us_av(j,i) +                             &
[3170]850                                         surf_usm_h%us(m)
851                      ENDIF
852                   ENDDO
[3004]853                ENDDO
854             ENDIF
[1]855
856          CASE ( 'v' )
[3004]857             IF ( ALLOCATED( v_av ) ) THEN
858                DO  i = nxlg, nxrg
859                   DO  j = nysg, nyng
860                      DO  k = nzb, nzt+1
861                         v_av(k,j,i) = v_av(k,j,i) + v(k,j,i)
862                      ENDDO
[1]863                   ENDDO
864                ENDDO
[3004]865             ENDIF
[1]866
[3421]867          CASE ( 'thetav' )
[3004]868             IF ( ALLOCATED( vpt_av ) ) THEN
869                DO  i = nxlg, nxrg
870                   DO  j = nysg, nyng
871                      DO  k = nzb, nzt+1
872                         vpt_av(k,j,i) = vpt_av(k,j,i) + vpt(k,j,i)
873                      ENDDO
[1]874                   ENDDO
875                ENDDO
[3004]876             ENDIF
[1]877
878          CASE ( 'w' )
[3004]879             IF ( ALLOCATED( w_av ) ) THEN
880                DO  i = nxlg, nxrg
881                   DO  j = nysg, nyng
882                      DO  k = nzb, nzt+1
883                         w_av(k,j,i) = w_av(k,j,i) + w(k,j,i)
884                      ENDDO
[1]885                   ENDDO
886                ENDDO
[3004]887             ENDIF
[1]888
[72]889          CASE ( 'z0*' )
[3004]890             IF ( ALLOCATED( z0_av ) ) THEN
[3170]891                DO  i = nxl, nxr
892                   DO  j = nys, nyn
893                      match_def = surf_def_h(0)%start_index(j,i) <=            &
894                                  surf_def_h(0)%end_index(j,i)
895                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
896                                  surf_lsm_h%end_index(j,i)
897                      match_usm = surf_usm_h%start_index(j,i) <=               &
898                                  surf_usm_h%end_index(j,i)
899
900                      IF ( match_def )  THEN
901                         m = surf_def_h(0)%end_index(j,i)
[3173]902                         z0_av(j,i) = z0_av(j,i) +                             &
[3170]903                                         surf_def_h(0)%z0(m)
904                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
905                         m = surf_lsm_h%end_index(j,i)
[3173]906                         z0_av(j,i) = z0_av(j,i) +                             &
[3170]907                                         surf_lsm_h%z0(m)
908                      ELSEIF ( match_usm )  THEN
909                         m = surf_usm_h%end_index(j,i)
[3173]910                         z0_av(j,i) = z0_av(j,i) +                             &
[3170]911                                         surf_usm_h%z0(m)
912                      ENDIF
913                   ENDDO
914                ENDDO   
[3004]915             ENDIF
[72]916
[978]917          CASE ( 'z0h*' )
[3004]918             IF ( ALLOCATED( z0h_av ) ) THEN
[3170]919                DO  i = nxl, nxr
920                   DO  j = nys, nyn
921                      match_def = surf_def_h(0)%start_index(j,i) <=            &
922                                  surf_def_h(0)%end_index(j,i)
923                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
924                                  surf_lsm_h%end_index(j,i)
925                      match_usm = surf_usm_h%start_index(j,i) <=               &
926                                  surf_usm_h%end_index(j,i)
927
928                      IF ( match_def )  THEN
929                         m = surf_def_h(0)%end_index(j,i)
[3173]930                         z0h_av(j,i) = z0h_av(j,i) +                           &
[3170]931                                         surf_def_h(0)%z0h(m)
932                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
933                         m = surf_lsm_h%end_index(j,i)
[3173]934                         z0h_av(j,i) = z0h_av(j,i) +                           &
[3170]935                                         surf_lsm_h%z0h(m)
936                      ELSEIF ( match_usm )  THEN
937                         m = surf_usm_h%end_index(j,i)
[3173]938                         z0h_av(j,i) = z0h_av(j,i) +                           &
[3170]939                                         surf_usm_h%z0h(m)
940                      ENDIF
941                   ENDDO
[3004]942                ENDDO
943             ENDIF
944   
[1788]945          CASE ( 'z0q*' )
[3004]946             IF ( ALLOCATED( z0q_av ) ) THEN
[3170]947                DO  i = nxl, nxr
948                   DO  j = nys, nyn
949                      match_def = surf_def_h(0)%start_index(j,i) <=            &
950                                  surf_def_h(0)%end_index(j,i)
951                      match_lsm = surf_lsm_h%start_index(j,i) <=               &
952                                  surf_lsm_h%end_index(j,i)
953                      match_usm = surf_usm_h%start_index(j,i) <=               &
954                                  surf_usm_h%end_index(j,i)
955
956                      IF ( match_def )  THEN
957                         m = surf_def_h(0)%end_index(j,i)
[3173]958                         z0q_av(j,i) = z0q_av(j,i) +                           &
[3170]959                                         surf_def_h(0)%z0q(m)
960                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
961                         m = surf_lsm_h%end_index(j,i)
[3173]962                         z0q_av(j,i) = z0q_av(j,i) +                           &
[3170]963                                         surf_lsm_h%z0q(m)
964                      ELSEIF ( match_usm )  THEN
965                         m = surf_usm_h%end_index(j,i)
[3173]966                         z0q_av(j,i) = z0q_av(j,i) +                           &
[3170]967                                         surf_usm_h%z0q(m)
968                      ENDIF
969                   ENDDO
[3004]970                ENDDO
971             ENDIF
[3294]972
[1]973          CASE DEFAULT
[3274]974
[3337]975!--          In case of urban surface variables it should be always checked
976!--          if respective arrays are allocated, at least in case of a restart
977!--          run, as averaged usm arrays are not read from file at the moment.
[3637]978             IF ( urban_surface )  THEN
979                CALL usm_3d_data_averaging( 'allocate', trimvar )
[3337]980             ENDIF
981
[2696]982!
[3637]983!--          Summing up data from all other modules
984             CALL module_interface_3d_data_averaging( 'sum', trimvar )
985
986
[1]987       END SELECT
988
989    ENDDO
990
[1318]991    CALL cpu_log( log_point(34), 'sum_up_3d_data', 'stop' )
[1]992
993
994 END SUBROUTINE sum_up_3d_data
Note: See TracBrowser for help on using the repository browser.