source: branches/FP_AI/src/FLEXPART.f90 @ 23

Last change on this file since 23 was 23, checked in by igpis, 10 years ago

start tracking test environment directory FP_AI

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.1.9  (2014-05-21)'
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