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

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

last commit documented

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