source: trunk/src/FLEXPART.f90 @ 25

Last change on this file since 25 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
22program 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
405end program flexpart
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG