source: palm/trunk/SOURCE/user_statistics.f90 @ 1952

Last change on this file since 1952 was 1818, checked in by maronga, 8 years ago

last commit documented / copyright update

  • Property svn:keywords set to Id
File size: 5.7 KB
Line 
1!> @file user_statistics.f90
2!--------------------------------------------------------------------------------!
3! This file is part of PALM.
4!
5! PALM is free software: you can redistribute it and/or modify it under the terms
6! of the GNU General Public License as published by the Free Software Foundation,
7! either version 3 of the License, or (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
10! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
11! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with
14! PALM. If not, see <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2016 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------!
18!
19! Current revisions:
20! -----------------
21!
22!
23! Former revisions:
24! -----------------
25! $Id: user_statistics.f90 1818 2016-04-06 15:53:27Z suehring $
26!
27! 1804 2016-04-05 16:30:18Z maronga
28! Removed code for parameter file check (__check)
29!
30! 1783 2016-03-06 18:36:17Z raasch
31! netcdf module name changed + related changes
32!
33! 1682 2015-10-07 23:56:08Z knoop
34! Code annotations made doxygen readable
35!
36! 1353 2014-04-08 15:21:23Z heinze
37! REAL constants provided with KIND-attribute
38!
39! 1320 2014-03-20 08:40:49Z raasch
40! kind-parameters added to all INTEGER and REAL declaration statements,
41! kinds are defined in new module kinds,
42! old module precision_kind is removed,
43! revision history before 2012 removed,
44! comment fields (!:) to be used for variable explanations added to
45! all variable declaration statements
46!
47! 1046 2012-11-09 14:38:45Z maronga
48! added preprocessor directive for parameter file check
49!
50! 1036 2012-10-22 13:43:42Z raasch
51! code put under GPL (PALM 3.9)
52!
53! 211 2008-11-11 04:46:24Z raasch
54! Former file user_interface.f90 split into one file per subroutine
55!
56! Description:
57! ------------
58!> Calculation of user-defined statistics, i.e. horizontally averaged profiles
59!> and time series.
60!> This routine is called for every statistic region sr defined by the user,
61!> but at least for the region "total domain" (sr=0).
62!> See section 3.5.4 on how to define, calculate, and output user defined
63!> quantities.
64!------------------------------------------------------------------------------!
65 SUBROUTINE user_statistics( mode, sr, tn )
66 
67
68    USE arrays_3d
69   
70    USE indices
71   
72    USE kinds
73   
74    USE netcdf_interface,                                                      &
75        ONLY:  dots_max
76
77    USE pegrid
78   
79    USE statistics
80   
81    USE user
82
83    IMPLICIT NONE
84
85    CHARACTER (LEN=*) ::  mode   !<
86
87    INTEGER(iwp) ::  i    !<
88    INTEGER(iwp) ::  j    !<
89    INTEGER(iwp) ::  k    !<
90    INTEGER(iwp) ::  sr   !<
91    INTEGER(iwp) ::  tn   !<
92
93    REAL(wp),                                                                  &
94       DIMENSION(dots_num_palm+1:dots_max) ::                                  &
95          ts_value_l   !<
96
97
98    IF ( mode == 'profiles' )  THEN
99
100!
101!--    Sample on how to calculate horizontally averaged profiles of user-
102!--    defined quantities. Each quantity is identified by the index
103!--    "pr_palm+#" where "#" is an integer starting from 1. These
104!--    user-profile-numbers must also be assigned to the respective strings
105!--    given by data_output_pr_user in routine user_check_data_output_pr.
106!       !$OMP DO
107!       DO  i = nxl, nxr
108!          DO  j = nys, nyn
109!             DO  k = nzb_s_inner(j,i)+1, nzt
110!!
111!!--             Sample on how to calculate the profile of the resolved-scale
112!!--             horizontal momentum flux u*v*
113!                sums_l(k,pr_palm+1,tn) = sums_l(k,pr_palm+1,tn) +               &
114!                      ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,sr) ) *     &
115!                      ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,sr) )       &
116!                                                 * rmask(j,i,sr)
117!!
118!!--             Further profiles can be defined and calculated by increasing
119!!--             the second index of array sums_l (replace ... appropriately)
120!                sums_l(k,pr_palm+2,tn) = sums_l(k,pr_palm+2,tn) + ...           &
121!                                         * rmask(j,i,sr)
122!             ENDDO
123!          ENDDO
124!       ENDDO
125
126    ELSEIF ( mode == 'time_series' )  THEN
127
128!
129!--    Sample on how to add values for the user-defined time series quantities.
130!--    These have to be defined before in routine user_init. This sample
131!--    creates two time series for the absolut values of the horizontal
132!--    velocities u and v.
133!       ts_value_l = 0.0_wp
134!       ts_value_l(dots_num_palm+1) = ABS( u_max )
135!       ts_value_l(dots_num_palm+2) = ABS( v_max )
136!
137!--     Collect / send values to PE0, because only PE0 outputs the time series.
138!--     CAUTION: Collection is done by taking the sum over all processors.
139!--              You may have to normalize this sum, depending on the quantity
140!--              that you like to calculate. For serial runs, nothing has to be
141!--              done.
142!--     HINT: If the time series value that you are calculating has the same
143!--           value on all PEs, you can omit the MPI_ALLREDUCE call and
144!--           assign ts_value(dots_num_palm+1:,sr) = ts_value_l directly.
145!#if defined( __parallel )
146!       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
147!       CALL MPI_ALLREDUCE( ts_value_l(dots_num_palm+1),                         &
148!                           ts_value(dots_num_palm+1,sr),                        &
149!                           dots_max-dots_num_palm, MPI_REAL, MPI_SUM, comm2d,   &
150!                           ierr )
151!#else
152!       ts_value(dots_num_palm+1:,sr) = ts_value_l
153!#endif
154
155    ENDIF
156
157 END SUBROUTINE user_statistics
158
Note: See TracBrowser for help on using the repository browser.