File: FLEXPART.f90

package info (click to toggle)
flexpart 9.02-21
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 4,896 kB
  • sloc: f90: 14,310; makefile: 28; sh: 18
file content (226 lines) | stat: -rw-r--r-- 7,441 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
!**********************************************************************
! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
!                                                                     *
! This file is part of FLEXPART.                                      *
!                                                                     *
! FLEXPART is free software: you can redistribute it and/or modify    *
! it under the terms of the GNU General Public License as published by*
! the Free Software Foundation, either version 3 of the License, or   *
! (at your option) any later version.                                 *
!                                                                     *
! FLEXPART is distributed in the hope that it will be useful,         *
! but WITHOUT ANY WARRANTY; without even the implied warranty of      *
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *
! GNU General Public License for more details.                        *
!                                                                     *
! You should have received a copy of the GNU General Public License   *
! along with FLEXPART.  If not, see <http://www.gnu.org/licenses/>.   *
!**********************************************************************

program flexpart

  !*****************************************************************************
  !                                                                            *
  !     This is the Lagrangian Particle Dispersion Model FLEXPART.             *
  !     The main program manages the reading of model run specifications, etc. *
  !     All actual computing is done within subroutine timemanager.            *
  !                                                                            *
  !     Author: A. Stohl                                                       *
  !                                                                            *
  !     18 May 1996                                                            *
  !                                                                            *
  !*****************************************************************************
  !                                                                            *
  ! Variables:                                                                 *
  !                                                                            *
  ! Constants:                                                                 *
  !                                                                            *
  !*****************************************************************************

  use point_mod
  use par_mod
  use com_mod
  use conv_mod

  implicit none

  integer :: i,j,ix,jy,inest
  integer :: idummy = -320

  ! Generate a large number of random numbers
  !******************************************

  do i=1,maxrand-1,2
    call gasdev1(idummy,rannumb(i),rannumb(i+1))
  end do
  call gasdev1(idummy,rannumb(maxrand),rannumb(maxrand-1))

  ! Print the GPL License statement
  !*******************************************************
  print*,'Welcome to FLEXPART Version 9.0'
  print*,'FLEXPART is free software released under the GNU Genera'// &
       'l Public License.'

  ! Read the pathnames where input/output files are stored
  !*******************************************************

  call readpaths

  ! Read the user specifications for the current model run
  !*******************************************************

  call readcommand


  ! Read the age classes to be used
  !********************************

  call readageclasses


  ! Read, which wind fields are available within the modelling period
  !******************************************************************

  call readavailable


  ! Read the model grid specifications,
  ! both for the mother domain and eventual nests
  !**********************************************

  call gridcheck
  call gridcheck_nests


  ! Read the output grid specifications
  !************************************

  call readoutgrid
  if (nested_output.eq.1) call readoutgrid_nest


  ! Read the receptor points for which extra concentrations are to be calculated
  !*****************************************************************************

  call readreceptors


  ! Read the physico-chemical species property table
  !*************************************************
  !SEC: now only needed SPECIES are read in readreleases.f
  !call readspecies


  ! Read the landuse inventory
  !***************************

  call readlanduse


  ! Assign fractional cover of landuse classes to each ECMWF grid point
  !********************************************************************

  call assignland



  ! Read the coordinates of the release locations
  !**********************************************

  call readreleases

  ! Read and compute surface resistances to dry deposition of gases
  !****************************************************************

  call readdepo


  ! Convert the release point coordinates from geografical to grid coordinates
  !***************************************************************************

  call coordtrafo


  ! Initialize all particles to non-existent
  !*****************************************

  do j=1,maxpart
    itra1(j)=-999999999
  end do

  ! For continuation of previous run, read in particle positions
  !*************************************************************

  if (ipin.eq.1) then
    call readpartpositions
  else
    numpart=0
    numparticlecount=0
  endif


  ! Calculate volume, surface area, etc., of all output grid cells
  ! Allocate fluxes and OHfield if necessary
  !***************************************************************

  call outgrid_init
  if (nested_output.eq.1) call outgrid_init_nest


  ! Read the OH field
  !******************

  if (OHREA.eqv..TRUE.) &
       call readOHfield

  ! Write basic information on the simulation to a file "header"
  ! and open files that are to be kept open throughout the simulation
  !******************************************************************

  call writeheader
  if (nested_output.eq.1) call writeheader_nest
  open(unitdates,file=path(2)(1:length(2))//'dates')
  call openreceptors
  if ((iout.eq.4).or.(iout.eq.5)) call openouttraj


  ! Releases can only start and end at discrete times (multiples of lsynctime)
  !***************************************************************************

  do i=1,numpoint
    ireleasestart(i)=nint(real(ireleasestart(i))/ &
         real(lsynctime))*lsynctime
    ireleaseend(i)=nint(real(ireleaseend(i))/ &
         real(lsynctime))*lsynctime
  end do


  ! Initialize cloud-base mass fluxes for the convection scheme
  !************************************************************

  do jy=0,nymin1
    do ix=0,nxmin1
      cbaseflux(ix,jy)=0.
    end do
  end do
  do inest=1,numbnests
    do jy=0,nyn(inest)-1
      do ix=0,nxn(inest)-1
        cbasefluxn(ix,jy,inest)=0.
      end do
    end do
  end do


  ! Calculate particle trajectories
  !********************************

  call timemanager


  write(*,*) 'CONGRATULATIONS: YOU HAVE SUCCESSFULLY COMPLETED A FLE&
       &XPART MODEL RUN!'

end program flexpart