source: palm/trunk/SOURCE/calc_mean_profile.f90 @ 2805

Last change on this file since 2805 was 2718, checked in by maronga, 7 years ago

deleting of deprecated files; headers updated where needed

  • Property svn:keywords set to Id
File size: 5.4 KB
RevLine 
[1873]1!> @file calc_mean_profile.f90
[2000]2!------------------------------------------------------------------------------!
[2696]3! This file is part of the PALM model system.
[1365]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.
[1365]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!
[2718]17! Copyright 1997-2018 Leibniz Universitaet Hannover
[2000]18!------------------------------------------------------------------------------!
[1365]19!
20! Current revisions:
21! -----------------
22!
[2233]23!
[1365]24! Former revisions:
25! -----------------
26! $Id: calc_mean_profile.f90 2718 2018-01-02 08:49:38Z suehring $
[2716]27! Corrected "Former revisions" section
28!
29! 2696 2017-12-14 17:12:51Z kanani
30! Change in file header (GPL part)
[2696]31! Enable usage also during initialization, required for initialization of
32! radiation and land-surface model (MS)
33!
34! 2233 2017-05-30 18:08:54Z suehring
[1365]35!
[2233]36! 2232 2017-05-30 17:47:52Z suehring
37! Adjustments to new topography concept
38!
[2001]39! 2000 2016-08-20 18:09:15Z knoop
40! Forced header and separation lines into 80 columns
41!
[1874]42! 1873 2016-04-18 14:50:06Z maronga
43! Module renamed (removed _mod)
44!
45!
[1851]46! 1850 2016-04-08 13:29:27Z maronga
47! Module renamed
48!
49!
[1739]50! 1738 2015-12-18 13:56:05Z raasch
51! bugfix: if a layer is completely filled with topography, no mean is calculated
52!
[1683]53! 1682 2015-10-07 23:56:08Z knoop
54! Code annotations made doxygen readable
55!
[1366]56! 1365 2014-04-22 15:03:56Z boeske
57! Initial revision
58!
[1365]59! Description:
60! ------------
[1682]61!> Calculate the horizontally averaged vertical temperature profile (pr=4 in case
62!> of potential temperature, 44 in case of virtual potential temperature, and 64
63!> in case of density (ocean runs)).
[1365]64!------------------------------------------------------------------------------!
[1682]65 MODULE calc_mean_profile_mod
66 
[1365]67
68    PRIVATE
69    PUBLIC calc_mean_profile
70
71    INTERFACE calc_mean_profile
72       MODULE PROCEDURE calc_mean_profile
73    END INTERFACE calc_mean_profile
74
75 CONTAINS
76
[1682]77!------------------------------------------------------------------------------!
78! Description:
79! ------------
80!> @todo Missing subroutine description.
81!------------------------------------------------------------------------------!
[1365]82    SUBROUTINE calc_mean_profile( var, pr )
83
84       USE control_parameters,                                                 &
85           ONLY:  intermediate_timestep_count, message_string
86
87       USE indices,                                                            &
[2232]88           ONLY:  ngp_2dh_s_inner, nxl, nxr, nyn, nys, nzb, nzb, nzt,          &
89                  wall_flags_0
[1365]90
91       USE kinds
92
93       USE pegrid
94
95       USE statistics,                                                         &
96           ONLY:  flow_statistics_called, hom, sums, sums_l
97
98
99       IMPLICIT NONE
100       
[1682]101       INTEGER(iwp) ::  i                  !<
102       INTEGER(iwp) ::  j                  !<
103       INTEGER(iwp) ::  k                  !<
104       INTEGER(iwp) ::  pr                 !<
105       INTEGER(iwp) ::  omp_get_thread_num !<
106       INTEGER(iwp) ::  tn                 !<
[1365]107       
108#if defined( __nopointer )
[1682]109       REAL(wp), DIMENSION(:,:,:) ::  var  !<
[1365]110#else
111       REAL(wp), DIMENSION(:,:,:), POINTER ::  var
112#endif
113
114!
115!--    Computation of the horizontally averaged profile of variable var, unless
116!--    already done by the relevant call from flow_statistics. The calculation
117!--    is done only for the first respective intermediate timestep in order to
118!--    spare communication time and to produce identical model results with jobs
[2696]119!--    which are calling flow_statistics at different time intervals. At
120!--    initialization, intermediate_timestep_count = 0 is considered as well.
121
[1365]122       IF ( .NOT. flow_statistics_called  .AND.                                &
[2696]123            intermediate_timestep_count <= 1 )  THEN
[1365]124
125!
126!--       Horizontal average of variable var
127          tn           =   0  ! Default thread number in case of one thread
128          !$OMP PARALLEL PRIVATE( i, j, k, tn )
129!$        tn = omp_get_thread_num()
130          sums_l(:,pr,tn) = 0.0_wp
131          !$OMP DO
132          DO  i = nxl, nxr
133             DO  j =  nys, nyn
[2232]134                DO  k = nzb, nzt+1
135                   sums_l(k,pr,tn) = sums_l(k,pr,tn) + var(k,j,i)              &
136                                     * MERGE( 1.0_wp, 0.0_wp,                  &
137                                              BTEST( wall_flags_0(k,j,i), 22 ) )
[1365]138                ENDDO
139             ENDDO
140          ENDDO
141          !$OMP END PARALLEL
142
143          DO  i = 1, threads_per_task-1
144             sums_l(:,pr,0) = sums_l(:,pr,0) + sums_l(:,pr,i)
145          ENDDO
146
147#if defined( __parallel )
148
149          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
150          CALL MPI_ALLREDUCE( sums_l(nzb,pr,0), sums(nzb,pr), nzt+2-nzb,       &
151                              MPI_REAL, MPI_SUM, comm2d, ierr )
152
153#else
154
155          sums(:,pr) = sums_l(:,pr,0)
156
157#endif
158
[1738]159          DO  k = nzb, nzt+1
160             IF ( ngp_2dh_s_inner(k,0) /= 0 )  THEN
161                hom(k,1,pr,0) = sums(k,pr) / ngp_2dh_s_inner(k,0)
162             ENDIF
163          ENDDO
[1365]164
165       ENDIF
166
167
168    END SUBROUTINE calc_mean_profile
169
[1738]170 END MODULE calc_mean_profile_mod
Note: See TracBrowser for help on using the repository browser.