source: branches/flexpart91_hasod/src/FLEXPART.f90 @ 7

Last change on this file since 7 was 7, checked in by hasod, 11 years ago

Initial import

  • namelist input for COMMAND
  • pathnames optionally as command line argument
  • conversion utility from COMMAND to COMMAND namelist
File size: 7.5 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(256) :: pathfile
52
53  ! Generate a large number of random numbers
54  !******************************************
55
56  do i=1,maxrand-1,2
57    call gasdev1(idummy,rannumb(i),rannumb(i+1))
58  end do
59  call gasdev1(idummy,rannumb(maxrand),rannumb(maxrand-1))
60
61  ! Print the GPL License statement
62  !*******************************************************
63  print*,'Welcome to FLEXPART Version 9.1 (Build 20121029)'
64  print*,'FLEXPART is free software released under the GNU Genera'// &
65       'l Public License.'
66
67  ! Read the pathnames where input/output files are stored
68  !*******************************************************
69
70  select case (iargc())
71  case (1)
72    call getarg(1,pathfile)
73  case (0)
74    write(pathfile,'(a11)') './pathnames'
75  end select
76
77  call readpaths(pathfile)
78  print*,length(4)
79
80  ! Read the user specifications for the current model run
81  !*******************************************************
82
83  call readcommand
84
85
86  ! Read the age classes to be used
87  !********************************
88
89  call readageclasses
90
91
92  ! Read, which wind fields are available within the modelling period
93  !******************************************************************
94
95  call readavailable
96
97
98  ! Read the model grid specifications,
99  ! both for the mother domain and eventual nests
100  !**********************************************
101
102  call gridcheck
103  call gridcheck_nests
104
105
106  ! Read the output grid specifications
107  !************************************
108
109  call readoutgrid
110  if (nested_output.eq.1) call readoutgrid_nest
111
112
113  ! Read the receptor points for which extra concentrations are to be calculated
114  !*****************************************************************************
115
116  call readreceptors
117
118
119  ! Read the physico-chemical species property table
120  !*************************************************
121  !SEC: now only needed SPECIES are read in readreleases.f
122  !call readspecies
123
124
125  ! Read the landuse inventory
126  !***************************
127
128  call readlanduse
129
130
131  ! Assign fractional cover of landuse classes to each ECMWF grid point
132  !********************************************************************
133
134  call assignland
135
136
137
138  ! Read the coordinates of the release locations
139  !**********************************************
140
141  call readreleases
142
143  ! Read and compute surface resistances to dry deposition of gases
144  !****************************************************************
145
146  call readdepo
147
148
149  ! Convert the release point coordinates from geografical to grid coordinates
150  !***************************************************************************
151
152  call coordtrafo
153
154
155  ! Initialize all particles to non-existent
156  !*****************************************
157
158  do j=1,maxpart
159    itra1(j)=-999999999
160  end do
161
162  ! For continuation of previous run, read in particle positions
163  !*************************************************************
164
165  if (ipin.eq.1) then
166    call readpartpositions
167  else
168    numpart=0
169    numparticlecount=0
170  endif
171
172
173  ! Calculate volume, surface area, etc., of all output grid cells
174  ! Allocate fluxes and OHfield if necessary
175  !***************************************************************
176
177  call outgrid_init
178  if (nested_output.eq.1) call outgrid_init_nest
179
180
181  ! Read the OH field
182  !******************
183
184  if (OHREA.eqv..TRUE.) &
185       call readOHfield
186
187  ! Write basic information on the simulation to a file "header"
188  ! and open files that are to be kept open throughout the simulation
189  !******************************************************************
190
191  call writeheader
192  if (nested_output.eq.1) call writeheader_nest
193  open(unitdates,file=path(2)(1:length(2))//'dates')
194  call openreceptors
195  if ((iout.eq.4).or.(iout.eq.5)) call openouttraj
196
197
198  ! Releases can only start and end at discrete times (multiples of lsynctime)
199  !***************************************************************************
200
201  do i=1,numpoint
202    ireleasestart(i)=nint(real(ireleasestart(i))/ &
203         real(lsynctime))*lsynctime
204    ireleaseend(i)=nint(real(ireleaseend(i))/ &
205         real(lsynctime))*lsynctime
206  end do
207
208
209  ! Initialize cloud-base mass fluxes for the convection scheme
210  !************************************************************
211
212  do jy=0,nymin1
213    do ix=0,nxmin1
214      cbaseflux(ix,jy)=0.
215    end do
216  end do
217  do inest=1,numbnests
218    do jy=0,nyn(inest)-1
219      do ix=0,nxn(inest)-1
220        cbasefluxn(ix,jy,inest)=0.
221      end do
222    end do
223  end do
224
225
226  ! Calculate particle trajectories
227  !********************************
228
229  call timemanager
230
231
232  write(*,*) 'CONGRATULATIONS: YOU HAVE SUCCESSFULLY COMPLETED A FLE&
233       &XPART MODEL RUN!'
234
235end program flexpart
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG