source: palm/trunk/SOURCE/flow_statistics.f90 @ 96

Last change on this file since 96 was 96, checked in by raasch, 17 years ago

more preliminary uncomplete changes for ocean version

  • Property svn:keywords set to Id
File size: 40.9 KB
Line 
1 SUBROUTINE flow_statistics
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6! Statistics for ocean version (salinity, density) added,
7! calculation of Deardorff velocity scale adjusted to be used with the ocean
8! version (HAS STILL TO BE COMPLETED!!!)
9!
10! Former revisions:
11! -----------------
12! $Id: flow_statistics.f90 96 2007-06-04 08:07:41Z raasch $
13!
14! 87 2007-05-22 15:46:47Z raasch
15! Two more arguments added to user_statistics, which is now also called for
16! user-defined profiles,
17! var_hom and var_sum renamed pr_palm
18!
19! 82 2007-04-16 15:40:52Z raasch
20! Cpp-directive lcmuk changed to intel_openmp_bug
21!
22! 75 2007-03-22 09:54:05Z raasch
23! Collection of time series quantities moved from routine flow_statistics to
24! here, routine user_statistics is called for each statistic region,
25! moisture renamed humidity
26!
27! 19 2007-02-23 04:53:48Z raasch
28! fluxes at top modified (tswst, qswst)
29!
30! RCS Log replace by Id keyword, revision history cleaned up
31!
32! Revision 1.41  2006/08/04 14:37:50  raasch
33! Error removed in non-parallel part (sums_l)
34!
35! Revision 1.1  1997/08/11 06:15:17  raasch
36! Initial revision
37!
38!
39! Description:
40! ------------
41! Compute average profiles and further average flow quantities for the different
42! user-defined (sub-)regions. The region indexed 0 is the total model domain.
43!
44! NOTE: For simplicity, nzb_s_outer and nzb_diff_s_outer are being used as a
45! ----  lower vertical index for k-loops for all variables so that regardless
46! of the variable and its respective staggered grid always the same number of
47! grid points is used for 2D averages. The disadvantage: depending on the
48! variable, up to one grid layer adjacent to the (vertical walls of the)
49! topography is missed out by this simplification.
50!------------------------------------------------------------------------------!
51
52    USE arrays_3d
53    USE cloud_parameters
54    USE cpulog
55    USE grid_variables
56    USE indices
57    USE interfaces
58    USE pegrid
59    USE statistics
60    USE control_parameters
61
62    IMPLICIT NONE
63
64    INTEGER ::  i, j, k, omp_get_thread_num, sr, tn
65    LOGICAL ::  first
66    REAL    ::  height, pts, sums_l_eper, sums_l_etot, ust, ust2, u2, vst, &
67                vst2, v2, w2, z_i(2)
68    REAL    ::  sums_ll(nzb:nzt+1,2)
69
70
71    CALL cpu_log( log_point(10), 'flow_statistics', 'start' )
72
73!
74!-- To be on the safe side, check whether flow_statistics has already been
75!-- called once after the current time step
76    IF ( flow_statistics_called )  THEN
77       IF ( myid == 0 )  PRINT*, '+++ WARNING: flow_statistics is called two', &
78                                 ' times within one timestep'
79       CALL local_stop
80    ENDIF
81
82!
83!-- Compute statistics for each (sub-)region
84    DO  sr = 0, statistic_regions
85
86!
87!--    Initialize (local) summation array
88       sums_l = 0.0
89
90!
91!--    Store sums that have been computed in other subroutines in summation
92!--    array
93       sums_l(:,11,:) = sums_l_l(:,sr,:)      ! mixing length from diffusivities
94!--    WARNING: next line still has to be adjusted for OpenMP
95       sums_l(:,21,0) = sums_wsts_bc_l(:,sr)  ! heat flux from advec_s_bc
96       sums_l(nzb+9,pr_palm,0)  = sums_divold_l(sr)  ! old divergence from pres
97       sums_l(nzb+10,pr_palm,0) = sums_divnew_l(sr)  ! new divergence from pres
98!--    WARNING: next four lines still may have to be adjusted for OpenMP
99       sums_l(nzb:nzb+2,pr_palm-1,0)    = sums_up_fraction_l(1,1:3,sr)! upstream
100       sums_l(nzb+3:nzb+5,pr_palm-1,0)  = sums_up_fraction_l(2,1:3,sr)! parts
101       sums_l(nzb+6:nzb+8,pr_palm-1,0)  = sums_up_fraction_l(3,1:3,sr)! from
102       sums_l(nzb+9:nzb+11,pr_palm-1,0) = sums_up_fraction_l(4,1:3,sr)! spline
103
104!
105!--    Horizontally averaged profiles of horizontal velocities and temperature.
106!--    They must have been computed before, because they are already required
107!--    for other horizontal averages.
108       tn = 0
109       !$OMP PARALLEL PRIVATE( i, j, k, tn )
110#if defined( __intel_openmp_bug )
111       tn = omp_get_thread_num()
112#else
113!$     tn = omp_get_thread_num()
114#endif
115
116       !$OMP DO
117       DO  i = nxl, nxr
118          DO  j =  nys, nyn
119             DO  k = nzb_s_outer(j,i), nzt+1
120                sums_l(k,1,tn)  = sums_l(k,1,tn)  + u(k,j,i)  * rmask(j,i,sr)
121                sums_l(k,2,tn)  = sums_l(k,2,tn)  + v(k,j,i)  * rmask(j,i,sr)
122                sums_l(k,4,tn)  = sums_l(k,4,tn)  + pt(k,j,i) * rmask(j,i,sr)
123             ENDDO
124          ENDDO
125       ENDDO
126
127!
128!--    Horizontally averaged profile of salinity
129       IF ( ocean )  THEN
130          !$OMP DO
131          DO  i = nxl, nxr
132             DO  j =  nys, nyn
133                DO  k = nzb_s_outer(j,i), nzt+1
134                   sums_l(k,23,tn)  = sums_l(k,23,tn) + &
135                                      sa(k,j,i) * rmask(j,i,sr)
136                ENDDO
137             ENDDO
138          ENDDO
139       ENDIF
140
141!
142!--    Horizontally averaged profiles of virtual potential temperature,
143!--    total water content, specific humidity and liquid water potential
144!--    temperature
145       IF ( humidity )  THEN
146          !$OMP DO
147          DO  i = nxl, nxr
148             DO  j =  nys, nyn
149                DO  k = nzb_s_outer(j,i), nzt+1
150                   sums_l(k,44,tn)  = sums_l(k,44,tn) + &
151                                      vpt(k,j,i) * rmask(j,i,sr)
152                   sums_l(k,41,tn)  = sums_l(k,41,tn) + &
153                                      q(k,j,i) * rmask(j,i,sr)
154                ENDDO
155             ENDDO
156          ENDDO
157          IF ( cloud_physics )  THEN
158             !$OMP DO
159             DO  i = nxl, nxr
160                DO  j =  nys, nyn
161                   DO  k = nzb_s_outer(j,i), nzt+1
162                      sums_l(k,42,tn) = sums_l(k,42,tn) + &
163                                      ( q(k,j,i) - ql(k,j,i) ) * rmask(j,i,sr)
164                      sums_l(k,43,tn) = sums_l(k,43,tn) + ( &
165                                      pt(k,j,i) + l_d_cp*pt_d_t(k) * ql(k,j,i) &
166                                                          ) * rmask(j,i,sr)
167                   ENDDO
168                ENDDO
169             ENDDO
170          ENDIF
171       ENDIF
172
173!
174!--    Horizontally averaged profiles of passive scalar
175       IF ( passive_scalar )  THEN
176          !$OMP DO
177          DO  i = nxl, nxr
178             DO  j =  nys, nyn
179                DO  k = nzb_s_outer(j,i), nzt+1
180                   sums_l(k,41,tn)  = sums_l(k,41,tn) + q(k,j,i) * rmask(j,i,sr)
181                ENDDO
182             ENDDO
183          ENDDO
184       ENDIF
185       !$OMP END PARALLEL
186
187!
188!--    Summation of thread sums
189       IF ( threads_per_task > 1 )  THEN
190          DO  i = 1, threads_per_task-1
191             sums_l(:,1,0) = sums_l(:,1,0) + sums_l(:,1,i)
192             sums_l(:,2,0) = sums_l(:,2,0) + sums_l(:,2,i)
193             sums_l(:,4,0) = sums_l(:,4,0) + sums_l(:,4,i)
194             IF ( ocean )  THEN
195                sums_l(:,23,0) = sums_l(:,23,0) + sums_l(:,23,i)
196             ENDIF
197             IF ( humidity )  THEN
198                sums_l(:,41,0) = sums_l(:,41,0) + sums_l(:,41,i)
199                sums_l(:,44,0) = sums_l(:,44,0) + sums_l(:,44,i)
200                IF ( cloud_physics )  THEN
201                   sums_l(:,42,0) = sums_l(:,42,0) + sums_l(:,42,i)
202                   sums_l(:,43,0) = sums_l(:,43,0) + sums_l(:,43,i)
203                ENDIF
204             ENDIF
205             IF ( passive_scalar )  THEN
206                sums_l(:,41,0) = sums_l(:,41,0) + sums_l(:,41,i)
207             ENDIF
208          ENDDO
209       ENDIF
210
211#if defined( __parallel )
212!
213!--    Compute total sum from local sums
214       CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), nzt+2-nzb, MPI_REAL, &
215                           MPI_SUM, comm2d, ierr )
216       CALL MPI_ALLREDUCE( sums_l(nzb,2,0), sums(nzb,2), nzt+2-nzb, MPI_REAL, &
217                           MPI_SUM, comm2d, ierr )
218       CALL MPI_ALLREDUCE( sums_l(nzb,4,0), sums(nzb,4), nzt+2-nzb, MPI_REAL, &
219                           MPI_SUM, comm2d, ierr )
220       IF ( ocean )  THEN
221          CALL MPI_ALLREDUCE( sums_l(nzb,23,0), sums(nzb,23), nzt+2-nzb, &
222                              MPI_REAL, MPI_SUM, comm2d, ierr )
223       ENDIF
224       IF ( humidity ) THEN
225          CALL MPI_ALLREDUCE( sums_l(nzb,44,0), sums(nzb,44), nzt+2-nzb, &
226                              MPI_REAL, MPI_SUM, comm2d, ierr )
227          CALL MPI_ALLREDUCE( sums_l(nzb,41,0), sums(nzb,41), nzt+2-nzb, &
228                              MPI_REAL, MPI_SUM, comm2d, ierr )
229          IF ( cloud_physics ) THEN
230             CALL MPI_ALLREDUCE( sums_l(nzb,42,0), sums(nzb,42), nzt+2-nzb, &
231                                 MPI_REAL, MPI_SUM, comm2d, ierr )
232             CALL MPI_ALLREDUCE( sums_l(nzb,43,0), sums(nzb,43), nzt+2-nzb, &
233                                 MPI_REAL, MPI_SUM, comm2d, ierr )
234          ENDIF
235       ENDIF
236
237       IF ( passive_scalar )  THEN
238          CALL MPI_ALLREDUCE( sums_l(nzb,41,0), sums(nzb,41), nzt+2-nzb, &
239                              MPI_REAL, MPI_SUM, comm2d, ierr )
240       ENDIF
241#else
242       sums(:,1) = sums_l(:,1,0)
243       sums(:,2) = sums_l(:,2,0)
244       sums(:,4) = sums_l(:,4,0)
245       IF ( ocean )  sums(:,23) = sums_l(:,23,0)
246       IF ( humidity ) THEN
247          sums(:,44) = sums_l(:,44,0)
248          sums(:,41) = sums_l(:,41,0)
249          IF ( cloud_physics ) THEN
250             sums(:,42) = sums_l(:,42,0)
251             sums(:,43) = sums_l(:,43,0)
252          ENDIF
253       ENDIF
254       IF ( passive_scalar )  sums(:,41) = sums_l(:,41,0)
255#endif
256
257!
258!--    Final values are obtained by division by the total number of grid points
259!--    used for summation. After that store profiles.
260       sums(:,1) = sums(:,1) / ngp_2dh_outer(:,sr)
261       sums(:,2) = sums(:,2) / ngp_2dh_outer(:,sr)
262       sums(:,4) = sums(:,4) / ngp_2dh_outer(:,sr)
263       hom(:,1,1,sr) = sums(:,1)             ! u
264       hom(:,1,2,sr) = sums(:,2)             ! v
265       hom(:,1,4,sr) = sums(:,4)             ! pt
266
267!
268!--    Salinity
269       IF ( ocean )  THEN
270          sums(:,23) = sums(:,23) / ngp_2dh_outer(:,sr)
271          hom(:,1,23,sr) = sums(:,23)             ! sa
272       ENDIF
273
274!
275!--    Humidity and cloud parameters
276       IF ( humidity ) THEN
277          sums(:,44) = sums(:,44) / ngp_2dh_outer(:,sr)
278          sums(:,41) = sums(:,41) / ngp_2dh_outer(:,sr)
279          hom(:,1,44,sr) = sums(:,44)             ! vpt
280          hom(:,1,41,sr) = sums(:,41)             ! qv (q)
281          IF ( cloud_physics ) THEN
282             sums(:,42) = sums(:,42) / ngp_2dh_outer(:,sr)
283             sums(:,43) = sums(:,43) / ngp_2dh_outer(:,sr)
284             hom(:,1,42,sr) = sums(:,42)             ! qv
285             hom(:,1,43,sr) = sums(:,43)             ! pt
286          ENDIF
287       ENDIF
288
289!
290!--    Passive scalar
291       IF ( passive_scalar )  hom(:,1,41,sr) = sums(:,41) / ngp_2dh_outer(:,sr)
292
293!
294!--    Horizontally averaged profiles of the remaining prognostic variables,
295!--    variances, the total and the perturbation energy (single values in last
296!--    column of sums_l) and some diagnostic quantities.
297!--    NOTE: for simplicity, nzb_s_outer is used below, although strictly
298!--    ----  speaking the following k-loop would have to be split up and
299!--          rearranged according to the staggered grid.
300       tn = 0
301#if defined( __intel_openmp_bug )
302       !$OMP PARALLEL PRIVATE( i, j, k, pts, sums_ll, sums_l_eper, sums_l_etot, &
303       !$OMP                    tn, ust, ust2, u2, vst, vst2, v2, w2 )
304       tn = omp_get_thread_num()
305#else
306       !$OMP PARALLEL PRIVATE( i, j, k, pts, sums_ll, sums_l_eper, sums_l_etot, tn, ust, ust2, u2, vst, vst2, v2, w2 )
307!$     tn = omp_get_thread_num()
308#endif
309       !$OMP DO
310       DO  i = nxl, nxr
311          DO  j =  nys, nyn
312             sums_l_etot = 0.0
313             sums_l_eper = 0.0
314             DO  k = nzb_s_outer(j,i), nzt+1
315                u2   = u(k,j,i)**2
316                v2   = v(k,j,i)**2
317                w2   = w(k,j,i)**2
318                ust2 = ( u(k,j,i) - hom(k,1,1,sr) )**2
319                vst2 = ( v(k,j,i) - hom(k,1,2,sr) )**2
320!
321!--             Prognostic and diagnostic variables
322                sums_l(k,3,tn)  = sums_l(k,3,tn)  + w(k,j,i)  * rmask(j,i,sr)
323                sums_l(k,8,tn)  = sums_l(k,8,tn)  + e(k,j,i)  * rmask(j,i,sr)
324                sums_l(k,9,tn)  = sums_l(k,9,tn)  + km(k,j,i) * rmask(j,i,sr)
325                sums_l(k,10,tn) = sums_l(k,10,tn) + kh(k,j,i) * rmask(j,i,sr)
326                sums_l(k,40,tn) = sums_l(k,40,tn) + p(k,j,i)
327
328!
329!--             Variances
330                sums_l(k,30,tn) = sums_l(k,30,tn) + ust2 * rmask(j,i,sr)
331                sums_l(k,31,tn) = sums_l(k,31,tn) + vst2 * rmask(j,i,sr)
332                sums_l(k,32,tn) = sums_l(k,32,tn) + w2   * rmask(j,i,sr)
333                sums_l(k,33,tn) = sums_l(k,33,tn) + &
334                                  ( pt(k,j,i)-hom(k,1,4,sr) )**2 * rmask(j,i,sr)
335!
336!--             Higher moments
337!--             (Computation of the skewness of w further below)
338                sums_l(k,38,tn) = sums_l(k,38,tn) + w(k,j,i) * w2 * &
339                                                    rmask(j,i,sr)
340!
341!--             Perturbation energy
342                sums_l(k,34,tn) = sums_l(k,34,tn) + 0.5 * ( ust2 + vst2 + w2 ) &
343                                                    * rmask(j,i,sr)
344                sums_l_etot  = sums_l_etot + &
345                                        0.5 * ( u2 + v2 + w2 ) * rmask(j,i,sr)
346                sums_l_eper  = sums_l_eper + &
347                                        0.5 * ( ust2+vst2+w2 ) * rmask(j,i,sr)
348             ENDDO
349!
350!--          Total and perturbation energy for the total domain (being
351!--          collected in the last column of sums_l). Summation of these
352!--          quantities is seperated from the previous loop in order to
353!--          allow vectorization of that loop.
354             sums_l(nzb+4,pr_palm,tn) = sums_l(nzb+4,pr_palm,tn) + sums_l_etot
355             sums_l(nzb+5,pr_palm,tn) = sums_l(nzb+5,pr_palm,tn) + sums_l_eper
356!
357!--          2D-arrays (being collected in the last column of sums_l)
358             sums_l(nzb,pr_palm,tn)   = sums_l(nzb,pr_palm,tn) +   &
359                                        us(j,i)   * rmask(j,i,sr)
360             sums_l(nzb+1,pr_palm,tn) = sums_l(nzb+1,pr_palm,tn) + &
361                                        usws(j,i) * rmask(j,i,sr)
362             sums_l(nzb+2,pr_palm,tn) = sums_l(nzb+2,pr_palm,tn) + &
363                                        vsws(j,i) * rmask(j,i,sr)
364             sums_l(nzb+3,pr_palm,tn) = sums_l(nzb+3,pr_palm,tn) + &
365                                        ts(j,i)   * rmask(j,i,sr)
366          ENDDO
367       ENDDO
368
369!
370!--    Horizontally averaged profiles of the vertical fluxes
371       !$OMP DO
372       DO  i = nxl, nxr
373          DO  j = nys, nyn
374!
375!--          Subgridscale fluxes (without Prandtl layer from k=nzb,
376!--          oterwise from k=nzb+1)
377!--          NOTE: for simplicity, nzb_diff_s_outer is used below, although
378!--          ----  strictly speaking the following k-loop would have to be
379!--                split up according to the staggered grid.
380             DO  k = nzb_diff_s_outer(j,i)-1, nzt
381!
382!--             Momentum flux w"u"
383                sums_l(k,12,tn) = sums_l(k,12,tn) - 0.25 * (                   &
384                               km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) &
385                                                           ) * (               &
386                                   ( u(k+1,j,i) - u(k,j,i)   ) * ddzu(k+1)     &
387                                 + ( w(k,j,i)   - w(k,j,i-1) ) * ddx           &
388                                                               ) * rmask(j,i,sr)
389!
390!--             Momentum flux w"v"
391                sums_l(k,14,tn) = sums_l(k,14,tn) - 0.25 * (                   &
392                               km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) &
393                                                           ) * (               &
394                                   ( v(k+1,j,i) - v(k,j,i)   ) * ddzu(k+1)     &
395                                 + ( w(k,j,i)   - w(k,j-1,i) ) * ddy           &
396                                                               ) * rmask(j,i,sr)
397             ENDDO
398
399             DO  k = nzb_diff_s_outer(j,i)-1, nzt_diff
400!
401!--             Heat flux w"pt"
402                sums_l(k,16,tn) = sums_l(k,16,tn)                              &
403                                         - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) )   &
404                                               * ( pt(k+1,j,i) - pt(k,j,i) )   &
405                                               * ddzu(k+1) * rmask(j,i,sr)
406
407
408!
409!--             Salinity flux w"sa"
410                IF ( ocean )  THEN
411                   sums_l(k,65,tn) = sums_l(k,65,tn)                           &
412                                         - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) )   &
413                                               * ( sa(k+1,j,i) - sa(k,j,i) )   &
414                                               * ddzu(k+1) * rmask(j,i,sr)
415                ENDIF
416
417!
418!--             Buoyancy flux, water flux (humidity flux) w"q"
419                IF ( humidity ) THEN
420                   sums_l(k,45,tn) = sums_l(k,45,tn)                           &
421                                         - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) )   &
422                                               * ( vpt(k+1,j,i) - vpt(k,j,i) ) &
423                                               * ddzu(k+1) * rmask(j,i,sr)
424                   sums_l(k,48,tn) = sums_l(k,48,tn)                           &
425                                         - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) )   &
426                                               * ( q(k+1,j,i) - q(k,j,i) )     &
427                                               * ddzu(k+1) * rmask(j,i,sr)
428                   IF ( cloud_physics ) THEN
429                      sums_l(k,51,tn) = sums_l(k,51,tn)                        &
430                                         - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) )   &
431                                               * ( ( q(k+1,j,i) - ql(k+1,j,i) )&
432                                                - ( q(k,j,i) - ql(k,j,i) ) )   &
433                                               * ddzu(k+1) * rmask(j,i,sr) 
434                   ENDIF
435                ENDIF
436
437!
438!--             Passive scalar flux
439                IF ( passive_scalar )  THEN
440                   sums_l(k,48,tn) = sums_l(k,48,tn)                           &
441                                         - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) )   &
442                                               * ( q(k+1,j,i) - q(k,j,i) )     &
443                                               * ddzu(k+1) * rmask(j,i,sr)
444                ENDIF
445
446             ENDDO
447
448!
449!--          Subgridscale fluxes in the Prandtl layer
450             IF ( use_surface_fluxes )  THEN
451                sums_l(nzb,12,tn) = sums_l(nzb,12,tn) + &
452                                    usws(j,i) * rmask(j,i,sr)     ! w"u"
453                sums_l(nzb,14,tn) = sums_l(nzb,14,tn) + &
454                                    vsws(j,i) * rmask(j,i,sr)     ! w"v"
455                sums_l(nzb,16,tn) = sums_l(nzb,16,tn) + &
456                                    shf(j,i)  * rmask(j,i,sr)     ! w"pt"
457                sums_l(nzb,58,tn) = sums_l(nzb,58,tn) + &
458                                    0.0 * rmask(j,i,sr)           ! u"pt"
459                sums_l(nzb,61,tn) = sums_l(nzb,61,tn) + &
460                                    0.0 * rmask(j,i,sr)           ! v"pt"
461                IF ( ocean )  THEN
462                   sums_l(nzb,65,tn) = sums_l(nzb,65,tn) + &
463                                       saswsb(j,i) * rmask(j,i,sr)  ! w"sa"
464                ENDIF
465                IF ( humidity )  THEN
466                   sums_l(nzb,48,tn) = sums_l(nzb,48,tn) + &
467                                       qsws(j,i) * rmask(j,i,sr)  ! w"q" (w"qv")
468                   IF ( cloud_physics )  THEN
469                      sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + (           &
470                                          ( 1.0 + 0.61 * q(nzb,j,i) ) *   &
471                                          shf(j,i) + 0.61 * pt(nzb,j,i) * &
472                                                     qsws(j,i)            &
473                                                              )
474!
475!--                   Formula does not work if ql(nzb) /= 0.0
476                      sums_l(nzb,51,tn) = sums_l(nzb,51,tn) + &   ! w"q" (w"qv")
477                                          qsws(j,i) * rmask(j,i,sr)
478                   ENDIF
479                ENDIF
480                IF ( passive_scalar )  THEN
481                   sums_l(nzb,48,tn) = sums_l(nzb,48,tn) + &
482                                       qsws(j,i) * rmask(j,i,sr)  ! w"q" (w"qv")
483                ENDIF
484             ENDIF
485
486!
487!--          Subgridscale fluxes at the top surface
488             IF ( use_top_fluxes )  THEN
489                sums_l(nzt,16,tn) = sums_l(nzt,16,tn) + &
490                                    tswst(j,i)  * rmask(j,i,sr)   ! w"pt"
491                sums_l(nzt,58,tn) = sums_l(nzt,58,tn) + &
492                                    0.0 * rmask(j,i,sr)           ! u"pt"
493                sums_l(nzt,61,tn) = sums_l(nzt,61,tn) + &
494                                    0.0 * rmask(j,i,sr)           ! v"pt"
495                IF ( ocean )  THEN
496                   sums_l(nzt,65,tn) = sums_l(nzt,65,tn) + &
497                                       saswst(j,i) * rmask(j,i,sr)  ! w"sa"
498                ENDIF
499                IF ( humidity )  THEN
500                   sums_l(nzt,48,tn) = sums_l(nzt,48,tn) + &
501                                       qswst(j,i) * rmask(j,i,sr)  ! w"q" (w"qv")
502                   IF ( cloud_physics )  THEN
503                      sums_l(nzt,45,tn) = sums_l(nzt,45,tn) + (           &
504                                          ( 1.0 + 0.61 * q(nzt,j,i) ) *   &
505                                          tswst(j,i) + 0.61 * pt(nzt,j,i) * &
506                                                     qsws(j,i)            &
507                                                              )
508!
509!--                   Formula does not work if ql(nzb) /= 0.0
510                      sums_l(nzt,51,tn) = sums_l(nzt,51,tn) + &   ! w"q" (w"qv")
511                                          qswst(j,i) * rmask(j,i,sr)
512                   ENDIF
513                ENDIF
514                IF ( passive_scalar )  THEN
515                   sums_l(nzt,48,tn) = sums_l(nzt,48,tn) + &
516                                       qswst(j,i) * rmask(j,i,sr)  ! w"q" (w"qv")
517                ENDIF
518             ENDIF
519
520!
521!--          Resolved fluxes (can be computed for all horizontal points)
522!--          NOTE: for simplicity, nzb_s_outer is used below, although strictly
523!--          ----  speaking the following k-loop would have to be split up and
524!--                rearranged according to the staggered grid.
525             DO  k = nzb_s_outer(j,i), nzt
526                ust = 0.5 * ( u(k,j,i)   - hom(k,1,1,sr) + &
527                              u(k+1,j,i) - hom(k+1,1,1,sr) )
528                vst = 0.5 * ( v(k,j,i)   - hom(k,1,2,sr) + &
529                              v(k+1,j,i) - hom(k+1,1,2,sr) )
530                pts = 0.5 * ( pt(k,j,i)   - hom(k,1,4,sr) + &
531                              pt(k+1,j,i) - hom(k+1,1,4,sr) )
532!
533!--             Momentum flux w*u*
534                sums_l(k,13,tn) = sums_l(k,13,tn) + 0.5 *                     &
535                                                    ( w(k,j,i-1) + w(k,j,i) ) &
536                                                    * ust * rmask(j,i,sr)
537!
538!--             Momentum flux w*v*
539                sums_l(k,15,tn) = sums_l(k,15,tn) + 0.5 *                     &
540                                                    ( w(k,j-1,i) + w(k,j,i) ) &
541                                                    * vst * rmask(j,i,sr)
542!
543!--             Heat flux w*pt*
544!--             The following formula (comment line, not executed) does not
545!--             work if applied to subregions
546!                sums_l(k,17,tn) = sums_l(k,17,tn) + 0.5 *                     &
547!                                                    ( pt(k,j,i)+pt(k+1,j,i) ) &
548!                                                    * w(k,j,i) * rmask(j,i,sr)
549                sums_l(k,17,tn) = sums_l(k,17,tn) + pts * w(k,j,i) * &
550                                                    rmask(j,i,sr)
551!
552!--             Higher moments
553                sums_l(k,35,tn) = sums_l(k,35,tn) + pts * w(k,j,i)**2 * &
554                                                    rmask(j,i,sr)
555                sums_l(k,36,tn) = sums_l(k,36,tn) + pts**2 * w(k,j,i) * &
556                                                    rmask(j,i,sr)
557
558!
559!--             Salinity flux and density (density does not belong to here,
560!--             but so far there is no suitable place to calculate)
561                IF ( ocean )  THEN
562                   pts = 0.5 * ( sa(k,j,i)   - hom(k,1,23,sr) + &
563                                 sa(k+1,j,i) - hom(k+1,1,23,sr) )
564                   sums_l(k,66,tn) = sums_l(k,66,tn) + pts * w(k,j,i) * &
565                                                       rmask(j,i,sr)
566                   sums_l(k,64,tn) = sums_l(k,64,tn) + rho(k,j,i) * &
567                                                       rmask(j,i,sr)
568                ENDIF
569
570!
571!--             Buoyancy flux, water flux, humidity flux and liquid water
572!--             content
573                IF ( humidity )  THEN
574                   pts = 0.5 * ( vpt(k,j,i)   - hom(k,1,44,sr) + &
575                                 vpt(k+1,j,i) - hom(k+1,1,44,sr) )
576                   sums_l(k,46,tn) = sums_l(k,46,tn) + pts * w(k,j,i) * &
577                                                       rmask(j,i,sr)
578                   pts = 0.5 * ( q(k,j,i)   - hom(k,1,41,sr) + &
579                                 q(k+1,j,i) - hom(k+1,1,41,sr) )
580                   sums_l(k,49,tn) = sums_l(k,49,tn) + pts * w(k,j,i) * &
581                                                       rmask(j,i,sr)
582                   IF ( cloud_physics  .OR.  cloud_droplets )  THEN
583                      pts = 0.5 *                                            &
584                             ( ( q(k,j,i)   - ql(k,j,i)   ) - hom(k,1,42,sr) &
585                             + ( q(k+1,j,i) - ql(k+1,j,i) ) - hom(k+1,1,42,sr) )
586                      sums_l(k,52,tn) = sums_l(k,52,tn) + pts * w(k,j,i) * &
587                                                          rmask(j,i,sr)
588                      sums_l(k,54,tn) = sums_l(k,54,tn) + ql(k,j,i) * &
589                                                          rmask(j,i,sr)
590                   ENDIF
591                ENDIF
592
593!
594!--             Passive scalar flux
595                IF ( passive_scalar )  THEN
596                   pts = 0.5 * ( q(k,j,i)   - hom(k,1,41,sr) + &
597                                 q(k+1,j,i) - hom(k+1,1,41,sr) )
598                   sums_l(k,49,tn) = sums_l(k,49,tn) + pts * w(k,j,i) * &
599                                                       rmask(j,i,sr)
600                ENDIF
601
602!
603!--             Energy flux w*e*
604                sums_l(k,37,tn) = sums_l(k,37,tn) + w(k,j,i) * 0.5 *           &
605                                              ( ust**2 + vst**2 + w(k,j,i)**2 )&
606                                              * rmask(j,i,sr)
607         
608             ENDDO
609          ENDDO
610       ENDDO
611
612!
613!--    Divergence of vertical flux of resolved scale energy and pressure
614!--    fluctuations. First calculate the products, then the divergence.
615!--    Calculation is time consuming. Do it only, if profiles shall be plotted.
616       IF ( hom(nzb+1,2,55,0) /= 0.0 )  THEN
617
618          sums_ll = 0.0  ! local array
619
620          !$OMP DO
621          DO  i = nxl, nxr
622             DO  j = nys, nyn
623                DO  k = nzb_s_outer(j,i)+1, nzt
624
625                   sums_ll(k,1) = sums_ll(k,1) + 0.5 * w(k,j,i) * (        &
626                  ( 0.25 * ( u(k,j,i)+u(k+1,j,i)+u(k,j,i+1)+u(k+1,j,i+1)   &
627                           - 2.0 * ( hom(k,1,1,sr) + hom(k+1,1,1,sr) )     &
628                           ) )**2                                          &
629                + ( 0.25 * ( v(k,j,i)+v(k+1,j,i)+v(k,j+1,i)+v(k+1,j+1,i)   &
630                           - 2.0 * ( hom(k,1,2,sr) + hom(k+1,1,2,sr) )     &
631                           ) )**2                                          &
632                   + w(k,j,i)**2                                  )
633
634                   sums_ll(k,2) = sums_ll(k,2) + 0.5 * w(k,j,i) &
635                                               * ( p(k,j,i) + p(k+1,j,i) )
636
637                ENDDO
638             ENDDO
639          ENDDO
640          sums_ll(0,1)     = 0.0    ! because w is zero at the bottom
641          sums_ll(nzt+1,1) = 0.0
642          sums_ll(0,2)     = 0.0
643          sums_ll(nzt+1,2) = 0.0
644
645          DO  k = nzb_s_outer(j,i)+1, nzt
646             sums_l(k,55,tn) = ( sums_ll(k,1) - sums_ll(k-1,1) ) * ddzw(k)
647             sums_l(k,56,tn) = ( sums_ll(k,2) - sums_ll(k-1,2) ) * ddzw(k)
648          ENDDO
649          sums_l(nzb,55,tn) = sums_l(nzb+1,55,tn)
650          sums_l(nzb,56,tn) = sums_l(nzb+1,56,tn)
651
652       ENDIF
653
654!
655!--    Divergence of vertical flux of SGS TKE
656       IF ( hom(nzb+1,2,57,0) /= 0.0 )  THEN
657
658          !$OMP DO
659          DO  i = nxl, nxr
660             DO  j = nys, nyn
661                DO  k = nzb_s_outer(j,i)+1, nzt
662
663                   sums_l(k,57,tn) = sums_l(k,57,tn) + (                       &
664                   (km(k,j,i)+km(k+1,j,i)) * (e(k+1,j,i)-e(k,j,i)) * ddzu(k+1) &
665                 - (km(k-1,j,i)+km(k,j,i)) * (e(k,j,i)-e(k-1,j,i)) * ddzu(k)   &
666                                                 ) * ddzw(k)
667
668                ENDDO
669             ENDDO
670          ENDDO
671          sums_l(nzb,57,tn) = sums_l(nzb+1,57,tn)
672
673       ENDIF
674
675!
676!--    Horizontal heat fluxes (subgrid, resolved, total).
677!--    Do it only, if profiles shall be plotted.
678       IF ( hom(nzb+1,2,58,0) /= 0.0 ) THEN
679
680          !$OMP DO
681          DO  i = nxl, nxr
682             DO  j = nys, nyn
683                DO  k = nzb_s_outer(j,i)+1, nzt
684!
685!--                Subgrid horizontal heat fluxes u"pt", v"pt"
686                   sums_l(k,58,tn) = sums_l(k,58,tn) - 0.5 *                   &
687                                                   ( kh(k,j,i) + kh(k,j,i-1) ) &
688                                                 * ( pt(k,j,i-1) - pt(k,j,i) ) &
689                                                 * ddx * rmask(j,i,sr)
690                   sums_l(k,61,tn) = sums_l(k,61,tn) - 0.5 *                   &
691                                                   ( kh(k,j,i) + kh(k,j-1,i) ) &
692                                                 * ( pt(k,j-1,i) - pt(k,j,i) ) &
693                                                 * ddy * rmask(j,i,sr)
694!
695!--                Resolved horizontal heat fluxes u*pt*, v*pt*
696                   sums_l(k,59,tn) = sums_l(k,59,tn) +                         &
697                                                  ( u(k,j,i) - hom(k,1,1,sr) ) &
698                                       * 0.5 * ( pt(k,j,i-1) - hom(k,1,4,sr) + &
699                                                 pt(k,j,i)   - hom(k,1,4,sr) )
700                   pts = 0.5 * ( pt(k,j-1,i) - hom(k,1,4,sr) + &
701                                 pt(k,j,i)   - hom(k,1,4,sr) )
702                   sums_l(k,62,tn) = sums_l(k,62,tn) +                         &
703                                                  ( v(k,j,i) - hom(k,1,2,sr) ) &
704                                       * 0.5 * ( pt(k,j-1,i) - hom(k,1,4,sr) + &
705                                                 pt(k,j,i)   - hom(k,1,4,sr) )
706                ENDDO
707             ENDDO
708          ENDDO
709!
710!--       Fluxes at the surface must be zero (e.g. due to the Prandtl-layer)
711          sums(nzb,58) = 0.0
712          sums(nzb,59) = 0.0
713          sums(nzb,60) = 0.0
714          sums(nzb,61) = 0.0
715          sums(nzb,62) = 0.0
716          sums(nzb,63) = 0.0
717
718       ENDIF
719
720!
721!--    Calculate the user-defined profiles
722       CALL user_statistics( 'profiles', sr, tn )
723       !$OMP END PARALLEL
724
725!
726!--    Summation of thread sums
727       IF ( threads_per_task > 1 )  THEN
728          DO  i = 1, threads_per_task-1
729             sums_l(:,3,0)          = sums_l(:,3,0) + sums_l(:,3,i)
730             sums_l(:,4:40,0)       = sums_l(:,4:40,0) + sums_l(:,4:40,i)
731             sums_l(:,45:pr_palm,0) = sums_l(:,45:pr_palm,0) + &
732                                      sums_l(:,45:pr_palm,i)
733             IF ( max_pr_user > 0 )  THEN
734                sums_l(:,pr_palm+1:pr_palm+max_pr_user,0) = &
735                                   sums_l(:,pr_palm+1:pr_palm+max_pr_user,0) + &
736                                   sums_l(:,pr_palm+1:pr_palm+max_pr_user,i)
737             ENDIF
738          ENDDO
739       ENDIF
740
741#if defined( __parallel )
742!
743!--    Compute total sum from local sums
744       CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), ngp_sums, MPI_REAL, &
745                           MPI_SUM, comm2d, ierr )
746#else
747       sums = sums_l(:,:,0)
748#endif
749
750!
751!--    Final values are obtained by division by the total number of grid points
752!--    used for summation. After that store profiles.
753!--    Profiles:
754       DO  k = nzb, nzt+1
755          sums(k,:pr_palm-2)      = sums(k,:pr_palm-2) / ngp_2dh_outer(k,sr)
756       ENDDO
757!--    Upstream-parts
758       sums(nzb:nzb+11,pr_palm-1) = sums(nzb:nzb+11,pr_palm-1) / ngp_3d(sr)
759!--    u* and so on
760!--    As sums(nzb:nzb+3,pr_palm) are full 2D arrays (us, usws, vsws, ts) whose
761!--    size is always ( nx + 1 ) * ( ny + 1 ), defined at the first grid layer
762!--    above the topography, they are being divided by ngp_2dh(sr)
763       sums(nzb:nzb+3,pr_palm)    = sums(nzb:nzb+3,pr_palm)    / &
764                                    ngp_2dh(sr)
765!--    eges, e*
766       sums(nzb+4:nzb+5,pr_palm)  = sums(nzb+4:nzb+5,pr_palm)  / &
767                                    ngp_3d_inner(sr)
768!--    Old and new divergence
769       sums(nzb+9:nzb+10,pr_palm) = sums(nzb+9:nzb+10,pr_palm) / &
770                                    ngp_3d_inner(sr)
771
772!--    User-defined profiles
773       IF ( max_pr_user > 0 )  THEN
774          DO  k = nzb, nzt+1
775             sums(k,pr_palm+1:pr_palm+max_pr_user) = &
776                                    sums(k,pr_palm+1:pr_palm+max_pr_user) / &
777                                    ngp_2dh_outer(k,sr)
778          ENDDO
779       ENDIF
780
781!
782!--    Collect horizontal average in hom.
783!--    Compute deduced averages (e.g. total heat flux)
784       hom(:,1,3,sr)  = sums(:,3)      ! w
785       hom(:,1,8,sr)  = sums(:,8)      ! e     profiles 5-7 are initial profiles
786       hom(:,1,9,sr)  = sums(:,9)      ! km
787       hom(:,1,10,sr) = sums(:,10)     ! kh
788       hom(:,1,11,sr) = sums(:,11)     ! l
789       hom(:,1,12,sr) = sums(:,12)     ! w"u"
790       hom(:,1,13,sr) = sums(:,13)     ! w*u*
791       hom(:,1,14,sr) = sums(:,14)     ! w"v"
792       hom(:,1,15,sr) = sums(:,15)     ! w*v*
793       hom(:,1,16,sr) = sums(:,16)     ! w"pt"
794       hom(:,1,17,sr) = sums(:,17)     ! w*pt*
795       hom(:,1,18,sr) = sums(:,16) + sums(:,17)    ! wpt
796       hom(:,1,19,sr) = sums(:,12) + sums(:,13)    ! wu
797       hom(:,1,20,sr) = sums(:,14) + sums(:,15)    ! wv
798       hom(:,1,21,sr) = sums(:,21)     ! w*pt*BC
799       hom(:,1,22,sr) = sums(:,16) + sums(:,21)    ! wptBC
800                                       ! profile 24 is initial profile (sa)
801                                       ! profiles 25-29 left empty for initial
802                                       ! profiles
803       hom(:,1,30,sr) = sums(:,30)     ! u*2
804       hom(:,1,31,sr) = sums(:,31)     ! v*2
805       hom(:,1,32,sr) = sums(:,32)     ! w*2
806       hom(:,1,33,sr) = sums(:,33)     ! pt*2
807       hom(:,1,34,sr) = sums(:,34)     ! e*
808       hom(:,1,35,sr) = sums(:,35)     ! w*2pt*
809       hom(:,1,36,sr) = sums(:,36)     ! w*pt*2
810       hom(:,1,37,sr) = sums(:,37)     ! w*e*
811       hom(:,1,38,sr) = sums(:,38)     ! w*3
812       hom(:,1,39,sr) = sums(:,38) / ( sums(:,32) + 1E-20 )**1.5    ! Sw
813       hom(:,1,40,sr) = sums(:,40)     ! p
814       hom(:,1,45,sr) = sums(:,45)     ! w"q"
815       hom(:,1,46,sr) = sums(:,46)     ! w*vpt*       
816       hom(:,1,47,sr) = sums(:,45) + sums(:,46)    ! wvpt
817       hom(:,1,48,sr) = sums(:,48)     ! w"q" (w"qv")
818       hom(:,1,49,sr) = sums(:,49)     ! w*q* (w*qv*)
819       hom(:,1,50,sr) = sums(:,48) + sums(:,49)    ! wq (wqv)
820       hom(:,1,51,sr) = sums(:,51)     ! w"qv"
821       hom(:,1,52,sr) = sums(:,52)     ! w*qv*       
822       hom(:,1,53,sr) = sums(:,52) + sums(:,51)    ! wq (wqv)
823       hom(:,1,54,sr) = sums(:,54)     ! ql
824       hom(:,1,55,sr) = sums(:,55)     ! w*u*u*/dz
825       hom(:,1,56,sr) = sums(:,56)     ! w*p*/dz
826       hom(:,1,57,sr) = sums(:,57)     ! w"e/dz
827       hom(:,1,58,sr) = sums(:,58)     ! u"pt"
828       hom(:,1,59,sr) = sums(:,59)     ! u*pt*
829       hom(:,1,60,sr) = sums(:,58) + sums(:,59)    ! upt_t
830       hom(:,1,61,sr) = sums(:,61)     ! v"pt"
831       hom(:,1,62,sr) = sums(:,62)     ! v*pt*
832       hom(:,1,63,sr) = sums(:,61) + sums(:,62)    ! vpt_t
833       hom(:,1,64,sr) = sums(:,64)     ! rho
834       hom(:,1,65,sr) = sums(:,65)     ! w"sa"
835       hom(:,1,66,sr) = sums(:,66)     ! w*sa*
836       hom(:,1,67,sr) = sums(:,65) + sums(:,66)    ! wsa
837
838       hom(:,1,pr_palm-1,sr) = sums(:,pr_palm-1)
839                                       ! upstream-parts u_x, u_y, u_z, v_x,
840                                       ! v_y, usw. (in last but one profile)
841       hom(:,1,pr_palm,sr) =   sums(:,pr_palm) 
842                                       ! u*, w'u', w'v', t* (in last profile)
843
844       IF ( max_pr_user > 0 )  THEN    ! user-defined profiles
845          hom(:,1,pr_palm+1:pr_palm+max_pr_user,sr) = &
846                               sums(:,pr_palm+1:pr_palm+max_pr_user)
847       ENDIF
848
849!
850!--    Determine the boundary layer height using two different schemes.
851!--    First scheme: Starting from the Earth's (Ocean's) surface, look for the
852!--    first relative minimum (maximum) of the total heat flux.
853!--    The corresponding height is assumed as the boundary layer height, if it
854!--    is less than 1.5 times the height where the heat flux becomes negative
855!--    (positive) for the first time.
856!--    NOTE: This criterion is still capable of improving!
857       z_i(1) = 0.0
858       first = .TRUE.
859!       IF ( .NOT. ocean )  THEN
860          DO  k = nzb, nzt-1
861             IF ( first .AND. hom(k,1,18,sr) < 0.0 )  THEN
862                first = .FALSE.
863                height = zw(k)
864             ENDIF
865             IF ( hom(k,1,18,sr) < 0.0  .AND. &
866                  hom(k+1,1,18,sr) > hom(k,1,18,sr) )  THEN
867                IF ( zw(k) < 1.5 * height )  THEN
868                   z_i(1) = zw(k)
869                ELSE
870                   z_i(1) = height
871                ENDIF
872                EXIT
873             ENDIF
874          ENDDO
875!       ELSE
876!       ENDIF
877
878!
879!--    Second scheme: Starting from the top model boundary, look for the first
880!--    characteristic kink in the temperature profile, where the originally
881!--    stable stratification notably weakens.
882       z_i(2) = 0.0
883       DO  k = nzt-1, nzb+1, -1
884          IF ( ( hom(k+1,1,4,sr) - hom(k,1,4,sr) ) > &
885               2.0 * ( hom(k,1,4,sr) - hom(k-1,1,4,sr) ) )  THEN
886             z_i(2) = zu(k)
887             EXIT
888          ENDIF
889       ENDDO
890
891       hom(nzb+6,1,pr_palm,sr) = z_i(1)
892       hom(nzb+7,1,pr_palm,sr) = z_i(2)
893
894!
895!--    Computation of both the characteristic vertical velocity and
896!--    the characteristic convective boundary layer temperature.
897!--    The horizontal average at nzb+1 is input for the average temperature.
898       IF ( hom(nzb,1,18,sr) > 0.0  .AND.  z_i(1) /= 0.0 )  THEN
899          hom(nzb+8,1,pr_palm,sr)  = ( g / hom(nzb+1,1,4,sr) * &
900                                       hom(nzb,1,18,sr) *      &
901                                       ABS( z_i(1) ) )**0.333333333
902!--       so far this only works if Prandtl layer is used
903          hom(nzb+11,1,pr_palm,sr) = hom(nzb,1,16,sr) / hom(nzb+8,1,pr_palm,sr)
904       ELSE
905          hom(nzb+8,1,pr_palm,sr)  = 0.0
906          hom(nzb+11,1,pr_palm,sr) = 0.0
907       ENDIF
908
909!
910!--    Collect the time series quantities
911       ts_value(1,sr) = hom(nzb+4,1,pr_palm,sr)     ! E
912       ts_value(2,sr) = hom(nzb+5,1,pr_palm,sr)     ! E*
913       ts_value(3,sr) = dt_3d
914       ts_value(4,sr) = hom(nzb,1,pr_palm,sr)       ! u*
915       ts_value(5,sr) = hom(nzb+3,1,pr_palm,sr)     ! th*
916       ts_value(6,sr) = u_max
917       ts_value(7,sr) = v_max
918       ts_value(8,sr) = w_max
919       ts_value(9,sr) = hom(nzb+10,1,pr_palm,sr)    ! new divergence
920       ts_value(10,sr) = hom(nzb+9,1,pr_palm,sr)    ! old Divergence
921       ts_value(11,sr) = hom(nzb+6,1,pr_palm,sr)    ! z_i(1)
922       ts_value(12,sr) = hom(nzb+7,1,pr_palm,sr)    ! z_i(2)
923       ts_value(13,sr) = hom(nzb+8,1,pr_palm,sr)    ! w*
924       ts_value(14,sr) = hom(nzb,1,16,sr)           ! w'pt'   at k=0
925       ts_value(15,sr) = hom(nzb+1,1,16,sr)         ! w'pt'   at k=1
926       ts_value(16,sr) = hom(nzb+1,1,18,sr)         ! wpt     at k=1
927       ts_value(17,sr) = hom(nzb,1,4,sr)            ! pt(0)
928       ts_value(18,sr) = hom(nzb+1,1,4,sr)          ! pt(zp)
929       ts_value(19,sr) = hom(nzb+9,1,pr_palm-1,sr)  ! splptx
930       ts_value(20,sr) = hom(nzb+10,1,pr_palm-1,sr) ! splpty
931       ts_value(21,sr) = hom(nzb+11,1,pr_palm-1,sr) ! splptz
932       IF ( ts_value(5,sr) /= 0.0 )  THEN
933          ts_value(22,sr) = ts_value(4,sr)**2 / &
934                            ( kappa * g * ts_value(5,sr) / ts_value(18,sr) ) ! L
935       ELSE
936          ts_value(22,sr) = 10000.0
937       ENDIF
938
939!
940!--    Calculate additional statistics provided by the user interface
941       CALL user_statistics( 'time_series', sr, 0 )
942
943    ENDDO    ! loop of the subregions
944
945!
946!-- If required, sum up horizontal averages for subsequent time averaging
947    IF ( do_sum )  THEN
948       IF ( average_count_pr == 0 )  hom_sum = 0.0
949       hom_sum = hom_sum + hom(:,1,:,:)
950       average_count_pr = average_count_pr + 1
951       do_sum = .FALSE.
952    ENDIF
953
954!
955!-- Set flag for other UPs (e.g. output routines, but also buoyancy).
956!-- This flag is reset after each time step in time_integration.
957    flow_statistics_called = .TRUE.
958
959    CALL cpu_log( log_point(10), 'flow_statistics', 'stop' )
960
961
962 END SUBROUTINE flow_statistics
963
964
965
Note: See TracBrowser for help on using the repository browser.