source: trunk/src/FLEXPART.f90 @ 28

Last change on this file since 28 was 27, checked in by hasod, 10 years ago
  • Implemented optional namelist input for COMMAND, RELEASES, SPECIES, AGECLASSES,OUTGRID,OUTGRID_NEST,RECEPTORS
  • Implemented com_mod switch nmlout to write input files as namelist to the output directory (.true. by default)
  • Proposed updated startup and runtime output (may change back to previous info if desired)
File size: 11.9 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  ! FLEXPART version string
63  flexversion='Version 9.2 beta (2014-07-01)'
64  verbosity=0
65
66  ! Read the pathnames where input/output files are stored
67  !*******************************************************
68
69  inline_options='none'
70  select case (iargc())
71  case (2)
72    call getarg(1,arg1)
73    pathfile=arg1
74    call getarg(2,arg2)
75    inline_options=arg2
76  case (1)
77    call getarg(1,arg1)
78    pathfile=arg1
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  end select
86 
87  ! Print the GPL License statement
88  !*******************************************************
89  print*,'Welcome to FLEXPART ', trim(flexversion)
90  print*,'FLEXPART is free software released under the GNU General Public License.'
91 
92  if (inline_options(1:1).eq.'-') then
93    if (trim(inline_options).eq.'-v'.or.trim(inline_options).eq.'-v1') then
94       print*, 'Verbose mode 1: display detailed information during run'
95       verbosity=1
96    endif
97    if (trim(inline_options).eq.'-v2') then
98       print*, 'Verbose mode 2: display more detailed information during run'
99       verbosity=2
100    endif
101    if (trim(inline_options).eq.'-i') then
102       print*, 'Info mode: provide detailed run specific information and stop'
103       verbosity=1
104       info_flag=1
105    endif
106    if (trim(inline_options).eq.'-i2') then
107       print*, 'Info mode: provide more detailed run specific information and stop'
108       verbosity=2
109       info_flag=1
110    endif
111  endif
112           
113  if (verbosity.gt.0) then
114    write(*,*) 'call readpaths'
115  endif
116  call readpaths(pathfile)
117 
118  if (verbosity.gt.1) then !show clock info
119     !print*,'length(4)',length(4)
120     !count=0,count_rate=1000
121     CALL SYSTEM_CLOCK(count_clock0, count_rate, count_max)
122     !WRITE(*,*) 'SYSTEM_CLOCK',count, count_rate, count_max
123     !WRITE(*,*) 'SYSTEM_CLOCK, count_clock0', count_clock0
124     !WRITE(*,*) 'SYSTEM_CLOCK, count_rate', count_rate
125     !WRITE(*,*) 'SYSTEM_CLOCK, count_max', count_max
126  endif
127
128  ! Read the user specifications for the current model run
129  !*******************************************************
130
131  if (verbosity.gt.0) then
132    write(*,*) 'call readcommand'
133  endif
134  call readcommand
135  if (verbosity.gt.0) then
136    write(*,*) '    ldirect=', ldirect
137    write(*,*) '    ibdate,ibtime=',ibdate,ibtime
138    write(*,*) '    iedate,ietime=', iedate,ietime
139    if (verbosity.gt.1) then   
140      CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
141      write(*,*) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
142    endif     
143  endif
144
145  ! Read the age classes to be used
146  !********************************
147  if (verbosity.gt.0) then
148    write(*,*) 'call readageclasses'
149  endif
150  call readageclasses
151
152  if (verbosity.gt.1) then   
153    CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
154    write(*,*) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
155  endif     
156
157  ! Read, which wind fields are available within the modelling period
158  !******************************************************************
159
160  if (verbosity.gt.0) then
161    write(*,*) 'call readavailable'
162  endif 
163  call readavailable
164
165  ! Read the model grid specifications,
166  ! both for the mother domain and eventual nests
167  !**********************************************
168 
169  if (verbosity.gt.0) then
170     write(*,*) 'call gridcheck'
171  endif
172
173  call gridcheck
174
175  if (verbosity.gt.1) then   
176    CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
177    write(*,*) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
178  endif     
179
180  if (verbosity.gt.0) then
181    write(*,*) 'call gridcheck_nests'
182  endif 
183  call gridcheck_nests
184
185  ! Read the output grid specifications
186  !************************************
187
188  if (verbosity.gt.0) then
189    write(*,*) 'call readoutgrid'
190  endif
191
192  call readoutgrid
193
194  if (nested_output.eq.1) then
195    call readoutgrid_nest
196    if (verbosity.gt.0) then
197      write(*,*) '# readoutgrid_nest'
198    endif
199  endif
200
201  ! Read the receptor points for which extra concentrations are to be calculated
202  !*****************************************************************************
203
204  if (verbosity.eq.1) then
205     print*,'call readreceptors'
206  endif
207  call readreceptors
208
209  ! Read the physico-chemical species property table
210  !*************************************************
211  !SEC: now only needed SPECIES are read in readreleases.f
212  !call readspecies
213
214
215  ! Read the landuse inventory
216  !***************************
217
218  if (verbosity.gt.0) then
219    print*,'call readlanduse'
220  endif
221  call readlanduse
222
223  ! Assign fractional cover of landuse classes to each ECMWF grid point
224  !********************************************************************
225
226  if (verbosity.gt.0) then
227    print*,'call assignland'
228  endif
229  call assignland
230
231  ! Read the coordinates of the release locations
232  !**********************************************
233
234  if (verbosity.gt.0) then
235    print*,'call readreleases'
236  endif
237  call readreleases
238
239  ! Read and compute surface resistances to dry deposition of gases
240  !****************************************************************
241
242  if (verbosity.gt.0) then
243    print*,'call readdepo'
244  endif
245  call readdepo
246
247  ! Convert the release point coordinates from geografical to grid coordinates
248  !***************************************************************************
249
250  call coordtrafo 
251  if (verbosity.gt.0) then
252    print*,'call coordtrafo'
253  endif
254
255  ! Initialize all particles to non-existent
256  !*****************************************
257
258  if (verbosity.gt.0) then
259    print*,'Initialize all particles to non-existent'
260  endif
261  do j=1,maxpart
262    itra1(j)=-999999999
263  end do
264
265  ! For continuation of previous run, read in particle positions
266  !*************************************************************
267
268  if (ipin.eq.1) then
269    if (verbosity.gt.0) then
270      print*,'call readpartpositions'
271    endif
272    call readpartpositions
273  else
274    if (verbosity.gt.0) then
275      print*,'numpart=0, numparticlecount=0'
276    endif   
277    numpart=0
278    numparticlecount=0
279  endif
280
281  ! Calculate volume, surface area, etc., of all output grid cells
282  ! Allocate fluxes and OHfield if necessary
283  !***************************************************************
284
285  if (verbosity.gt.0) then
286    print*,'call outgrid_init'
287  endif
288  call outgrid_init
289  if (nested_output.eq.1) call outgrid_init_nest
290
291  ! Read the OH field
292  !******************
293
294  if (OHREA.eqv..TRUE.) then
295    if (verbosity.gt.0) then
296      print*,'call readOHfield'
297    endif
298    call readOHfield
299  endif
300
301  ! Write basic information on the simulation to a file "header"
302  ! and open files that are to be kept open throughout the simulation
303  !******************************************************************
304
305  if (verbosity.gt.0) then
306    print*,'call writeheader'
307  endif
308
309  call writeheader
310  ! FLEXPART 9.2 ticket ?? write header in ASCII format
311  call writeheader_txt
312  !if (nested_output.eq.1) call writeheader_nest
313  if (nested_output.eq.1.and.surf_only.ne.1) call writeheader_nest
314  if (nested_output.eq.1.and.surf_only.eq.1) call writeheader_nest_surf
315  if (nested_output.ne.1.and.surf_only.eq.1) call writeheader_surf
316
317  !open(unitdates,file=path(2)(1:length(2))//'dates')
318
319  if (verbosity.gt.0) then
320    print*,'call openreceptors'
321  endif
322  call openreceptors
323  if ((iout.eq.4).or.(iout.eq.5)) call openouttraj
324
325  ! Releases can only start and end at discrete times (multiples of lsynctime)
326  !***************************************************************************
327
328  if (verbosity.gt.0) then
329    print*,'discretize release times'
330  endif
331  do i=1,numpoint
332    ireleasestart(i)=nint(real(ireleasestart(i))/real(lsynctime))*lsynctime
333    ireleaseend(i)=nint(real(ireleaseend(i))/real(lsynctime))*lsynctime
334  end do
335
336  ! Initialize cloud-base mass fluxes for the convection scheme
337  !************************************************************
338
339  if (verbosity.gt.0) then
340    print*,'Initialize cloud-base mass fluxes for the convection scheme'
341  endif
342
343  do jy=0,nymin1
344    do ix=0,nxmin1
345      cbaseflux(ix,jy)=0.
346    end do
347  end do
348  do inest=1,numbnests
349    do jy=0,nyn(inest)-1
350      do ix=0,nxn(inest)-1
351        cbasefluxn(ix,jy,inest)=0.
352      end do
353    end do
354  end do
355
356  ! Calculate particle trajectories
357  !********************************
358
359  if (verbosity.gt.0) then
360     if (verbosity.gt.1) then   
361       CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
362       write(*,*) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
363     endif
364     if (info_flag.eq.1) then
365       print*, 'info only mode (stop)'   
366       stop
367     endif
368     print*,'call timemanager'
369  endif
370
371  call timemanager
372
373  write(*,*) 'CONGRATULATIONS: YOU HAVE SUCCESSFULLY COMPLETED A FLEXPART MODEL RUN!'
374
375end program flexpart
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG