source: flexpart.git/src/par_mod.f90 @ 5f2e8f6

flexpart-noresm
Last change on this file since 5f2e8f6 was 5f2e8f6, checked in by Ignacio Pisso <Ignacio.Pisso@…>, 8 years ago

new flexpart noresm code in src

  • Property mode set to 100755
File size: 12.4 KB
Line 
1!**********************************************************************
2! Copyright 2016                                                      *
3! Andreas Stohl, Massimo Cassiani, Petra Seibert, A. Frank,           *
4! Gerhard Wotawa,  Caroline Forster, Sabine Eckhardt, John Burkhart,  *
5! Harald Sodemann, Ignacio Pisso                                      *
6!                                                                     *
7! This file is part of FLEXPART-NorESM                                *
8!                                                                     *
9! FLEXPART-NorESM is free software: you can redistribute it           *
10! and/or modify                                                       *
11! it under the terms of the GNU General Public License as published by*
12! the Free Software Foundation, either version 3 of the License, or   *
13! (at your option) any later version.                                 *
14!                                                                     *
15! FLEXPART-NorESM is distributed in the hope that it will be useful,  *
16! but WITHOUT ANY WARRANTY; without even the implied warranty of      *
17! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *
18! GNU General Public License for more details.                        *
19!                                                                     *
20! You should have received a copy of the GNU General Public License   *
21! along with FLEXPART-NorESM.                                         *
22!  If not, see <http://www.gnu.org/licenses/>.                        *
23!**********************************************************************
24     
25
26!*******************************************************************************
27!   Include file for calculation of particle trajectories (Program FLEXPART)   *
28!        This file contains the parameter statements used in FLEXPART          *
29!                                                                              *
30!        Author: A. Stohl                                                      *
31!                                                                              *
32!        1997                                                                  *
33!                                                                              *
34!        Last update 10 August 2000                                            *
35!                                                                              *
36!        modified by m.Cassiani, 2016 to use NorESM meteo files                *
37!                                                                              *
38!*******************************************************************************
39
40module par_mod
41
42  implicit none
43 
44  integer, parameter :: yearorigin=-4800 !look in juldate for this: comment by mc
45
46  !****************************************************************
47  ! Parameter defining KIND parameter for "double precision"
48  !****************************************************************
49
50  integer,parameter :: dp=selected_real_kind(P=15)
51
52
53  !***********************************************************
54  ! Number of directories/files used for FLEXPART input/output
55  !***********************************************************
56
57  integer,parameter :: numpath=5 !one additional path for NorESM TO ACCOUNT FOR THE GRID FILE IN CAM4: comment by mc
58
59  ! numpath                 Number of different pathnames for input/output files
60
61  integer, parameter :: maxdim=10,maxvar=70,maxtime=12 ! parameter used in readwind and gridcheck for reading NORESM output file: commmnt added by mc
62  !*****************************
63  ! Physical and other constants
64  !*****************************
65
66  real,parameter :: pi=3.14159265, r_earth=6.371e6, r_air=287.05, ga=9.81
67  real,parameter :: cpa=1004.6, kappa=0.286, pi180=pi/180., vonkarman=0.4
68
69  ! pi                      number "pi"
70  ! pi180                   pi/180.
71  ! r_earth                 radius of earth [m]
72  ! r_air                   individual gas constant for dry air [J/kg/K]
73  ! ga                      gravity acceleration of earth [m/s**2]
74  ! cpa                     specific heat for dry air
75  ! kappa                   exponent of formula for potential temperature
76  ! vonkarman               von Karman constant
77
78  real,parameter :: karman=0.40, href=15., convke=2.0
79  real,parameter :: hmixmin=100., hmixmax=4500., turbmesoscale=0.16
80  real,parameter :: d_trop=50., d_strat=0.1
81
82  ! karman                  Karman's constant
83  ! href [m]                Reference height for dry deposition
84  ! konvke                  Relative share of kinetic energy used for parcel lifting
85  ! hmixmin,hmixmax         Minimum and maximum allowed PBL height
86  ! turbmesoscale           the factor by which standard deviations of winds at grid
87  !                    points surrounding the particle positions are scaled to
88  !                    yield the scales for the mesoscale wind velocity fluctuations
89  ! d_trop [m2/s]           Turbulent diffusivity for horizontal components in the troposphere
90  ! d_strat [m2/s]          Turbulent diffusivity for vertical component in the stratosphere
91
92  real,parameter :: xmwml=18.016/28.960
93
94  ! xmwml   ratio of molar weights of water vapor and dry air
95  !****************************************************
96  ! Constants related to the stratospheric ozone tracer
97  !****************************************************
98
99  real,parameter :: ozonescale=60., pvcrit=2.0
100
101  ! ozonescale              ppbv O3 per PV unit
102  ! pvcrit                  PV level of the tropopause
103
104
105
106  !********************
107  ! Some time constants
108  !********************
109
110  integer,parameter :: idiffnorm=10800, idiffmax=2*idiffnorm, minstep=1
111
112  ! idiffnorm [s]           normal time interval between two wind fields
113  ! idiffmax [s]            maximum time interval between two wind fields
114  ! minstep [s]             minimum time step to be used within FLEXPART
115
116
117  !*****************************************************************
118  ! Parameters for polar stereographic projection close to the poles
119  !*****************************************************************
120
121  real,parameter :: switchnorth=75., switchsouth=-75.
122
123  ! switchnorth    use polar stereographic grid north of switchnorth
124  ! switchsouth    use polar stereographic grid south of switchsouth
125
126
127  !*********************************************
128  ! Maximum dimensions of the input mother grids
129  !*********************************************
130  integer,parameter :: nxmax=145,nymax=97,nuvzmax=27,nwzmax=27,nzmax=27  !for NorESM with 1.875x2.5 grid: added by mc
131  !integer,parameter :: nxmax=361,nymax=181,nuvzmax=92,nwzmax=92,nzmax=92
132  !integer,parameter :: nxmax=361,nymax=181,nuvzmax=61,nwzmax=61,nzmax=61
133  !integer,parameter :: nxmax=721,nymax=361,nuvzmax=64,nwzmax=64,nzmax=64
134  !integer,parameter :: nxshift=359  ! for ECMWF
135  !nteger,parameter :: nxshift=0     ! for GFS
136  integer,parameter :: nxshift=73     ! added by mc for CAM 4.0 NOTE THAT THE DATA OF CAM 4.0 HAVE LON(1)=0 with 144 nodes of 2.5 degree, therefore we move origin to -177.5.
137 
138  integer,parameter :: nconvlevmax = nuvzmax-1
139  integer,parameter :: na = nconvlevmax+1
140
141
142  ! nxmax,nymax        maximum dimension of wind fields in x and y
143  !                    direction, respectively
144  ! nuvzmax,nwzmax     maximum dimension of (u,v) and (w) wind fields in z
145  !                    direction (for fields on eta levels)
146  ! nzmax              maximum dimension of wind fields in z direction
147  !                    for the transformed Cartesian coordinates
148  ! nxshift            for global grids (in x), the grid can be shifted by
149  !                    nxshift grid points, in order to accomodate nested
150  !                    grids, and output grids overlapping the domain "boundary"
151  !                    nxshift must not be negative; "normal" setting would be 0
152  ! ntracermax         maximum number of tracer species in convection
153  ! nconvlevmax        maximum number of levels for convection
154  ! na                 parameter used in Emanuel's convect subroutine
155
156
157  !*********************************************
158  ! Maximum dimensions of the nested input grids
159  !*********************************************
160
161  integer,parameter :: maxnests=0, nxmaxn=0, nymaxn=0 ! <<<-----------------these must be always zero for NorESM: comment by mc
162 
163
164  ! maxnests                maximum number of nested grids
165  ! nxmaxn,nymaxn           maximum dimension of nested wind fields in
166  !                         x and y direction, respectively
167
168
169  !*********************************
170  ! Parmaters for GRIB file decoding
171  !*********************************
172
173  integer,parameter :: jpack=4*nxmax*nymax, jpunp=4*jpack
174
175  ! jpack,jpunp             maximum dimensions needed for GRIB file decoding
176
177
178  !**************************************
179  ! Maximum dimensions of the output grid
180  !**************************************
181
182  !integer,parameter :: maxageclass=1,maxzgrid=10,nclassunc=1
183  integer,parameter :: maxageclass=9,nclassunc=1
184
185  ! nclassunc               number of classes used to calculate the uncertainty
186  !                         of the output
187  ! maxageclass             maximum number of age classes used for output
188
189  ! Sabine Eckhardt, June, 2008
190  ! the dimensions of the OUTGRID are now set dynamically during runtime
191  ! maxxgrid,maxygrid,maxzgrid    maximum dimensions in x,y,z direction
192  ! maxxgridn,maxygridn           maximum dimension of the nested grid
193  !integer maxxgrid,maxygrid,maxzgrid,maxxgridn,maxygridn
194  !integer,parameter :: maxxgrid=361,maxygrid=181,maxxgridn=0,maxygridn=0)
195
196  integer,parameter :: maxreceptor=200
197
198  ! maxreceptor             maximum number of receptor points
199
200
201  !**************************************************
202  ! Maximum number of particles, species, and similar
203  !**************************************************
204
205  integer,parameter :: maxpart=20000000
206  integer,parameter :: maxspec=4
207
208
209  ! maxpart                 Maximum number of particles
210  ! maxspec                 Maximum number of chemical species per release
211
212  ! maxpoint is also set dynamically during runtime
213  ! maxpoint                Maximum number of release locations
214
215  ! ---------
216  ! Sabine Eckhardt: change of landuse inventary numclass=13
217  ! ---------
218  integer,parameter :: maxwf=50000, maxtable=1000, numclass=13, ni=11
219
220  ! maxwf                   maximum number of wind fields to be used for simulation
221  ! maxtable                Maximum number of chemical species that can be
222  !                         tabulated for FLEXPART
223  ! numclass                Number of landuse classes available to FLEXPART
224  ! ni                      Number of diameter classes of particles
225
226  !**************************************************************************
227  ! dimension of the OH field
228  !**************************************************************************
229  integer,parameter :: maxxOH=72, maxyOH=46, maxzOH=7
230
231  !**************************************************************************
232  ! Maximum number of particles to be released in a single atmospheric column
233  ! for the domain-filling trajectories option
234  !**************************************************************************
235
236  integer,parameter :: maxcolumn=3000
237
238
239  !*********************************
240  ! Dimension of random number field
241  !*********************************
242
243  integer,parameter :: maxrand=2000000
244
245  ! maxrand                 number of random numbers used
246
247
248  !*****************************************************
249  ! Number of clusters to be used for plume trajectories
250  !*****************************************************
251
252  integer,parameter :: ncluster=5
253
254  !************************************
255  ! Unit numbers for input/output files
256  !************************************
257
258  integer,parameter :: unitpath=1, unitcommand=1, unitageclasses=1, unitgrid=1
259  integer,parameter :: unitavailab=1, unitreleases=88, unitpartout=93
260  integer,parameter :: unitpartin=93, unitflux=98, unitouttraj=96
261  integer,parameter :: unitvert=1, unitoro=1, unitpoin=1, unitreceptor=1
262  integer,parameter :: unitoutgrid=97, unitoutgridppt=99, unitoutinfo=1
263  integer,parameter :: unitspecies=1, unitoutrecept=91, unitoutreceptppt=92
264  integer,parameter :: unitlsm=1, unitsurfdata=1, unitland=1, unitwesely=1
265  integer,parameter :: unitOH=1
266  integer,parameter :: unitdates=94, unitheader=90, unitshortpart=95
267  integer,parameter :: unitboundcond=89
268  integer,parameter :: unitdiagnostic1=72,unitdiagnostic2=73,unitdiagnostic3=74 !number from 70 to 79 reserved for diagnostic
269
270end module par_mod
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG