Commit f13406cf authored by Ignacio Pisso's avatar Ignacio Pisso
Browse files

move version 9.1.8 form branches to trunk. Contributions from HSO, saeck,...

move version 9.1.8 form branches to trunk. Contributions from HSO, saeck, pesei, NIK, RT, XKF, IP and others

git-svn-id: http://flexpart.flexpart.eu:8088/svn/FlexPart90/trunk@20 ef8cc7e1-21b7-489e-abab-c1baa636049d
parent e200b7ad
...@@ -48,6 +48,8 @@ program flexpart ...@@ -48,6 +48,8 @@ program flexpart
integer :: i,j,ix,jy,inest integer :: i,j,ix,jy,inest
integer :: idummy = -320 integer :: idummy = -320
character(len=256) :: inline_options !pathfile, flexversion, arg2
! Generate a large number of random numbers ! Generate a large number of random numbers
!****************************************** !******************************************
...@@ -57,56 +59,164 @@ program flexpart ...@@ -57,56 +59,164 @@ program flexpart
end do end do
call gasdev1(idummy,rannumb(maxrand),rannumb(maxrand-1)) call gasdev1(idummy,rannumb(maxrand),rannumb(maxrand-1))
!
flexversion='Version 9.1.8 (2013-12-08)'
!verbosity=0
! Read the pathnames where input/output files are stored
!*******************************************************
inline_options='none'
select case (iargc())
case (2)
call getarg(1,arg1)
pathfile=arg1
call getarg(2,arg2)
inline_options=arg2
case (1)
call getarg(1,arg1)
pathfile=arg1
verbosity=0
if (arg1(1:1).eq.'-') then
write(pathfile,'(a11)') './pathnames'
inline_options=arg1
endif
case (0)
write(pathfile,'(a11)') './pathnames'
verbosity=0
end select
if (inline_options(1:1).eq.'-') then
print*, 'inline options=', inline_options
if (trim(inline_options).eq.'-v'.or.trim(inline_options).eq.'-v1') then
print*, 'verbose mode 1: additional information will be displayed'
verbosity=1
endif
if (trim(inline_options).eq.'-v2') then
print*, 'verbose mode 2: additional information will be displayed'
verbosity=2
endif
if (trim(inline_options).eq.'-i') then
print*, 'info mode: will provide run specific information and stop'
verbosity=1
info_flag=1
endif
if (trim(inline_options).eq.'-i2') then
print*, 'info mode: will provide run specific information and stop'
verbosity=2
info_flag=1
endif
endif
! Print the GPL License statement ! Print the GPL License statement
!******************************************************* !*******************************************************
print*,'Welcome to FLEXPART Version 9.0' print*,'Welcome to FLEXPART', trim(flexversion)
print*,'FLEXPART is free software released under the GNU Genera'// & print*,'FLEXPART is free software released under the GNU Genera'// &
'l Public License.' 'l Public License.'
if (verbosity.gt.0) then
WRITE(*,*) 'call readpaths'
endif
call readpaths(pathfile)
if (verbosity.gt.1) then !show clock info
!print*,'length(4)',length(4)
!count=0,count_rate=1000
CALL SYSTEM_CLOCK(count_clock0, count_rate, count_max)
!WRITE(*,*) 'SYSTEM_CLOCK',count, count_rate, count_max
!WRITE(*,*) 'SYSTEM_CLOCK, count_clock0', count_clock0
!WRITE(*,*) 'SYSTEM_CLOCK, count_rate', count_rate
!WRITE(*,*) 'SYSTEM_CLOCK, count_max', count_max
endif
! Read the pathnames where input/output files are stored
!*******************************************************
call readpaths
! Read the user specifications for the current model run ! Read the user specifications for the current model run
!******************************************************* !*******************************************************
if (verbosity.gt.0) then
WRITE(*,*) 'call readcommand'
endif
call readcommand call readcommand
if (verbosity.gt.0) then
WRITE(*,*) ' ldirect=', ldirect
WRITE(*,*) ' ibdate,ibtime=',ibdate,ibtime
WRITE(*,*) ' iedate,ietime=', iedate,ietime
if (verbosity.gt.1) then
CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
WRITE(*,*) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
endif
endif
! Read the age classes to be used ! Read the age classes to be used
!******************************** !********************************
if (verbosity.gt.0) then
WRITE(*,*) 'call readageclasses'
endif
call readageclasses call readageclasses
if (verbosity.gt.1) then
CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
WRITE(*,*) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
endif
! Read, which wind fields are available within the modelling period ! Read, which wind fields are available within the modelling period
!****************************************************************** !******************************************************************
if (verbosity.gt.0) then
WRITE(*,*) 'call readavailable'
endif
call readavailable call readavailable
! Read the model grid specifications, ! Read the model grid specifications,
! both for the mother domain and eventual nests ! both for the mother domain and eventual nests
!********************************************** !**********************************************
if (verbosity.gt.0) then
WRITE(*,*) 'call gridcheck'
endif
call gridcheck call gridcheck
if (verbosity.gt.1) then
CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
WRITE(*,*) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
endif
if (verbosity.gt.0) then
WRITE(*,*) 'call gridcheck_nests'
endif
call gridcheck_nests call gridcheck_nests
! Read the output grid specifications ! Read the output grid specifications
!************************************ !************************************
if (verbosity.gt.0) then
WRITE(*,*) 'call readoutgrid'
endif
call readoutgrid call readoutgrid
if (nested_output.eq.1) call readoutgrid_nest
if (nested_output.eq.1) then
call readoutgrid_nest
if (verbosity.gt.0) then
WRITE(*,*) '# readoutgrid_nest'
endif
endif
! Read the receptor points for which extra concentrations are to be calculated ! Read the receptor points for which extra concentrations are to be calculated
!***************************************************************************** !*****************************************************************************
if (verbosity.eq.1) then
print*,'call readreceptors'
endif
call readreceptors call readreceptors
! Read the physico-chemical species property table ! Read the physico-chemical species property table
!************************************************* !*************************************************
!SEC: now only needed SPECIES are read in readreleases.f !SEC: now only needed SPECIES are read in readreleases.f
...@@ -116,12 +226,18 @@ program flexpart ...@@ -116,12 +226,18 @@ program flexpart
! Read the landuse inventory ! Read the landuse inventory
!*************************** !***************************
if (verbosity.gt.0) then
print*,'call readlanduse'
endif
call readlanduse call readlanduse
! Assign fractional cover of landuse classes to each ECMWF grid point ! Assign fractional cover of landuse classes to each ECMWF grid point
!******************************************************************** !********************************************************************
if (verbosity.gt.0) then
print*,'call assignland'
endif
call assignland call assignland
...@@ -129,23 +245,35 @@ program flexpart ...@@ -129,23 +245,35 @@ program flexpart
! Read the coordinates of the release locations ! Read the coordinates of the release locations
!********************************************** !**********************************************
if (verbosity.gt.0) then
print*,'call readreleases'
endif
call readreleases call readreleases
! Read and compute surface resistances to dry deposition of gases ! Read and compute surface resistances to dry deposition of gases
!**************************************************************** !****************************************************************
if (verbosity.gt.0) then
print*,'call readdepo'
endif
call readdepo call readdepo
! Convert the release point coordinates from geografical to grid coordinates ! Convert the release point coordinates from geografical to grid coordinates
!*************************************************************************** !***************************************************************************
call coordtrafo call coordtrafo
if (verbosity.gt.0) then
print*,'call coordtrafo'
endif
! Initialize all particles to non-existent ! Initialize all particles to non-existent
!***************************************** !*****************************************
if (verbosity.gt.0) then
print*,'Initialize all particles to non-existent'
endif
do j=1,maxpart do j=1,maxpart
itra1(j)=-999999999 itra1(j)=-999999999
end do end do
...@@ -154,8 +282,14 @@ program flexpart ...@@ -154,8 +282,14 @@ program flexpart
!************************************************************* !*************************************************************
if (ipin.eq.1) then if (ipin.eq.1) then
if (verbosity.gt.0) then
print*,'call readpartpositions'
endif
call readpartpositions call readpartpositions
else else
if (verbosity.gt.0) then
print*,'numpart=0, numparticlecount=0'
endif
numpart=0 numpart=0
numparticlecount=0 numparticlecount=0
endif endif
...@@ -165,6 +299,10 @@ program flexpart ...@@ -165,6 +299,10 @@ program flexpart
! Allocate fluxes and OHfield if necessary ! Allocate fluxes and OHfield if necessary
!*************************************************************** !***************************************************************
if (verbosity.gt.0) then
print*,'call outgrid_init'
endif
call outgrid_init call outgrid_init
if (nested_output.eq.1) call outgrid_init_nest if (nested_output.eq.1) call outgrid_init_nest
...@@ -172,16 +310,38 @@ program flexpart ...@@ -172,16 +310,38 @@ program flexpart
! Read the OH field ! Read the OH field
!****************** !******************
if (OHREA.eqv..TRUE.) & if (OHREA.eqv..TRUE.) then
if (verbosity.gt.0) then
print*,'call readOHfield'
endif
call readOHfield call readOHfield
endif
! Write basic information on the simulation to a file "header" ! Write basic information on the simulation to a file "header"
! and open files that are to be kept open throughout the simulation ! and open files that are to be kept open throughout the simulation
!****************************************************************** !******************************************************************
if (verbosity.gt.0) then
print*,'call writeheader'
endif
call writeheader call writeheader
if (nested_output.eq.1) call writeheader_nest ! FLEXPART 9.2 ticket ?? write header in ASCII format
open(unitdates,file=path(2)(1:length(2))//'dates') call writeheader_txt
!if (nested_output.eq.1) call writeheader_nest
if (nested_output.eq.1.and.surf_only.ne.1) call writeheader_nest
if (nested_output.eq.1.and.surf_only.eq.1) call writeheader_nest_surf
if (nested_output.ne.1.and.surf_only.eq.1) call writeheader_surf
!open(unitdates,file=path(2)(1:length(2))//'dates')
if (verbosity.gt.0) then
print*,'call openreceptors'
endif
call openreceptors call openreceptors
if ((iout.eq.4).or.(iout.eq.5)) call openouttraj if ((iout.eq.4).or.(iout.eq.5)) call openouttraj
...@@ -189,6 +349,9 @@ program flexpart ...@@ -189,6 +349,9 @@ program flexpart
! Releases can only start and end at discrete times (multiples of lsynctime) ! Releases can only start and end at discrete times (multiples of lsynctime)
!*************************************************************************** !***************************************************************************
if (verbosity.gt.0) then
print*,'discretize release times'
endif
do i=1,numpoint do i=1,numpoint
ireleasestart(i)=nint(real(ireleasestart(i))/ & ireleasestart(i)=nint(real(ireleasestart(i))/ &
real(lsynctime))*lsynctime real(lsynctime))*lsynctime
...@@ -200,6 +363,10 @@ program flexpart ...@@ -200,6 +363,10 @@ program flexpart
! Initialize cloud-base mass fluxes for the convection scheme ! Initialize cloud-base mass fluxes for the convection scheme
!************************************************************ !************************************************************
if (verbosity.gt.0) then
print*,'Initialize cloud-base mass fluxes for the convection scheme'
endif
do jy=0,nymin1 do jy=0,nymin1
do ix=0,nxmin1 do ix=0,nxmin1
cbaseflux(ix,jy)=0. cbaseflux(ix,jy)=0.
...@@ -217,6 +384,18 @@ program flexpart ...@@ -217,6 +384,18 @@ program flexpart
! Calculate particle trajectories ! Calculate particle trajectories
!******************************** !********************************
if (verbosity.gt.0) then
if (verbosity.gt.1) then
CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
WRITE(*,*) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
endif
if (info_flag.eq.1) then
print*, 'info only mode (stop)'
stop
endif
print*,'call timemanager'
endif
call timemanager call timemanager
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
! * ! *
! June 1996 * ! June 1996 *
! * ! *
! Last update: 9 August 2000 * ! Last update:15 August 2013 IP *
! * ! *
!******************************************************************************* !*******************************************************************************
...@@ -24,10 +24,13 @@ module com_mod ...@@ -24,10 +24,13 @@ module com_mod
character :: path(numpath+2*maxnests)*120 character :: path(numpath+2*maxnests)*120
integer :: length(numpath+2*maxnests) integer :: length(numpath+2*maxnests)
character(len=256) :: pathfile, flexversion, arg1, arg2
! path path names needed for trajectory model ! path path names needed for trajectory model
! length length of path names needed for trajectory model ! length length of path names needed for trajectory model
! pathfile file where pathnames are stored
! flexversion version of flexpart
! arg input arguments from launch at command line
!******************************************************** !********************************************************
! Variables defining the general model run specifications ! Variables defining the general model run specifications
...@@ -64,7 +67,7 @@ module com_mod ...@@ -64,7 +67,7 @@ module com_mod
real :: ctl,fine real :: ctl,fine
integer :: ifine,iout,ipout,ipin,iflux,mdomainfill integer :: ifine,iout,ipout,ipin,iflux,mdomainfill
integer :: mquasilag,nested_output,ind_source,ind_receptor integer :: mquasilag,nested_output,ind_source,ind_receptor
integer :: ind_rel,ind_samp,ioutputforeachrelease,linit_cond integer :: ind_rel,ind_samp,ioutputforeachrelease,linit_cond,surf_only
logical :: turbswitch logical :: turbswitch
! ctl factor, by which time step must be smaller than Lagrangian time scale ! ctl factor, by which time step must be smaller than Lagrangian time scale
...@@ -90,6 +93,8 @@ module com_mod ...@@ -90,6 +93,8 @@ module com_mod
! 0=no, 1=mass unit, 2=mass mixing ratio unit ! 0=no, 1=mass unit, 2=mass mixing ratio unit
! mquasilag 0: normal run ! mquasilag 0: normal run
! 1: Particle position output is produced in a condensed format and particles are numbered ! 1: Particle position output is produced in a condensed format and particles are numbered
! surf_only switch output in grid_time files for surface only or full vertical resolution
! 0=no (full vertical resolution), 1=yes (surface only)
! nested_output: 0 no, 1 yes ! nested_output: 0 no, 1 yes
! turbswitch determines how the Markov chain is formulated ! turbswitch determines how the Markov chain is formulated
...@@ -138,6 +143,8 @@ module com_mod ...@@ -138,6 +143,8 @@ module com_mod
!real xmass(maxpoint,maxspec) !real xmass(maxpoint,maxspec)
real :: decay(maxspec) real :: decay(maxspec)
real :: weta(maxspec),wetb(maxspec) real :: weta(maxspec),wetb(maxspec)
! NIK: 31.01.2013- parameters for in-cloud scavening
real :: weta_in(maxspec), wetb_in(maxspec), wetc_in(maxspec), wetd_in(maxspec)
real :: reldiff(maxspec),henry(maxspec),f0(maxspec) real :: reldiff(maxspec),henry(maxspec),f0(maxspec)
real :: density(maxspec),dquer(maxspec),dsigma(maxspec) real :: density(maxspec),dquer(maxspec),dsigma(maxspec)
real :: vsetaver(maxspec),cunningham(maxspec),weightmolar(maxspec) real :: vsetaver(maxspec),cunningham(maxspec),weightmolar(maxspec)
...@@ -171,7 +178,9 @@ module com_mod ...@@ -171,7 +178,9 @@ module com_mod
! decay decay constant of radionuclide ! decay decay constant of radionuclide
! WET DEPOSITION ! WET DEPOSITION
! weta, wetb parameters for determining wet scavenging coefficients ! weta, wetb parameters for determining below-cloud wet scavenging coefficients
! weta_in, wetb_in parameters for determining in-cloud wet scavenging coefficients
! wetc_in, wetd_in parameters for determining in-cloud wet scavenging coefficients
! GAS DEPOSITION ! GAS DEPOSITION
! reldiff diffusivitiy of species relative to diff. of H2O ! reldiff diffusivitiy of species relative to diff. of H2O
...@@ -330,8 +339,12 @@ module com_mod ...@@ -330,8 +339,12 @@ module com_mod
real :: tth(0:nxmax-1,0:nymax-1,nuvzmax,2) real :: tth(0:nxmax-1,0:nymax-1,nuvzmax,2)
real :: qvh(0:nxmax-1,0:nymax-1,nuvzmax,2) real :: qvh(0:nxmax-1,0:nymax-1,nuvzmax,2)
real :: pplev(0:nxmax-1,0:nymax-1,nuvzmax,2) real :: pplev(0:nxmax-1,0:nymax-1,nuvzmax,2)
!scavenging NIK, PS
integer(kind=1) :: clouds(0:nxmax-1,0:nymax-1,nzmax,2) integer(kind=1) :: clouds(0:nxmax-1,0:nymax-1,nzmax,2)
integer :: cloudsh(0:nxmax-1,0:nymax-1,2) integer :: cloudsh(0:nxmax-1,0:nymax-1,2)
integer icloudbot(0:nxmax-1,0:nymax-1,2)
integer icloudthck(0:nxmax-1,0:nymax-1,2)
! uu,vv,ww [m/2] wind components in x,y and z direction ! uu,vv,ww [m/2] wind components in x,y and z direction
! uupol,vvpol [m/s] wind components in polar stereographic projection ! uupol,vvpol [m/s] wind components in polar stereographic projection
...@@ -345,6 +358,10 @@ module com_mod ...@@ -345,6 +358,10 @@ module com_mod
! cloud, no precipitation 1 ! cloud, no precipitation 1
! rainout conv/lsp dominated 2/3 ! rainout conv/lsp dominated 2/3
! washout conv/lsp dominated 4/5 ! washout conv/lsp dominated 4/5
! PS 2013
!c icloudbot (m) cloud bottom height
!c icloudthck (m) cloud thickness
! pplev for the GFS version ! pplev for the GFS version
! 2d fields ! 2d fields
...@@ -661,7 +678,6 @@ module com_mod ...@@ -661,7 +678,6 @@ module com_mod
! ohreact OH reaction rate ! ohreact OH reaction rate
!******************** !********************
! Random number field ! Random number field
!******************** !********************
...@@ -670,5 +686,12 @@ module com_mod ...@@ -670,5 +686,12 @@ module com_mod
! rannumb field of normally distributed random numbers ! rannumb field of normally distributed random numbers
!********************
! Verbosity, testing flags
!********************
integer :: verbosity=0
integer :: info_flag=0
INTEGER :: count_clock, count_clock0, count_rate, count_max
end module com_mod end module com_mod
...@@ -107,8 +107,9 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & ...@@ -107,8 +107,9 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
call caldate(jul,jjjjmmdd,ihmmss) call caldate(jul,jjjjmmdd,ihmmss)
write(adate,'(i8.8)') jjjjmmdd write(adate,'(i8.8)') jjjjmmdd
write(atime,'(i6.6)') ihmmss write(atime,'(i6.6)') ihmmss
open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND')
write(unitdates,'(a)') adate//atime write(unitdates,'(a)') adate//atime
close(unitdates)
! For forward simulations, output fields have dimension MAXSPEC, ! For forward simulations, output fields have dimension MAXSPEC,
! for backward simulations, output fields have dimension MAXPOINT. ! for backward simulations, output fields have dimension MAXPOINT.
...@@ -157,7 +158,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & ...@@ -157,7 +158,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
xl=outlon0+real(ix)*dxout xl=outlon0+real(ix)*dxout
yl=outlat0+real(jy)*dyout yl=outlat0+real(jy)*dyout
xl=(xl-