Skip to content

GitLab

Commit 748a49b1 authored by Ignacio Pisso's avatar Ignacio Pisso
Browse files

remove version 9 code from src

parent e200b7ad
Expand all Hide whitespace changes
Inline Side-by-side
src/FLEXPART.f90 deleted 100644 → 0
View file @ e200b7ad
!**********************************************************************
! 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
src/advance.f90 deleted 100644 → 0
View file @ e200b7ad
This diff is collapsed.
src/assignland.f90 deleted 100644 → 0
View file @ e200b7ad
!**********************************************************************
! 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/>. *
!**********************************************************************
subroutine assignland
!*****************************************************************************
! *
! This routine assigns fractions of the 13 landuse classes to each ECMWF *
! grid point. *
! The landuse inventory of *
! *
! Belward, A.S., Estes, J.E., and Kline, K.D., 1999, *
! The IGBP-DIS 1-Km Land-Cover Data Set DISCover: *
! A Project Overview: Photogrammetric Engineering and Remote Sensing , *
! v. 65, no. 9, p. 1013-1020 *
! *
! if there are no data in the inventory *
! the ECMWF land/sea mask is used to distinguish *
! between sea (-> ocean) and land (-> grasslands). *
! *
! Author: A. Stohl *
! *
! 5 December 1996 *
! 8 February 1999 Additional use of nests, A. Stohl *
! 29 December 2006 new landuse inventory, S. Eckhardt *
!*****************************************************************************
! *
! Variables: *
! xlanduse fractions of numclass landuses for each model grid point *
! landinvent landuse inventory (0.3 deg resolution) *
! *
!*****************************************************************************
use par_mod
use com_mod
implicit none
integer :: ix,jy,k,l,li,nrefine,iix,jjy
integer,parameter :: lumaxx=1200,lumaxy=600
integer,parameter :: xlon0lu=-180,ylat0lu=-90
real,parameter :: dxlu=0.3
real :: xlon,ylat,sumperc,p,xi,yj
real :: xlandusep(lumaxx,lumaxy,numclass)
! character*2 ck
do ix=1,lumaxx
do jy=1,lumaxy
do k=1,numclass
xlandusep(ix,jy,k)=0.
end do
sumperc=0.
do li=1,3
sumperc=sumperc+landinvent(ix,jy,li+3)
end do
do li=1,3
k=landinvent(ix,jy,li)
if (sumperc.gt.0) then
p=landinvent(ix,jy,li+3)/sumperc
else
p=0
endif
! p has values between 0 and 1
xlandusep(ix,jy,k)=p
end do
end do
end do
! do 13 k=1,11
! write (ck,'(i2.2)') k
! open(4,file='xlandusetest'//ck,form='formatted')
! do 11 ix=1,lumaxx
!11 write (4,*) (xlandusep(ix,jy,k),jy=1,lumaxy)
!11 write (4,*) (landinvent(ix,jy,k),jy=1,lumaxy)
!13 close(4)
! write (*,*) xlon0,ylat0,xlon0n(1),ylat0n(1),nxmin1,nymin1
! write (*,*) dx, dy, dxout, dyout, ylat0, xlon0
nrefine=10
do ix=0,nxmin1
do jy=0,nymin1
do k=1,numclass
sumperc=0.
xlanduse(ix,jy,k)=0.
end do
do iix=1, nrefine
xlon=(ix+(iix-1)/real(nrefine))*dx+xlon0 ! longitude, should be between -180 and 179
if (xlon.ge.(xlon0lu+lumaxx*dxlu)) then
xlon=xlon-lumaxx*dxlu
endif
do jjy=1, nrefine
ylat=(jy+(jjy-1)/real(nrefine))*dy+ylat0 ! and lat. of each gridpoint
xi=int((xlon-xlon0lu)/dxlu)+1
yj=int((ylat-ylat0lu)/dxlu)+1
if (xi.gt.lumaxx) xi=xi-lumaxx
if (yj.gt.lumaxy) yj=yj-lumaxy
if (xi.lt.0) then
write (*,*) 'problem with landuseinv sampling: ', &
xlon,xlon0lu,ix,iix,xlon0,dx,nxmax
stop
endif
do k=1,numclass
xlanduse(ix,jy,k)= &
xlanduse(ix,jy,k)+xlandusep(int(xi),int(yj),k)
sumperc=sumperc+xlanduse(ix,jy,k) ! just for the check if landuseinv. is available
end do
end do
end do
if (sumperc.gt.0) then ! detailed landuse available
sumperc=0.
do k=1,numclass
xlanduse(ix,jy,k)= &
xlanduse(ix,jy,k)/real(nrefine*nrefine)
sumperc=sumperc+xlanduse(ix,jy,k)
end do
!cc the sum of all categories should be 1 ... 100 percent ... in order to get vdep right!
if (sumperc.lt.1-1E-5) then
do k=1,numclass
xlanduse(ix,jy,k)= &
xlanduse(ix,jy,k)/sumperc
end do
endif
else
if (lsm(ix,jy).lt.0.1) then ! over sea -> ocean
xlanduse(ix,jy,3)=1.
else ! over land -> rangeland
xlanduse(ix,jy,7)=1.
endif
endif
end do
end do
!***********************************
! for test: write out xlanduse
! open(4,file='landusetest',form='formatted')
! do 56 k=1,13
! do 55 ix=0,nxmin1
!55 write (4,*) (xlanduse(ix,jy,k),jy=0,nymin1)
!56 continue
! close(4)
! write (*,*) 'landuse written'
!stop
! open(4,file='landseatest'//ck,form='formatted')
! do 57 ix=0,nxmin1
!57 write (4,*) (lsm(ix,jy),jy=0,nymin1)
! write (*,*) 'landseamask written'
!****************************************
! Same as above, but for the nested grids
!****************************************
!************** TEST ********************
! dyn(1)=dyn(1)/40
! dxn(1)=dxn(1)/40
! xlon0n(1)=1
! ylat0n(1)=50
!************** TEST ********************
do l=1,numbnests
do ix=0,nxn(l)-1
do jy=0,nyn(l)-1
do k=1,numclass
sumperc=0.
xlandusen(ix,jy,k,l)=0.
end do
do iix=1, nrefine
xlon=(ix+(iix-1)/real(nrefine))*dxn(l)+xlon0n(l)
do jjy=1, nrefine
ylat=(jy+(jjy-1)/real(nrefine))*dyn(l)+ylat0n(l)
xi=int((xlon-xlon0lu)/dxlu)+1
yj=int((ylat-ylat0lu)/dxlu)+1
if (xi.gt.lumaxx) xi=xi-lumaxx
if (yj.gt.lumaxy) yj=yj-lumaxy
do k=1,numclass
xlandusen(ix,jy,k,l)=xlandusen(ix,jy,k,l)+ &
xlandusep(int(xi),int(yj),k)
sumperc=sumperc+xlandusen(ix,jy,k,l)
end do
end do
end do
if (sumperc.gt.0) then ! detailed landuse available
sumperc=0.
do k=1,numclass
xlandusen(ix,jy,k,l)= &
xlandusen(ix,jy,k,l)/real(nrefine*nrefine)
sumperc=sumperc+xlandusen(ix,jy,k,l)
end do
!cc the sum of all categories should be 1 ... 100 percent ... in order to get vdep right!
if (sumperc.lt.1-1E-5) then
do k=1,numclass
xlandusen(ix,jy,k,l)=xlandusen(ix,jy,k,l)/sumperc
end do
endif
else ! check land/sea mask
if (lsmn(ix,jy,l).lt.0.1) then ! over sea -> ocean
xlandusen(ix,jy,3,l)=1.
else ! over land -> grasslands
xlandusen(ix,jy,7,l)=1.
endif
endif
end do
end do
end do
!***********************************
! for test: write out xlanduse
! do 66 k=1,11
! write (ck,'(i2.2)') k
! open(4,file='nlandusetest'//ck,form='formatted')
! do 65 ix=0,nxn(1)-1
!65 write (4,*) (xlandusen(ix,jy,k,1),jy=0,nyn(1)-1)
!66 close(4)
! write (*,*) 'landuse nested written'
end subroutine assignland
src/boundcond_domainfill.f90 deleted 100644 → 0
View file @ e200b7ad
This diff is collapsed.
src/calcfluxes.f90 deleted 100644 → 0
View file @ e200b7ad
!**********************************************************************
! 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/>. *
!**********************************************************************
subroutine calcfluxes(nage,jpart,xold,yold,zold)
! i i i i i
!*****************************************************************************
! *
! Calculation of the gross fluxes across horizontal, eastward and *
! northward facing surfaces. The routine calculates the mass flux *
! due to the motion of only one particle. The fluxes of subsequent calls *
! to this subroutine are accumulated until the next output is due. *
! Upon output, flux fields are re-set to zero in subroutine fluxoutput.f.*
! *
! Author: A. Stohl *
! *
! 04 April 2000 *
! *
!*****************************************************************************
! *
! Variables: *
! *
! nage Age class of the particle considered *
! jpart Index of the particle considered *
! xold,yold,zold "Memorized" old positions of the particle *
! *
!*****************************************************************************
use flux_mod
use outg_mod
use par_mod
use com_mod
implicit none
integer :: jpart,nage,ixave,jyave,kz,kzave,kp
integer :: k,k1,k2,ix,ix1,ix2,ixs,jy,jy1,jy2
real :: xold,yold,zold,xmean,ymean
! Determine average positions
!****************************
if ((ioutputforeachrelease.eq.1).and.(mdomainfill.eq.0)) then
kp=npoint(jpart)
else
kp=1
endif
xmean=(xold+xtra1(jpart))/2.
ymean=(yold+ytra1(jpart))/2.
ixave=int((xmean*dx+xoutshift)/dxout)
jyave=int((ymean*dy+youtshift)/dyout)
do kz=1,numzgrid ! determine height of cell
if (outheight(kz).gt.ztra1(jpart)) goto 16
end do
16 kzave=kz
! Determine vertical fluxes
!**************************
if ((ixave.ge.0).and.(jyave.ge.0).and.(ixave.le.numxgrid-1).and. &
(jyave.le.numygrid-1)) then
do kz=1,numzgrid ! determine height of cell
if (outheighthalf(kz).gt.zold) goto 11
end do
11 k1=min(numzgrid,kz)
do kz=1,numzgrid ! determine height of cell
if (outheighthalf(kz).gt.ztra1(jpart)) goto 21
end do
21 k2=min(numzgrid,kz)
do k=1,nspec
do kz=k1,k2-1
flux(5,ixave,jyave,kz,k,kp,nage)= &
flux(5,ixave,jyave,kz,k,kp,nage)+ &
xmass1(jpart,k)
end do
do kz=k2,k1-1
flux(6,ixave,jyave,kz,k,kp,nage)= &
flux(6,ixave,jyave,kz,k,kp,nage)+ &
xmass1(jpart,k)
end do
end do
endif
! Determine west-east fluxes (fluxw) and east-west fluxes (fluxe)
!****************************************************************
if ((kzave.le.numzgrid).and.(jyave.ge.0).and. &
(jyave.le.numygrid-1)) then
! 1) Particle does not cross domain boundary
if (abs(xold-xtra1(jpart)).lt.real(nx)/2.) then
ix1=int((xold*dx+xoutshift)/dxout+0.5)
ix2=int((xtra1(jpart)*dx+xoutshift)/dxout+0.5)
do k=1,nspec
do ix=ix1,ix2-1
if ((ix.ge.0).and.(ix.le.numxgrid-1)) then
flux(1,ix,jyave,kzave,k,kp,nage)= &
flux(1,ix,jyave,kzave,k,kp,nage) &
+xmass1(jpart,k)
endif
end do
do ix=ix2,ix1-1
if ((ix.ge.0).and.(ix.le.numxgrid-1)) then
flux(2,ix,jyave,kzave,k,kp,nage)= &
flux(2,ix,jyave,kzave,k,kp,nage) &
+xmass1(jpart,k)
endif
end do
end do
! 2) Particle crosses domain boundary: use cyclic boundary condition
! and attribute flux to easternmost grid row only (approximation valid
! for relatively slow motions compared to output grid cell size)
else
ixs=int(((real(nxmin1)-1.e5)*dx+xoutshift)/dxout)
if ((ixs.ge.0).and.(ixs.le.numxgrid-1)) then
if