source: branches/petra/src/par_mod.f90 @ 37

Last change on this file since 37 was 37, checked in by pesei, 9 years ago

Wet dep quick fix and other small changes. Wet depo quick fix not final yet.

  • Property svn:executable set to *
File size: 12.9 KB
Line 
1!**********************************************************************
2! Copyright 1998-2015                                                 *
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
22!*******************************************************************************
23!   Include file for calculation of particle trajectories (Program FLEXPART)   *
24!        This file contains the parameter statements used in FLEXPART          *
25!                                                                              *
26!        Author: A. Stohl                                                      *
27!                                                                              *
28!        1997                                                                  *
29!                                                                              *
30!        15 August 2013, IP                                                    *
31!        2/2015, PS: nshift=0, unitheader_txt -> unitheader_rel
32!                                                                              *
33!                                                                              *
34!*******************************************************************************
35
36module par_mod
37
38  implicit none
39
40  !****************************************************************
41  ! Parameter defining KIND parameter for "double precision"
42  !****************************************************************
43
44  integer,parameter :: dp=selected_real_kind(P=15)
45
46
47  !***********************************************************
48  ! Number of directories/files used for FLEXPART input/output
49  !***********************************************************
50
51  integer,parameter :: numpath=4
52
53  ! numpath                 Number of different pathnames for input/output files
54
55
56  !*****************************
57  ! Physical and other constants
58  !*****************************
59
60  real,parameter :: pi=3.14159265, r_earth=6.371e6, r_air=287.05, ga=9.81
61  real,parameter :: cpa=1004.6, kappa=0.286, pi180=pi/180., vonkarman=0.4
62
63  ! pi                      number "pi"
64  ! pi180                   pi/180.
65  ! r_earth                 radius of earth [m]
66  ! r_air                   individual gas constant for dry air [J/kg/K]
67  ! ga                      gravity acceleration of earth [m/s**2]
68  ! cpa                     specific heat for dry air
69  ! kappa                   exponent of formula for potential temperature
70  ! vonkarman               von Karman constant
71
72  real,parameter :: karman=0.40, href=15., convke=2.0
73  real,parameter :: hmixmin=100., hmixmax=4500., turbmesoscale=0.16
74  real,parameter :: d_trop=50., d_strat=0.1
75
76  ! karman                  Karman's constant
77  ! href [m]                Reference height for dry deposition
78  ! konvke                  Relative share of kinetic energy used for parcel lifting
79  ! hmixmin,hmixmax         Minimum and maximum allowed PBL height
80  ! turbmesoscale           the factor by which standard deviations of winds at grid
81  !                    points surrounding the particle positions are scaled to
82  !                    yield the scales for the mesoscale wind velocity fluctuations
83  ! d_trop [m2/s]           Turbulent diffusivity for horizontal components in the troposphere
84  ! d_strat [m2/s]          Turbulent diffusivity for vertical component in the stratosphere
85
86  real,parameter :: xmwml=18.016/28.960
87
88  ! xmwml   ratio of molar weights of water vapor and dry air
89  !****************************************************
90  ! Constants related to the stratospheric ozone tracer
91  !****************************************************
92
93  real,parameter :: ozonescale=60., pvcrit=2.0
94
95  ! ozonescale              ppbv O3 per PV unit
96  ! pvcrit                  PV level of the tropopause
97
98
99
100  !********************
101  ! Some time constants
102  !********************
103
104  integer,parameter :: idiffnorm=10800, idiffmax=2*idiffnorm, minstep=1
105  integer,parameter :: itagekernmin=10800
106
107  ! idiffnorm [s]           normal time interval between two wind fields
108  ! idiffmax [s]            maximum time interval between two wind fields
109  ! minstep [s]             minimum time step to be used within FLEXPART
110  ! itagekernmin [s]        minimum particle age [s] for using output kernel
111
112  !*****************************************************************
113  ! Parameters for polar stereographic projection close to the poles
114  !*****************************************************************
115
116  real,parameter :: switchnorth=75., switchsouth=-75.
117
118  ! switchnorth    use polar stereographic grid north of switchnorth
119  ! switchsouth    use polar stereographic grid south of switchsouth
120
121
122  !*********************************************
123  ! Maximum dimensions of the input mother grids
124  !*********************************************
125 
126  !integer,parameter :: nxmax=361,nymax=181,nuvzmax=92,nwzmax=92,nzmax=92 !FNL XF
127  !integer,parameter :: nxmax=361,nymax=181,nuvzmax=152,nwzmax=152,nzmax=152 !ECMWF new
128  integer,parameter :: nxmax=361,nymax=181,nuvzmax=92,nwzmax=92,nzmax=92 !ECMWF
129  !integer,parameter :: nxmax=361,nymax=181,nuvzmax=26,nwzmax=26,nzmax=26
130  !integer,parameter :: nxmax=721,nymax=361,nuvzmax=64,nwzmax=64,nzmax=64
131  !integer,parameter :: nxmax=1201,nymax=235,nuvzmax=58,nwzmax=58,nzmax=58
132
133  integer,parameter :: nxshift= 0 !359 ! for ECMWF
134  !integer,parameter :: nxshift=0     ! for GFS or FNL (XF)
135
136  integer,parameter :: nconvlevmax = nuvzmax-1
137  integer,parameter :: na = nconvlevmax+1
138
139
140  ! nxmax,nymax        maximum dimension of wind fields in x and y
141  !                    direction, respectively
142  ! nuvzmax,nwzmax     maximum dimension of (u,v) and (w) wind fields in z
143  !                    direction (for fields on eta levels)
144  ! nzmax              maximum dimension of wind fields in z direction
145  !                    for the transformed Cartesian coordinates
146  ! nxshift            for global grids (in x), the grid can be shifted by
147  !                    nxshift grid points, in order to accomodate nested
148  !                    grids, and output grids overlapping the domain "boundary"
149  !                    nxshift must not be negative; "normal" setting would be 0
150  ! ntracermax         maximum number of tracer species in convection
151  ! nconvlevmax        maximum number of levels for convection
152  ! na                 parameter used in Emanuel's convect subroutine
153
154
155  !*********************************************
156  ! Maximum dimensions of the nested input grids
157  !*********************************************
158
159  !integer,parameter :: maxnests=0, nxmaxn=0, nymaxn=0
160  integer,parameter :: maxnests=1,nxmaxn=351,nymaxn=351 !ECMWF
161  !integer,parameter :: maxnests=1, nxmaxn=201, nymaxn=161 ! FNL XF
162  ! maxnests                maximum number of nested grids
163  ! nxmaxn,nymaxn           maximum dimension of nested wind fields in
164  !                         x and y direction, respectively
165
166
167  !*********************************
168  ! Parmaters for GRIB file decoding
169  !*********************************
170
171  integer,parameter :: jpack=4*nxmax*nymax, jpunp=4*jpack
172
173  ! jpack,jpunp             maximum dimensions needed for GRIB file decoding
174
175
176  !**************************************
177  ! Maximum dimensions of the output grid
178  !**************************************
179
180  !integer,parameter :: maxageclass=1,maxzgrid=10,nclassunc=1
181  integer,parameter :: maxageclass=1,nclassunc=1
182
183  ! nclassunc               number of classes used to calculate the uncertainty
184  !                         of the output
185  ! maxageclass             maximum number of age classes used for output
186
187  ! Sabine Eckhardt, June, 2008
188  ! the dimensions of the OUTGRID are now set dynamically during runtime
189  ! maxxgrid,maxygrid,maxzgrid    maximum dimensions in x,y,z direction
190  ! maxxgridn,maxygridn           maximum dimension of the nested grid
191  !integer maxxgrid,maxygrid,maxzgrid,maxxgridn,maxygridn
192  !integer,parameter :: maxxgrid=361,maxygrid=181,maxxgridn=0,maxygridn=0)
193
194  integer,parameter :: maxreceptor=200
195
196  ! maxreceptor             maximum number of receptor points
197
198
199  !**************************************************
200  ! Maximum number of particles, species, and similar
201  !**************************************************
202
203  integer,parameter :: maxpart=150000
204  integer,parameter :: maxspec=4
205
206
207  ! maxpart                 Maximum number of particles
208  ! maxspec                 Maximum number of chemical species per release
209
210  ! maxpoint is also set dynamically during runtime
211  ! maxpoint                Maximum number of release locations
212
213  ! ---------
214  ! Sabine Eckhardt: change of landuse inventary numclass=13
215  ! ---------
216  integer,parameter :: maxwf=50000, maxtable=1000, numclass=13, ni=11
217
218  ! maxwf                   maximum number of wind fields to be used for simulation
219  ! maxtable                Maximum number of chemical species that can be
220  !                         tabulated for FLEXPART
221  ! numclass                Number of landuse classes available to FLEXPART
222  ! ni                      Number of diameter classes of particles
223
224  !**************************************************************************
225  ! dimension of the OH field
226  !**************************************************************************
227  integer,parameter :: maxxOH=72, maxyOH=46, maxzOH=7
228
229  !**************************************************************************
230  ! Maximum number of particles to be released in a single atmospheric column
231  ! for the domain-filling trajectories option
232  !**************************************************************************
233
234  integer,parameter :: maxcolumn=3000
235
236
237  !*********************************
238  ! Dimension of random number field
239  !*********************************
240
241  integer,parameter :: maxrand=2000000
242
243  ! maxrand                 number of random numbers used
244
245
246  !*****************************************************
247  ! Number of clusters to be used for plume trajectories
248  !*****************************************************
249
250  integer,parameter :: ncluster=5
251
252  !************************************
253  ! Unit numbers for input/output files
254  !************************************
255
256  integer,parameter :: unitpath=1, unitcommand=1, unitageclasses=1, unitgrid=1
257  integer,parameter :: unitavailab=1, unitreleases=88, unitpartout=93
258  integer,parameter :: unitpartin=93, unitflux=98, unitouttraj=96
259  integer,parameter :: unitvert=1, unitoro=1, unitpoin=1, unitreceptor=1
260  integer,parameter :: unitoutgrid=97, unitoutgridppt=99, unitoutinfo=1
261  integer,parameter :: unitspecies=1, unitoutrecept=91, unitoutreceptppt=92
262  integer,parameter :: unitlsm=1, unitsurfdata=1, unitland=1, unitwesely=1
263  integer,parameter :: unitOH=1
264  integer,parameter :: unitdates=94, unitheader=90,unitheader_rel=100, unitshortpart=95
265  integer,parameter :: unitboundcond=89
266
267!******************************************************
268! for use in wet scavenging (PS, 2012, 2015)
269!******************************************************
270
271  integer,parameter :: icmv=-9999 ! integer code for missing values
272  ! some cloud heights used when trying to construct reasonable cloud:
273  integer,parameter :: icloudtopconvmin = 6000
274  integer,parameter :: icloudtopmin = 3000
275  integer,parameter :: icloudbot1 = 500, icloudtop1 =  8000
276  integer,parameter :: icloudbot2 = 0,   icloudtop2 = 10000
277 
278  real, parameter :: precmin = 0.002 ! minimum prec in mm/h for cloud diagnostics
279  real, parameter :: rhmininit = 0.90 ! standard condition for presence of clouds
280! PS       note that original by Sabine Eckhart was 80%
281! PS       however, for T<-20 C we consider saturation over ice
282! PS       so I think 90% should be enough         
283  real, parameter :: rhminx = 0.30 ! extreme condition for presence of clouds
284
285! Parameters for testing
286!*******************************************
287!  integer :: verbosity=0
288
289end module par_mod
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG