Commit b4d29ce9 authored by Harald Sodemann's avatar Harald Sodemann
Browse files

* Implemented optional namelist input for COMMAND, RELEASES, SPECIES,

  AGECLASSES,OUTGRID,OUTGRID_NEST,RECEPTORS
* Implemented com_mod switch nmlout to write input files as namelist to
  the output directory (.true. by default)
* Proposed updated startup and runtime output (may change back to previous
  info if desired)


git-svn-id: http://flexpart.flexpart.eu:8088/svn/FlexPart90/trunk@27 ef8cc7e1-21b7-489e-abab-c1baa636049d
parent 87910afa
......@@ -59,9 +59,10 @@ program flexpart
end do
call gasdev1(idummy,rannumb(maxrand),rannumb(maxrand-1))
!
flexversion='Version 9.2 beta (2014-05-23)'
!verbosity=0
! FLEXPART version string
flexversion='Version 9.2 beta (2014-07-01)'
verbosity=0
! Read the pathnames where input/output files are stored
!*******************************************************
......@@ -75,51 +76,45 @@ program flexpart
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
! Print the GPL License statement
!*******************************************************
print*,'Welcome to FLEXPART ', trim(flexversion)
print*,'FLEXPART is free software released under the GNU General Public License.'
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'
print*, 'Verbose mode 1: display detailed information during run'
verbosity=1
endif
if (trim(inline_options).eq.'-v2') then
print*, 'verbose mode 2: additional information will be displayed'
print*, 'Verbose mode 2: display more detailed information during run'
verbosity=2
endif
if (trim(inline_options).eq.'-i') then
print*, 'info mode: will provide run specific information and stop'
print*, 'Info mode: provide detailed 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'
print*, 'Info mode: provide more detailed run specific information and stop'
verbosity=2
info_flag=1
endif
endif
! Print the GPL License statement
!*******************************************************
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'
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
......@@ -130,44 +125,40 @@ program flexpart
!WRITE(*,*) 'SYSTEM_CLOCK, count_max', count_max
endif
! Read the user specifications for the current model run
!*******************************************************
if (verbosity.gt.0) then
WRITE(*,*) 'call readcommand'
write(*,*) 'call readcommand'
endif
call readcommand
if (verbosity.gt.0) then
WRITE(*,*) ' ldirect=', ldirect
WRITE(*,*) ' ibdate,ibtime=',ibdate,ibtime
WRITE(*,*) ' iedate,ietime=', iedate,ietime
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
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'
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
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'
write(*,*) 'call readavailable'
endif
call readavailable
......@@ -176,28 +167,26 @@ program flexpart
!**********************************************
if (verbosity.gt.0) then
WRITE(*,*) 'call gridcheck'
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
write(*,*) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
endif
if (verbosity.gt.0) then
WRITE(*,*) 'call gridcheck_nests'
write(*,*) 'call gridcheck_nests'
endif
call gridcheck_nests
! Read the output grid specifications
!************************************
if (verbosity.gt.0) then
WRITE(*,*) 'call readoutgrid'
write(*,*) 'call readoutgrid'
endif
call readoutgrid
......@@ -205,7 +194,7 @@ program flexpart
if (nested_output.eq.1) then
call readoutgrid_nest
if (verbosity.gt.0) then
WRITE(*,*) '# readoutgrid_nest'
write(*,*) '# readoutgrid_nest'
endif
endif
......@@ -231,7 +220,6 @@ program flexpart
endif
call readlanduse
! Assign fractional cover of landuse classes to each ECMWF grid point
!********************************************************************
......@@ -240,8 +228,6 @@ program flexpart
endif
call assignland
! Read the coordinates of the release locations
!**********************************************
......@@ -250,7 +236,6 @@ program flexpart
endif
call readreleases
! Read and compute surface resistances to dry deposition of gases
!****************************************************************
......@@ -267,7 +252,6 @@ program flexpart
print*,'call coordtrafo'
endif
! Initialize all particles to non-existent
!*****************************************
......@@ -294,19 +278,16 @@ program flexpart
numparticlecount=0
endif
! Calculate volume, surface area, etc., of all output grid cells
! 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
! Read the OH field
!******************
......@@ -321,7 +302,6 @@ program flexpart
! and open files that are to be kept open throughout the simulation
!******************************************************************
if (verbosity.gt.0) then
print*,'call writeheader'
endif
......@@ -331,12 +311,9 @@ program flexpart
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
......@@ -345,7 +322,6 @@ program flexpart
call openreceptors
if ((iout.eq.4).or.(iout.eq.5)) call openouttraj
! Releases can only start and end at discrete times (multiples of lsynctime)
!***************************************************************************
......@@ -353,13 +329,10 @@ program flexpart
print*,'discretize release times'
endif
do i=1,numpoint
ireleasestart(i)=nint(real(ireleasestart(i))/ &
real(lsynctime))*lsynctime
ireleaseend(i)=nint(real(ireleaseend(i))/ &
real(lsynctime))*lsynctime
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
!************************************************************
......@@ -380,14 +353,13 @@ program flexpart
end do
end do
! 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
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)'
......@@ -398,8 +370,6 @@ program flexpart
call timemanager
write(*,*) 'CONGRATULATIONS: YOU HAVE SUCCESSFULLY COMPLETED A FLE&
&XPART MODEL RUN!'
write(*,*) 'CONGRATULATIONS: YOU HAVE SUCCESSFULLY COMPLETED A FLEXPART MODEL RUN!'
end program flexpart
......@@ -681,11 +681,12 @@ module com_mod
! rannumb field of normally distributed random numbers
!********************
! Verbosity, testing flags
! Verbosity, testing flags, namelist I/O
!********************
integer :: verbosity=0
integer :: info_flag=0
INTEGER :: count_clock, count_clock0, count_rate, count_max
integer :: count_clock, count_clock0, count_rate, count_max
logical :: nmlout=.true.
end module com_mod
......@@ -442,15 +442,13 @@ subroutine gridcheck
! Output of grid info
!********************
write(*,*)
write(*,*)
write(*,'(a,2i7)') '# of vertical levels in ECMWF data: ', &
write(*,'(a,2i7)') ' Vertical levels in ECMWF data: ', &
nuvz+1,nwz
write(*,*)
write(*,'(a)') 'Mother domain:'
write(*,'(a)') ' Mother domain:'
write(*,'(a,f10.5,a,f10.5,a,f10.5)') ' Longitude range: ', &
xlon0,' to ',xlon0+(nx-1)*dx,' Grid distance: ',dx
write(*,'(a,f10.5,a,f10.5,a,f10.5)') ' Latitude range: ', &
write(*,'(a,f10.5,a,f10.5,a,f10.5)') ' Latitude range : ', &
ylat0,' to ',ylat0+(ny-1)*dy,' Grid distance: ',dy
write(*,*)
......
......@@ -422,13 +422,13 @@ subroutine gridcheck
write(*,*)
write(*,*)
write(*,'(a,2i7)') '# of vertical levels in NCEP data: ', &
write(*,'(a,2i7)') 'Vertical levels in NCEP data: ', &
nuvz,nwz
write(*,*)
write(*,'(a)') 'Mother domain:'
write(*,'(a,f10.2,a1,f10.2,a,f10.2)') ' Longitude range: ', &
xlon0,' to ',xlon0+(nx-1)*dx,' Grid distance: ',dx
write(*,'(a,f10.2,a1,f10.2,a,f10.2)') ' Latitude range: ', &
write(*,'(a,f10.2,a1,f10.2,a,f10.2)') ' Latitude range : ', &
ylat0,' to ',ylat0+(ny-1)*dy,' Grid distance: ',dy
write(*,*)
......
......@@ -349,11 +349,11 @@ subroutine gridcheck_nests
! Output of grid info
!********************
write(*,'(a,i2)') 'Nested domain #: ',l
write(*,'(a,i2,a)') ' Nested domain ',l,':'
write(*,'(a,f10.5,a,f10.5,a,f10.5)') ' Longitude range: ', &
xlon0n(l),' to ',xlon0n(l)+(nxn(l)-1)*dxn(l), &
' Grid distance: ',dxn(l)
write(*,'(a,f10.5,a,f10.5,a,f10.5)') ' Latitude range: ', &
write(*,'(a,f10.5,a,f10.5,a,f10.5)') ' Latitude range : ', &
ylat0n(l),' to ',ylat0n(l)+(nyn(l)-1)*dyn(l), &
' Grid distance: ',dyn(l)
write(*,*)
......
......@@ -224,8 +224,8 @@ subroutine outgrid_init
!write (*,*) 'Dimensions for fields', numxgrid,numygrid, &
! maxspec,maxpointspec_act,nclassunc,maxageclass
write (*,*) ' Allocating fields for nested and global output (x,y): ', &
max(numxgrid,numxgridn),max(numygrid,numygridn)
write (*,*) 'Allocating fields for global output (x,y): ', numxgrid,numygrid
write (*,*) 'Allocating fields for nested output (x,y): ', numxgridn,numygridn
! allocate fields for concoutput with maximum dimension of outgrid
! and outgrid_nest
......
......@@ -121,8 +121,8 @@ module par_mod
!*********************************************
!integer,parameter :: nxmax=361,nymax=181,nuvzmax=92,nwzmax=92,nzmax=92 !FNL XF
integer,parameter :: nxmax=361,nymax=181,nuvzmax=152,nwzmax=152,nzmax=152 !ECMWF new
!integer,parameter :: nxmax=361,nymax=181,nuvzmax=92,nwzmax=92,nzmax=92 !ECMWF
!integer,parameter :: nxmax=361,nymax=181,nuvzmax=152,nwzmax=152,nzmax=152 !ECMWF new
integer,parameter :: nxmax=361,nymax=181,nuvzmax=92,nwzmax=92,nzmax=92 !ECMWF
!integer,parameter :: nxmax=361,nymax=181,nuvzmax=26,nwzmax=26,nzmax=26
!integer,parameter :: nxmax=721,nymax=361,nuvzmax=64,nwzmax=64,nzmax=64
!integer,parameter :: nxmax=1201,nymax=235,nuvzmax=58,nwzmax=58,nzmax=58
......@@ -197,7 +197,7 @@ module par_mod
! Maximum number of particles, species, and similar
!**************************************************
integer,parameter :: maxpart=15000000
integer,parameter :: maxpart=150000
integer,parameter :: maxspec=4
......
......@@ -27,8 +27,9 @@ subroutine readageclasses
! run. *
! *
! Author: A. Stohl *
! *
! 20 March 2000 *
! HSO, 1 July 2014 *
! Added optional namelist input *
! *
!*****************************************************************************
! *
......@@ -45,6 +46,15 @@ subroutine readageclasses
integer :: i
! namelist help variables
integer :: readerror
! namelist declaration
namelist /ageclass/ &
nageclass, &
lage
nageclass=-1 ! preset to negative value to identify failed namelist input
! If age spectra calculation is switched off, set number of age classes
! to 1 and maximum age to a large number
......@@ -56,19 +66,35 @@ subroutine readageclasses
return
endif
! If age spectra claculation is switched on,
! open the AGECLASSSES file and read user options
!************************************************
open(unitageclasses,file=path(1)(1:length(1))//'AGECLASSES', &
status='old',err=999)
open(unitageclasses,file=path(1)(1:length(1))//'AGECLASSES',form='formatted',status='old',err=999)
! try to read in as a namelist
read(unitageclasses,ageclass,iostat=readerror)
close(unitageclasses)
if ((nageclass.lt.0).or.(readerror.ne.0)) then
open(unitageclasses,file=path(1)(1:length(1))//'AGECLASSES',status='old',err=999)
do i=1,13
read(unitageclasses,*)
end do
read(unitageclasses,*) nageclass
read(unitageclasses,*) lage(1)
do i=2,nageclass
read(unitageclasses,*) lage(i)
end do
close(unitageclasses)
endif
! write ageclasses file in namelist format to output directory if requested
if (nmlout.eqv..true.) then
open(unitageclasses,file=path(2)(1:length(2))//'AGECLASSES.namelist',err=1000)
write(unitageclasses,nml=ageclass)
close(unitageclasses)
endif
if (nageclass.gt.maxageclass) then
write(*,*) ' #### FLEXPART MODEL ERROR! NUMBER OF AGE #### '
......@@ -79,7 +105,6 @@ subroutine readageclasses
stop
endif
read(unitageclasses,*) lage(1)
if (lage(1).le.0) then
write(*,*) ' #### FLEXPART MODEL ERROR! AGE OF FIRST #### '
write(*,*) ' #### CLASS MUST BE GREATER THAN ZERO. CHANGE #### '
......@@ -88,7 +113,6 @@ subroutine readageclasses
endif
do i=2,nageclass
read(unitageclasses,*) lage(i)
if (lage(i).le.lage(i-1)) then
write(*,*) ' #### FLEXPART MODEL ERROR! AGE CLASSES #### '
write(*,*) ' #### MUST BE GIVEN IN TEMPORAL ORDER. #### '
......@@ -104,4 +128,10 @@ subroutine readageclasses
write(*,'(a)') path(1)(1:length(1))
stop
1000 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "AGECLASSES" #### '
write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY #### '
write(*,'(a)') path(2)(1:length(2))
stop
end subroutine readageclasses
......@@ -122,8 +122,8 @@ subroutine readavailable
!*********************************************************************
do k=1,numbnests
print*,length(numpath+2*(k-1)+1),length(numpath+2*(k-1)+2),length(4),length(3)
print*,path(numpath+2*(k-1)+2)(1:length(numpath+2*(k-1)+2))
!print*,length(numpath+2*(k-1)+1),length(numpath+2*(k-1)+2),length(4),length(3)
!print*,path(numpath+2*(k-1)+2)(1:length(numpath+2*(k-1)+2))
open(unitavailab,file=path(numpath+2*(k-1)+2) &
(1:length(numpath+2*(k-1)+2)),status='old',err=998)
......
......@@ -28,6 +28,8 @@ subroutine readcommand
! Author: A. Stohl *
! *
! 18 May 1996 *
! HSO, 1 July 2014 *
! Added optional namelist input *
! *
!*****************************************************************************
! *
......@@ -79,7 +81,6 @@ subroutine readcommand
real(kind=dp) :: juldate
character(len=50) :: line
logical :: old
logical :: nml_COMMAND=.true. , nmlout=.true. !.false.
integer :: readerror
namelist /command/ &
......@@ -110,7 +111,7 @@ subroutine readcommand
surf_only
! Presetting namelist command
ldirect=1
ldirect=0
ibdate=20000101
ibtime=0
iedate=20000102
......@@ -141,46 +142,16 @@ subroutine readcommand
! Open the command file and read user options
! Namelist input first: try to read as namelist file
!**************************************************************************
open(unitcommand,file=path(1)(1:length(1))//'COMMAND',status='old', &
form='formatted',iostat=readerror)
! If fail, check if file does not exist
if (readerror.ne.0) then
print*,'***ERROR: file COMMAND not found in '
print*, path(1)(1:length(1))//'COMMAND'
print*, 'Check your pathnames file.'
stop
endif
! print error code
!write(*,*) 'readcommand > readerror open=' , readerror
!probe first line
read (unitcommand,901) line
!write(*,*) 'index(line,COMMAND) =', index(line,'COMMAND')
open(unitcommand,file=path(1)(1:length(1))//'COMMAND',status='old',form='formatted',err=999)
!default is namelist input
! distinguish namelist from fixed text input
if (index(line,'COMMAND') .eq. 0) then
nml_COMMAND = .false.
!write(*,*) 'COMMAND file does not contain the string COMMAND in the first line'
endif
!write(*,*) 'readcommand > read as namelist? ' , nml_COMMAND
rewind(unitcommand)
! try namelist input (default)
read(unitcommand,command,iostat=readerror)
close(unitcommand)
!write(*,*) 'readcommand > readerror read=' , readerror
! If error in namelist format, try to open with old input code
! if (readerror.ne.0) then
! IP 21/5/2014 the previous line cause the old long format
! to be confused with namelist input
! use text input
if (nml_COMMAND .eqv. .false.) then
! distinguish namelist from fixed text input
if ((readerror.ne.0).or.(ldirect.eq.0)) then ! parse as text file format
open(unitcommand,file=path(1)(1:length(1))//'COMMAND',status='old', &
err=999)
open(unitcommand,file=path(1)(1:length(1))//'COMMAND',status='old', err=999)
! Check the format of the COMMAND file (either in free format,
! or using formatted mask)
......@@ -192,10 +163,10 @@ subroutine readcommand
901 format (a)
if (index(line,'LDIRECT') .eq. 0) then
old = .false.
!write(*,*) 'readcommand old short'
write(*,*) 'COMMAND in old short format, please update to namelist format'
else
old = .true.
!write(*,*) 'readcommand old long'
write(*,*) 'COMMAND in old long format, please update to namelist format'
endif
rewind(unitcommand)
......@@ -205,7 +176,6 @@ subroutine readcommand
call skplin(7,unitcommand)
if (old) call skplin(1,unitcommand)
read(unitcommand,*) ldirect
if (old) call skplin(3,unitcommand)
read(unitcommand,*) ibdate,ibtime
......@@ -264,9 +234,6 @@ subroutine readcommand
open(unitcommand,file=path(2)(1:length(2))//'COMMAND.namelist',err=1000)
write(unitcommand,nml=command)
close(unitcommand)
! open(unitheader,file=path(2)(1:length(2))//'header_nml',status='new',err=999)
! write(unitheader,NML=COMMAND)
!close(unitheader)
endif
ifine=max(ifine,1)
......
......@@ -28,6 +28,8 @@ subroutine readoutgrid
! Author: A. Stohl *
! *
! 4 June 1996 *
! HSO, 1 July 2014
! Added optional namelist input
! *
!*****************************************************************************
! *
......@@ -52,17 +54,42 @@ subroutine readoutgrid
real :: outhelp,xr,xr1,yr,yr1
real,parameter :: eps=1.e-4
! namelist variables
integer, parameter :: maxoutlev=500
integer :: readerror