source: flexpart.git/src/initialize_cbl_vel.f90 @ 027e844

10.4.1_peseiGFS_025bugfixes+enhancementsdevrelease-10release-10.4.1scaling-bugunivie
Last change on this file since 027e844 was 5f9d14a, checked in by Espen Sollum ATMOS <eso@…>, 9 years ago

Updated wet depo scheme

  • Property mode set to 100644
File size: 3.6 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 initialize_cbl_vel(idum,zp,ust,wst,h,sigmaw,wp, ol)
23!                              i/o   i  i   i  i     i  o   i 
24
25  use par_mod, only:pi
26  use com_mod, only:ldirect
27  use random_mod, only: gasdev, ran3
28
29  implicit none
30
31!===============================================================================
32! CBL skewed vertical profiles and formulation of LHH 1996 with profile of w3
33! from LHB 2000
34! LHH formulation has been modified to account for variable density profiles and
35! backward in time or forward in time simulations
36! see Cassiani et al. BLM 2014 doi  for explanations and references
37!===============================================================================
38
39
40  real :: usurad2,usurad2p,C0,costluar4,eps
41  parameter  (usurad2=0.7071067812,usurad2p=0.3989422804,C0=2,costluar4=0.66667,eps=0.000001)
42
43  integer idum
44  real :: wp,zp,ust,wst,h,dens,ddens,sigmaw,dsigmawdz,tlw,dcas,dcas1!,ran3,gasdev
45  real :: w3,w2
46  real ::  z, &   
47       skew, &
48       skew2, &
49       radw2, &
50       fluarw,fluarw2, &
51       rluarw, &
52       xluarw, &
53       aluarw, &
54       bluarw, &
55       sigmawa, &
56       sigmawb, & 
57       ath, &
58       bth, &
59       wb,wa
60  real timedir
61  real ol, transition
62
63!--------------------------------------------------------------------------- 
64  timedir=ldirect !direction of time forward (1) or backward(-1)
65  z=zp/h
66
67
68  transition=1.
69  if (-h/ol.lt.15) transition=((sin((((-h/ol)+10.)/10.)*pi)))/2.+0.5  !see also in cbl.f90
70
71  w2=sigmaw*sigmaw
72  w3=(((1.2*z*((1.-z)**(3./2.)))+eps)*wst**3) *transition
73
74  skew=w3/(w2**1.5)
75  skew2=skew*skew
76
77  radw2=sqrt(w2) !sigmaw
78
79  fluarw=costluar4*skew**0.333333333333333
80  fluarw2=fluarw*fluarw
81  rluarw=(1.+fluarw2)**3.*skew2/((3.+fluarw2)**2.*fluarw2)  !-> r
82  xluarw=rluarw**0.5 !----> r^1/2
83
84  aluarw=0.5*(1.-xluarw/(4.+rluarw)**0.5)
85  bluarw=1.-aluarw
86
87  sigmawa=radw2*(bluarw/(aluarw*(1.+fluarw2)))**0.5
88  sigmawb=radw2*(aluarw/(bluarw*(1.+fluarw2)))**0.5
89
90  wa=(fluarw*sigmawa)
91  wb=(fluarw*sigmawb)
92
93  dcas=ran3(idum)
94
95  if (dcas.le.aluarw) then
96    dcas1=gasdev(idum)
97    wp=timedir*(dcas1*sigmawa+wa)
98  else
99    dcas1=gasdev(idum)
100    wp=timedir*(dcas1*sigmawb-wb)
101  end if
102
103  return
104end subroutine initialize_cbl_vel
105
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG