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

Last change on this file since 1353 was 1353, checked in by heinze, 10 years ago

REAL constants provided with KIND-attribute

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