Context Navigation

FLEXPART.f90 @ 24

Last change on this file since 24 was 24, checked in by igpis, 10 years ago
version 9.2 beta. Changes from HH, AST, MC, NIK, IP. Changes in vert transform. New SPECIES input includes scavenging coefficients
File size: 12.2 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
22	program flexpart
23
24	!*****************************************************************************
25	! *
26	! This is the Lagrangian Particle Dispersion Model FLEXPART. *
27	! The main program manages the reading of model run specifications, etc. *
28	! All actual computing is done within subroutine timemanager. *
29	! *
30	! Author: A. Stohl *
31	! *
32	! 18 May 1996 *
33	! *
34	!*****************************************************************************
35	! *
36	! Variables: *
37	! *
38	! Constants: *
39	! *
40	!*****************************************************************************
41
42	use point_mod
43	use par_mod
44	use com_mod
45	use conv_mod
46
47	implicit none
48
49	integer :: i,j,ix,jy,inest
50	integer :: idummy = -320
51	character(len=256) :: inline_options !pathfile, flexversion, arg2
52
53
54	! Generate a large number of random numbers
55	!******************************************
56
57	do i=1,maxrand-1,2
58	call gasdev1(idummy,rannumb(i),rannumb(i+1))
59	end do
60	call gasdev1(idummy,rannumb(maxrand),rannumb(maxrand-1))
61
62	!
63	flexversion='Version 9.2 beta (2014-05-23)'
64	!verbosity=0
65	! Read the pathnames where input/output files are stored
66	!*******************************************************
67
68	inline_options='none'
69	select case (iargc())
70	case (2)
71	call getarg(1,arg1)
72	pathfile=arg1
73	call getarg(2,arg2)
74	inline_options=arg2
75	case (1)
76	call getarg(1,arg1)
77	pathfile=arg1
78	verbosity=0
79	if (arg1(1:1).eq.'-') then
80	write(pathfile,'(a11)') './pathnames'
81	inline_options=arg1
82	endif
83	case (0)
84	write(pathfile,'(a11)') './pathnames'
85	verbosity=0
86	end select
87
88	if (inline_options(1:1).eq.'-') then
89	print*, 'inline options=', inline_options
90	if (trim(inline_options).eq.'-v'.or.trim(inline_options).eq.'-v1') then
91	print*, 'verbose mode 1: additional information will be displayed'
92	verbosity=1
93	endif
94	if (trim(inline_options).eq.'-v2') then
95	print*, 'verbose mode 2: additional information will be displayed'
96	verbosity=2
97	endif
98	if (trim(inline_options).eq.'-i') then
99	print*, 'info mode: will provide run specific information and stop'
100	verbosity=1
101	info_flag=1
102	endif
103	if (trim(inline_options).eq.'-i2') then
104	print*, 'info mode: will provide run specific information and stop'
105	verbosity=2
106	info_flag=1
107	endif
108	endif
109
110
111	! Print the GPL License statement
112	!*******************************************************
113	print*,'Welcome to FLEXPART ', trim(flexversion)
114	print*,'FLEXPART is free software released under the GNU Genera'// &
115	'l Public License.'
116
117	if (verbosity.gt.0) then
118	WRITE(,) 'call readpaths'
119	endif
120	call readpaths(pathfile)
121
122
123	if (verbosity.gt.1) then !show clock info
124	!print*,'length(4)',length(4)
125	!count=0,count_rate=1000
126	CALL SYSTEM_CLOCK(count_clock0, count_rate, count_max)
127	!WRITE(,) 'SYSTEM_CLOCK',count, count_rate, count_max
128	!WRITE(,) 'SYSTEM_CLOCK, count_clock0', count_clock0
129	!WRITE(,) 'SYSTEM_CLOCK, count_rate', count_rate
130	!WRITE(,) 'SYSTEM_CLOCK, count_max', count_max
131	endif
132
133
134	! Read the user specifications for the current model run
135	!*******************************************************
136
137	if (verbosity.gt.0) then
138	WRITE(,) 'call readcommand'
139	endif
140	call readcommand
141	if (verbosity.gt.0) then
142	WRITE(,) ' ldirect=', ldirect
143	WRITE(,) ' ibdate,ibtime=',ibdate,ibtime
144	WRITE(,) ' iedate,ietime=', iedate,ietime
145	if (verbosity.gt.1) then
146	CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
147	WRITE(,) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
148	endif
149	endif
150
151
152	! Read the age classes to be used
153	!********************************
154	if (verbosity.gt.0) then
155	WRITE(,) 'call readageclasses'
156	endif
157	call readageclasses
158
159	if (verbosity.gt.1) then
160	CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
161	WRITE(,) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
162	endif
163
164
165
166	! Read, which wind fields are available within the modelling period
167	!******************************************************************
168
169	if (verbosity.gt.0) then
170	WRITE(,) 'call readavailable'
171	endif
172	call readavailable
173
174	! Read the model grid specifications,
175	! both for the mother domain and eventual nests
176	!**********************************************
177
178	if (verbosity.gt.0) then
179	WRITE(,) 'call gridcheck'
180	endif
181
182	call gridcheck
183
184	if (verbosity.gt.1) then
185	CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
186	WRITE(,) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
187	endif
188
189
190	if (verbosity.gt.0) then
191	WRITE(,) 'call gridcheck_nests'
192	endif
193	call gridcheck_nests
194
195
196	! Read the output grid specifications
197	!************************************
198
199	if (verbosity.gt.0) then
200	WRITE(,) 'call readoutgrid'
201	endif
202
203	call readoutgrid
204
205	if (nested_output.eq.1) then
206	call readoutgrid_nest
207	if (verbosity.gt.0) then
208	WRITE(,) '# readoutgrid_nest'
209	endif
210	endif
211
212	! Read the receptor points for which extra concentrations are to be calculated
213	!*****************************************************************************
214
215	if (verbosity.eq.1) then
216	print*,'call readreceptors'
217	endif
218	call readreceptors
219
220	! Read the physico-chemical species property table
221	!*************************************************
222	!SEC: now only needed SPECIES are read in readreleases.f
223	!call readspecies
224
225
226	! Read the landuse inventory
227	!***************************
228
229	if (verbosity.gt.0) then
230	print*,'call readlanduse'
231	endif
232	call readlanduse
233
234
235	! Assign fractional cover of landuse classes to each ECMWF grid point
236	!********************************************************************
237
238	if (verbosity.gt.0) then
239	print*,'call assignland'
240	endif
241	call assignland
242
243
244
245	! Read the coordinates of the release locations
246	!**********************************************
247
248	if (verbosity.gt.0) then
249	print*,'call readreleases'
250	endif
251	call readreleases
252
253
254	! Read and compute surface resistances to dry deposition of gases
255	!****************************************************************
256
257	if (verbosity.gt.0) then
258	print*,'call readdepo'
259	endif
260	call readdepo
261
262	! Convert the release point coordinates from geografical to grid coordinates
263	!***************************************************************************
264
265	call coordtrafo
266	if (verbosity.gt.0) then
267	print*,'call coordtrafo'
268	endif
269
270
271	! Initialize all particles to non-existent
272	!*****************************************
273
274	if (verbosity.gt.0) then
275	print*,'Initialize all particles to non-existent'
276	endif
277	do j=1,maxpart
278	itra1(j)=-999999999
279	end do
280
281	! For continuation of previous run, read in particle positions
282	!*************************************************************
283
284	if (ipin.eq.1) then
285	if (verbosity.gt.0) then
286	print*,'call readpartpositions'
287	endif
288	call readpartpositions
289	else
290	if (verbosity.gt.0) then
291	print*,'numpart=0, numparticlecount=0'
292	endif
293	numpart=0
294	numparticlecount=0
295	endif
296
297
298	! Calculate volume, surface area, etc., of all output grid cells
299	! Allocate fluxes and OHfield if necessary
300	!***************************************************************
301
302
303	if (verbosity.gt.0) then
304	print*,'call outgrid_init'
305	endif
306	call outgrid_init
307	if (nested_output.eq.1) call outgrid_init_nest
308
309
310	! Read the OH field
311	!******************
312
313	if (OHREA.eqv..TRUE.) then
314	if (verbosity.gt.0) then
315	print*,'call readOHfield'
316	endif
317	call readOHfield
318	endif
319
320	! Write basic information on the simulation to a file "header"
321	! and open files that are to be kept open throughout the simulation
322	!******************************************************************
323
324
325	if (verbosity.gt.0) then
326	print*,'call writeheader'
327	endif
328
329	call writeheader
330	! FLEXPART 9.2 ticket ?? write header in ASCII format
331	call writeheader_txt
332	!if (nested_output.eq.1) call writeheader_nest
333	if (nested_output.eq.1.and.surf_only.ne.1) call writeheader_nest
334
335	if (nested_output.eq.1.and.surf_only.eq.1) call writeheader_nest_surf
336	if (nested_output.ne.1.and.surf_only.eq.1) call writeheader_surf
337
338
339
340	!open(unitdates,file=path(2)(1:length(2))//'dates')
341
342	if (verbosity.gt.0) then
343	print*,'call openreceptors'
344	endif
345	call openreceptors
346	if ((iout.eq.4).or.(iout.eq.5)) call openouttraj
347
348
349	! Releases can only start and end at discrete times (multiples of lsynctime)
350	!***************************************************************************
351
352	if (verbosity.gt.0) then
353	print*,'discretize release times'
354	endif
355	do i=1,numpoint
356	ireleasestart(i)=nint(real(ireleasestart(i))/ &
357	real(lsynctime))*lsynctime
358	ireleaseend(i)=nint(real(ireleaseend(i))/ &
359	real(lsynctime))*lsynctime
360	end do
361
362
363	! Initialize cloud-base mass fluxes for the convection scheme
364	!************************************************************
365
366	if (verbosity.gt.0) then
367	print*,'Initialize cloud-base mass fluxes for the convection scheme'
368	endif
369
370	do jy=0,nymin1
371	do ix=0,nxmin1
372	cbaseflux(ix,jy)=0.
373	end do
374	end do
375	do inest=1,numbnests
376	do jy=0,nyn(inest)-1
377	do ix=0,nxn(inest)-1
378	cbasefluxn(ix,jy,inest)=0.
379	end do
380	end do
381	end do
382
383
384	! Calculate particle trajectories
385	!********************************
386
387	if (verbosity.gt.0) then
388	if (verbosity.gt.1) then
389	CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
390	WRITE(,) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
391	endif
392	if (info_flag.eq.1) then
393	print*, 'info only mode (stop)'
394	stop
395	endif
396	print*,'call timemanager'
397	endif
398
399	call timemanager
400
401
402	write(,) 'CONGRATULATIONS: YOU HAVE SUCCESSFULLY COMPLETED A FLE&
403	&XPART MODEL RUN!'
404
405	end program flexpart

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format