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
integer :: i,j,ix,jy,inest
integer :: idummy = -320
character(len=256) :: inline_options !pathfile, flexversion, arg2
! Generate a large number of random numbers
!******************************************
......@@ -57,56 +59,164 @@ program flexpart
end do
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*,'Welcome to FLEXPART Version 9.0'
print*,'Welcome to FLEXPART', trim(flexversion)
print*,'FLEXPART is free software released under the GNU Genera'// &
'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
!*******************************************************
if (verbosity.gt.0) then
WRITE(*,*) 'call readcommand'
endif
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
!********************************
if (verbosity.gt.0) then
WRITE(*,*) 'call readageclasses'
endif
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
!******************************************************************
if (verbosity.gt.0) then
WRITE(*,*) 'call readavailable'
endif
call readavailable
! Read the model grid specifications,
! both for the mother domain and eventual nests
!**********************************************
if (verbosity.gt.0) then
WRITE(*,*) 'call gridcheck'
endif
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
! Read the output grid specifications
!************************************
if (verbosity.gt.0) then
WRITE(*,*) 'call readoutgrid'
endif
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
!*****************************************************************************
if (verbosity.eq.1) then
print*,'call readreceptors'
endif
call readreceptors
! Read the physico-chemical species property table
!*************************************************
!SEC: now only needed SPECIES are read in readreleases.f
......@@ -116,12 +226,18 @@ program flexpart
! Read the landuse inventory
!***************************
if (verbosity.gt.0) then
print*,'call readlanduse'
endif
call readlanduse
! Assign fractional cover of landuse classes to each ECMWF grid point
!********************************************************************
if (verbosity.gt.0) then
print*,'call assignland'
endif
call assignland
......@@ -129,23 +245,35 @@ program flexpart
! Read the coordinates of the release locations
!**********************************************
if (verbosity.gt.0) then
print*,'call readreleases'
endif
call readreleases
! Read and compute surface resistances to dry deposition of gases
!****************************************************************
if (verbosity.gt.0) then
print*,'call readdepo'
endif
call readdepo
! 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
!*****************************************
if (verbosity.gt.0) then
print*,'Initialize all particles to non-existent'
endif
do j=1,maxpart
itra1(j)=-999999999
end do
......@@ -154,8 +282,14 @@ program flexpart
!*************************************************************
if (ipin.eq.1) then
if (verbosity.gt.0) then
print*,'call readpartpositions'
endif
call readpartpositions
else
if (verbosity.gt.0) then
print*,'numpart=0, numparticlecount=0'
endif
numpart=0
numparticlecount=0
endif
......@@ -165,6 +299,10 @@ program flexpart
! Allocate fluxes and OHfield if necessary
!***************************************************************
if (verbosity.gt.0) then
print*,'call outgrid_init'
endif
call outgrid_init
if (nested_output.eq.1) call outgrid_init_nest
......@@ -172,16 +310,38 @@ program flexpart
! Read the OH field
!******************
if (OHREA.eqv..TRUE.) &
if (OHREA.eqv..TRUE.) then
if (verbosity.gt.0) then
print*,'call readOHfield'
endif
call readOHfield
endif
! Write basic information on the simulation to a file "header"
! and open files that are to be kept open throughout the simulation
!******************************************************************
if (verbosity.gt.0) then
print*,'call writeheader'
endif
call writeheader
if (nested_output.eq.1) call writeheader_nest
open(unitdates,file=path(2)(1:length(2))//'dates')
! FLEXPART 9.2 ticket ?? write header in ASCII format
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
if ((iout.eq.4).or.(iout.eq.5)) call openouttraj
......@@ -189,6 +349,9 @@ program flexpart
! 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
ireleasestart(i)=nint(real(ireleasestart(i))/ &
real(lsynctime))*lsynctime
......@@ -200,6 +363,10 @@ program flexpart
! 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 ix=0,nxmin1
cbaseflux(ix,jy)=0.
......@@ -217,6 +384,18 @@ program flexpart
! 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
......
......@@ -6,7 +6,7 @@
! *
! June 1996 *
! *
! Last update: 9 August 2000 *
! Last update:15 August 2013 IP *
! *
!*******************************************************************************
......@@ -24,10 +24,13 @@ module com_mod
character :: path(numpath+2*maxnests)*120
integer :: length(numpath+2*maxnests)
character(len=256) :: pathfile, flexversion, arg1, arg2
! path 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
......@@ -64,7 +67,7 @@ module com_mod
real :: ctl,fine
integer :: ifine,iout,ipout,ipin,iflux,mdomainfill
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
! ctl factor, by which time step must be smaller than Lagrangian time scale
......@@ -90,6 +93,8 @@ module com_mod
! 0=no, 1=mass unit, 2=mass mixing ratio unit
! mquasilag 0: normal run
! 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
! turbswitch determines how the Markov chain is formulated
......@@ -138,6 +143,8 @@ module com_mod
!real xmass(maxpoint,maxspec)
real :: decay(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 :: density(maxspec),dquer(maxspec),dsigma(maxspec)
real :: vsetaver(maxspec),cunningham(maxspec),weightmolar(maxspec)
......@@ -171,7 +178,9 @@ module com_mod
! decay decay constant of radionuclide
! 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
! reldiff diffusivitiy of species relative to diff. of H2O
......@@ -330,8 +339,12 @@ module com_mod
real :: tth(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)
!scavenging NIK, PS
integer(kind=1) :: clouds(0:nxmax-1,0:nymax-1,nzmax,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
! uupol,vvpol [m/s] wind components in polar stereographic projection
......@@ -345,6 +358,10 @@ module com_mod
! cloud, no precipitation 1
! rainout conv/lsp dominated 2/3
! washout conv/lsp dominated 4/5
! PS 2013
!c icloudbot (m) cloud bottom height
!c icloudthck (m) cloud thickness
! pplev for the GFS version
! 2d fields
......@@ -661,7 +678,6 @@ module com_mod
! ohreact OH reaction rate
!********************
! Random number field
!********************
......@@ -670,5 +686,12 @@ module com_mod
! 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
......@@ -107,8 +107,9 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
call caldate(jul,jjjjmmdd,ihmmss)
write(adate,'(i8.8)') jjjjmmdd
write(atime,'(i6.6)') ihmmss
open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND')
write(unitdates,'(a)') adate//atime
close(unitdates)
! For forward simulations, output fields have dimension MAXSPEC,
! for backward simulations, output fields have dimension MAXPOINT.
......@@ -157,7 +158,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
xl=outlon0+real(ix)*dxout
yl=outlat0+real(jy)*dyout
xl=(xl-xlon0)/dx
yl=(yl-ylat0)/dx
yl=(yl-ylat0)/dy !v9.1.1
iix=max(min(nint(xl),nxmin1),0)
jjy=max(min(nint(yl),nymin1),0)
densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
......
This diff is collapsed.
This diff is collapsed.
......@@ -97,7 +97,8 @@ subroutine gridcheck
! coordinate parameters
integer :: isec1(56),isec2(22+nxmax+nymax)
real(kind=4) :: zsec2(60+2*nuvzmax),zsec4(jpunp)
!real(kind=4) :: zsec2(60+2*nuvzmax),zsec4(jpunp)
real(kind=4) :: zsec2(184),zsec4(jpunp)
character(len=1) :: opt
!HSO grib api error messages
......@@ -465,7 +466,6 @@ subroutine gridcheck
j=numskip+i
k=nlev_ec+1+numskip+i
akm(nwz-i+1)=zsec2(j)
! write (*,*) 'ifield:',ifield,k,j,zsec2(10+j)
bkm(nwz-i+1)=zsec2(k)
end do
......
!**********************************************************************
! 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 gridcheck
!**********************************************************************
! *
! FLEXPART MODEL SUBROUTINE GRIDCHECK *
! *
!**********************************************************************
! *
! AUTHOR: G. WOTAWA *
! DATE: 1997-08-06 *
! LAST UPDATE: 1997-10-10 *
! *
! Update: 1999-02-08, global fields allowed, A. Stohl*
! CHANGE: 17/11/2005, Caroline Forster, GFS data *
! CHANGE: 11/01/2008, Harald Sodemann, GRIB1/2 input with *
! ECMWF grib_api *
! CHANGE: 03/12/2008, Harald Sodemann, update to f90 with *
! ECMWF grib_api *
! *
!**********************************************************************
! *
! DESCRIPTION: *
! *
! THIS SUBROUTINE DETERMINES THE GRID SPECIFICATIONS (LOWER LEFT *
! LONGITUDE, LOWER LEFT LATITUDE, NUMBER OF GRID POINTS, GRID DIST- *
! ANCE AND VERTICAL DISCRETIZATION OF THE ECMWF MODEL) FROM THE *
! GRIB HEADER OF THE FIRST INPUT FILE. THE CONSISTANCY (NO CHANGES *
! WITHIN ONE FLEXPART RUN) IS CHECKED IN THE ROUTINE "READWIND" AT *
! ANY CALL. *
! *
! XLON0 geographical longitude of lower left gridpoint *
! YLAT0 geographical latitude of lower left gridpoint *
! NX number of grid points x-direction *
! NY number of grid points y-direction *
! DX grid distance x-direction *
! DY grid distance y-direction *
! NUVZ number of grid points for horizontal wind *
! components in z direction *
! NWZ number of grid points for vertical wind *
! component in z direction *
! sizesouth, sizenorth give the map scale (i.e. number of virtual grid*
! points of the polar stereographic grid): *
! used to check the CFL criterion *
! VHEIGHT(1)- heights of gridpoints where u and v are *
! UVHEIGHT(NUVZ) given *
! WHEIGHT(1)- heights of gridpoints where w is given *
! WHEIGHT(NWZ) *
! *
!**********************************************************************
use grib_api
use par_mod
use com_mod
use conv_mod
use cmapf_mod, only: stlmbr,stcm2p
implicit none
!HSO parameters for grib_api
integer :: ifile
integer :: iret
integer :: igrib
real(kind=4) :: xaux1,xaux2,yaux1,yaux2
real(kind=8) :: xaux1in,xaux2in,yaux1in,yaux2in
integer :: gribVer,parCat,parNum,typSurf,valSurf,discipl
!HSO end
integer :: ix,jy,i,ifn,ifield,j,k,iumax,iwmax,numskip
real :: sizesouth,sizenorth,xauxa,pint
real :: akm_usort(nwzmax)
real,parameter :: eps=0.0001
! NCEP GFS
real :: pres(nwzmax), help
integer :: i179,i180,i181
! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
integer :: isec1(8),isec2(3)
real(kind=4) :: zsec4(jpunp)
character(len=1) :: opt
!HSO grib api error messages
character(len=24) :: gribErrorMsg = 'Error reading grib file'
character(len=20) :: gribFunction = 'gridcheckwind_gfs'
!
if (numbnests.ge.1) then
write(*,*) ' ###########################################'
write(*,*) ' FLEXPART ERROR SUBROUTINE GRIDCHECK:'
write(*,*) ' NO NESTED WINDFIELDAS ALLOWED FOR GFS! '
write(*,*) ' ###########################################'
stop
endif
iumax=0
iwmax=0
if(ideltas.gt.0) then
ifn=1
else
ifn=numbwf
endif
!
! OPENING OF DATA FILE (GRIB CODE)
!
5 call grib_open_file(ifile,path(3)(1:length(3)) &
//trim(wfname(ifn)),'r',iret)
if (iret.ne.GRIB_SUCCESS) then
goto 999 ! ERROR DETECTED
endif