source: trunk/src/part0.f90 @ 28

Last change on this file since 28 was 4, checked in by mlanger, 11 years ago
File size: 6.9 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
22subroutine part0(dquer,dsigma,density,fract,schmi,cun,vsh)
23  !                  i      i       i      o     o    o   o
24  !*****************************************************************************
25  !                                                                            *
26  !      Calculation of time independent factors of the dry deposition of      *
27  !      particles:                                                            *
28  !      Log-Normal-distribution of mass [dM/dlog(dp)], unimodal               *
29  !                                                                            *
30  !      AUTHOR: Matthias Langer, adapted by Andreas Stohl, 13 November 1993   *
31  !                                                                            *
32  !      Literature:                                                           *
33  !      [1]  Scire/Yamartino/Carmichael/Chang (1989),                         *
34  !             CALGRID: A Mesoscale Photochemical Grid Model.                 *
35  !             Vol II: User's Guide. (Report No.A049-1, June, 1989)           *
36  !                                                                            *
37  !*****************************************************************************
38  !                                                                            *
39  ! Variables:                                                                 *
40  ! alpha            help variable                                             *
41  ! cun              'slip-flow' correction after Cunningham                   *
42  ! d01 [um]         upper diameter                                            *
43  ! d02 [um]         lower diameter                                            *
44  ! dc [m2/s]        coefficient of Brownian diffusion                         *
45  ! delta            distance given in standard deviation units                *
46  ! density [kg/m3]  density of the particle                                   *
47  ! dmean            geometric mean diameter of interval                       *
48  ! dquer [um]       geometric mass mean particle diameter                     *
49  ! dsigma           e.g. dsigma=10 or dsigma=0.1 means that 68% of the mass   *
50  !                  are between 0.1*dquer and 10*dquer                        *
51  ! fract(ni)        mass fraction of each diameter interval                   *
52  ! kn               Knudsen number                                            *
53  ! ni               number of diameter intervals, for which deposition        *
54  !                  is calculated                                             *
55  ! schmidt          Schmidt number                                            *
56  ! schmi            schmidt**2/3                                              *
57  ! vsh [m/s]        gravitational settling velocity of the particle           *
58  ! x01              normalized upper diameter                                 *
59  ! x02              normalized lower diameter                                 *
60  !                                                                            *
61  ! Constants:                                                                 *
62  ! g [m/s2]         Acceleration of gravity                                   *
63  ! kb [J/K]         Stefan-Boltzmann constant                                 *
64  ! lam [m]          mean free path of air molecules                           *
65  ! myl [kg/m/s]     dynamical viscosity of air                                *
66  ! nyl [m2/s]       kinematic viscosity of air                                *
67  ! tr               reference temperature                                     *
68  !                                                                            *
69  ! Function:                                                                  *
70  ! erf              calculates the integral of the Gauss function             *
71  !                                                                            *
72  !*****************************************************************************
73
74  use par_mod
75
76  implicit none
77
78  real,parameter :: tr=293.15
79
80  integer :: i
81  real :: dquer,dsigma,density,xdummy,d01,d02,delta,x01,x02,fract(ni)
82  real :: dmean,alpha,cun,dc,schmidt,schmi(ni),vsh(ni),kn,erf
83  real,parameter :: myl=1.81e-5,nyl=0.15e-4
84  real,parameter :: lam=6.53e-8,kb=1.38e-23,eps=1.2e-38
85
86
87  ! xdummy constant for all intervals
88  !**********************************
89
90  xdummy=sqrt(2.)*alog(dsigma)
91
92
93  ! particles diameters are split up to ni intervals between
94  ! dquer-3*dsigma and dquer+3*dsigma
95  !*********************************************************
96
97  delta=6./real(ni)
98
99  d01=dquer*dsigma**(-3)
100  do i=1,ni
101    d02=d01
102    d01=dquer*dsigma**(-3.+delta*real(i))
103    x01=alog(d01/dquer)/xdummy
104    x02=alog(d02/dquer)/xdummy
105
106
107  ! Area under Gauss-function is calculated and gives mass fraction of interval
108  !****************************************************************************
109
110    fract(i)=0.5*(erf(x01)-erf(x02))
111
112
113  ! Geometric mean diameter of interval in [m]
114  !*******************************************
115
116    dmean=1.E-6*exp(0.5*alog(d01*d02))
117
118
119  ! Calculation of time independent parameters of each interval
120  !************************************************************
121
122    kn=2.*lam/dmean
123    if ((-1.1/kn).le.log10(eps)*log(10.)) then
124      alpha=1.257
125    else
126      alpha=1.257+0.4*exp(-1.1/kn)
127    endif
128    cun=1.+alpha*kn
129    dc=kb*tr*cun/(3.*pi*myl*dmean)
130    schmidt=nyl/dc
131    schmi(i)=schmidt**(-2./3.)
132    vsh(i)=ga*density*dmean*dmean*cun/(18.*myl)
133
134  end do
135
136end subroutine part0
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG