source: flexpart.git/src/mean_mod.f90 @ 7999df47

10.4.1_peseiGFS_025bugfixes+enhancementsdevrelease-10release-10.4.1scaling-bugunivie
Last change on this file since 7999df47 was 6a678e3, checked in by Espen Sollum ATMOS <eso@…>, 8 years ago

Added option to use double precision for calculating the deposition fields

  • Property mode set to 100644
File size: 8.0 KB
Line 
1!**********************************************************************
2! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
3! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
4! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
5!                                                                     *
6! This file is part of FLEXPART.                                      *
7!                                                                     *
8! FLEXPART is free software: you can redistribute it and/or modify    *
9! it under the terms of the GNU General Public License as published by*
10! the Free Software Foundation, either version 3 of the License, or   *
11! (at your option) any later version.                                 *
12!                                                                     *
13! FLEXPART is distributed in the hope that it will be useful,         *
14! but WITHOUT ANY WARRANTY; without even the implied warranty of      *
15! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *
16! GNU General Public License for more details.                        *
17!                                                                     *
18! You should have received a copy of the GNU General Public License   *
19! along with FLEXPART.  If not, see <http://www.gnu.org/licenses/>.   *
20!**********************************************************************
21
22module mean_mod
23  public
24
25! Interface to select single or double precision version of the 'mean'
26! function from type of input arguments ("function overloading")
27!********************************************************************
28  interface mean
29    module procedure mean_sp
30    module procedure mean_dp
31    module procedure mean_mixed_prec
32  end interface mean
33
34contains
35
36  subroutine mean_sp(x_sp,xm,xs,number)
37
38!*****************************************************************************
39!                                                                            *
40!  This subroutine calculates mean and standard deviation of a given element.*
41!                                                                            *
42!      AUTHOR: Andreas Stohl, 25 January 1994                                *
43!                                                                            *
44!      Single precision version ESO 2016                                     *
45!*****************************************************************************
46!                                                                            *
47! Variables:                                                                 *
48! x_sp(number)        field of input data                                    *
49! xm                  mean                                                   *
50! xs                  standard deviation                                     *
51! number              number of elements of field x_sp                       *
52!                                                                            *
53! Constants:                                                                 *
54! eps                 tiny number                                            *
55!                                                                            *
56!*****************************************************************************
57
58    use par_mod, only: sp
59
60    implicit none
61
62    ! integer :: number,i
63    ! real(sp) :: x_sp(number),xm,xs,xl,xq,xaux
64    ! real(sp),parameter :: eps=1.0e-30
65
66    real(sp), intent(in) :: x_sp(number)
67    real(sp), intent(out) ::xm,xs
68    integer,intent(in) :: number
69    real(sp) :: xl,xq,xaux
70    real(sp),parameter :: eps=1.0e-30
71    integer :: i
72
73    xl=0.
74    xq=0.
75    do i=1,number
76      xl=xl+x_sp(i)
77      xq=xq+x_sp(i)*x_sp(i)
78    end do
79
80    xm=xl/real(number,kind=sp)
81
82    xaux=xq-xl*xl/real(number,kind=sp)
83
84    if (xaux.lt.eps) then
85      xs=0.
86    else
87      xs=sqrt(xaux/real(number-1,kind=sp))
88    endif
89
90  end subroutine mean_sp
91
92  subroutine mean_dp(x_dp,xm,xs,number)
93
94!*****************************************************************************
95!                                                                            *
96!  This subroutine calculates mean and standard deviation of a given element.*
97!                                                                            *
98!      AUTHOR: Andreas Stohl, 25 January 1994                                *
99!                                                                            *
100!      Double precision version ESO 2016                                     *
101!*****************************************************************************
102!                                                                            *
103! Variables:                                                                 *
104! x_dp(number)        field of input data                                    *
105! xm                  mean                                                   *
106! xs                  standard deviation                                     *
107! number              number of elements of field x_dp                       *
108!                                                                            *
109! Constants:                                                                 *
110! eps                 tiny number                                            *
111!                                                                            *
112!*****************************************************************************
113
114    use par_mod, only: dp
115
116    implicit none
117
118    real(dp), intent(in) :: x_dp(number)
119    real(dp), intent(out) ::xm,xs
120    integer,intent(in) :: number
121    real(dp) :: xl,xq,xaux
122    real(dp),parameter :: eps=1.0e-30
123    integer :: i
124
125    xl=0._dp
126    xq=0._dp
127    do i=1,number
128      xl=xl+x_dp(i)
129      xq=xq+x_dp(i)*x_dp(i)
130    end do
131
132    xm=xl/real(number,kind=dp)
133
134    xaux=xq-xl*xl/real(number,kind=dp)
135
136    if (xaux.lt.eps) then
137      xs=0._dp
138    else
139      xs=sqrt(xaux/real(number-1,kind=dp))
140    endif
141
142  end subroutine mean_dp
143
144  subroutine mean_mixed_prec(x_dp,xm,xs,number)
145
146!*****************************************************************************
147!                                                                            *
148!  This subroutine calculates mean and standard deviation of a given element.*
149!                                                                            *
150!      AUTHOR: Andreas Stohl, 25 January 1994                                *
151!                                                                            *
152!      Mixed precision version ESO 2016 (dp input, sp output)                *
153!*****************************************************************************
154!                                                                            *
155! Variables:                                                                 *
156! x_dp(number)        field of input data                                    *
157! xm                  mean                                                   *
158! xs                  standard deviation                                     *
159! number              number of elements of field x_dp                       *
160!                                                                            *
161! Constants:                                                                 *
162! eps                 tiny number                                            *
163!                                                                            *
164!*****************************************************************************
165
166    use par_mod, only: sp,dp
167
168    implicit none
169
170    real(dp), intent(in) :: x_dp(number)
171    real(sp), intent(out) ::xm,xs
172    integer,intent(in) :: number
173    real(sp) :: xl,xq,xaux
174    real(sp),parameter :: eps=1.0e-30
175    integer :: i
176
177    xl=0._sp
178    xq=0._sp
179    do i=1,number
180      xl=xl+x_dp(i)
181      xq=xq+x_dp(i)*x_dp(i)
182    end do
183
184    xm=xl/real(number,kind=sp)
185
186    xaux=xq-xl*xl/real(number,kind=sp)
187
188    if (xaux.lt.eps) then
189      xs=0._sp
190    else
191      xs=sqrt(xaux/real(number-1,kind=sp))
192    endif
193
194  end subroutine mean_mixed_prec
195end module mean_mod
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG